Add typeExpression to type converter

This commit is contained in:
Eugen Wissner 2024-07-29 08:26:47 +03:00
parent ce7652c618
commit 92990e52f0
5 changed files with 134 additions and 35 deletions

11
TODO
View File

@ -1,4 +1,9 @@
# AST missing
# Name analysis
- Import
- Record and Union initialization
- Collect all global type and procedure definitions.
Give errors if:
- The type is already defined.
- Base type is not defined.
- Circular type reference.
- Check definitions inside procedures.

View File

@ -1,4 +1,4 @@
cabal-version: 3.0
cabal-version: 3.4
name: elna
version: 0.1.0.0
synopsis:
@ -16,13 +16,14 @@ extra-doc-files: TODO README
common warnings
build-depends:
base ^>=4.17.2.1,
base >=4.7 && <5,
megaparsec ^>= 9.6,
text ^>= 2.0
ghc-options: -Wall
default-extensions:
ExplicitForAll,
OverloadedStrings
default-language: GHC2021
library elna-internal
import: warnings
@ -32,9 +33,11 @@ library elna-internal
Language.Elna.NameAnalysis
Language.Elna.Parser
Language.Elna.SymbolTable
Language.Elna.Types
build-depends:
hashable ^>= 1.4.3,
parser-combinators ^>= 1.3,
transformers ^>= 0.6.1,
vector ^>= 0.13.1,
unordered-containers ^>= 0.2.20
hs-source-dirs: lib
@ -43,9 +46,8 @@ executable elna
import: warnings
main-is: Main.hs
build-depends:
elna-internal
elna:elna-internal
hs-source-dirs: src
default-language: GHC2021
test-suite elna-test
import: warnings
@ -58,11 +60,10 @@ test-suite elna-test
ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
build-depends:
elna-internal,
elna:elna-internal,
hspec >= 2.10.9 && < 2.12,
hspec-expectations ^>= 0.8.2,
hspec-megaparsec ^>= 2.2.0,
text
build-tool-depends:
hspec-discover:hspec-discover
default-language: GHC2021

View File

@ -1,3 +1,65 @@
module Language.Elna.NameAnalysis
(
( Error(..)
, nameAnalysis
) where
import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE)
import Control.Monad.Trans.Reader (Reader, ask, runReader)
import Data.Functor ((<&>))
import qualified Language.Elna.AST as AST
import Language.Elna.Location (Identifier(..))
import Language.Elna.SymbolTable (Info(..), SymbolTable, symbolTable)
import qualified Language.Elna.SymbolTable as SymbolTable
import Language.Elna.Types (Type(..))
import Control.Monad.Trans.Class (MonadTrans(..))
data Error
= UndefinedTypeError Identifier
| UnexpectedTypeInfoError Info
deriving (Eq, Show)
newtype NameAnalysis a = NameAnalysis
{ runNameAnalysis :: ExceptT Error (Reader SymbolTable) a
}
instance Functor NameAnalysis
where
fmap f (NameAnalysis x) = NameAnalysis $ f <$> x
instance Applicative NameAnalysis
where
pure x = NameAnalysis $ pure x
(NameAnalysis f) <*> (NameAnalysis x) = NameAnalysis $ f <*> x
instance Monad NameAnalysis
where
(NameAnalysis x) >>= f = NameAnalysis $ x >>= (runNameAnalysis . f)
nameAnalysis :: AST.Program -> Either Error SymbolTable
nameAnalysis = flip runReader symbolTable
. runExceptT
. runNameAnalysis
. program
program :: AST.Program -> NameAnalysis SymbolTable
program (AST.Program declarations) = do
globalDeclarations <- traverse declaration declarations
NameAnalysis $ lift ask
declaration :: AST.Declaration -> NameAnalysis (Identifier, Info)
declaration (AST.TypeDefinition identifier typeExpression) =
(identifier,) . TypeInfo <$> dataType typeExpression
declaration (AST.ProcedureDefinition identifier _parameters _variables _body) = do
environmentSymbolTable <- NameAnalysis $ lift ask
pure (identifier, ProcedureInfo environmentSymbolTable mempty)
dataType :: AST.TypeExpression -> NameAnalysis Type
dataType (AST.NamedType baseType) = do
environmentSymbolTable <- NameAnalysis $ lift ask
case SymbolTable.lookup baseType environmentSymbolTable of
Just baseInfo
| TypeInfo baseType' <- baseInfo -> pure baseType'
| otherwise -> NameAnalysis $ throwE $ UnexpectedTypeInfoError baseInfo
_ -> NameAnalysis $ throwE $ UndefinedTypeError baseType
dataType (AST.ArrayType arraySize baseType) =
dataType baseType <&> ArrayType arraySize

View File

@ -1,37 +1,43 @@
module Language.Elna.SymbolTable
( Info(..)
, ParameterInfo(..)
, SymbolTable(..)
, Type(..)
, booleanType
, intType
, SymbolTable
, enter
, lookup
, symbolTable
) where
import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import qualified Data.HashMap.Strict as HashMap
import Data.Vector (Vector)
import Data.Word (Word32)
import Language.Elna.Location (Identifier(..), showArrayType)
data Type
= PrimitiveType Text
| ArrayType Word32 Type
deriving Eq
instance Show Type
where
show (PrimitiveType typeName) = show typeName
show (ArrayType elementCount typeName) = showArrayType elementCount typeName
intType :: Type
intType = PrimitiveType "int"
booleanType :: Type
booleanType = PrimitiveType "boolean"
import Language.Elna.Location (Identifier(..))
import Language.Elna.Types (Type(..), intType, booleanType)
import Prelude hiding (lookup)
newtype SymbolTable = SymbolTable (HashMap Identifier Info)
deriving (Eq, Show)
instance Semigroup SymbolTable
where
(SymbolTable lhs) <> (SymbolTable rhs) = SymbolTable $ rhs <> lhs
instance Monoid SymbolTable
where
mempty = SymbolTable HashMap.empty
symbolTable :: SymbolTable
symbolTable = SymbolTable $ HashMap.fromList
[ ("boolean", TypeInfo booleanType)
, ("int", TypeInfo intType)
]
enter :: Identifier -> Info -> SymbolTable -> SymbolTable
enter identifier info (SymbolTable table) = SymbolTable
$ HashMap.insert identifier info table
lookup :: Identifier -> SymbolTable -> Maybe Info
lookup identifier (SymbolTable table) = HashMap.lookup identifier table
data ParameterInfo = ParameterInfo
{ name :: Identifier
, type' :: Type

View File

@ -0,0 +1,25 @@
module Language.Elna.Types
( Type(..)
, booleanType
, intType
) where
import Data.Text (Text)
import Data.Word (Word32)
import Language.Elna.Location (showArrayType)
data Type
= PrimitiveType Text
| ArrayType Word32 Type
deriving Eq
instance Show Type
where
show (PrimitiveType typeName) = show typeName
show (ArrayType elementCount typeName) = showArrayType elementCount typeName
intType :: Type
intType = PrimitiveType "int"
booleanType :: Type
booleanType = PrimitiveType "boolean"