Tidy up

2 files changed, 122 insertions, 127 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
diff --git a/test/Language.hs b/test/Language.hs
index 3e6a898..351e244 100644
--- a/test/Language.hs
+++ b/test/Language.hs
@@ -11,31 +11,31 @@ import Text.Parsec.Pos (newPos)
 
 assertCompileAst :: String -> [A.Expr] -> Assertion
 assertCompileAst input expected = do
-  r <- return $ parseFromString input
+  let r = parseFromString input
   case r of
     Left e -> assertFailure $ show e
     Right ast -> do
-      res <- return $ compileToAst ast
+      let res = compileToAst ast
       case res of
         Left e -> assertFailure $ show e
         Right ast -> assertEqual "" expected ast
 
 assertAst :: String -> [A.Expr] -> Assertion
 assertAst input expected = do
-  r <- return $ parseFromString input
+  let r = parseFromString input
   case r of
     Left e -> assertFailure $ show e
     Right ast -> assertEqual "" expected ast
 
 expectError :: String -> E.ErrorType -> Assertion
 expectError input etyp = do
-  r <- return $ parseFromString input
+  let r = parseFromString input
   case r of
     Left e -> assertFailure $ show e
     Right ast -> do
-      res <- return $ compile ast
+      let res = compile ast
       case res of
-        Left e -> case (find (\(E.Error t _ _) -> t == etyp) e) of
+        Left e -> case find (\(E.Error t _ _) -> t == etyp) e of
           Just _ -> return ()
           Nothing -> assertFailure $ "expected " ++ show etyp ++ " didn't happen, got instead:\n" ++ unlines (map (\(E.Error t _ _) -> show t) e)
         Right _ -> assertFailure "expected error, didn't happen"
@@ -53,115 +53,115 @@ testCases =
           ],
     TestLabel
       "parse a function"
-      $ TestCase $
-        assertAst
-          "module main\n\
-          \def fn() { }"
-          [ A.Module "main" $ newPos "-" 1 1,
-            A.Func "fn" [] Nothing [] False False $ newPos "-" 2 1
-          ],
+      $ TestCase
+      $ assertAst
+        "module main\n\
+        \def fn() { }"
+        [ A.Module "main" $ newPos "-" 1 1,
+          A.Func "fn" [] Nothing [] False False $ newPos "-" 2 1
+        ],
     TestLabel
       "parse a function with parameters"
-      $ TestCase $
-        assertAst
-          "module main\n\
-          \def fn(a: u8) { }"
-          [ A.Module "main" $ newPos "-" 1 1,
-            A.Func "fn" [("a", A.Type "u8", True, newPos "-" 2 8)] Nothing [] False False $ newPos "-" 2 1
-          ],
+      $ TestCase
+      $ assertAst
+        "module main\n\
+        \def fn(a: u8) { }"
+        [ A.Module "main" $ newPos "-" 1 1,
+          A.Func "fn" [("a", A.Type "u8", True, newPos "-" 2 8)] Nothing [] False False $ newPos "-" 2 1
+        ],
     TestLabel
       "parse a function with return value"
-      $ TestCase $
-        assertAst
-          "module main\n\
-          \def fn(): u8 {\n\
-          \return 1; }"
-          [ A.Module "main" $ newPos "-" 1 1,
-            A.Func "fn" [] (Just $ A.Type "u8") [A.Return (Just $ A.Num 1 $ newPos "-" 3 8) $ newPos "-" 3 1] False False $ newPos "-" 2 1
-          ],
+      $ TestCase
+      $ assertAst
+        "module main\n\
+        \def fn(): u8 {\n\
+        \return 1; }"
+        [ A.Module "main" $ newPos "-" 1 1,
+          A.Func "fn" [] (Just $ A.Type "u8") [A.Return (Just $ A.Num 1 $ newPos "-" 3 8) $ newPos "-" 3 1] False False $ newPos "-" 2 1
+        ],
     TestLabel
       "parse a function call"
-      $ TestCase $
-        assertAst
-          "module main\n\
-          \def fn() { }\n\
-          \fn();"
-          [ A.Module "main" $ newPos "-" 1 1,
-            A.Func "fn" [] Nothing [] False False $ newPos "-" 2 1,
-            A.Call (A.Variable "fn" $ newPos "-" 3 1) [] $ newPos "-" 3 1
-          ],
+      $ TestCase
+      $ assertAst
+        "module main\n\
+        \def fn() { }\n\
+        \fn();"
+        [ A.Module "main" $ newPos "-" 1 1,
+          A.Func "fn" [] Nothing [] False False $ newPos "-" 2 1,
+          A.Call (A.Variable "fn" $ newPos "-" 3 1) [] $ newPos "-" 3 1
+        ],
     TestLabel
       "parse a function call with arguments"
-      $ TestCase $
-        assertAst
-          "module main\n\
-          \def fn(a: u8) { }\n\
-          \fn(10);"
-          [ A.Module "main" $ newPos "-" 1 1,
-            A.Func "fn" [("a", A.Type "u8", True, newPos "-" 2 8)] Nothing [] False False $ newPos "-" 2 1,
-            A.Call (A.Variable "fn" $ newPos "-" 3 1) [A.Num 10 $ newPos "-" 3 4] $ newPos "-" 3 1
-          ],
+      $ TestCase
+      $ assertAst
+        "module main\n\
+        \def fn(a: u8) { }\n\
+        \fn(10);"
+        [ A.Module "main" $ newPos "-" 1 1,
+          A.Func "fn" [("a", A.Type "u8", True, newPos "-" 2 8)] Nothing [] False False $ newPos "-" 2 1,
+          A.Call (A.Variable "fn" $ newPos "-" 3 1) [A.Num 10 $ newPos "-" 3 4] $ newPos "-" 3 1
+        ],
     TestLabel
       "parse empty return on a function"
