# HG changeset patch # User unc0rr # Date 1322157553 -10800 # Node ID eae5900fd8a4e8a25b42d42c46cad05c171a5788 # Parent 850b8dd3e6df8e8e4ba6cd22302438fa57da0ece Improve parser a bit, preparation to parsing whole program at once and compiling it into single C file diff -r 850b8dd3e6df -r eae5900fd8a4 tools/PascalParser.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 diff -r 850b8dd3e6df -r eae5900fd8a4 tools/pas2c.hs --- 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])