Collect function declaration symbols
This commit is contained in:
parent
c9ff4f0a2a
commit
0a8d3fce2f
GPG Key ID:
A27FDC1E8EE902C0
4
TODO
4
TODO
@ -9,3 +9,7 @@
|
||||
- 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.
|
||||
|
||||
@ -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
|
||||
-}
|
||||
|
||||
@ -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)
|
||||
-}
|
||||
|
||||
14
src/Main.hs
14
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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user