tools/pas2c.hs
changeset 7265 3f96073156e1
parent 7151 ec15d9e1a7e3
child 7315 59b5b19e6604
equal deleted inserted replaced
7264:4c438ad3eddc 7265:3f96073156e1
    87 pas2C fn = do
    87 pas2C fn = do
    88     setCurrentDirectory "../hedgewars/"
    88     setCurrentDirectory "../hedgewars/"
    89     s <- flip execStateT initState $ f fn
    89     s <- flip execStateT initState $ f fn
    90     renderCFiles s
    90     renderCFiles s
    91     where
    91     where
    92     printLn = liftIO . hPutStrLn stderr
    92     printLn = liftIO . hPutStrLn stdout
    93     print = liftIO . hPutStr stderr
    93     print = liftIO . hPutStr stdout
    94     initState = Map.empty
    94     initState = Map.empty
    95     f :: String -> StateT (Map.Map String PascalUnit) IO ()
    95     f :: String -> StateT (Map.Map String PascalUnit) IO ()
    96     f fileName = do
    96     f fileName = do
    97         processed <- gets $ Map.member fileName
    97         processed <- gets $ Map.member fileName
    98         unless processed $ do
    98         unless processed $ do
   120 
   120 
   121 renderCFiles :: Map.Map String PascalUnit -> IO ()
   121 renderCFiles :: Map.Map String PascalUnit -> IO ()
   122 renderCFiles units = do
   122 renderCFiles units = do
   123     let u = Map.toList units
   123     let u = Map.toList units
   124     let nss = Map.map (toNamespace nss) units
   124     let nss = Map.map (toNamespace nss) units
   125     hPutStrLn stderr $ "Units: " ++ (show . Map.keys . Map.filter (not . Map.null) $ nss)
   125     --hPutStrLn stderr $ "Units: " ++ (show . Map.keys . Map.filter (not . Map.null) $ nss)
   126     --writeFile "pas2c.log" $ unlines . map (\t -> show (fst t) ++ "\n" ++ (unlines . map ((:) '\t' . show) . snd $ t)) . Map.toList $ nss
   126     --writeFile "pas2c.log" $ unlines . map (\t -> show (fst t) ++ "\n" ++ (unlines . map ((:) '\t' . show) . snd $ t)) . Map.toList $ nss
   127     mapM_ (toCFiles nss) u
   127     mapM_ (toCFiles nss) u
   128     where
   128     where
   129     toNamespace :: Map.Map String Records -> PascalUnit -> Records
   129     toNamespace :: Map.Map String Records -> PascalUnit -> Records
   130     toNamespace nss (System tvs) = 
   130     toNamespace nss (System tvs) = 
   164         un [a] b = a : b
   164         un [a] b = a : b
   165 
   165 
   166 toCFiles :: Map.Map String Records -> (String, PascalUnit) -> IO ()
   166 toCFiles :: Map.Map String Records -> (String, PascalUnit) -> IO ()
   167 toCFiles _ (_, System _) = return ()
   167 toCFiles _ (_, System _) = return ()
   168 toCFiles ns p@(fn, pu) = do
   168 toCFiles ns p@(fn, pu) = do
   169     hPutStrLn stderr $ "Rendering '" ++ fn ++ "'..."
   169     hPutStrLn stdout $ "Rendering '" ++ fn ++ "'..."
   170     toCFiles' p
   170     toCFiles' p
   171     where
   171     where
   172     toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C initialState . pascal2C) p
   172     toCFiles' (fn, p@(Program {})) = writeFile (fn ++ ".c") $ (render2C initialState . pascal2C) p
   173     toCFiles' (fn, (Unit unitId@(Identifier i _) interface implementation _ _)) = do
   173     toCFiles' (fn, (Unit unitId@(Identifier i _) interface implementation _ _)) = do
   174         let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface) initialState{currentUnit = map toLower i ++ "_"}
   174         let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface) initialState{currentUnit = map toLower i ++ "_"}