A try to improve parser move (has regressions)
authorunc0rr
Sat, 05 Nov 2011 09:37:17 +0300
changeset 6277 627b5752733a
parent 6275 f1b4f37dba22
child 6287 68db7625060d
A try to improve parser move (has regressions)
hedgewars/uTypes.pas
tools/PascalParser.hs
tools/pas2c.hs
--- a/hedgewars/uTypes.pas	Fri Nov 04 14:10:27 2011 +0300
+++ b/hedgewars/uTypes.pas	Sat Nov 05 09:37:17 2011 +0300
@@ -32,7 +32,7 @@
 
 type
     HwColor4f = record
-        r, g, b, a: byte
+        r, g, b, a: byte;
         end;
 
     // Possible states of the game
--- a/tools/PascalParser.hs	Fri Nov 04 14:10:27 2011 +0300
+++ b/tools/PascalParser.hs	Sat Nov 05 09:37:17 2011 +0300
@@ -14,7 +14,6 @@
     Program Identifier Implementation
     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
     deriving Show
-
 data Interface = Interface Uses TypesAndVars
     deriving Show
 data Implementation = Implementation Uses TypesAndVars
@@ -23,16 +22,19 @@
     deriving Show
 data TypesAndVars = TypesAndVars [TypeVarDeclaration]
     deriving Show
-data TypeVarDeclaration = TypeDeclaration TypeDecl
-    | ConstDeclaration String
-    | VarDeclaration Bool String
+data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
+    | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe Expression)
     | FunctionDeclaration Identifier Identifier (Maybe Phrase)
     deriving Show
 data TypeDecl = SimpleType Identifier
     | RangeType Range
+    | Sequence [Identifier]
     | ArrayDecl Range TypeDecl
+    | RecordType [TypeVarDeclaration]
+    | UnknownType
     deriving Show
-data Range = Range Identifier    
+data Range = Range Identifier
+           | RangeFromTo Expression Expression
     deriving Show
 data Initialize = Initialize String
     deriving Show
@@ -51,12 +53,15 @@
         | Assignment Reference Expression
     deriving Show
 data Expression = Expression String
-    | FunCall Identifier [Expression]
+    | FunCall Reference [Expression]
     | PrefixOp String Expression
     | PostfixOp String Expression
     | BinOp String Expression Expression
     | StringLiteral String
+    | CharCode String
     | NumberLiteral String
+    | HexNumber String
+    | Address Reference
     | Reference Reference
     deriving Show
 data Reference = ArrayElement Identifier Expression
@@ -79,7 +84,7 @@
             , "shr", "while", "do", "repeat", "until", "case", "of"
             , "type", "var", "const", "out", "array"
             , "procedure", "function", "with", "for", "to"
-            , "downto", "div", "mod"
+            , "downto", "div", "mod", "record", "set"
             ]
     , reservedOpNames= [] 
     , caseSensitive  = False   
@@ -87,7 +92,18 @@
     
 pas = patch $ makeTokenParser pascalLanguageDef
     where
-    patch tp = tp {stringLiteral = between (char '\'') (char '\'') (many $ noneOf "'")}
+    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
@@ -136,12 +152,13 @@
         , [Infix (char '.' >> return RecordField) AssocLeft]
         ]
     
-    
-varsDecl endsWithSemi = do
-    vs <- many (try (aVarDecl >> semi pas) >> comments)
-    when (not endsWithSemi) $ aVarDecl >> return ()
+varsDecl1 = varsParser many1    
+varsDecl = varsParser many
+varsParser m endsWithSemi = do
+    vs <- m (aVarDecl >>= \i -> semi pas >> comments >> return i)
+    v <- if not endsWithSemi then liftM (\a -> [a]) aVarDecl else return []
     comments
-    return $ VarDeclaration False $ show vs
+    return $ vs ++ v
     where
     aVarDecl = do
         when (not endsWithSemi) $
