From bcc469bc7f1d73e66828637b5b518b7cab8e2781 Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Fri, 9 Sep 2022 16:54:06 +0100
Subject: SDCC generation WIP

---
 src/Micro/Env.hs | 28 ++++++++++++++++++++--------
 1 file changed, 20 insertions(+), 8 deletions(-)

(limited to 'src/Micro/Env.hs')

diff --git a/src/Micro/Env.hs b/src/Micro/Env.hs
index 7259deb..9de7248 100644
--- a/src/Micro/Env.hs
+++ b/src/Micro/Env.hs
@@ -6,7 +6,21 @@ import qualified Micro.Ast as A
 import Micro.Error
 import Text.Parsec (SourcePos)
 
-type Sym = (A.Ident, A.Type, Bool, SourcePos)
+data Sym = Sym
+  { symId :: A.Ident,
+    symType :: A.Type,
+    symPriv :: Bool,
+    symRef :: Bool,
+    symPos :: SourcePos
+  }
+  deriving (Show)
+
+newSym :: A.Ident -> A.Type -> Bool -> Bool -> SourcePos -> Sym
+newSym a b c d e = Sym {symId = a, symType = b, symPriv = c, symRef = d, symPos = e}
+
+-- XXX: this name is not good
+toSym :: Bool -> A.FuncParam -> Sym
+toSym ref (a, b, c, d) = newSym a b c ref d
 
 type SymMap = Map.Map A.Ident Sym
 
@@ -45,9 +59,9 @@ existsSyml env sym = isJust $ getSyml env sym
 -- environment. It will create a new enviroment if the symbol already exists
 -- (shadowing).
 addSym :: Env -> Sym -> Env
-addSym env@(Env m parent) sym@(id, _, _, _) = case getSym env id of
-  Nothing -> Env (Map.insert id sym m) parent
-  Just _ -> Env (Map.singleton id sym) $ Just env
+addSym env@(Env m parent) sym = case getSym env (symId sym) of
+  Nothing -> Env (Map.insert (symId sym) sym m) parent
+  Just _ -> Env (Map.singleton (symId sym) sym) $ Just env
 
 -- | @addEnv e@ adds a new local environment using @e@ as parent.
 addEnv :: Env -> Env
@@ -56,8 +70,6 @@ addEnv env = Env Map.empty $ Just env
 -- | @addSymUniq e s@ adds a local symbol @s@ to the enviroment @e@ if it
 -- doesn't exist.
 addSymUniq :: Env -> Sym -> Either Error Env
-addSymUniq ev (id, typ, priv, pos) = case getSyml ev id of
+addSymUniq ev sym = case getSyml ev (symId sym) of
   Nothing -> Right $ addSym ev sym
-  Just (_, _, _, p) -> Left $ Error AlreadyDefined ("\"" ++ id ++ "\" already defined in " ++ show p) pos
-  where
-    sym = (id, typ, priv, pos)
+  Just other -> Left $ Error AlreadyDefined ("\"" ++ symId sym ++ "\" already defined in " ++ show (symPos other)) $ symPos sym
-- 
cgit v1.2.3