Write parameter info into procedure info
This commit is contained in:
parent
5e7683af32
commit
38a8d6811c
lib/Language/Elna
@ -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
|
||||||
|
@ -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)
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user