summaryrefslogtreecommitdiff
path: root/lib/Language/Elna
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Language/Elna')
-rw-r--r--lib/Language/Elna/NameAnalysis.hs42
-rw-r--r--lib/Language/Elna/SymbolTable.hs4
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