# HG changeset patch
# User unc0rr
# Date 1320611762 -10800
# Node ID 25cfd9f4a5674a3af6a5c16749ed39f5aca05222
# Parent  553680d78546f8614cde46629e385718a1b9a90d
Even more improvements to the parser and converter

diff -r 553680d78546 -r 25cfd9f4a567 tools/PascalParser.hs
--- a/tools/PascalParser.hs	Sun Nov 06 14:15:43 2011 -0500
+++ b/tools/PascalParser.hs	Sun Nov 06 23:36:02 2011 +0300
@@ -24,7 +24,7 @@
     deriving Show
 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
     | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe Expression)
-    | FunctionDeclaration Identifier Identifier (Maybe Phrase)
+    | FunctionDeclaration Identifier TypeDecl (Maybe Phrase)
     deriving Show
 data TypeDecl = SimpleType Identifier
     | RangeType Range
@@ -32,6 +32,7 @@
     | ArrayDecl Range TypeDecl
     | RecordType [TypeVarDeclaration]
     | PointerTo TypeDecl
+    | String
     | UnknownType
     deriving Show
 data Range = Range Identifier
@@ -87,6 +88,7 @@
             , "type", "var", "const", "out", "array", "packed"
             , "procedure", "function", "with", "for", "to"
             , "downto", "div", "mod", "record", "set", "nil"
+            , "string", "shortstring"
             ]
     , reservedOpNames= [] 
     , caseSensitive  = False   
@@ -205,6 +207,7 @@
         
 typeDecl = choice [
     char '^' >> typeDecl >>= return . PointerTo
+    , try (string "shortstring") >> return String
     , arrayDecl
     , recordDecl
     , rangeDecl >>= return . RangeType
@@ -306,7 +309,7 @@
                 else
                 return Nothing
         comments
-        return $ [FunctionDeclaration i (Identifier "") b]
+        return $ [FunctionDeclaration i UnknownType b]
         
     funcDecl = do
         string "function"
@@ -319,12 +322,12 @@
         comments
         char ':'
         comments
-        ret <- iD
+        ret <- typeDecl
         comments
         char ';'
+        comments
         b <- if isImpl then
                 do
-                comments
                 optional $ typeVarDeclaration True
                 comments
                 liftM Just functionBody
@@ -365,7 +368,7 @@
     where
     term = comments >> choice [
         parens pas $ expression 
-        , integer pas >>= return . NumberLiteral . show
+        , try $ integer pas >>= return . NumberLiteral . show
         , stringLiteral pas >>= return . StringLiteral
         , char '#' >> many digit >>= return . CharCode
         , char '$' >> many hexDigit >>= return . HexNumber
@@ -396,6 +399,9 @@
            , Infix (try $ string "or" >> return (BinOp "or")) AssocLeft
            , Infix (try $ string "xor" >> return (BinOp "xor")) AssocLeft
           ]
+        , [  Infix (try $ string "shl" >> return (BinOp "and")) AssocNone
+           , Infix (try $ string "shr" >> return (BinOp "or")) AssocNone
+          ]
         , [Prefix (try (string "not") >> return (PrefixOp "not"))]
         ]
     
diff -r 553680d78546 -r 25cfd9f4a567 tools/pas2c.hs
--- a/tools/pas2c.hs	Sun Nov 06 14:15:43 2011 -0500
+++ b/tools/pas2c.hs	Sun Nov 06 23:36:02 2011 +0300
@@ -19,65 +19,74 @@
 
 
 tvar2C :: TypeVarDeclaration -> Doc
