aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2022-09-10 15:12:54 +0100
committerJuan J. Martinez <jjm@usebox.net>2022-09-10 15:12:54 +0100
commit22c9414d07e6514fd0329fbceb3132766beb3cda (patch)
tree37e462e918ca93c176290c8969ae479e56f1ec47
parent94edc33c318f60cd7de3ae8537df6eb269fc9deb (diff)
downloadmicro-lang-hs-22c9414d07e6514fd0329fbceb3132766beb3cda.tar.gz
micro-lang-hs-22c9414d07e6514fd0329fbceb3132766beb3cda.zip
Use a record for state
-rw-r--r--src/Micro/Compiler.hs41
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