From d1fc24d2f17ca1649717c76a130db3869b6abc88 Mon Sep 17 00:00:00 2001 From: "Juan J. Martinez" Date: Sat, 13 Aug 2022 07:51:47 +0100 Subject: Split in modules --- src/Compiler.hs | 72 +++------------------------------------------------------ src/Env.hs | 62 +++++++++++++++++++++++++++++++++++++++++++++++++ src/Error.hs | 16 +++++++++++++ src/Main.hs | 1 + 4 files changed, 82 insertions(+), 69 deletions(-) create mode 100644 src/Env.hs create mode 100644 src/Error.hs (limited to 'src') 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 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) diff --git a/src/Error.hs b/src/Error.hs new file mode 100644 index 0000000..96b02dc --- /dev/null +++ b/src/Error.hs @@ -0,0 +1,16 @@ +module Error where + +import Data.List (sort) +import Text.Parsec (SourcePos) + +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) diff --git a/src/Main.hs b/src/Main.hs index e428ba5..0b4325c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -3,6 +3,7 @@ module Main where import Compiler import Control.Monad.State (evalState) import qualified Data.Map as Map +import Error (showErrorList) import Lexer (scan) import Parser (parse, parseFromFile) import System.Exit (exitFailure) -- cgit v1.2.3