Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
authorunc0rr
Thu, 24 Nov 2011 20:59:13 +0300
changeset 6417 eae5900fd8a4
parent 6416 850b8dd3e6df
child 6418 f1a3c3aab5b4
Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file
tools/PascalParser.hs
tools/pas2c.hs
--- a/tools/PascalParser.hs	Thu Nov 24 16:33:36 2011 +0100
+++ b/tools/PascalParser.hs	Thu Nov 24 20:59:13 2011 +0300
@@ -14,7 +14,7 @@
 import PascalBasics
 
 data PascalUnit =
-    Program Identifier Implementation
+    Program Identifier Implementation Phrase
     | Unit Identifier Interface Implementation (Maybe Initialize) (Maybe Finalize)
     deriving Show
 data Interface = Interface Uses TypesAndVars
@@ -27,7 +27,7 @@
     deriving Show
 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
     | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression)
-    | FunctionDeclaration Identifier TypeDecl (Maybe (TypesAndVars,Phrase))
+    | FunctionDeclaration Identifier TypeDecl (Maybe (TypesAndVars, Phrase))
     deriving Show
 data TypeDecl = SimpleType Identifier
     | RangeType Range
@@ -54,7 +54,7 @@
         | ForCycle Identifier Expression Expression Phrase
         | WithBlock Reference Phrase
         | Phrases [Phrase]
-        | SwitchCase Expression [(Expression, Phrase)] (Maybe Phrase)
+        | SwitchCase Expression [([Expression], Phrase)] (Maybe Phrase)
         | Assignment Reference Expression
     deriving Show
 data Expression = Expression String
@@ -278,11 +278,12 @@
         comments
         char ';'
         comments
-        b <- if isImpl then
+        forward <- liftM isJust $ optionMaybe ((try $ string "forward;") >> comments)
+        b <- if isImpl && (not forward) then
                 liftM Just functionBody
                 else
                 return Nothing
-        comments
+--        comments
         return $ [FunctionDeclaration i UnknownType b]
         
     funcDecl = do
@@ -297,7 +298,8 @@
         comments
         char ';'
         comments
-        b <- if isImpl then
+        forward <- liftM isJust $ optionMaybe ((try $ string "forward;") >> comments)
+        b <- if isImpl && (not forward) then
                 liftM Just functionBody
                 else
                 return Nothing
@@ -309,9 +311,16 @@
     name <- iD
     (char ';')
     comments
-    impl <- implementation
+    comments
+    u <- uses
+    comments
+    tv <- typeVarDeclaration True
     comments
-    return $ Program name impl
+    p <- phrase
+    comments
+    char '.'
+    comments
+    return $ Program name (Implementation u (TypesAndVars tv)) p
 
 interface = do
     string "interface"
@@ -341,8 +350,8 @@
         , try $ float pas >>= return . FloatLiteral . show
         , try $ natural pas >>= return . NumberLiteral . show
         , stringLiteral pas >>= return . StringLiteral
-        , char '#' >> many digit >>= return . CharCode
-        , char '$' >> many hexDigit >>= return . HexNumber
+        , char '#' >> many digit >>= \c -> comments >> return (CharCode c)
+        , char '$' >> many hexDigit >>=  \h -> comments >> return (HexNumber h)
         , char '-' >> expression >>= return . PrefixOp "-"
         , try $ string "nil" >> return Null
         , reference >>= return . Reference
@@ -482,7 +491,7 @@
     return $ SwitchCase e cs o2
     where
     aCase = do
-        e <- expression
+        e <- (commaSep pas) expression
         comments
         char ':'
         comments
@@ -574,3 +583,4 @@
     exprs <- parens pas $ commaSep1 pas $ e
     spaces
     return (name, exprs)
+        
\ No newline at end of file
--- a/tools/pas2c.hs	Thu Nov 24 16:33:36 2011 +0100
+++ b/tools/pas2c.hs	Thu Nov 24 20:59:13 2011 +0300
@@ -4,22 +4,47 @@
 import Text.PrettyPrint.HughesPJ
 import Data.Maybe
 import Data.Char
-import Text.Parsec.String
+import Text.Parsec.Prim
+import Control.Monad.State
+import System.IO
+import System.Directory
+import Control.Monad.IO.Class
+import PascalPreprocessor
+import Control.Exception
+import System.IO.Error
+import qualified Data.Set as Set
 
 
 pas2C :: String -> IO String
-pas2C fileName = do
-    ptree <- parseFromFile pascalUnit fileName
-    case ptree of
-         (Left a) -> return (show a)
-         (Right a) -> (return . render . pascal2C) a
-
+pas2C = flip evalStateT initState . f
+    where
+    printLn = liftIO . hPutStrLn stderr
+    initState = Set.empty
+    f :: String -> StateT (Set.Set String) IO String
+    f fileName = do
+        liftIO $ setCurrentDirectory "../hedgewars/"
+        
+        fc' <- liftIO $ tryJust (guard . isDoesNotExistError) $ preprocess fileName
+        case fc' of
+            (Left a) -> return ""
+            (Right fc) -> do
+                modify $ Set.insert fileName
+                printLn $ "Preprocessed " ++ fileName
+                liftIO $ writeFile "debug.txt" fc
+                let ptree = parse pascalUnit fileName fc
+                case ptree of
+                     (Left a) -> return (show a)
+                     (Right a) -> (return . render . pascal2C) a
+         
 pascal2C :: PascalUnit -> Doc
 pascal2C (Unit unitName interface implementation init fin) = 
     interface2C interface
     $+$ 
     implementation2C implementation
-
+pascal2C (Program _ implementation mainFunction) =
+    implementation2C implementation
+    $+$
+    tvar2C (FunctionDeclaration (Identifier "main") (SimpleType $ Identifier "int") (Just (TypesAndVars [], mainFunction)))
 interface2C :: Interface -> Doc
 interface2C (Interface uses tvars) = typesAndVars2C tvars
 
@@ -90,8 +115,8 @@
 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 :: ([Expression], Phrase) -> Doc
+    case2C (e, p) = text "case" <+> parens (hsep . punctuate (char ',') . map expr2C $ e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;")
 phrase2C (WithBlock ref p) = text "namespace" <> parens (ref2C ref) $$ (phrase2C $ wrapPhrase p)
 phrase2C (ForCycle (Identifier i) e1 e2 p) = 
     text "for" <> (parens . hsep . punctuate (char ';') $ [text i <+> text "=" <+> expr2C e1, text i <+> text "<=" <+> expr2C e2, text "++" <> text i])