From d1fc24d2f17ca1649717c76a130db3869b6abc88 Mon Sep 17 00:00:00 2001
From: "Juan J. Martinez" <jjm@usebox.net>
Date: Sat, 13 Aug 2022 07:51:47 +0100
Subject: Split in modules

---
 src/Env.hs | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 src/Env.hs

(limited to 'src/Env.hs')

diff --git a/src/Env.hs b/src/Env.hs
new file mode 100644
index 0000000..bf81899
--- /dev/null
+++ b/src/Env.hs
@@ -0,0 +1,62 @@
+module Env where
+
+import qualified Ast as A
+import qualified Data.Map as Map
+import Data.Maybe (isJust)
+import Error
+import Text.Parsec (SourcePos)
+
+type Sym = (A.Ident, A.Type, SourcePos)
+
+type SymMap = Map.Map A.Ident Sym
+
+data Env = Env SymMap (Maybe Env) deriving (Show)
+
+emptyEnv = Env Map.empty Nothing
+
+-- first parameter tells if we look on the local environment
+-- or if we should check also in the parent(s)
+getSymB :: Bool -> Env -> A.Ident -> Maybe Sym
+getSymB local (Env m parent) id =
+  case (local, Map.lookup id m) of
+    (False, Nothing) -> do
+      p <- parent
+      getSym p id
+    (_, s) -> s
+
+-- get symbol
+getSym :: Env -> A.Ident -> Maybe Sym
+getSym = getSymB False
+
+-- get symbol local
+getSyml :: Env -> A.Ident -> Maybe Sym
+getSyml = getSymB True
+
+-- if a symbol exists
+existsSym :: Env -> A.Ident -> Bool
+existsSym env sym = isJust $ getSym env sym
+
+-- if a local symbol exists
+existsSyml :: Env -> A.Ident -> Bool
+existsSyml env sym = isJust $ getSyml env sym
+
+-- add symbol
+addSym :: Env -> Sym -> Env
+addSym (Env m parent) (id, typ, pos) = case getSym env id of
+  Nothing -> Env (Map.insert id sym m) parent
+  Just s -> Env (Map.singleton id sym) $ Just env
+  where
+    env = (Env m parent)
+    sym = (id, typ, pos)
+
+-- adds a new local environment
+addEnv :: Env -> Env
+addEnv env = Env Map.empty $ Just env
+
+-- add a local symbol if it doesn't exist
+addSymUniq :: Env -> Sym -> Either Error Env
+addSymUniq ev (id, typ, pos) = case getSyml ev id of
+  Nothing -> Right $ addSym ev sym
+  Just (_, _, p) -> Left $ Error ("\"" ++ id ++ "\" already defined in " ++ show p) pos
+  where
+    sym = (id, typ, pos)
-- 
cgit v1.2.3