tools/PascalParser.hs
changeset 6388 14718b2685a3
parent 6387 3dcb839b5904
child 6391 bd5851ab3157
--- a/tools/PascalParser.hs	Wed Nov 16 20:42:45 2011 +0300
+++ b/tools/PascalParser.hs	Wed Nov 16 21:35:14 2011 +0300
@@ -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,11 @@
     | InitHexNumber String
     | InitString String
     | InitChar String
+    | BuiltInFunction String [InitExpression]
     | InitNull
     deriving Show
 
+builtin = ["succ", "pred", "low", "high"]
     
 pascalLanguageDef
     = emptyDef
@@ -103,13 +105,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}
@@ -280,9 +285,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) [
@@ -391,7 +396,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
@@ -570,10 +576,12 @@
 initExpression = buildExpressionParser table term <?> "initialization expression"
     where
     term = comments >> choice [
-        try $ parens pas (commaSep pas $ initExpression) >>= return . InitArray
+        liftM (uncurry BuiltInFunction) $ builtInFunction initExpression 
+        , 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
@@ -616,4 +624,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 <- many1 e
+    spaces
+    return (name, exprs)