tools/PascalParser.hs
changeset 6307 25cfd9f4a567
parent 6290 c6245ed6cbc0
child 6310 31145a87811a
equal deleted inserted replaced
6306:553680d78546 6307:25cfd9f4a567
    22     deriving Show
    22     deriving Show
    23 data TypesAndVars = TypesAndVars [TypeVarDeclaration]
    23 data TypesAndVars = TypesAndVars [TypeVarDeclaration]
    24     deriving Show
    24     deriving Show
    25 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
    25 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
    26     | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe Expression)
    26     | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe Expression)
    27     | FunctionDeclaration Identifier Identifier (Maybe Phrase)
    27     | FunctionDeclaration Identifier TypeDecl (Maybe Phrase)
    28     deriving Show
    28     deriving Show
    29 data TypeDecl = SimpleType Identifier
    29 data TypeDecl = SimpleType Identifier
    30     | RangeType Range
    30     | RangeType Range
    31     | Sequence [Identifier]
    31     | Sequence [Identifier]
    32     | ArrayDecl Range TypeDecl
    32     | ArrayDecl Range TypeDecl
    33     | RecordType [TypeVarDeclaration]
    33     | RecordType [TypeVarDeclaration]
    34     | PointerTo TypeDecl
    34     | PointerTo TypeDecl
       
    35     | String
    35     | UnknownType
    36     | UnknownType
    36     deriving Show
    37     deriving Show
    37 data Range = Range Identifier
    38 data Range = Range Identifier
    38            | RangeFromTo Expression Expression
    39            | RangeFromTo Expression Expression
    39     deriving Show
    40     deriving Show
    85             , "implementation", "and", "or", "xor", "shl"
    86             , "implementation", "and", "or", "xor", "shl"
    86             , "shr", "while", "do", "repeat", "until", "case", "of"
    87             , "shr", "while", "do", "repeat", "until", "case", "of"
    87             , "type", "var", "const", "out", "array", "packed"
    88             , "type", "var", "const", "out", "array", "packed"
    88             , "procedure", "function", "with", "for", "to"
    89             , "procedure", "function", "with", "for", "to"
    89             , "downto", "div", "mod", "record", "set", "nil"
    90             , "downto", "div", "mod", "record", "set", "nil"
       
    91             , "string", "shortstring"
    90             ]
    92             ]
    91     , reservedOpNames= [] 
    93     , reservedOpNames= [] 
    92     , caseSensitive  = False   
    94     , caseSensitive  = False   
    93     }
    95     }
    94     
    96     
   203         comments
   205         comments
   204         return $ VarDeclaration False ([i], UnknownType) (Just e)
   206         return $ VarDeclaration False ([i], UnknownType) (Just e)
   205         
   207         
   206 typeDecl = choice [
   208 typeDecl = choice [
   207     char '^' >> typeDecl >>= return . PointerTo
   209     char '^' >> typeDecl >>= return . PointerTo
       
   210     , try (string "shortstring") >> return String
   208     , arrayDecl
   211     , arrayDecl
   209     , recordDecl
   212     , recordDecl
   210     , rangeDecl >>= return . RangeType
   213     , rangeDecl >>= return . RangeType
   211     , seqenceDecl >>= return . Sequence
   214     , seqenceDecl >>= return . Sequence
   212     , identifier pas >>= return . SimpleType . Identifier
   215     , identifier pas >>= return . SimpleType . Identifier
   304                 comments
   307                 comments
   305                 liftM Just functionBody
   308                 liftM Just functionBody
   306                 else
   309                 else
   307                 return Nothing
   310                 return Nothing
   308         comments
   311         comments
   309         return $ [FunctionDeclaration i (Identifier "") b]
   312         return $ [FunctionDeclaration i UnknownType b]
   310         
   313         
   311     funcDecl = do
   314     funcDecl = do
   312         string "function"
   315         string "function"
   313         comments
   316         comments
   314         i <- iD
   317         i <- iD
   317             varsDecl False
   320             varsDecl False
   318             char ')'
   321             char ')'
   319         comments
   322         comments
   320         char ':'
   323         char ':'
   321         comments
   324         comments
   322         ret <- iD
   325         ret <- typeDecl
   323         comments
   326         comments
   324         char ';'
   327         char ';'
       
   328         comments
   325         b <- if isImpl then
   329         b <- if isImpl then
   326                 do
   330                 do
   327                 comments
       
   328                 optional $ typeVarDeclaration True
   331                 optional $ typeVarDeclaration True
   329                 comments
   332                 comments
   330                 liftM Just functionBody
   333                 liftM Just functionBody
   331                 else
   334                 else
   332                 return Nothing
   335                 return Nothing
   363 
   366 
   364 expression = buildExpressionParser table term <?> "expression"
   367 expression = buildExpressionParser table term <?> "expression"
   365     where
   368     where
   366     term = comments >> choice [
   369     term = comments >> choice [
   367         parens pas $ expression 
   370         parens pas $ expression 
   368         , integer pas >>= return . NumberLiteral . show
   371         , try $ integer pas >>= return . NumberLiteral . show
   369         , stringLiteral pas >>= return . StringLiteral
   372         , stringLiteral pas >>= return . StringLiteral
   370         , char '#' >> many digit >>= return . CharCode
   373         , char '#' >> many digit >>= return . CharCode
   371         , char '$' >> many hexDigit >>= return . HexNumber
   374         , char '$' >> many hexDigit >>= return . HexNumber
   372         , char '@' >> reference >>= return . Address
   375         , char '@' >> reference >>= return . Address
   373         , try $ string "nil" >> return Null
   376         , try $ string "nil" >> return Null
   394           ]
   397           ]
   395         , [  Infix (try $ string "and" >> return (BinOp "and")) AssocLeft
   398         , [  Infix (try $ string "and" >> return (BinOp "and")) AssocLeft
   396            , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
   399            , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
   397            , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
   400            , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
   398           ]
   401           ]
       
   402         , [  Infix (try $ string "shl" >> return (BinOp "and")) AssocNone
       
   403            , Infix (try $ string "shr" >> return (BinOp "or")) AssocNone
       
   404           ]
   399         , [Prefix (try (string "not") >> return (PrefixOp "not"))]
   405         , [Prefix (try (string "not") >> return (PrefixOp "not"))]
   400         ]
   406         ]
   401     
   407     
   402 phrasesBlock = do
   408 phrasesBlock = do
   403     try $ string "begin"
   409     try $ string "begin"