Further work on propagating types. Now it hopefully works fully, just need to annotate namespace with types first.
module PascalUnitSyntaxTree where
import Data.Maybe
import Data.Char
data PascalUnit =
Program Identifier Implementation Phrase
| Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
| System [TypeVarDeclaration]
deriving Show
data Interface = Interface Uses TypesAndVars
deriving Show
data Implementation = Implementation Uses TypesAndVars
deriving Show
data Identifier = Identifier String BaseType
deriving Show
data TypesAndVars = TypesAndVars [TypeVarDeclaration]
deriving Show
data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
| VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
| FunctionDeclaration Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
| OperatorDeclaration String Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
deriving Show
data TypeDecl = SimpleType Identifier
| RangeType Range
| Sequence [Identifier]
| ArrayDecl (Maybe Range) TypeDecl
| RecordType [TypeVarDeclaration] (Maybe [[TypeVarDeclaration]])
| PointerTo TypeDecl
| String Integer
| Set TypeDecl
| FunctionType TypeDecl [TypeVarDeclaration]
| DeriveType InitExpression
| UnknownType
deriving Show
data Range = Range Identifier
| RangeFromTo InitExpression InitExpression
deriving Show
data Initialize = Initialize String
deriving Show
data Finalize = Finalize String
deriving Show
data Uses = Uses [Identifier]
deriving Show
data Phrase = ProcCall Reference [Expression]
| IfThenElse Expression Phrase (Maybe Phrase)
| WhileCycle Expression Phrase
| RepeatCycle Expression [Phrase]
| ForCycle Identifier Expression Expression Phrase
| WithBlock Reference Phrase
| Phrases [Phrase]
| SwitchCase Expression [([InitExpression], Phrase)] (Maybe [Phrase])
| Assignment Reference Expression
| NOP
deriving Show
data Expression = Expression String
| BuiltInFunCall [Expression] Reference
| PrefixOp String Expression
| PostfixOp String Expression
| BinOp String Expression Expression
| StringLiteral String
| CharCode String
| HexCharCode String
| NumberLiteral String
| FloatLiteral String
| HexNumber String
| Reference Reference
| SetExpression [Identifier]
| Null
deriving Show
data Reference = ArrayElement [Expression] Reference
| FunCall [Expression] Reference
| TypeCast Identifier Expression
| SimpleReference Identifier
| Dereference Reference
| RecordField Reference Reference
| Address Reference
| RefExpression Expression
deriving Show
data InitExpression = InitBinOp String InitExpression InitExpression
| InitPrefixOp String InitExpression
| InitReference Identifier
| InitArray [InitExpression]
| InitRecord [(Identifier, InitExpression)]
| InitFloat String
| InitNumber String
| InitHexNumber String
| InitString String
| InitChar String
| BuiltInFunction String [InitExpression]
| InitSet [InitExpression]
| InitAddress InitExpression
| InitNull
| InitRange Range
| InitTypeCast Identifier InitExpression
deriving Show
data BaseType = BTUnknown
| BTChar
| BTString
| BTInt
| BTRecord [(String, BaseType)]
| BTArray BaseType BaseType
| BTFunction
| BTPointerTo BaseType
| BTSet
| BTEnum [String]
| BTVoid
deriving Show
{--
type2BaseType :: TypeDecl -> BaseType
type2BaseType st@(SimpleType (Identifier s _)) = f (map toLower s)
where
f "longint" = BTInt
f "integer" = BTInt
f "word" = BTInt
f "pointer" = BTPointerTo BTVoid
f _ = error $ show st
type2BaseType (Sequence ids) = BTEnum $ map (\(Identifier i _) -> i) ids
type2BaseType (RecordType tv mtvs) = BTRecord $ concatMap f (concat $ tv : fromMaybe [] mtvs)
where
f (VarDeclaration _ (ids, td) _) = map (\(Identifier i _) -> (i, type2BaseType td)) ids
type2BaseType (PointerTo t) = BTPointerTo $ type2BaseType t
type2BaseType a = error $ show a
--}