@@ -151,22 +168,32 @@
                 , try $ string "out"
                 ]
         comments
-        ids <- (commaSep1 pas) $ (iD <?> "variable declaration")
-        char ':'
+        ids <- try $ do
+            i <- (commaSep1 pas) $ (iD <?> "variable declaration")
+            char ':'
+            return i
+        comments
+        t <- typeDecl <?> "variable type declaration"
         comments
-        t <- typeDecl
-        comments
-        return (ids, t)
+        init <- option Nothing $ do
+            char '='
+            comments
+            e <- expression
+            comments
+            char ';'
+            comments
+            return (Just e)
+        return $ VarDeclaration False (ids, t) init
 
 
 constsDecl = do
-    vs <- many (try (aConstDecl >> semi pas) >> comments)
+    vs <- many (try (aConstDecl >>= \i -> semi pas >> return i) >>= \i -> comments >> return i)
     comments
-    return $ VarDeclaration True $ show vs
+    return vs
     where
     aConstDecl = do
         comments
-        ids <- iD <?> "const declaration"
+        i <- iD <?> "const declaration"
         optional $ do
             char ':'
             comments
@@ -176,11 +203,13 @@
         comments
         e <- expression
         comments
-        return (ids, e)
+        return $ VarDeclaration False ([i], UnknownType) (Just e)
         
 typeDecl = choice [
     arrayDecl
+    , recordDecl
     , rangeDecl >>= return . RangeType
+    , seqenceDecl >>= return . Sequence
     , identifier pas >>= return . SimpleType . Identifier
     ] <?> "type declaration"
     where
@@ -195,16 +224,44 @@
         comments
         t <- typeDecl
         return $ ArrayDecl r t
+    recordDecl = do
+        try $ string "record"
+        comments
+        vs <- varsDecl True
+        string "end"
+        return $ RecordType vs
+    seqenceDecl = (parens pas) $ (commaSep pas) iD
 
+typesDecl = many (aTypeDecl >>= \t -> comments >> return t)
+    where
+    aTypeDecl = do
+        i <- try $ do
+            i <- iD <?> "type declaration"
+            comments
+            char '='
+            return i
+        comments
+        t <- typeDecl
+        comments
+        semi pas
+        comments
+        return $ TypeDeclaration i t
         
 rangeDecl = choice [
-    iD >>= return . Range
+    try $ rangeft
+    , iD >>= return . Range
     ] <?> "range declaration"
-
+    where
+    rangeft = do
+    e1 <- expression
+    string ".."
+    e2 <- expression
+    return $ RangeFromTo e1 e2
     
-typeVarDeclaration isImpl = choice [
+typeVarDeclaration isImpl = (liftM concat . many . choice) [
     varSection,
     constSection,
+    typeSection,
     funcDecl,
     procDecl
     ]
@@ -212,7 +269,7 @@
     varSection = do
         try $ string "var"
         comments
-        v <- varsDecl True
+        v <- varsDecl1 True
         comments
         return v
 
@@ -222,6 +279,13 @@
         c <- constsDecl
         comments
         return c
+
+    typeSection = do
+        try $ string "type"
+        comments
+        t <- typesDecl
+        comments
+        return t
         
     procDecl = do
         string "procedure"
@@ -236,13 +300,13 @@
         b <- if isImpl then
                 do
                 comments
-                optional $ typeVarDeclaration isImpl
+                optional $ typeVarDeclaration True
                 comments
                 liftM Just functionBody
                 else
                 return Nothing
         comments
-        return $ FunctionDeclaration i (Identifier "") b
+        return $ [FunctionDeclaration i (Identifier "") b]
         
     funcDecl = do
         string "function"
@@ -260,12 +324,12 @@
         b <- if isImpl then
                 do
                 comments
-                typeVarDeclaration isImpl
+                optional $ typeVarDeclaration True
                 comments
                 liftM Just functionBody
                 else
                 return Nothing
-        return $ FunctionDeclaration i ret Nothing
+        return $ [FunctionDeclaration i ret Nothing]
 
 program = do
     string "program"
@@ -282,7 +346,7 @@
     comments
     u <- uses
     comments
-    tv <- many (typeVarDeclaration False)
+    tv <- typeVarDeclaration False
     comments
     return $ Interface u (TypesAndVars tv)
 
@@ -291,7 +355,7 @@
     comments
     u <- uses
     comments
-    tv <- many (typeVarDeclaration True)
+    tv <- typeVarDeclaration True
     string "end."
     comments
     return $ Implementation u (TypesAndVars tv)
@@ -302,6 +366,9 @@
         parens pas $ expression 
         , integer pas >>= return . NumberLiteral . show
         , stringLiteral pas >>= return . StringLiteral
+        , char '#' >> many digit >>= return . CharCode
+        , char '$' >> many hexDigit >>= return . HexNumber
+        , char '@' >> reference >>= return . Address
         , try $ funCall
         , reference >>= return . Reference
         ] <?> "simple expression"
