Tidy up

1 files changed, 23 insertions, 28 deletions

diff --git a/src/Micro/Compiler.hs b/src/Micro/Compiler.hs
index bd01b12..70ce82c 100644
--- a/src/Micro/Compiler.hs
+++ b/src/Micro/Compiler.hs
@@ -7,7 +7,8 @@ where
 
 import Control.Arrow (ArrowChoice (left))
 import Control.Monad.State
-import Data.Maybe (catMaybes, fromMaybe, isNothing)
+import Data.Foldable (traverse_)
+import Data.Maybe (isNothing, mapMaybe)
 import Micro.Asm.Sdcc (generate)
 import qualified Micro.Ast as A
 import Micro.Env
@@ -30,38 +31,36 @@ startState = CompState emptyEnv []
 -- returns either, returning accumulated right and the collected lefts as a
 -- list.
 foldlEither :: (accr -> b -> Either accl accr) -> (accr, [accl]) -> [b] -> (accr, [accl])
-foldlEither fn init xs =
+foldlEither fn =
   foldl
     ( \(r, l) x -> case fn r x of
         Left e -> (r, e : l)
         Right x -> (x, l)
     )
-    init
-    xs
 
 -- | @addError error@ adds @error@ to the state and returns no type to allow
 -- the compilation to continue.
 addError :: Error -> State CompState (Maybe A.Type)
 addError e = do
   modify $ \st -> st {stErr = e : stErr st}
-  pure $ Nothing
+  pure Nothing
 
 -- | @typecheckCall args params@ resolves @args@ and compares it with @params@,
 -- returning a string describing an error or Nothing in case of type match.
 typecheckCall :: [A.Expr] -> [A.Type] -> State CompState (Maybe String)
 typecheckCall args params
   | length args /= length params = return $ Just "invalid number of arguments in function call"
-  | length params == 0 = pure Nothing
+  | null params = pure Nothing
   | otherwise = do
       -- resolve all args types
       targs <- traverse compileOne args
       case sequence targs of
         Just t
           -- after resolution, we could have less "rights"
-          | length t /= length params -> return $ Nothing
+          | length t /= length params -> pure Nothing
           -- compare types
-          | all (\(a, b) -> a == b) $ zip t params ->
-              return $ Nothing -- all good!
+          | all (uncurry (==)) $ zip t params ->
+              pure Nothing -- all good!
           | otherwise -> return $ Just ("type mismatch in function call\n     found: " ++ A.showList t ++ "\n  expected: " ++ A.showList params)
         Nothing ->
           -- there was an error in on argument
@@ -85,22 +84,18 @@ types = ["bool", "u8", "s8", "u16", "s16"]
 definedType :: A.Type -> Bool
 definedType (A.Type t) = t `elem` types
 definedType (A.FuncType ts r) =
-  all definedType ts && fromMaybe False (fmap definedType r)
+  all definedType ts && maybe False definedType r
 
 verifyFuncType :: String -> [A.FuncParam] -> Maybe A.Type -> SourcePos -> [Error]
 verifyFuncType ident params ret pos = do
-  ( catMaybes $
-      map
-        ( \(_, t, _, pos) ->
-            if not (definedType t)
-              then Just $ Error UndefinedType ("undefined type in declaration of \"" ++ ident ++ "\"") pos
-              else Nothing
-        )
-        params
+  mapMaybe
+    ( \(_, t, _, pos) ->
+        if not (definedType t)
+          then Just $ Error UndefinedType ("undefined type in declaration of \"" ++ ident ++ "\"") pos
+          else Nothing
     )
-    ++ if not (fromMaybe True (fmap definedType ret))
-      then [Error UndefinedType ("undefined return type in \"" ++ ident ++ "\"") pos]
-      else []
+    params
+    ++ [Error UndefinedType ("undefined return type in \"" ++ ident ++ "\"") pos | not (maybe True definedType ret)]
 
 compileOne :: A.Expr -> State CompState (Maybe A.Type)
 compileOne x = do
@@ -123,14 +118,14 @@ compileOne x = do
       -- current env
       st <- get
       -- check for undefined types
-      (ev, errs) <- return (stEnv st, (verifyFuncType ident params ret pos) ++ stErr st)
+      (ev, errs) <- return (stEnv st, verifyFuncType ident params ret pos ++ stErr st)
       -- updated with the function
       (ev, errs) <-
         return $ case addSymUniq ev (Sym ident ftype priv False pos) of
           Left err -> (ev, err : errs)
           Right ev -> (ev, errs)
       -- lambdas can only access local variables (closures aren't supported)
-      fev <- return $ if anon then emptyEnv else ev
+      let fev = if anon then emptyEnv else ev
       -- with parameters
       (nev, errs) <- return $ foldlEither addSymUniq (addEnv fev, errs) $ map (toSym True) params
       -- helper for return
@@ -169,7 +164,7 @@ compileOne x = do
           case value of
             Nothing ->
               if isNothing rtyp
-                then pure $ Nothing
+                then pure Nothing
                 else addError $ Error TypeError ("invalid return value\n     found: ()\n  expected: " ++ showMaybeType rtyp) pos
             Just v -> do
               r <- compileOne v
@@ -196,7 +191,7 @@ foldConstant x =
       fa <- foldConstant a
       fb <- foldConstant b
       let newOp = A.BinOp op pos fa fb
-      if newOp /= x then foldConstant newOp else Right $ newOp
+      if newOp /= x then foldConstant newOp else Right newOp
     (A.Func ident params ret body priv anon pos) -> do
       fbody <- traverse foldConstant body
       Right $ A.Func ident params ret fbody priv anon pos
@@ -214,7 +209,7 @@ foldConstant x =
 
 compileAll :: [A.Expr] -> State CompState (Either [Error] SymMap)
 compileAll ast = do
-  _ <- traverse compileOne ast
+  traverse_ compileOne ast
   st <- get
   let (Env sym _) = stEnv st
   let errs = stErr st
@@ -225,10 +220,10 @@ compileAll ast = do
 compileToAst :: [A.Expr] -> Either [Error] [A.Expr]
 compileToAst ast = do
   _ <- evalState (compileAll ast) startState
-  left (\e -> [e]) $ traverse foldConstant ast
+  left (: []) $ traverse foldConstant ast
 
 compile :: [A.Expr] -> Either [Error] String
 compile ast = do
   _ <- evalState (compileAll ast) startState
-  fast <- left (\e -> [e]) $ traverse foldConstant ast
+  fast <- left (: []) $ traverse foldConstant ast
   return $ generate version fast