--- a/tools/PascalParser.hs Mon Nov 14 13:31:38 2011 -0500
+++ b/tools/PascalParser.hs Sat Nov 19 14:30:58 2011 -0500
@@ -36,7 +36,7 @@
| UnknownType
deriving Show
data Range = Range Identifier
- | RangeFromTo Expression Expression
+ | RangeFromTo InitExpression InitExpression
deriving Show
data Initialize = Initialize String
deriving Show
@@ -55,6 +55,7 @@
| Assignment Reference Expression
deriving Show
data Expression = Expression String
+ | BuiltInFunCall [Expression] Reference
| PrefixOp String Expression
| PostfixOp String Expression
| BinOp String Expression Expression
@@ -68,7 +69,6 @@
deriving Show
data Reference = ArrayElement [Expression] Reference
| FunCall [Expression] Reference
- | BuiltInFunCall [Expression] Reference
| SimpleReference Identifier
| Dereference Reference
| RecordField Reference Reference
@@ -84,9 +84,12 @@
| InitHexNumber String
| InitString String
| InitChar String
+ | BuiltInFunction String [InitExpression]
+ | InitSet [Identifier]
| InitNull
deriving Show
+builtin = ["succ", "pred", "low", "high"]
pascalLanguageDef
= emptyDef
@@ -103,13 +106,16 @@
, "type", "var", "const", "out", "array", "packed"
, "procedure", "function", "with", "for", "to"
, "downto", "div", "mod", "record", "set", "nil"
- , "string", "shortstring", "succ", "pred", "low"
- , "high"
- ]
+ , "string", "shortstring"
+ ] ++ builtin
, reservedOpNames= []
, caseSensitive = False
}
+caseInsensitiveString s = do
+ mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s <?> s
+ return s
+
pas = patch $ makeTokenParser pascalLanguageDef
where
patch tp = tp {stringLiteral = sl}
@@ -162,17 +168,22 @@
reference = buildExpressionParser table term <?> "reference"
where
term = comments >> choice [
- parens pas reference
- , char '@' >> reference >>= return . Address
- , iD >>= return . SimpleReference
+ parens pas (reference >>= postfixes) >>= postfixes
+ , char '@' >> reference >>= postfixes >>= return . Address
+ , liftM SimpleReference iD >>= postfixes
] <?> "simple reference"
table = [
- [Postfix $ (parens pas) (option [] parameters) >>= return . FunCall]
- , [Postfix (char '^' >> return Dereference)]
- , [Postfix $ (brackets pas) (commaSep1 pas $ expression) >>= return . ArrayElement]
- , [Infix (try (char '.' >> notFollowedBy (char '.')) >> return RecordField) AssocLeft]
+ [Infix (try (char '.' >> notFollowedBy (char '.')) >> return RecordField) AssocLeft]
]
+
+ postfixes r = many postfix >>= return . foldl fp r
+ postfix = choice [
+ parens pas (option [] parameters) >>= return . FunCall
+ , char '^' >> return Dereference
+ , (brackets pas) (commaSep1 pas $ expression) >>= return . ArrayElement
+ ]
+ fp r f = f r
varsDecl1 = varsParser sepEndBy1
@@ -275,9 +286,9 @@
] <?> "range declaration"
where
rangeft = do
- e1 <- expression
+ e1 <- initExpression
string ".."
- e2 <- expression
+ e2 <- initExpression
return $ RangeFromTo e1 e2
typeVarDeclaration isImpl = (liftM concat . many . choice) [
@@ -386,7 +397,8 @@
expression = buildExpressionParser table term <?> "expression"
where
term = comments >> choice [
- parens pas $ expression
+ builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n))
+ , parens pas $ expression
, try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
, try $ float pas >>= return . FloatLiteral . show
, try $ integer pas >>= return . NumberLiteral . show
@@ -477,12 +489,12 @@
withBlock = do
try $ string "with"
comments
- r <- reference
+ rs <- (commaSep1 pas) reference
comments
string "do"
comments
o <- phrase
- return $ WithBlock r o
+ return $ foldr WithBlock o rs
repeatCycle = do
try $ string "repeat"
@@ -565,10 +577,13 @@
initExpression = buildExpressionParser table term <?> "initialization expression"
where
term = comments >> choice [
- try $ parens pas (commaSep pas $ initExpression) >>= return . InitArray
+ liftM (uncurry BuiltInFunction) $ builtInFunction initExpression
+ , try $ brackets pas (commaSep pas $ iD) >>= return . InitSet
+ , try $ parens pas (commaSep pas $ initExpression) >>= return . InitArray
, parens pas (semiSep pas $ recField) >>= return . InitRecord
, try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . InitNumber . show) i
, try $ float pas >>= return . InitFloat . show
+ , try $ integer pas >>= return . InitNumber . show
, stringLiteral pas >>= return . InitString
, char '#' >> many digit >>= return . InitChar
, char '$' >> many hexDigit >>= return . InitHexNumber
@@ -611,4 +626,10 @@
]
, [Prefix (try (string "not") >> return (InitPrefixOp "not"))]
]
-
\ No newline at end of file
+
+builtInFunction e = do
+ name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin
+ spaces
+ exprs <- parens pas $ commaSep1 pas $ e
+ spaces
+ return (name, exprs)