tools/pas2c.hs
changeset 6455 d2b13364eddd
parent 6453 11c578d30bd3
child 6467 090269e528df
equal deleted inserted replaced
6453:11c578d30bd3 6455:d2b13364eddd
    16 
    16 
    17 
    17 
    18 pas2C :: String -> IO ()
    18 pas2C :: String -> IO ()
    19 pas2C fn = do
    19 pas2C fn = do
    20     setCurrentDirectory "../hedgewars/"
    20     setCurrentDirectory "../hedgewars/"
    21     flip evalStateT initState $ f fn
    21     s <- flip execStateT initState $ f fn
       
    22     writeFile "dump" $ show s
    22     where
    23     where
    23     printLn = liftIO . hPutStrLn stderr
    24     printLn = liftIO . hPutStrLn stderr
       
    25     print = liftIO . hPutStr stderr
    24     initState = Map.empty
    26     initState = Map.empty
    25     f :: String -> StateT (Map.Map String PascalUnit) IO ()
    27     f :: String -> StateT (Map.Map String PascalUnit) IO ()
    26     f fileName = do
    28     f fileName = do
    27         processed <- gets $ Map.member fileName
    29         processed <- gets $ Map.member fileName
    28         unless processed $ do
    30         unless processed $ do
       
    31             print ("Preprocessing '" ++ fileName ++ ".pas'... ")
    29             fc' <- liftIO 
    32             fc' <- liftIO 
    30                 $ tryJust (guard . isDoesNotExistError) 
    33                 $ tryJust (guard . isDoesNotExistError) 
    31                 $ hPutStr stderr ("Preprocessing '" ++ fileName ++ ".pas'... ") >> preprocess (fileName ++ ".pas")
    34                 $ preprocess (fileName ++ ".pas")
    32             case fc' of
    35             case fc' of
    33                 (Left a) -> do
    36                 (Left a) -> do
    34                     modify (Map.insert fileName System)
    37                     modify (Map.insert fileName System)
    35                     printLn "doesn't exist"
    38                     printLn "doesn't exist"
    36                 (Right fc) -> do
    39                 (Right fc) -> do
    37                     printLn "ok"
    40                     print "ok, parsing... "
    38                     let ptree = parse pascalUnit fileName fc
    41                     let ptree = parse pascalUnit fileName fc
    39                     case ptree of
    42                     case ptree of
    40                          (Left a) -> do
    43                          (Left a) -> do
    41                             liftIO $ writeFile "preprocess.out" fc
    44                             liftIO $ writeFile "preprocess.out" fc
    42                             printLn $ show a ++ "\nsee preprocess.out for preprocessed source"
    45                             printLn $ show a ++ "\nsee preprocess.out for preprocessed source"
    43                             fail "stop"
    46                             fail "stop"
    44                          (Right a) -> do
    47                          (Right a) -> do
       
    48                             printLn "ok"
    45                             modify (Map.insert fileName a)
    49                             modify (Map.insert fileName a)
    46                             mapM_ f (usesFiles a)
    50                             mapM_ f (usesFiles a)
    47                             
    51 
    48          
    52 
    49 usesFiles :: PascalUnit -> [String]         
    53 usesFiles :: PascalUnit -> [String]         
    50 usesFiles (Program _ (Implementation uses _) _) = uses2List uses
    54 usesFiles (Program _ (Implementation uses _) _) = uses2List uses
    51 usesFiles (Unit _ (Interface uses1 _) (Implementation uses2 _) _ _) = uses2List uses1 ++ uses2List uses2
    55 usesFiles (Unit _ (Interface uses1 _) (Implementation uses2 _) _ _) = uses2List uses1 ++ uses2List uses2
    52 
    56 
    53 
    57