diff --git a/TODO b/TODO index 41aee95..b165159 100644 --- a/TODO +++ b/TODO @@ -9,3 +9,9 @@ - Don't ignore relocations where the symbol is not defined in the symbol table. Report an error about an undefined symbol. - Don't hardcode symbols in symbolEntry. + +# Name analysis + +- Format error messages. +- Name analyzer collects procedure names in the first run. Implement the second run, + where the analyzer goes into and checks procedures. diff --git a/lib/Language/Elna/NameAnalysis.hs b/lib/Language/Elna/NameAnalysis.hs index 78b3ce4..0ef702d 100644 --- a/lib/Language/Elna/NameAnalysis.hs +++ b/lib/Language/Elna/NameAnalysis.hs @@ -1,39 +1,23 @@ module Language.Elna.NameAnalysis ( nameAnalysis - -- , Error(..) + , Error(..) ) where +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Vector as Vector +import qualified Language.Elna.SymbolTable as SymbolTable import qualified Language.Elna.AST as AST import Language.Elna.SymbolTable ( SymbolTable - , empty - --, Info(..) - -- , ParameterInfo(..) + , Info(..) + , ParameterInfo(..) ) - -nameAnalysis :: AST.Program -> SymbolTable -- Either Error SymbolTable -nameAnalysis = const empty {- runExcept - . flip runReaderT builtInSymbolTable - . runNameAnalysis - . program -} -{- import Control.Monad.Trans.Except (Except, runExcept, throwE) -import Control.Monad.Trans.Reader - ( ReaderT(..) - , ask - , asks - , runReaderT - , withReaderT - ) import Data.Functor ((<&>)) import Language.Elna.Location (Identifier(..)) -import qualified Language.Elna.SymbolTable as SymbolTable import Language.Elna.Types (Type(..)) -import Control.Monad.Trans.Class (MonadTrans(..)) -import Control.Monad (foldM, unless) -import qualified Data.List.NonEmpty as NonEmpty import Data.Foldable (traverse_) -import qualified Data.Vector as Vector +import Control.Monad (foldM) data Error = UndefinedTypeError Identifier @@ -44,7 +28,7 @@ data Error deriving (Eq, Show) newtype NameAnalysis a = NameAnalysis - { runNameAnalysis :: ReaderT SymbolTable (Except Error) a + { runNameAnalysis :: Except Error a } instance Functor NameAnalysis @@ -60,30 +44,77 @@ instance Monad NameAnalysis where (NameAnalysis x) >>= f = NameAnalysis $ x >>= (runNameAnalysis . f) -program :: AST.Program -> NameAnalysis SymbolTable -program (AST.Program declarations) - = NameAnalysis ask - >>= flip (foldM declaration) declarations +nameAnalysis :: AST.Program -> Either Error SymbolTable +nameAnalysis = runExcept + . runNameAnalysis + . program SymbolTable.builtInSymbolTable +program :: SymbolTable -> AST.Program -> NameAnalysis SymbolTable +program symbolTable (AST.Program declarations) = do + globalTable <- foldM procedureDeclaration symbolTable declarations + foldM declaration globalTable declarations + +procedureDeclaration :: SymbolTable -> AST.Declaration -> NameAnalysis SymbolTable +procedureDeclaration globalTable (AST.ProcedureDeclaration identifier parameters _ _) = do + parametersInfo <- mapM (parameter globalTable) parameters + let procedureInfo = ProcedureInfo SymbolTable.empty + $ Vector.fromList parametersInfo + maybe (NameAnalysis $ throwE $ IdentifierAlreadyDefinedError identifier) pure + $ SymbolTable.enter identifier procedureInfo globalTable + 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 - parametersInfo <- mapM parameter parameters - variableInfo <- mapM variableDeclaration variables - newTable <- either (identifierAlreadyDefinedError . NonEmpty.head) pure - $ SymbolTable.fromList - $ fmap parameterToVariableInfo parametersInfo - <> variableInfo - traverse_ (statement globalTable) body - let procedureInfo = ProcedureInfo newTable - $ Vector.fromList parametersInfo - enter identifier procedureInfo globalTable +declaration globalTable (AST.ProcedureDeclaration identifier parameters variables body) = do + variableInfo <- mapM (variableDeclaration globalTable) variables + parameterInfo <- mapM (parameterToVariableInfo globalTable) parameters + procedureTable <- fmap (SymbolTable.scope globalTable) + $ either (NameAnalysis . throwE . IdentifierAlreadyDefinedError . NonEmpty.head) pure + $ SymbolTable.fromList + $ parameterInfo <> variableInfo + traverse_ (statement procedureTable) body + pure $ SymbolTable.update (updater procedureTable) identifier globalTable + where + updater procedureTable (ProcedureInfo _ parameters') = Just + $ ProcedureInfo procedureTable parameters' + updater _ _ = Nothing + +parameterToVariableInfo :: SymbolTable -> AST.Parameter -> NameAnalysis (Identifier, Info) +parameterToVariableInfo symbolTable (AST.Parameter identifier typeExpression isReferenceParameter') + = (identifier,) . VariableInfo isReferenceParameter' + <$> dataType symbolTable typeExpression + +variableDeclaration :: SymbolTable -> AST.VariableDeclaration -> NameAnalysis (Identifier, Info) +variableDeclaration globalTable (AST.VariableDeclaration identifier typeExpression) + = (identifier,) . VariableInfo False + <$> dataType globalTable typeExpression + +parameter :: SymbolTable -> AST.Parameter -> NameAnalysis ParameterInfo +parameter environmentSymbolTable (AST.Parameter identifier typeExpression isReferenceParameter') = do + parameterType <- dataType environmentSymbolTable typeExpression + case parameterType of + ArrayType _ _ + | not isReferenceParameter' -> NameAnalysis + $ throwE $ UnexpectedArrayByValue identifier + _ -> + let parameterInfo = ParameterInfo + { name = identifier + , type' = parameterType + , isReferenceParameter = isReferenceParameter' + } + in pure parameterInfo + +dataType :: SymbolTable -> AST.TypeExpression -> NameAnalysis Type +dataType environmentSymbolTable (AST.NamedType baseType) = do + case SymbolTable.lookup baseType environmentSymbolTable of + Just baseInfo + | TypeInfo baseType' <- baseInfo -> pure baseType' + | otherwise -> NameAnalysis $ throwE $ UnexpectedTypeInfoError baseInfo + _ -> NameAnalysis $ throwE $ UndefinedTypeError baseType +dataType environmentSymbolTable (AST.ArrayType arraySize baseType) = + dataType environmentSymbolTable baseType <&> ArrayType arraySize statement :: SymbolTable -> AST.Statement -> NameAnalysis () statement _ AST.EmptyStatement = pure () -statement globalTable (AST.AssignmentStatement lvalue rvalue) +{- statement globalTable (AST.AssignmentStatement lvalue rvalue) = variableAccess globalTable lvalue >> expression globalTable rvalue statement globalTable (AST.IfStatement ifCondition ifStatement elseStatement) @@ -170,41 +201,4 @@ variableDeclaration :: AST.VariableDeclaration -> NameAnalysis (Identifier, Info variableDeclaration (AST.VariableDeclaration identifier typeExpression) = (identifier,) . VariableInfo False <$> dataType typeExpression - -parameter :: AST.Parameter -> NameAnalysis ParameterInfo -parameter (AST.Parameter identifier typeExpression isReferenceParameter') = do - parameterType <- dataType typeExpression - case parameterType of - ArrayType _ _ - | not isReferenceParameter' -> NameAnalysis - $ lift $ throwE $ UnexpectedArrayByValue identifier - _ -> - let parameterInfo = ParameterInfo - { name = identifier - , type' = parameterType - , isReferenceParameter = isReferenceParameter' - } - in pure parameterInfo - -parameterToVariableInfo :: ParameterInfo -> (Identifier, Info) -parameterToVariableInfo ParameterInfo{..} = - ( name - , VariableInfo isReferenceParameter type' - ) - -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 ask - case SymbolTable.lookup baseType environmentSymbolTable of - Just baseInfo - | TypeInfo baseType' <- baseInfo -> pure 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 c8406fc..52b8542 100644 --- a/lib/Language/Elna/SymbolTable.hs +++ b/lib/Language/Elna/SymbolTable.hs @@ -1,64 +1,72 @@ module Language.Elna.SymbolTable ( SymbolTable - , empty - {-, Info(..) + , Info(..) , ParameterInfo(..) , builtInSymbolTable + , empty , enter , fromList , lookup - , member -} + , member + , scope + , toMap + , update ) where -data SymbolTable = SymbolTable -- (HashMap Identifier Info) - deriving (Eq, Show) - -empty :: SymbolTable -empty = SymbolTable -- HashMap.empty - -{- import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.List (sort) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty +import Data.Maybe (isJust) import Data.Vector (Vector) import Language.Elna.Location (Identifier(..)) import Language.Elna.Types (Type(..), intType, booleanType) import Prelude hiding (lookup) -instance Semigroup SymbolTable - where - (SymbolTable lhs) <> (SymbolTable rhs) = SymbolTable $ rhs <> lhs +data SymbolTable = SymbolTable (Maybe SymbolTable) (HashMap Identifier Info) + deriving (Eq, Show) -instance Monoid SymbolTable - where - mempty = empty +empty :: SymbolTable +empty = SymbolTable Nothing HashMap.empty + +update :: (Info -> Maybe Info) -> Identifier -> SymbolTable -> SymbolTable +update updater key (SymbolTable parent mappings) = SymbolTable parent + $ HashMap.update updater key mappings + +scope :: SymbolTable -> SymbolTable -> SymbolTable +scope parent (SymbolTable _ mappings) = SymbolTable (Just parent) mappings builtInSymbolTable :: SymbolTable -builtInSymbolTable = SymbolTable $ HashMap.fromList +builtInSymbolTable = SymbolTable Nothing $ HashMap.fromList [ ("boolean", TypeInfo booleanType) , ("int", TypeInfo intType) ] +toMap :: SymbolTable -> HashMap Identifier Info +toMap (SymbolTable _ map') = map' + enter :: Identifier -> Info -> SymbolTable -> Maybe SymbolTable -enter identifier info table@(SymbolTable hashTable) +enter identifier info table@(SymbolTable parent hashTable) | member identifier table = Nothing | otherwise = Just - $ SymbolTable - $ HashMap.insert identifier info hashTable + $ SymbolTable parent (HashMap.insert identifier info hashTable) lookup :: Identifier -> SymbolTable -> Maybe Info -lookup identifier (SymbolTable table) = HashMap.lookup identifier table +lookup identifier (SymbolTable parent table) + | Just found <- HashMap.lookup identifier table = Just found + | Just parent' <- parent = lookup identifier parent' + | otherwise = Nothing member :: Identifier -> SymbolTable -> Bool -member identifier (SymbolTable table) = HashMap.member identifier table +member identifier table = + isJust $ lookup identifier table fromList :: [(Identifier, Info)] -> Either (NonEmpty Identifier) SymbolTable fromList elements | Just identifierDuplicates' <- identifierDuplicates = Left identifierDuplicates' - | otherwise = Right $ SymbolTable $ HashMap.fromList elements + | otherwise = Right $ SymbolTable Nothing $ HashMap.fromList elements where identifierDuplicates = NonEmpty.nonEmpty $ fmap NonEmpty.head @@ -77,4 +85,3 @@ data Info | VariableInfo Bool Type | ProcedureInfo SymbolTable (Vector ParameterInfo) deriving (Eq, Show) --} diff --git a/src/Main.hs b/src/Main.hs index 646d967..a993e98 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -25,11 +25,13 @@ main = execParser commandLine >>= withCommandLine >>= withParsedInput defaultOutput . runParser programP input withParsedInput output (Right program) = - let symbolTable = nameAnalysis program - _ = typeAnalysis symbolTable program - intermediate' = intermediate symbolTable program - in elfObject output - $ riscv32Elf - $ generateCode symbolTable intermediate' + either print (withSymbolTable output program) + $ nameAnalysis program withParsedInput _ (Left errorBundle) = putStrLn $ errorBundlePretty errorBundle + withSymbolTable output program symbolTable = + let _ = typeAnalysis symbolTable program + intermediate' = intermediate symbolTable program + instructions = generateCode symbolTable intermediate' + in elfObject output + $ riscv32Elf instructions