-      $ TestCase $
-        assertAst
-          "module main\n\
-          \def fn() {\n\
-          \return; }"
-          [ A.Module "main" $ newPos "-" 1 1,
-            A.Func "fn" [] Nothing [A.Return Nothing $ newPos "-" 3 1] False False $ newPos "-" 2 1
-          ],
+      $ TestCase
+      $ assertAst
+        "module main\n\
+        \def fn() {\n\
+        \return; }"
+        [ A.Module "main" $ newPos "-" 1 1,
+          A.Func "fn" [] Nothing [A.Return Nothing $ newPos "-" 3 1] False False $ newPos "-" 2 1
+        ],
     TestLabel
       "parse a recursive function"
-      $ TestCase $
-        assertAst
-          "module main\n\
-          \def fn() {\n\
-          \fn(); }"
-          [ A.Module "main" $ newPos "-" 1 1,
-            A.Func "fn" [] Nothing [A.Call (A.Variable "fn" $ newPos "-" 3 1) [] $ newPos "-" 3 1] False False $ newPos "-" 2 1
-          ],
+      $ TestCase
+      $ assertAst
+        "module main\n\
+        \def fn() {\n\
+        \fn(); }"
+        [ A.Module "main" $ newPos "-" 1 1,
+          A.Func "fn" [] Nothing [A.Call (A.Variable "fn" $ newPos "-" 3 1) [] $ newPos "-" 3 1] False False $ newPos "-" 2 1
+        ],
     TestLabel
       "parse a function with a function parameter"
-      $ TestCase $
-        assertAst
-          "module main\n\
-          \def fn1() { }\n\
-          \def fn2(f: ()) {\n\
-          \f(); }\n\
-          \fn2(fn1);"
-          [ A.Module "main" $ newPos "-" 1 1,
-            A.Func "fn1" [] Nothing [] False False $ newPos "-" 2 1,
-            A.Func
-              "fn2"
-              [("f", A.FuncType [] Nothing, True, newPos "-" 3 9)]
-              Nothing
-              [ A.Call (A.Variable "f" $ newPos "-" 4 1) [] $ newPos "-" 4 1
-              ]
-              False
-              False
-              $ newPos "-" 3 1,
-            A.Call (A.Variable "fn2" $ newPos "-" 5 1) [A.Variable "fn1" $ newPos "-" 5 5] $ newPos "-" 5 1
-          ],
+      $ TestCase
+      $ assertAst
+        "module main\n\
+        \def fn1() { }\n\
+        \def fn2(f: ()) {\n\
+        \f(); }\n\
+        \fn2(fn1);"
+        [ A.Module "main" $ newPos "-" 1 1,
+          A.Func "fn1" [] Nothing [] False False $ newPos "-" 2 1,
+          A.Func
+            "fn2"
+            [("f", A.FuncType [] Nothing, True, newPos "-" 3 9)]
+            Nothing
+            [ A.Call (A.Variable "f" $ newPos "-" 4 1) [] $ newPos "-" 4 1
+            ]
+            False
+            False
+            $ newPos "-" 3 1,
+          A.Call (A.Variable "fn2" $ newPos "-" 5 1) [A.Variable "fn1" $ newPos "-" 5 5] $ newPos "-" 5 1
+        ],
     TestLabel
       "parse a function with a function parameter (lambda)"
-      $ TestCase $
-        assertAst
-          "module main\n\
-          \def fn(f: ()) {\n\
-          \f(); }\n\
-          \fn(() { });"
-          [ A.Module "main" $ newPos "-" 1 1,
-            A.Func
-              "fn"
-              [("f", A.FuncType [] Nothing, True, newPos "-" 2 8)]
-              Nothing
-              [A.Call (A.Variable "f" $ newPos "-" 3 1) [] $ newPos "-" 3 1]
-              False
-              False
-              $ newPos "-" 2 1,
-            A.Call (A.Variable "fn" $ newPos "-" 4 1) [A.Func "lambda@4,4" [] Nothing [] True True $ newPos "-" 4 4] $ newPos "-" 4 1
-          ],
+      $ TestCase
+      $ assertAst
+        "module main\n\
+        \def fn(f: ()) {\n\
+        \f(); }\n\
+        \fn(() { });"
+        [ A.Module "main" $ newPos "-" 1 1,
+          A.Func
+            "fn"
+            [("f", A.FuncType [] Nothing, True, newPos "-" 2 8)]
+            Nothing
+            [A.Call (A.Variable "f" $ newPos "-" 3 1) [] $ newPos "-" 3 1]
+            False
+            False
+            $ newPos "-" 2 1,
+          A.Call (A.Variable "fn" $ newPos "-" 4 1) [A.Func "lambda@4,4" [] Nothing [] True True $ newPos "-" 4 4] $ newPos "-" 4 1
+        ],
     TestLabel "parse a call to lambda" $
       TestCase $
         assertAst