# HG changeset patch # User koda # Date 1351991605 -3600 # Node ID 97f41bdf077024622310e28503d313e7e602418e # Parent 91511b219de7fe79642e92df24b386265815847f pas2C is slowely becoming parametric diff -r 91511b219de7 -r 97f41bdf0770 tools/pas2c.hs --- a/tools/pas2c.hs Sat Nov 03 23:44:49 2012 +0100 +++ b/tools/pas2c.hs Sun Nov 04 02:13:25 2012 +0100 @@ -94,11 +94,11 @@ docToLower :: Doc -> Doc docToLower = text . map toLower . render -pas2C :: String -> IO () -pas2C fn = do - setCurrentDirectory "../hedgewars/" +pas2C :: String -> String -> String -> IO () +pas2C fn inputPath outputPath = do + setCurrentDirectory inputPath s <- flip execStateT initState $ f fn - renderCFiles s + renderCFiles s outputPath where printLn = liftIO . hPutStrLn stdout print = liftIO . hPutStr stdout @@ -120,7 +120,7 @@ let ptree = parse pascalUnit fileName fc case ptree of (Left a) -> do - liftIO $ writeFile "preprocess.out" fc + liftIO $ writeFile (outputPath ++ "preprocess.out") fc printLn $ show a ++ "\nsee preprocess.out for preprocessed source" fail "stop" (Right a) -> do @@ -129,13 +129,13 @@ mapM_ f (usesFiles a) -renderCFiles :: Map.Map String PascalUnit -> IO () -renderCFiles units = do +renderCFiles :: Map.Map String PascalUnit -> String -> IO () +renderCFiles units outputPath = do let u = Map.toList units let nss = Map.map (toNamespace nss) units --hPutStrLn stderr $ "Units: " ++ (show . Map.keys . Map.filter (not . Map.null) $ nss) --writeFile "pas2c.log" $ unlines . map (\t -> show (fst t) ++ "\n" ++ (unlines . map ((:) '\t' . show) . snd $ t)) . Map.toList $ nss - mapM_ (toCFiles nss) u + mapM_ (toCFiles outputPath nss) u where toNamespace :: Map.Map String Records -> PascalUnit -> Records toNamespace nss (System tvs) = @@ -179,19 +179,19 @@ records = Map.fromList $ map (\(Record a b d) -> (map toLower a, [Record (prefix ++ a) b d])) recs un [a] b = a : b -toCFiles :: Map.Map String Records -> (String, PascalUnit) -> IO () -toCFiles _ (_, System _) = return () -toCFiles _ (_, Redo _) = return () -toCFiles ns p@(fn, pu) = do +toCFiles :: String -> Map.Map String Records -> (String, PascalUnit) -> IO () +toCFiles _ _ (_, System _) = return () +toCFiles _ _ (_, Redo _) = return () +toCFiles outputPath ns p@(fn, pu) = do hPutStrLn stdout $ "Rendering '" ++ fn ++ "'..." toCFiles' p where - toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ "#include \"fpcrtl.h\"\n" ++ (render2C initialState . pascal2C) p + toCFiles' (fn, p@(Program {})) = writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n" ++ (render2C initialState . pascal2C) p toCFiles' (fn, (Unit unitId@(Identifier i _) interface implementation _ _)) = do let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface True) initialState{currentUnit = map toLower i ++ "_"} (a', s') = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface False) initialState{currentUnit = map toLower i ++ "_"} - writeFile (fn ++ ".h") $ "#pragma once\n\n#include \"pas2c.h\"\n\n" ++ (render (a $+$ text "")) - writeFile (fn ++ ".c") $ "#include \"fpcrtl.h\"\n\n#include \"" ++ fn ++ ".h\"\n" ++ render (a' $+$ text "") ++ (render2C s . implementation2C) implementation + writeFile (outputPath ++ fn ++ ".h") $ "#pragma once\n\n#include \"pas2c.h\"\n\n" ++ (render (a $+$ text "")) + writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n\n#include \"" ++ fn ++ ".h\"\n" ++ render (a' $+$ text "") ++ (render2C s . implementation2C) implementation initialState = emptyState ns render2C :: RenderState -> State RenderState Doc -> String @@ -1084,4 +1084,8 @@ op2C "/" = "/(float)" op2C a = a -main = pas2C "hwengine" +main = do + let programName = "hwengine" + let inputPath = "../hedgewars/" + let outputPath = "./" + pas2C programName inputPath outputPath