From 22c9414d07e6514fd0329fbceb3132766beb3cda Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Sat, 10 Sep 2022 15:12:54 +0100
Subject: Use a record for state

---
 src/Micro/Compiler.hs | 41 ++++++++++++++++++++++++-----------------
 1 file changed, 24 insertions(+), 17 deletions(-)

(limited to 'src/Micro')

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
-- 
cgit v1.2.3