2 |
2 |
3 import PascalParser |
3 import PascalParser |
4 import Text.PrettyPrint.HughesPJ |
4 import Text.PrettyPrint.HughesPJ |
5 import Data.Maybe |
5 import Data.Maybe |
6 import Data.Char |
6 import Data.Char |
7 import Text.Parsec.String |
7 import Text.Parsec.Prim |
|
8 import Control.Monad.State |
|
9 import System.IO |
|
10 import System.Directory |
|
11 import Control.Monad.IO.Class |
|
12 import PascalPreprocessor |
|
13 import Control.Exception |
|
14 import System.IO.Error |
|
15 import qualified Data.Set as Set |
8 |
16 |
9 |
17 |
10 pas2C :: String -> IO String |
18 pas2C :: String -> IO String |
11 pas2C fileName = do |
19 pas2C = flip evalStateT initState . f |
12 ptree <- parseFromFile pascalUnit fileName |
20 where |
13 case ptree of |
21 printLn = liftIO . hPutStrLn stderr |
14 (Left a) -> return (show a) |
22 initState = Set.empty |
15 (Right a) -> (return . render . pascal2C) a |
23 f :: String -> StateT (Set.Set String) IO String |
16 |
24 f fileName = do |
|
25 liftIO $ setCurrentDirectory "../hedgewars/" |
|
26 |
|
27 fc' <- liftIO $ tryJust (guard . isDoesNotExistError) $ preprocess fileName |
|
28 case fc' of |
|
29 (Left a) -> return "" |
|
30 (Right fc) -> do |
|
31 modify $ Set.insert fileName |
|
32 printLn $ "Preprocessed " ++ fileName |
|
33 liftIO $ writeFile "debug.txt" fc |
|
34 let ptree = parse pascalUnit fileName fc |
|
35 case ptree of |
|
36 (Left a) -> return (show a) |
|
37 (Right a) -> (return . render . pascal2C) a |
|
38 |
17 pascal2C :: PascalUnit -> Doc |
39 pascal2C :: PascalUnit -> Doc |
18 pascal2C (Unit unitName interface implementation init fin) = |
40 pascal2C (Unit unitName interface implementation init fin) = |
19 interface2C interface |
41 interface2C interface |
20 $+$ |
42 $+$ |
21 implementation2C implementation |
43 implementation2C implementation |
22 |
44 pascal2C (Program _ implementation mainFunction) = |
|
45 implementation2C implementation |
|
46 $+$ |
|
47 tvar2C (FunctionDeclaration (Identifier "main") (SimpleType $ Identifier "int") (Just (TypesAndVars [], mainFunction))) |
23 interface2C :: Interface -> Doc |
48 interface2C :: Interface -> Doc |
24 interface2C (Interface uses tvars) = typesAndVars2C tvars |
49 interface2C (Interface uses tvars) = typesAndVars2C tvars |
25 |
50 |
26 implementation2C :: Implementation -> Doc |
51 implementation2C :: Implementation -> Doc |
27 implementation2C (Implementation uses tvars) = typesAndVars2C tvars |
52 implementation2C (Implementation uses tvars) = typesAndVars2C tvars |
88 | otherwise = text "else" $$ (phrase2C . wrapPhrase) (fromJust mphrase2) |
113 | otherwise = text "else" $$ (phrase2C . wrapPhrase) (fromJust mphrase2) |
89 phrase2C (Assignment ref expr) = ref2C ref <> text " = " <> expr2C expr <> semi |
114 phrase2C (Assignment ref expr) = ref2C ref <> text " = " <> expr2C expr <> semi |
90 phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ (phrase2C $ wrapPhrase phrase) |
115 phrase2C (WhileCycle expr phrase) = text "while" <> parens (expr2C expr) $$ (phrase2C $ wrapPhrase phrase) |
91 phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $+$ (nest 4 . vcat . map case2C) cases |
116 phrase2C (SwitchCase expr cases mphrase) = text "switch" <> parens (expr2C expr) <> text "of" $+$ (nest 4 . vcat . map case2C) cases |
92 where |
117 where |
93 case2C :: (Expression, Phrase) -> Doc |
118 case2C :: ([Expression], Phrase) -> Doc |
94 case2C (e, p) = text "case" <+> parens (expr2C e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;") |
119 case2C (e, p) = text "case" <+> parens (hsep . punctuate (char ',') . map expr2C $ e) <> char ':' <> nest 4 (phrase2C p $+$ text "break;") |
95 phrase2C (WithBlock ref p) = text "namespace" <> parens (ref2C ref) $$ (phrase2C $ wrapPhrase p) |
120 phrase2C (WithBlock ref p) = text "namespace" <> parens (ref2C ref) $$ (phrase2C $ wrapPhrase p) |
96 phrase2C (ForCycle (Identifier i) e1 e2 p) = |
121 phrase2C (ForCycle (Identifier i) e1 e2 p) = |
97 text "for" <> (parens . hsep . punctuate (char ';') $ [text i <+> text "=" <+> expr2C e1, text i <+> text "<=" <+> expr2C e2, text "++" <> text i]) |
122 text "for" <> (parens . hsep . punctuate (char ';') $ [text i <+> text "=" <+> expr2C e1, text i <+> text "<=" <+> expr2C e2, text "++" <> text i]) |
98 $$ |
123 $$ |
99 phrase2C (wrapPhrase p) |
124 phrase2C (wrapPhrase p) |