--- a/tools/PascalParser.hs Sun Nov 06 14:15:43 2011 -0500
+++ b/tools/PascalParser.hs Sun Nov 06 23:36:02 2011 +0300
@@ -24,7 +24,7 @@
deriving Show
data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
| VarDeclaration Bool ([Identifier], TypeDecl) (Maybe Expression)
- | FunctionDeclaration Identifier Identifier (Maybe Phrase)
+ | FunctionDeclaration Identifier TypeDecl (Maybe Phrase)
deriving Show
data TypeDecl = SimpleType Identifier
| RangeType Range
@@ -32,6 +32,7 @@
| ArrayDecl Range TypeDecl
| RecordType [TypeVarDeclaration]
| PointerTo TypeDecl
+ | String
| UnknownType
deriving Show
data Range = Range Identifier
@@ -87,6 +88,7 @@
, "type", "var", "const", "out", "array", "packed"
, "procedure", "function", "with", "for", "to"
, "downto", "div", "mod", "record", "set", "nil"
+ , "string", "shortstring"
]
, reservedOpNames= []
, caseSensitive = False
@@ -205,6 +207,7 @@
typeDecl = choice [
char '^' >> typeDecl >>= return . PointerTo
+ , try (string "shortstring") >> return String
, arrayDecl
, recordDecl
, rangeDecl >>= return . RangeType
@@ -306,7 +309,7 @@
else
return Nothing
comments
- return $ [FunctionDeclaration i (Identifier "") b]
+ return $ [FunctionDeclaration i UnknownType b]
funcDecl = do
string "function"
@@ -319,12 +322,12 @@
comments
char ':'
comments
- ret <- iD
+ ret <- typeDecl
comments
char ';'
+ comments
b <- if isImpl then
do
- comments
optional $ typeVarDeclaration True
comments
liftM Just functionBody
@@ -365,7 +368,7 @@
where
term = comments >> choice [
parens pas $ expression
- , integer pas >>= return . NumberLiteral . show
+ , try $ integer pas >>= return . NumberLiteral . show
, stringLiteral pas >>= return . StringLiteral
, char '#' >> many digit >>= return . CharCode
, char '$' >> many hexDigit >>= return . HexNumber
@@ -396,6 +399,9 @@
, Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
, Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
]
+ , [ Infix (try $ string "shl" >> return (BinOp "and")) AssocNone
+ , Infix (try $ string "shr" >> return (BinOp "or")) AssocNone
+ ]
, [Prefix (try (string "not") >> return (PrefixOp "not"))]
]