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/Compiler.hs | 72 +++------------------------------------------------------
 1 file changed, 3 insertions(+), 69 deletions(-)

(limited to 'src/Compiler.hs')

diff --git a/src/Compiler.hs b/src/Compiler.hs
index 32dd1ee..fc4d9e6 100644
--- a/src/Compiler.hs
+++ b/src/Compiler.hs
@@ -2,78 +2,12 @@ module Compiler where
 
 import qualified Ast as A
 import Control.Monad.State
-import Data.List (sort)
-import qualified Data.Map as Map
-import Data.Maybe (isJust)
+import Env
+import Error
 import System.Environment (getEnv, getEnvironment)
 import Text.Parsec (ParseError, SourcePos)
 import Text.Read (Lexeme (String))
 
-data Error = Error String SourcePos deriving (Eq)
-
-instance Show Error where
-  show (Error message pos) =
-    "error: " ++ show pos ++ ":\n" ++ message
-
-instance Ord Error where
-  compare (Error _ pos1) (Error _ pos2) = compare pos1 pos2
-
-showErrorList :: [Error] -> String
-showErrorList errs = unlines $ map show (sort errs)
-
-type Sym = (A.Ident, A.Type, SourcePos)
-
-type SymMap = Map.Map A.Ident Sym
-
-data Env = Env SymMap (Maybe Env) deriving (Show)
-
--- 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)
-
 toFuncType :: [A.FuncParam] -> Maybe A.Type -> A.Type
 toFuncType params rtyp =
   A.FuncType (map (\(_, t, _) -> t) params) rtyp
@@ -83,7 +17,7 @@ type CompState = (Env, [Error])
 type CompResult = Either [Error] ()
 
 startState :: CompState
-startState = (Env Map.empty Nothing, [])
+startState = (emptyEnv, [])
 
 compile :: [A.Expr] -> State CompState CompResult
 compile (x : xs) = do
-- 
cgit v1.2.3