Write parameter info into procedure info

This commit is contained in:
Eugen Wissner 2024-08-12 00:50:36 +02:00
parent 5e7683af32
commit 38a8d6811c
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
4 changed files with 44 additions and 14 deletions

View File

@ -14,19 +14,26 @@ import Control.Monad.Trans.Reader
import Data.Functor ((<&>)) import Data.Functor ((<&>))
import qualified Language.Elna.AST as AST import qualified Language.Elna.AST as AST
import Language.Elna.Location (Identifier(..)) import Language.Elna.Location (Identifier(..))
import Language.Elna.SymbolTable (Info(..), SymbolTable, builtInSymbolTable) import Language.Elna.SymbolTable
( Info(..)
, ParameterInfo(..)
, SymbolTable
, builtInSymbolTable
)
import qualified Language.Elna.SymbolTable as SymbolTable import qualified Language.Elna.SymbolTable as SymbolTable
import Language.Elna.Types (Type(..)) import Language.Elna.Types (Type(..))
import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad (foldM, unless) import Control.Monad (foldM, unless)
import qualified Data.List.NonEmpty as NonEmpty import qualified Data.List.NonEmpty as NonEmpty
import Data.Foldable (traverse_) import Data.Foldable (traverse_)
import qualified Data.Vector as Vector
data Error data Error
= UndefinedTypeError Identifier = UndefinedTypeError Identifier
| UnexpectedTypeInfoError Info | UnexpectedTypeInfoError Info
| IdentifierAlreadyDefinedError Identifier | IdentifierAlreadyDefinedError Identifier
| UndefinedSymbolError Identifier | UndefinedSymbolError Identifier
| UnexpectedArrayByValue Identifier
deriving (Eq, Show) deriving (Eq, Show)
newtype NameAnalysis a = NameAnalysis newtype NameAnalysis a = NameAnalysis
@ -66,9 +73,12 @@ declaration globalTable (AST.ProcedureDefinition identifier parameters variables
variableInfo <- mapM variableDeclaration variables variableInfo <- mapM variableDeclaration variables
newTable <- either (identifierAlreadyDefinedError . NonEmpty.head) pure newTable <- either (identifierAlreadyDefinedError . NonEmpty.head) pure
$ SymbolTable.fromList $ SymbolTable.fromList
$ parametersInfo <> variableInfo $ fmap parameterToVariableInfo parametersInfo
<> variableInfo
traverse_ (statement globalTable) body traverse_ (statement globalTable) body
enter identifier (ProcedureInfo newTable mempty) globalTable let procedureInfo = ProcedureInfo newTable
$ Vector.fromList parametersInfo
enter identifier procedureInfo globalTable
statement :: SymbolTable -> AST.Statement -> NameAnalysis () statement :: SymbolTable -> AST.Statement -> NameAnalysis ()
statement _ AST.EmptyStatement = pure () statement _ AST.EmptyStatement = pure ()
@ -151,13 +161,29 @@ identifierAlreadyDefinedError = NameAnalysis
variableDeclaration :: AST.VariableDeclaration -> NameAnalysis (Identifier, Info) variableDeclaration :: AST.VariableDeclaration -> NameAnalysis (Identifier, Info)
variableDeclaration (AST.VariableDeclaration identifier typeExpression) variableDeclaration (AST.VariableDeclaration identifier typeExpression)
= (identifier,) . flip VariableInfo False = (identifier,) . VariableInfo False
<$> dataType typeExpression <$> dataType typeExpression
parameter :: AST.Parameter -> NameAnalysis (Identifier, Info) parameter :: AST.Parameter -> NameAnalysis ParameterInfo
parameter (AST.Parameter identifier typeExpression isReferenceParameter') parameter (AST.Parameter identifier typeExpression isReferenceParameter') = do
= (identifier,) . flip VariableInfo isReferenceParameter' parameterType <- dataType typeExpression
<$> 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 :: forall a. SymbolTable -> NameAnalysis a -> NameAnalysis a
withSymbolTable symbolTable' = NameAnalysis withSymbolTable symbolTable' = NameAnalysis

View File

@ -73,6 +73,6 @@ data ParameterInfo = ParameterInfo
data Info data Info
= TypeInfo Type = TypeInfo Type
| VariableInfo Type Bool | VariableInfo Bool Type
| ProcedureInfo SymbolTable (Vector ParameterInfo) | ProcedureInfo SymbolTable (Vector ParameterInfo)
deriving (Eq, Show) deriving (Eq, Show)

View File

@ -125,7 +125,7 @@ expression globalTable = \case
AST.VariableExpression identifier -> do AST.VariableExpression identifier -> do
localLookup <- TypeAnalysis $ asks $ SymbolTable.lookup identifier localLookup <- TypeAnalysis $ asks $ SymbolTable.lookup identifier
case localLookup <|> SymbolTable.lookup identifier globalTable of case localLookup <|> SymbolTable.lookup identifier globalTable of
Just (VariableInfo variableType _) -> pure variableType Just (VariableInfo _ variableType) -> pure variableType
Just anotherInfo -> TypeAnalysis $ lift $ throwE Just anotherInfo -> TypeAnalysis $ lift $ throwE
$ UnexpectedVariableInfoError anotherInfo $ UnexpectedVariableInfoError anotherInfo
Nothing -> TypeAnalysis $ lift $ throwE Nothing -> TypeAnalysis $ lift $ throwE

View File

@ -1,5 +1,6 @@
module Language.Elna.Types module Language.Elna.Types
( Type(..) ( Type(..)
, addressByteSize
, booleanType , booleanType
, intType , intType
) where ) where
@ -8,18 +9,21 @@ import Data.Text (Text)
import Data.Word (Word32) import Data.Word (Word32)
import Language.Elna.Location (showArrayType) import Language.Elna.Location (showArrayType)
addressByteSize :: Int
addressByteSize = 4
data Type data Type
= PrimitiveType Text = PrimitiveType Text Int
| ArrayType Word32 Type | ArrayType Word32 Type
deriving Eq deriving Eq
instance Show Type instance Show Type
where where
show (PrimitiveType typeName) = show typeName show (PrimitiveType typeName _) = show typeName
show (ArrayType elementCount typeName) = showArrayType elementCount typeName show (ArrayType elementCount typeName) = showArrayType elementCount typeName
intType :: Type intType :: Type
intType = PrimitiveType "int" intType = PrimitiveType "int" 4
booleanType :: Type booleanType :: Type
booleanType = PrimitiveType "boolean" booleanType = PrimitiveType "boolean" 1