aboutsummaryrefslogtreecommitdiff
path: root/src/Compiler.hs
diff options
context:
space:
mode:
authorJuan J. Martinez <jjm@usebox.net>2022-08-13 07:51:47 +0100
committerJuan J. Martinez <jjm@usebox.net>2022-08-13 07:51:47 +0100
commitd1fc24d2f17ca1649717c76a130db3869b6abc88 (patch)
tree3c02146890c46e264ff2e0bca0529750b45b6737 /src/Compiler.hs
parenta41685b320d9b5e6aa18fc630c3d5e9479195e79 (diff)
downloadmicro-lang-hs-d1fc24d2f17ca1649717c76a130db3869b6abc88.tar.gz
micro-lang-hs-d1fc24d2f17ca1649717c76a130db3869b6abc88.zip
Split in modules
Diffstat (limited to 'src/Compiler.hs')
-rw-r--r--src/Compiler.hs72
1 files changed, 3 insertions, 69 deletions
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