-tvar2C (FunctionDeclaration (Identifier name) (Identifier returnType) Nothing) = 
-    text $ maybeVoid returnType ++ " " ++ name ++ "();"
+tvar2C (FunctionDeclaration (Identifier name) returnType Nothing) = 
+    type2C returnType <+> text (name ++ "();")
 
     
-tvar2C (FunctionDeclaration (Identifier name) (Identifier returnType) (Just phrase)) = 
-    text (maybeVoid returnType ++ " " ++ name ++ "()") 
+tvar2C (FunctionDeclaration (Identifier name) returnType (Just phrase)) = 
+    type2C returnType <+> text (name ++ "()") 
     $$
     phrase2C phrase
 tvar2C _ = empty
 
+type2C :: TypeDecl -> Doc
+type2C UnknownType = text "void"
+type2C _ = text "<<type>>"
 
 phrase2C :: Phrase -> Doc
-phrase2C (Phrases p) = braces . nest 4 . vcat . map phrase2C $ p
+phrase2C (Phrases p) = text "{" $+$ (nest 4 . vcat . map phrase2C $ p) $+$ text "}"
 phrase2C (ProcCall (Identifier name) params) = text name <> parens (hsep . punctuate (char ',') . map expr2C $ params) <> semi
-phrase2C (IfThenElse (expr) phrase1 mphrase2) = text "if" <> parens (expr2C expr) $$ (braces . nest 4 . phrase2C) phrase1 $+$ elsePart
+phrase2C (IfThenElse (expr) phrase1 mphrase2) = text "if" <> parens (expr2C expr) $+$ (phrase2C . wrapPhrase) phrase1 $+$ elsePart
     where
     elsePart | isNothing mphrase2 = empty
-             | otherwise = text "else" $$ (braces . nest 4 . phrase2C) (fromJust mphrase2)
+             | otherwise = text "else" $$ (phrase2C . wrapPhrase) (fromJust mphrase2)
 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
+phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ (phrase2C $ wrapPhrase phrase)
+phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $+$ (nest 4 . vcat . map case2C) cases
     where
     case2C :: (Expression, Phrase) -> Doc
-    case2C (e, p) = text "case" <+> parens (expr2C e) <> char ':' <> nest 4 (phrase2C p $$ text "break;")
+    case2C (e, p) = text "case" <+> parens (expr2C e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;")
 {-
         | RepeatCycle Expression Phrase
         | ForCycle
-        | SwitchCase Expression [(Expression, Phrase)] (Maybe Phrase)
-        | Assignment Identifier Expression
         -}
 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
+wrapPhrase p@(Phrases _) = p
+wrapPhrase p = Phrases [p]
 
 expr2C :: Expression -> Doc
 expr2C (Expression s) = text s
 expr2C (FunCall ref params) = ref2C ref <> parens (hsep . punctuate (char ',') . map expr2C $ params)
-expr2C (BinOp op expr1 expr2) = (expr2C expr1) <+> op2C op <+> (expr2C expr2)
+expr2C (BinOp op expr1 expr2) = parens $ (expr2C expr1) <+> op2C op <+> (expr2C expr2)
 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
+expr2C (PrefixOp op expr) = op2C op <+> expr2C expr
+    {-
     | PostfixOp String Expression
     | CharCode String
     -}            
 expr2C _ = empty
 
+
+ref2C :: Reference -> Doc
+ref2C (ArrayElement (Identifier name) expr) = text name <> brackets (expr2C expr)
+ref2C (SimpleReference (Identifier name)) = text name
+ref2C (RecordField (Dereference ref1) ref2) = ref2C ref1 <> text "->" <> ref2C ref2
+ref2C (RecordField ref1 ref2) = ref2C ref1 <> text "." <> ref2C ref2
+ref2C (Dereference ref) = parens $ text "*" <> ref2C ref
+
 op2C "or" = text "|"
 op2C "and" = text "&"
+op2C "not" = text "!"
+op2C "xor" = text "^"
 op2C "div" = text "/"
 op2C "mod" = text "%"
+op2C "shl" = text "<<"
+op2C "shr" = text ">>"
 op2C "<>" = text "!="
 op2C "=" = text "=="
 op2C a = text a