tools/PascalParser.hs
branch0.9.17
changeset 6400 a057306acea6
parent 6397 6eb58ae8b510
child 6399 a904c735979c
--- 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)