tools/PascalPreprocessor.hs
author koda
Sun, 22 Apr 2012 02:10:44 +0200
changeset 6906 6f5e1e64f106
parent 6891 ab9843957664
child 6964 6dde80ae7049
permissions -rw-r--r--
fix compiling hw for ios (was looking for the wrong math.h and used an old variable name)

module PascalPreprocessor where

import Text.Parsec
import Control.Monad.IO.Class
import Control.Monad
import System.IO
import qualified Data.Map as Map
import Data.Char


-- comments are removed
comment = choice [
        char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return ""
        , (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return ""
        , (try $ string "//") >> manyTill anyChar (try newline) >> return "\n"
        ]

initDefines = Map.fromList [("FPC", ""), ("PAS2C", "")]
        
preprocess :: String -> IO String
preprocess fn = do
    r <- runParserT (preprocessFile fn) (initDefines, [True]) "" ""
    case r of
         (Left a) -> do
             hPutStrLn stderr (show a)
             return ""
         (Right a) -> return a
    
    where
    preprocessFile fn = do
        f <- liftIO (readFile fn)
        setInput f
        preprocessor
        
    preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String
    
    preprocessor = chainr codeBlock (return (++)) ""
    
    codeBlock = do
        s <- choice [
            switch
            , comment
            , char '\'' >> many (noneOf "'\n") >>= \s -> char '\'' >> return ('\'' : s ++ "'")
            , identifier >>= replace
            , noneOf "{" >>= \a -> return [a]
            ]
        (_, ok) <- getState
        return $ if and ok then s else ""

    --otherChar c = c `notElem` "{/('_" && not (isAlphaNum c)
    identifier = do
        c <- letter <|> oneOf "_"
        s <- many (alphaNum <|> oneOf "_")
        return $ c:s
            
    switch = do
        try $ string "{$"
        s <- choice [
            include
            , ifdef
            , if'
            , elseSwitch
            , endIf
            , define
            , unknown
            ]
        return s
        
    include = do
        try $ string "INCLUDE"
        spaces
        (char '"')
        fn <- many1 $ noneOf "\"\n"
        char '"'
        spaces
        char '}'
        f <- liftIO (readFile fn)
        c <- getInput
        setInput $ f ++ c
        return ""

    ifdef = do
        s <- try (string "IFDEF") <|> try (string "IFNDEF")
        let f = if s == "IFNDEF" then not else id
        
        spaces
        d <- identifier
        spaces
        char '}'
        
        updateState $ \(m, b) ->
            (m, (f $ d `Map.member` m) : b)
      
        return ""

    if' = do
        s <- try (string "IF" >> notFollowedBy alphaNum)
        
        manyTill anyChar (char '}')
        --char '}'
        
        updateState $ \(m, b) ->
            (m, False : b)
      
        return ""

    elseSwitch = do
        try $ string "ELSE}"
        updateState $ \(m, b:bs) -> (m, (not b):bs)
        return ""
    endIf = do
        try $ string "ENDIF}"
        updateState $ \(m, b:bs) -> (m, bs)
        return ""
    define = do
        try $ string "DEFINE"
        spaces
        i <- identifier        
        d <- ((string ":=" >> return ())<|> spaces) >> many (noneOf "}")
        char '}'
        updateState $ \(m, b) -> (if and b then Map.insert i d m else m, b)
        return ""
    replace s = do
        (m, _) <- getState
        return $ Map.findWithDefault s s m
        
    unknown = do
        fn <- many1 $ noneOf "}\n"
        char '}'
        return $ "{$" ++ fn ++ "}"