tools/PascalUnitSyntaxTree.hs
changeset 6618 2d3232069c4b
parent 6512 0df7f6697939
child 6626 a447993f2ad7
equal deleted inserted replaced
6617:c61a4f68e6e9 6618:2d3232069c4b
     1 module PascalUnitSyntaxTree where
     1 module PascalUnitSyntaxTree where
     2 
     2 
     3 import Data.Traversable
     3 --import Data.Traversable
       
     4 import Data.Maybe
     4 
     5 
     5 data PascalUnit =
     6 data PascalUnit =
     6     Program Identifier Implementation Phrase
     7     Program Identifier Implementation Phrase
     7     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
     8     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
     8     | System [TypeVarDeclaration]
     9     | System [TypeVarDeclaration]
    91     | InitNull
    92     | InitNull
    92     | InitRange Range
    93     | InitRange Range
    93     | InitTypeCast Identifier InitExpression
    94     | InitTypeCast Identifier InitExpression
    94     deriving Show
    95     deriving Show
    95 
    96 
    96 data BaseType = Unknown
    97 data BaseType = BTUnknown
    97     | BTChar
    98     | BTChar
    98     | BTString
    99     | BTString
    99     | BTInt
   100     | BTInt
   100     | BTRecord
   101     | BTRecord [(String, BaseType)]
   101     | BTArray
   102     | BTArray BaseType BaseType
   102     | BTFunction
   103     | BTFunction
   103     | BTPointerTo BaseType
   104     | BTPointerTo BaseType
   104     | BTSet
   105     | BTSet
   105     | BTEnum [String]
   106     | BTEnum [String]
   106     | Void
   107     | BTVoid
   107     deriving Show
   108     deriving Show
   108     
   109     
       
   110 
       
   111 type2BaseType :: TypeDecl -> BaseType
       
   112 type2BaseType (SimpleType (Identifier s _)) = f s
       
   113     where
       
   114     f "longint" = BTInt
       
   115     f "integer" = BTInt
       
   116     f "word" = BTInt
       
   117     f "pointer" = BTPointerTo BTVoid
       
   118     f _ = BTUnknown
       
   119 type2BaseType (Sequence ids) = BTEnum $ map (\(Identifier i _) -> i) ids
       
   120 type2BaseType (RecordType tv mtvs) = BTRecord $ concatMap f (concat $ tv : fromMaybe [] mtvs)
       
   121     where
       
   122     f (VarDeclaration _ (ids, td) _) = map (\(Identifier i _) -> (i, type2BaseType td)) ids
       
   123 type2BaseType _ = BTUnknown  
       
   124