diff options
author | Juan J. Martinez <jjm@usebox.net> | 2022-09-10 15:12:54 +0100 |
---|---|---|
committer | Juan J. Martinez <jjm@usebox.net> | 2022-09-10 15:12:54 +0100 |
commit | 22c9414d07e6514fd0329fbceb3132766beb3cda (patch) | |
tree | 37e462e918ca93c176290c8969ae479e56f1ec47 | |
parent | 94edc33c318f60cd7de3ae8537df6eb269fc9deb (diff) | |
download | micro-lang-hs-22c9414d07e6514fd0329fbceb3132766beb3cda.tar.gz micro-lang-hs-22c9414d07e6514fd0329fbceb3132766beb3cda.zip |
Use a record for state
-rw-r--r-- | src/Micro/Compiler.hs | 41 |
1 files changed, 24 insertions, 17 deletions
diff --git a/src/Micro/Compiler.hs b/src/Micro/Compiler.hs index de5728a..1b17794 100644 --- a/src/Micro/Compiler.hs +++ b/src/Micro/Compiler.hs @@ -11,7 +11,12 @@ import Text.Parsec (SourcePos) version :: String version = "0.1.0" -type CompState = (Env, [Error]) +data CompState = CompState + { stEnv :: Env, + stErr :: [Error], + stAst :: [A.Expr] + } + deriving (Show) data CompResult = CompResult { -- last resolved type @@ -30,7 +35,7 @@ successResult :: String -> CompResult successResult out = CompResult {crLast = Nothing, crExit = Right out} startState :: CompState -startState = (emptyEnv, []) +startState = CompState emptyEnv [] [] -- | @foldlEither fn init xs@ folds left @xs@ applying a function @fn@ that -- returns either, returning accumulated right and the collected lefts as a @@ -49,8 +54,8 @@ foldlEither fn init xs = -- the compilation to continue. addError :: Error -> State CompState CompResult addError e = do - (ev, errs) <- get - put (ev, e : errs) + st <- get + put st {stErr = e : stErr st} pure $ typeResult Nothing -- | @typecheckCall args params@ resolves @args@ and compares it with @params@, @@ -146,9 +151,9 @@ compile x = do typecheckBinOp a b pos (A.Func ident params ret body priv anon pos) -> do -- current env - (ev, errs) <- get + st <- get -- check for undefined types - (ev, errs) <- return $ (ev, (verifyFuncType ident params ret pos) ++ errs) + (ev, errs) <- return $ (stEnv st, (verifyFuncType ident params ret pos) ++ stErr st) -- updated with the function (ev, errs) <- return $ case addSymUniq ev (newSym ident ftype priv False pos) of @@ -160,11 +165,11 @@ compile x = do (nev, errs) <- return $ foldlEither addSymUniq (addEnv fev, errs) $ map (toSym True) params -- helper for return nev <- return $ addSym nev $ newSym "$fn$" ftype True True pos - put (nev, errs) + put st {stEnv = nev, stErr = errs} _ <- compileAll body - (_, errs) <- get + st <- get -- store updated errors and the env with the function - put (ev, errs) + put st {stEnv = ev, stErr = errs} return $ typeResult $ Just ftype where ftype = A.toFuncType params ret @@ -178,21 +183,21 @@ compile x = do Nothing -> return $ typeResult rtyp _ -> addError $ Error NonCallable "non callable value in function call" pos (A.Var ident typ val priv pos) -> do - (ev, errs) <- get - (ev, errs) <- return $ foldlEither addSymUniq (ev, errs) [newSym ident typ priv True pos] + st <- get + (ev, errs) <- return $ foldlEither addSymUniq (stEnv st, stErr st) [newSym ident typ priv True pos] errs <- return $ if not (definedType typ) then Error UndefinedType ("undefined type in declaration \"" ++ ident ++ "\"") pos : errs else errs - put (ev, errs) + put st {stEnv = ev, stErr = errs} vt <- typecheckVal val $ Just typ case vt of Just err -> addError $ Error TypeError err pos Nothing -> return $ typeResult $ Just typ (A.Return value pos) -> do - (ev, _) <- get - case getSyml ev "$fn$" of + st <- get + case getSyml (stEnv st) "$fn$" of Just Sym {symType = A.FuncType _ rtyp} -> do r <- typecheckReturn value rtyp case r of @@ -200,15 +205,17 @@ compile x = do Nothing -> return $ typeResult rtyp _ -> addError $ Error UnexpectedReturn "return without function call" pos (A.Variable ident pos) -> do - (ev, _) <- get - case getSym ev ident of + st <- get + case getSym (stEnv st) ident of Just Sym {symType = t} -> return $ typeResult $ Just t Nothing -> addError $ Error Undefined ("undefined \"" ++ ident ++ "\"") pos compileAll :: [A.Expr] -> State CompState CompResult compileAll ast = do _ <- traverse compile ast - ((Env sym _), errs) <- get + st <- get + let (Env sym _) = stEnv st + let errs = stErr st case errs of [] -> pure $ successResult $ generate version sym ast _ -> return $ errorResult errs |