tools/PascalUnitSyntaxTree.hs
changeset 6626 a447993f2ad7
parent 6618 2d3232069c4b
child 6635 c2fa29fe2a58
equal deleted inserted replaced
6625:2d8c5815292f 6626:a447993f2ad7
     1 module PascalUnitSyntaxTree where
     1 module PascalUnitSyntaxTree where
     2 
     2 
     3 --import Data.Traversable
       
     4 import Data.Maybe
     3 import Data.Maybe
       
     4 import Data.Char
     5 
     5 
     6 data PascalUnit =
     6 data PascalUnit =
     7     Program Identifier Implementation Phrase
     7     Program Identifier Implementation Phrase
     8     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
     8     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
     9     | System [TypeVarDeclaration]
     9     | System [TypeVarDeclaration]
    28     | RecordType [TypeVarDeclaration] (Maybe [[TypeVarDeclaration]])
    28     | RecordType [TypeVarDeclaration] (Maybe [[TypeVarDeclaration]])
    29     | PointerTo TypeDecl
    29     | PointerTo TypeDecl
    30     | String Integer
    30     | String Integer
    31     | Set TypeDecl
    31     | Set TypeDecl
    32     | FunctionType TypeDecl [TypeVarDeclaration]
    32     | FunctionType TypeDecl [TypeVarDeclaration]
       
    33     | DeriveType InitExpression 
    33     | UnknownType
    34     | UnknownType
    34     deriving Show
    35     deriving Show
    35 data Range = Range Identifier
    36 data Range = Range Identifier
    36            | RangeFromTo InitExpression InitExpression
    37            | RangeFromTo InitExpression InitExpression
    37     deriving Show
    38     deriving Show
   106     | BTEnum [String]
   107     | BTEnum [String]
   107     | BTVoid
   108     | BTVoid
   108     deriving Show
   109     deriving Show
   109     
   110     
   110 
   111 
       
   112 {--
   111 type2BaseType :: TypeDecl -> BaseType
   113 type2BaseType :: TypeDecl -> BaseType
   112 type2BaseType (SimpleType (Identifier s _)) = f s
   114 type2BaseType st@(SimpleType (Identifier s _)) = f (map toLower s)
   113     where
   115     where
   114     f "longint" = BTInt
   116     f "longint" = BTInt
   115     f "integer" = BTInt
   117     f "integer" = BTInt
   116     f "word" = BTInt
   118     f "word" = BTInt
   117     f "pointer" = BTPointerTo BTVoid
   119     f "pointer" = BTPointerTo BTVoid
   118     f _ = BTUnknown
   120     f _ = error $ show st
   119 type2BaseType (Sequence ids) = BTEnum $ map (\(Identifier i _) -> i) ids
   121 type2BaseType (Sequence ids) = BTEnum $ map (\(Identifier i _) -> i) ids
   120 type2BaseType (RecordType tv mtvs) = BTRecord $ concatMap f (concat $ tv : fromMaybe [] mtvs)
   122 type2BaseType (RecordType tv mtvs) = BTRecord $ concatMap f (concat $ tv : fromMaybe [] mtvs)
   121     where
   123     where
   122     f (VarDeclaration _ (ids, td) _) = map (\(Identifier i _) -> (i, type2BaseType td)) ids
   124     f (VarDeclaration _ (ids, td) _) = map (\(Identifier i _) -> (i, type2BaseType td)) ids
   123 type2BaseType _ = BTUnknown  
   125 type2BaseType (PointerTo t) = BTPointerTo $ type2BaseType t
   124     
   126 type2BaseType a = error $ show a
       
   127 --}