@@ -451,9 +518,9 @@
     return $ ProcCall i p
 
 funCall = do
-    i <- iD
+    r <- reference
     p <- (parens pas) $ option [] parameters
-    return $ FunCall i p
+    return $ FunCall r p
 
 parameters = (commaSep pas) expression <?> "parameters"
         
--- a/tools/pas2c.hs	Fri Nov 04 14:10:27 2011 +0300
+++ b/tools/pas2c.hs	Sat Nov 05 09:37:17 2011 +0300
@@ -3,6 +3,7 @@
 import PascalParser
 import Text.PrettyPrint.HughesPJ
 import Data.Maybe
+import Data.Char
 
 
 pascal2C :: PascalUnit -> Doc
@@ -36,7 +37,7 @@
     where
     elsePart | isNothing mphrase2 = empty
              | otherwise = text "else" $$ (braces . nest 4 . phrase2C) (fromJust mphrase2)
-phrase2C (Assignment (Identifier name) expr) = text name <> text " = " <> expr2C expr <> semi
+phrase2C (Assignment ref expr) = ref2C ref <> text " = " <> expr2C expr <> semi
 phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ nest 4 (phrase2C phrase)
 phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $$ (nest 4 . vcat . map case2C) cases
     where
@@ -50,14 +51,26 @@
         -}
 phrase2C _ = empty
 
+ref2C :: Reference -> Doc
+ref2C (ArrayElement (Identifier name) expr) = text name <> brackets (expr2C expr)
+ref2C (SimpleReference (Identifier name)) = text name
+ref2C (RecordField ref1 ref2) = ref2C ref1 <> text "." <> ref2C ref2
+ref2C (Dereference ref) = parens $ text "*" <> ref2C ref
 
 expr2C :: Expression -> Doc
 expr2C (Expression s) = text s
-expr2C (FunCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params)
+expr2C (FunCall ref params) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params)
 expr2C (BinOp op expr1 expr2) = (expr2C expr1) <+> op2C op <+> (expr2C expr2)
-{-    | FunCall Identifier [Expression]
+expr2C (NumberLiteral s) = text s
+expr2C (HexNumber s) = text "0x" <> (text . map toLower $ s)
+expr2C (StringLiteral s) = doubleQuotes $ text s 
+expr2C (Address ref) = text "&" <> ref2C ref
+expr2C (Reference ref) = ref2C ref
+
+{-    
     | PrefixOp String Expression
-    | BinOp String Expression Expression
+    | PostfixOp String Expression
+    | CharCode String
     -}            
 expr2C _ = empty
 
@@ -66,6 +79,7 @@
 op2C "div" = text "/"
 op2C "mod" = text "%"
 op2C "<>" = text "!="
+op2C "=" = text "=="
 op2C a = text a
 
 maybeVoid "" = "void"