tools/PascalUnitSyntaxTree.hs
author unc0rr
Fri, 03 Feb 2012 14:21:07 +0400
changeset 6618 2d3232069c4b
parent 6512 0df7f6697939
child 6626 a447993f2ad7
permissions -rw-r--r--
Propagate types on identifiers
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
     1
module PascalUnitSyntaxTree where
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
     2
6618
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
     3
--import Data.Traversable
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
     4
import Data.Maybe
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
     5
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
     6
data PascalUnit =
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
     7
    Program Identifier Implementation Phrase
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
     8
    | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
6512
0df7f6697939 "System" unit to help converter
unc0rr
parents: 6489
diff changeset
     9
    | System [TypeVarDeclaration]
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    10
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    11
data Interface = Interface Uses TypesAndVars
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    12
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    13
data Implementation = Implementation Uses TypesAndVars
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    14
    deriving Show
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6467
diff changeset
    15
data Identifier = Identifier String BaseType
6467
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    16
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    17
data TypesAndVars = TypesAndVars [TypeVarDeclaration]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    18
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    19
data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    20
    | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    21
    | FunctionDeclaration Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    22
    | OperatorDeclaration String Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    23
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    24
data TypeDecl = SimpleType Identifier
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    25
    | RangeType Range
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    26
    | Sequence [Identifier]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    27
    | ArrayDecl (Maybe Range) TypeDecl
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    28
    | RecordType [TypeVarDeclaration] (Maybe [[TypeVarDeclaration]])
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    29
    | PointerTo TypeDecl
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    30
    | String Integer
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    31
    | Set TypeDecl
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    32
    | FunctionType TypeDecl [TypeVarDeclaration]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    33
    | UnknownType
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    34
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    35
data Range = Range Identifier
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    36
           | RangeFromTo InitExpression InitExpression
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    37
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    38
data Initialize = Initialize String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    39
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    40
data Finalize = Finalize String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    41
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    42
data Uses = Uses [Identifier]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    43
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    44
data Phrase = ProcCall Reference [Expression]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    45
        | IfThenElse Expression Phrase (Maybe Phrase)
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    46
        | WhileCycle Expression Phrase
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    47
        | RepeatCycle Expression [Phrase]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    48
        | ForCycle Identifier Expression Expression Phrase
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    49
        | WithBlock Reference Phrase
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    50
        | Phrases [Phrase]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    51
        | SwitchCase Expression [([InitExpression], Phrase)] (Maybe [Phrase])
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    52
        | Assignment Reference Expression
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    53
        | NOP
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    54
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    55
data Expression = Expression String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    56
    | BuiltInFunCall [Expression] Reference
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    57
    | PrefixOp String Expression
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    58
    | PostfixOp String Expression
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    59
    | BinOp String Expression Expression
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    60
    | StringLiteral String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    61
    | CharCode String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    62
    | HexCharCode String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    63
    | NumberLiteral String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    64
    | FloatLiteral String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    65
    | HexNumber String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    66
    | Reference Reference
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    67
    | SetExpression [Identifier]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    68
    | Null
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    69
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    70
data Reference = ArrayElement [Expression] Reference
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    71
    | FunCall [Expression] Reference
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    72
    | TypeCast Identifier Expression
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    73
    | SimpleReference Identifier
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    74
    | Dereference Reference
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    75
    | RecordField Reference Reference
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    76
    | Address Reference
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    77
    | RefExpression Expression
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    78
    deriving Show
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    79
data InitExpression = InitBinOp String InitExpression InitExpression
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    80
    | InitPrefixOp String InitExpression
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    81
    | InitReference Identifier
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    82
    | InitArray [InitExpression]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    83
    | InitRecord [(Identifier, InitExpression)]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    84
    | InitFloat String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    85
    | InitNumber String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    86
    | InitHexNumber String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    87
    | InitString String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    88
    | InitChar String
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    89
    | BuiltInFunction String [InitExpression]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    90
    | InitSet [InitExpression]
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    91
    | InitAddress InitExpression
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    92
    | InitNull
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    93
    | InitRange Range
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    94
    | InitTypeCast Identifier InitExpression
090269e528df - Improve parsing of prefix operators
unc0rr
parents:
diff changeset
    95
    deriving Show
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6467
diff changeset
    96
6618
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
    97
data BaseType = BTUnknown
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6467
diff changeset
    98
    | BTChar
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6467
diff changeset
    99
    | BTString
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6467
diff changeset
   100
    | BTInt
6618
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   101
    | BTRecord [(String, BaseType)]
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   102
    | BTArray BaseType BaseType
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6467
diff changeset
   103
    | BTFunction
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6467
diff changeset
   104
    | BTPointerTo BaseType
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6467
diff changeset
   105
    | BTSet
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6467
diff changeset
   106
    | BTEnum [String]
6618
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   107
    | BTVoid
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6467
diff changeset
   108
    deriving Show
6618
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   109
    
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   110
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   111
type2BaseType :: TypeDecl -> BaseType
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   112
type2BaseType (SimpleType (Identifier s _)) = f s
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   113
    where
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   114
    f "longint" = BTInt
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   115
    f "integer" = BTInt
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   116
    f "word" = BTInt
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   117
    f "pointer" = BTPointerTo BTVoid
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   118
    f _ = BTUnknown
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   119
type2BaseType (Sequence ids) = BTEnum $ map (\(Identifier i _) -> i) ids
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   120
type2BaseType (RecordType tv mtvs) = BTRecord $ concatMap f (concat $ tv : fromMaybe [] mtvs)
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   121
    where
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   122
    f (VarDeclaration _ (ids, td) _) = map (\(Identifier i _) -> (i, type2BaseType td)) ids
2d3232069c4b Propagate types on identifiers
unc0rr
parents: 6512
diff changeset
   123
type2BaseType _ = BTUnknown  
6489
e1f0058cfedd Add base type tags to identifiers
unc0rr
parents: 6467
diff changeset
   124