diff --git a/TODO b/TODO index 775114d..9862022 100644 --- a/TODO +++ b/TODO @@ -1,3 +1 @@ -# Name analysis - -- Ensure type, procedure, variable and parameter names are unique. +# Type analysis diff --git a/elna.cabal b/elna.cabal index da5e162..6ca8912 100644 --- a/elna.cabal +++ b/elna.cabal @@ -33,6 +33,7 @@ library elna-internal Language.Elna.NameAnalysis Language.Elna.Parser Language.Elna.SymbolTable + Language.Elna.TypeAnalysis Language.Elna.Types build-depends: exceptions ^>= 0.10, diff --git a/lib/Language/Elna/NameAnalysis.hs b/lib/Language/Elna/NameAnalysis.hs index afb040e..57c41b3 100644 --- a/lib/Language/Elna/NameAnalysis.hs +++ b/lib/Language/Elna/NameAnalysis.hs @@ -4,7 +4,13 @@ module Language.Elna.NameAnalysis ) where import Control.Monad.Trans.Except (Except, runExcept, throwE) -import Control.Monad.Trans.Reader (ReaderT(..), ask, runReaderT, withReaderT) +import Control.Monad.Trans.Reader + ( ReaderT(..) + , ask + , asks + , runReaderT + , withReaderT + ) import Data.Functor ((<&>)) import qualified Language.Elna.AST as AST import Language.Elna.Location (Identifier(..)) @@ -12,13 +18,15 @@ import Language.Elna.SymbolTable (Info(..), SymbolTable, builtInSymbolTable) import qualified Language.Elna.SymbolTable as SymbolTable import Language.Elna.Types (Type(..)) import Control.Monad.Trans.Class (MonadTrans(..)) -import Control.Monad (foldM) +import Control.Monad (foldM, unless) import qualified Data.List.NonEmpty as NonEmpty +import Data.Foldable (traverse_) data Error = UndefinedTypeError Identifier | UnexpectedTypeInfoError Info | IdentifierAlreadyDefinedError Identifier + | UndefinedSymbolError Identifier deriving (Eq, Show) newtype NameAnalysis a = NameAnalysis @@ -53,15 +61,83 @@ declaration :: SymbolTable -> AST.Declaration -> NameAnalysis SymbolTable declaration globalTable (AST.TypeDefinition identifier typeExpression) = withSymbolTable globalTable (dataType typeExpression) >>= flip (enter identifier) globalTable . TypeInfo - -declaration globalTable (AST.ProcedureDefinition identifier parameters variables _body) = do +declaration globalTable (AST.ProcedureDefinition identifier parameters variables body) = do parametersInfo <- mapM parameter parameters variableInfo <- mapM variableDeclaration variables newTable <- either (identifierAlreadyDefinedError . NonEmpty.head) pure $ SymbolTable.fromList $ parametersInfo <> variableInfo + traverse_ (statement globalTable) body enter identifier (ProcedureInfo newTable mempty) globalTable +statement :: SymbolTable -> AST.Statement -> NameAnalysis () +statement _ AST.EmptyStatement = pure () +statement globalTable (AST.AssignmentStatement lvalue rvalue) + = expression globalTable lvalue + >> expression globalTable rvalue +statement globalTable (AST.IfStatement condition ifStatement elseStatement) + = expression globalTable condition + >> statement globalTable ifStatement + >> maybe (pure ()) (statement globalTable) elseStatement +statement globalTable (AST.WhileStatement condition loop) + = expression globalTable condition + >> statement globalTable loop +statement globalTable (AST.CompoundStatement statements) = + traverse_ (statement globalTable) statements +statement globalTable (AST.CallStatement name arguments) + = checkSymbol name globalTable + >> traverse_ (expression globalTable) arguments + +checkSymbol :: Identifier -> SymbolTable -> NameAnalysis () +checkSymbol identifier globalTable = + let undefinedSymbolError = NameAnalysis + $ lift + $ throwE + $ UndefinedSymbolError identifier + isDefined = SymbolTable.member identifier globalTable + in NameAnalysis (asks (SymbolTable.member identifier)) + >>= (flip unless undefinedSymbolError . (isDefined ||)) + +expression :: SymbolTable -> AST.Expression -> NameAnalysis () +expression globalTable (AST.VariableExpression identifier) = + checkSymbol identifier globalTable +expression _ (AST.LiteralExpression _) = pure () +expression globalTable (AST.NegationExpression negation) = + expression globalTable negation +expression globalTable (AST.SumExpression lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +expression globalTable (AST.SubtractionExpression lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +expression globalTable (AST.ProductExpression lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +expression globalTable (AST.DivisionExpression lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +expression globalTable (AST.EqualExpression lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +expression globalTable (AST.NonEqualExpression lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +expression globalTable (AST.LessExpression lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +expression globalTable (AST.GreaterExpression lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +expression globalTable (AST.LessOrEqualExpression lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +expression globalTable (AST.GreaterOrEqualExpression lhs rhs) + = expression globalTable lhs + >> expression globalTable rhs +expression globalTable (AST.ArrayExpression arrayExpression indexExpression) + = expression globalTable arrayExpression + >> expression globalTable indexExpression + enter :: Identifier -> Info -> SymbolTable -> NameAnalysis SymbolTable enter identifier info table = maybe (identifierAlreadyDefinedError identifier) pure diff --git a/lib/Language/Elna/TypeAnalysis.hs b/lib/Language/Elna/TypeAnalysis.hs new file mode 100644 index 0000000..9804753 --- /dev/null +++ b/lib/Language/Elna/TypeAnalysis.hs @@ -0,0 +1,39 @@ +module Language.Elna.TypeAnalysis + ( Error(..) + , typeAnalysis + ) where + +import Control.Monad.Trans.Except (Except, runExcept) +import Control.Monad.Trans.Reader (ReaderT, runReaderT) +import qualified Language.Elna.AST as AST +import Language.Elna.SymbolTable (SymbolTable) + +data Error = Error + deriving (Eq, Show) + +newtype TypeAnalysis a = TypeAnalysis + { runTypeAnalysis :: ReaderT SymbolTable (Except Error) a + } + +instance Functor TypeAnalysis + where + fmap f (TypeAnalysis x) = TypeAnalysis $ f <$> x + +instance Applicative TypeAnalysis + where + pure = TypeAnalysis . pure + (TypeAnalysis f) <*> (TypeAnalysis x) = TypeAnalysis $ f <*> x + +instance Monad TypeAnalysis + where + (TypeAnalysis x) >>= f = TypeAnalysis $ x >>= (runTypeAnalysis . f) + +typeAnalysis :: SymbolTable -> AST.Program -> Maybe Error +typeAnalysis globalTable = either Just (const Nothing) + . runExcept + . flip runReaderT globalTable + . runTypeAnalysis + . program + +program :: AST.Program -> TypeAnalysis () +program (AST.Program _declarations) = pure ()