diff options
Diffstat (limited to 'lib/Language')
| -rw-r--r-- | lib/Language/Elna/NameAnalysis.hs | 42 | ||||
| -rw-r--r-- | lib/Language/Elna/SymbolTable.hs | 4 |
2 files changed, 29 insertions, 17 deletions
diff --git a/lib/Language/Elna/NameAnalysis.hs b/lib/Language/Elna/NameAnalysis.hs index abbfb93..49b7915 100644 --- a/lib/Language/Elna/NameAnalysis.hs +++ b/lib/Language/Elna/NameAnalysis.hs @@ -3,8 +3,8 @@ module Language.Elna.NameAnalysis , nameAnalysis ) where -import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE) -import Control.Monad.Trans.Reader (Reader, ask, runReader) +import Control.Monad.Trans.Except (Except, runExcept, throwE) +import Control.Monad.Trans.Reader (ReaderT(..), ask, runReaderT, withReaderT) import Data.Functor ((<&>)) import qualified Language.Elna.AST as AST import Language.Elna.Location (Identifier(..)) @@ -12,6 +12,7 @@ import Language.Elna.SymbolTable (Info(..), SymbolTable, symbolTable) import qualified Language.Elna.SymbolTable as SymbolTable import Language.Elna.Types (Type(..)) import Control.Monad.Trans.Class (MonadTrans(..)) +import Control.Monad (foldM) data Error = UndefinedTypeError Identifier @@ -19,7 +20,7 @@ data Error deriving (Eq, Show) newtype NameAnalysis a = NameAnalysis - { runNameAnalysis :: ExceptT Error (Reader SymbolTable) a + { runNameAnalysis :: ReaderT SymbolTable (Except Error) a } instance Functor NameAnalysis @@ -36,30 +37,37 @@ instance Monad NameAnalysis (NameAnalysis x) >>= f = NameAnalysis $ x >>= (runNameAnalysis . f) nameAnalysis :: AST.Program -> Either Error SymbolTable -nameAnalysis = flip runReader symbolTable - . runExceptT +nameAnalysis = runExcept + . flip runReaderT symbolTable . runNameAnalysis . program program :: AST.Program -> NameAnalysis SymbolTable -program (AST.Program declarations) = do - globalDeclarations <- traverse declaration declarations - NameAnalysis $ lift ask +program (AST.Program declarations) + = NameAnalysis ask + >>= flip (foldM declaration) declarations -declaration :: AST.Declaration -> NameAnalysis (Identifier, Info) -declaration (AST.TypeDefinition identifier typeExpression) = - (identifier,) . TypeInfo <$> dataType typeExpression -declaration (AST.ProcedureDefinition identifier _parameters _variables _body) = do - environmentSymbolTable <- NameAnalysis $ lift ask - pure (identifier, ProcedureInfo environmentSymbolTable mempty) +declaration :: SymbolTable -> AST.Declaration -> NameAnalysis SymbolTable +declaration globalTable (AST.TypeDefinition identifier typeExpression) + = flip (SymbolTable.enter identifier) globalTable . TypeInfo + <$> withSymbolTable globalTable (dataType typeExpression) + +declaration globalTable (AST.ProcedureDefinition identifier _parameters _variables _body) = + let localTable = SymbolTable.empty + in pure $ SymbolTable.enter identifier (ProcedureInfo localTable mempty) globalTable + +withSymbolTable :: forall a. SymbolTable -> NameAnalysis a -> NameAnalysis a +withSymbolTable symbolTable' = NameAnalysis + . withReaderT (const symbolTable') + . runNameAnalysis dataType :: AST.TypeExpression -> NameAnalysis Type dataType (AST.NamedType baseType) = do - environmentSymbolTable <- NameAnalysis $ lift ask + environmentSymbolTable <- NameAnalysis ask case SymbolTable.lookup baseType environmentSymbolTable of Just baseInfo | TypeInfo baseType' <- baseInfo -> pure baseType' - | otherwise -> NameAnalysis $ throwE $ UnexpectedTypeInfoError baseInfo - _ -> NameAnalysis $ throwE $ UndefinedTypeError baseType + | otherwise -> NameAnalysis $ lift $ throwE $ UnexpectedTypeInfoError baseInfo + _ -> NameAnalysis $ lift $ throwE $ UndefinedTypeError baseType dataType (AST.ArrayType arraySize baseType) = dataType baseType <&> ArrayType arraySize diff --git a/lib/Language/Elna/SymbolTable.hs b/lib/Language/Elna/SymbolTable.hs index ba2e41f..f1c6534 100644 --- a/lib/Language/Elna/SymbolTable.hs +++ b/lib/Language/Elna/SymbolTable.hs @@ -2,6 +2,7 @@ module Language.Elna.SymbolTable ( Info(..) , ParameterInfo(..) , SymbolTable + , empty , enter , lookup , symbolTable @@ -31,6 +32,9 @@ symbolTable = SymbolTable $ HashMap.fromList , ("int", TypeInfo intType) ] +empty :: SymbolTable +empty = SymbolTable HashMap.empty + enter :: Identifier -> Info -> SymbolTable -> SymbolTable enter identifier info (SymbolTable table) = SymbolTable $ HashMap.insert identifier info table |
