equal
deleted
inserted
replaced
21 |
21 |
22 pas2C :: String -> IO () |
22 pas2C :: String -> IO () |
23 pas2C fn = do |
23 pas2C fn = do |
24 setCurrentDirectory "../hedgewars/" |
24 setCurrentDirectory "../hedgewars/" |
25 s <- flip execStateT initState $ f fn |
25 s <- flip execStateT initState $ f fn |
26 mapM_ toCFiles (Map.toList s) |
26 renderCFiles s |
27 where |
27 where |
28 printLn = liftIO . hPutStrLn stderr |
28 printLn = liftIO . hPutStrLn stderr |
29 print = liftIO . hPutStr stderr |
29 print = liftIO . hPutStr stderr |
30 initState = Map.empty |
30 initState = Map.empty |
31 f :: String -> StateT (Map.Map String PascalUnit) IO () |
31 f :: String -> StateT (Map.Map String PascalUnit) IO () |
51 (Right a) -> do |
51 (Right a) -> do |
52 printLn "ok" |
52 printLn "ok" |
53 modify (Map.insert fileName a) |
53 modify (Map.insert fileName a) |
54 mapM_ f (usesFiles a) |
54 mapM_ f (usesFiles a) |
55 |
55 |
|
56 |
|
57 renderCFiles :: Map.Map String PascalUnit -> IO () |
|
58 renderCFiles units = do |
|
59 let u = Map.toList units |
|
60 mapM_ toCFiles u |
|
61 |
56 toCFiles :: (String, PascalUnit) -> IO () |
62 toCFiles :: (String, PascalUnit) -> IO () |
57 toCFiles (_, System _) = return () |
63 toCFiles (_, System _) = return () |
58 toCFiles p@(fn, pu) = do |
64 toCFiles p@(fn, pu) = do |
59 hPutStrLn stderr $ "Rendering '" ++ fn ++ "'..." |
65 hPutStrLn stderr $ "Rendering '" ++ fn ++ "'..." |
60 toCFiles' p |
66 toCFiles' p |
170 |
176 |
171 |
177 |
172 type2C :: TypeDecl -> State RenderState Doc |
178 type2C :: TypeDecl -> State RenderState Doc |
173 type2C UnknownType = return $ text "void" |
179 type2C UnknownType = return $ text "void" |
174 type2C (String l) = return $ text $ "string" ++ show l |
180 type2C (String l) = return $ text $ "string" ++ show l |
175 type2C (SimpleType i) = id2C True i |
181 type2C (SimpleType i) = id2C False i |
176 type2C (PointerTo t) = liftM (<> text "*") $ type2C t |
182 type2C (PointerTo t) = liftM (<> text "*") $ type2C t |
177 type2C (RecordType tvs union) = do |
183 type2C (RecordType tvs union) = do |
178 t <- mapM (tvar2C False) tvs |
184 t <- mapM (tvar2C False) tvs |
179 return $ text "{" $+$ (nest 4 . vcat $ t) $+$ text "}" |
185 return $ text "{" $+$ (nest 4 . vcat $ t) $+$ text "}" |
180 type2C (RangeType r) = return $ text "<<range type>>" |
186 type2C (RangeType r) = return $ text "<<range type>>" |