tools/PascalParser.hs
changeset 6412 4b9a59116535
parent 6399 a904c735979c
child 6414 8474b7fa84d6
--- a/tools/PascalParser.hs	Tue Nov 22 02:08:42 2011 +0100
+++ b/tools/PascalParser.hs	Tue Nov 22 19:34:15 2011 +0300
@@ -1,16 +1,18 @@
 module PascalParser where
 
-import Text.Parsec.Expr
+import Text.Parsec
 import Text.Parsec.Char
 import Text.Parsec.Token
 import Text.Parsec.Language
+import Text.Parsec.Expr
 import Text.Parsec.Prim
 import Text.Parsec.Combinator
 import Text.Parsec.String
 import Control.Monad
-import Data.Char
 import Data.Maybe
 
+import PascalBasics
+
 data PascalUnit =
     Program Identifier Implementation
     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
@@ -90,66 +92,12 @@
     | InitNull
     deriving Show
 
-builtin = ["succ", "pred", "low", "high"]
-    
-pascalLanguageDef
-    = emptyDef
-    { commentStart   = "(*"
-    , commentEnd     = "*)"
-    , commentLine    = "//"
-    , nestedComments = False
-    , identStart     = letter <|> oneOf "_"
-    , identLetter    = alphaNum <|> oneOf "_."
-    , reservedNames  = [
-            "begin", "end", "program", "unit", "interface"
-            , "implementation", "and", "or", "xor", "shl"
-            , "shr", "while", "do", "repeat", "until", "case", "of"
-            , "type", "var", "const", "out", "array", "packed"
-            , "procedure", "function", "with", "for", "to"
-            , "downto", "div", "mod", "record", "set", "nil"
-            , "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}
-    sl = do
-        (char '\'')
-        s <- (many $ noneOf "'")
-        (char '\'')
-        ss <- many $ do
-            (char '\'')
-            s' <- (many $ noneOf "'")
-            (char '\'')
-            return $ '\'' : s'
-        comments    
-        return $ concat (s:ss)
-    
-comments = do
-    spaces
-    skipMany $ do
-        comment
-        spaces
-
 pascalUnit = do
     comments
     u <- choice [program, unit]
     comments
     return u
 
-comment = choice [
-        char '{' >> manyTill anyChar (try $ char '}')
-        , (try $ string "(*") >> manyTill anyChar (try $ string "*)")
-        , (try $ string "//") >> manyTill anyChar (try newline)
-        ]
-
 iD = do
     i <- liftM Identifier (identifier pas)
     comments
@@ -389,12 +337,13 @@
     term = comments >> choice [
         builtInFunction expression >>= \(n, e) -> return $ BuiltInFunCall e (SimpleReference (Identifier n))
         , parens pas $ expression 
-        , try $ integer pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
+        , try $ natural pas >>= \i -> notFollowedBy (char '.') >> (return . NumberLiteral . show) i
         , try $ float pas >>= return . FloatLiteral . show
-        , try $ integer pas >>= return . NumberLiteral . show
+        , try $ natural pas >>= return . NumberLiteral . show
         , stringLiteral pas >>= return . StringLiteral
         , char '#' >> many digit >>= return . CharCode
         , char '$' >> many hexDigit >>= return . HexNumber
+        , char '-' >> expression >>= return . PrefixOp "-"
         , try $ string "nil" >> return Null
         , reference >>= return . Reference
         ] <?> "simple expression"
@@ -407,7 +356,6 @@
           ]
         , [  Infix (char '+' >> return (BinOp "+")) AssocLeft
            , Infix (char '-' >> return (BinOp "-")) AssocLeft
-           , Prefix (char '-' >> return (PrefixOp "-"))
           ]
         , [  Infix (try (string "<>") >> return (BinOp "<>")) AssocNone
            , Infix (try (string "<=") >> return (BinOp "<=")) AssocNone
@@ -626,3 +574,4 @@
     exprs <- parens pas $ commaSep1 pas $ e
     spaces
     return (name, exprs)
+        
\ No newline at end of file