From 87692f1c8c7a4dc48a7bd319a0a0e15070d8e852 Mon Sep 17 00:00:00 2001 From: "Juan J. Martinez" Date: Wed, 21 Dec 2022 22:11:13 +0000 Subject: Tidy up --- src/Micro/Compiler.hs | 51 +++++++++++++++++++++++---------------------------- 1 file changed, 23 insertions(+), 28 deletions(-) (limited to 'src/Micro') 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 -- cgit v1.2.3