tools/PascalParser.hs
changeset 6401 b9d9024cf203
parent 6399 a904c735979c
child 6412 4b9a59116535
equal deleted inserted replaced
6398:33c92c4ac749 6401:b9d9024cf203
     7 import Text.Parsec.Prim
     7 import Text.Parsec.Prim
     8 import Text.Parsec.Combinator
     8 import Text.Parsec.Combinator
     9 import Text.Parsec.String
     9 import Text.Parsec.String
    10 import Control.Monad
    10 import Control.Monad
    11 import Data.Char
    11 import Data.Char
       
    12 import Data.Maybe
    12 
    13 
    13 data PascalUnit =
    14 data PascalUnit =
    14     Program Identifier Implementation
    15     Program Identifier Implementation
    15     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
    16     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
    16     deriving Show
    17     deriving Show
    22     deriving Show
    23     deriving Show
    23 data TypesAndVars = TypesAndVars [TypeVarDeclaration]
    24 data TypesAndVars = TypesAndVars [TypeVarDeclaration]
    24     deriving Show
    25     deriving Show
    25 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
    26 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
    26     | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
    27     | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
    27     | FunctionDeclaration Identifier TypeDecl (Maybe Phrase)
    28     | FunctionDeclaration Identifier TypeDecl (Maybe (TypesAndVars,Phrase))
    28     deriving Show
    29     deriving Show
    29 data TypeDecl = SimpleType Identifier
    30 data TypeDecl = SimpleType Identifier
    30     | RangeType Range
    31     | RangeType Range
    31     | Sequence [Identifier]
    32     | Sequence [Identifier]
    32     | ArrayDecl Range TypeDecl
    33     | ArrayDecl Range TypeDecl
    33     | RecordType [TypeVarDeclaration]
    34     | RecordType [TypeVarDeclaration]
    34     | PointerTo TypeDecl
    35     | PointerTo TypeDecl
    35     | String
    36     | String Integer
    36     | UnknownType
    37     | UnknownType
    37     deriving Show
    38     deriving Show
    38 data Range = Range Identifier
    39 data Range = Range Identifier
    39            | RangeFromTo InitExpression InitExpression
    40            | RangeFromTo InitExpression InitExpression
    40     deriving Show
    41     deriving Show
   235         comments
   236         comments
   236         return $ VarDeclaration False ([i], UnknownType) (Just e)
   237         return $ VarDeclaration False ([i], UnknownType) (Just e)
   237         
   238         
   238 typeDecl = choice [
   239 typeDecl = choice [
   239     char '^' >> typeDecl >>= return . PointerTo
   240     char '^' >> typeDecl >>= return . PointerTo
   240     , try (string "shortstring") >> return String
   241     , try (string "shortstring") >> return (String 255)
       
   242     , try (string "string") >> optionMaybe (brackets pas $ integer pas) >>= return . String . fromMaybe 255
   241     , arrayDecl
   243     , arrayDecl
   242     , recordDecl
   244     , recordDecl
   243     , sequenceDecl >>= return . Sequence
   245     , sequenceDecl >>= return . Sequence
   244     , try (identifier pas) >>= return . SimpleType . Identifier
   246     , try (identifier pas) >>= return . SimpleType . Identifier
   245     , rangeDecl >>= return . RangeType
   247     , rangeDecl >>= return . RangeType
   322         
   324         
   323     procDecl = do
   325     procDecl = do
   324         try $ string "procedure"
   326         try $ string "procedure"
   325         comments
   327         comments
   326         i <- iD
   328         i <- iD
   327         optional $ do
   329         optional $ parens pas $ varsDecl False
   328             char '('
       
   329             varsDecl False
       
   330             char ')'
       
   331         comments
   330         comments
   332         char ';'
   331         char ';'
       
   332         comments
   333         b <- if isImpl then
   333         b <- if isImpl then
   334                 do
       
   335                 comments
       
   336                 optional $ typeVarDeclaration True
       
   337                 comments
       
   338                 liftM Just functionBody
   334                 liftM Just functionBody
   339                 else
   335                 else
   340                 return Nothing
   336                 return Nothing
   341         comments
   337         comments
   342         return $ [FunctionDeclaration i UnknownType b]
   338         return $ [FunctionDeclaration i UnknownType b]
   343         
   339         
   344     funcDecl = do
   340     funcDecl = do
   345         try $ string "function"
   341         try $ string "function"
   346         comments
   342         comments
   347         i <- iD
   343         i <- iD
   348         optional $ do
   344         optional $ parens pas $ varsDecl False
   349             char '('
       
   350             varsDecl False
       
   351             char ')'
       
   352         comments
   345         comments
   353         char ':'
   346         char ':'
   354         comments
   347         comments
   355         ret <- typeDecl
   348         ret <- typeDecl
   356         comments
   349         comments
   357         char ';'
   350         char ';'
   358         comments
   351         comments
   359         b <- if isImpl then
   352         b <- if isImpl then
   360                 do
       
   361                 optional $ typeVarDeclaration True
       
   362                 comments
       
   363                 liftM Just functionBody
   353                 liftM Just functionBody
   364                 else
   354                 else
   365                 return Nothing
   355                 return Nothing
   366         return $ [FunctionDeclaration i ret b]
   356         return $ [FunctionDeclaration i ret b]
   367 
   357 
   538         comments
   528         comments
   539         o <- phrase
   529         o <- phrase
   540         comments
   530         comments
   541         return o
   531         return o
   542     string "end"
   532     string "end"
       
   533     comments
   543     return $ SwitchCase e cs o2
   534     return $ SwitchCase e cs o2
   544     where
   535     where
   545     aCase = do
   536     aCase = do
   546         e <- expression
   537         e <- expression
   547         comments
   538         comments
   557     return $ ProcCall i p
   548     return $ ProcCall i p
   558 
   549 
   559 parameters = (commaSep pas) expression <?> "parameters"
   550 parameters = (commaSep pas) expression <?> "parameters"
   560         
   551         
   561 functionBody = do
   552 functionBody = do
       
   553     tv <- typeVarDeclaration True
       
   554     comments
   562     p <- phrasesBlock
   555     p <- phrasesBlock
   563     char ';'
   556     char ';'
   564     comments
   557     comments
   565     return p
   558     return (TypesAndVars tv, p)
   566 
   559 
   567 uses = liftM Uses (option [] u)
   560 uses = liftM Uses (option [] u)
   568     where
   561     where
   569         u = do
   562         u = do
   570             string "uses"
   563             string "uses"