tools/PascalPreprocessor.hs
changeset 6413 6714531e7bd2
parent 6412 4b9a59116535
child 6414 8474b7fa84d6
equal deleted inserted replaced
6412:4b9a59116535 6413:6714531e7bd2
     2 
     2 
     3 import Text.Parsec
     3 import Text.Parsec
     4 import Control.Monad.IO.Class
     4 import Control.Monad.IO.Class
     5 import System.IO
     5 import System.IO
     6 import qualified Data.Map as Map
     6 import qualified Data.Map as Map
       
     7 
       
     8 
       
     9 -- comments are removed
       
    10 comment = choice [
       
    11         char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return ""
       
    12         , (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return ""
       
    13         , (try $ string "//") >> manyTill anyChar (try newline) >> return "\n"
       
    14         ]
     7 
    15 
     8 preprocess :: String -> IO String
    16 preprocess :: String -> IO String
     9 preprocess fn = do
    17 preprocess fn = do
    10     r <- runParserT (preprocessFile fn) Map.empty "" ""
    18     r <- runParserT (preprocessFile fn) Map.empty "" ""
    11     case r of
    19     case r of
    18     preprocessFile :: String -> ParsecT String (Map.Map String String) IO String
    26     preprocessFile :: String -> ParsecT String (Map.Map String String) IO String
    19     preprocessFile fn = do
    27     preprocessFile fn = do
    20         f <- liftIO (readFile fn)
    28         f <- liftIO (readFile fn)
    21         setInput f
    29         setInput f
    22         preprocessor
    30         preprocessor
       
    31         
    23     preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String) IO String
    32     preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String) IO String
       
    33     
    24     preprocessor = chainl codeBlock (return (++)) ""
    34     preprocessor = chainl codeBlock (return (++)) ""
       
    35     
    25     codeBlock = choice [
    36     codeBlock = choice [
    26             switch
    37             switch
    27             --, comment
    38             , comment
    28             , char '\'' >> many (noneOf "'") >>= \s -> char '\'' >> return ('\'' : s ++ "'")
    39             , char '\'' >> many (noneOf "'") >>= \s -> char '\'' >> return ('\'' : s ++ "'")
    29             , many1 $ noneOf "{'"
    40             , many1 $ noneOf "{'/("
       
    41             , char '/' >> notFollowedBy (char '/') >> return "/"
       
    42             , char '(' >> notFollowedBy (char '*') >> return "("
    30             ]
    43             ]
       
    44             
    31     switch = do
    45     switch = do
    32         try $ string "{$"
    46         try $ string "{$"
    33         s <- choice [
    47         s <- choice [
    34             include
    48             include
    35             , unknown
    49             , unknown
    36             ]
    50             ]
    37         return s
    51         return s
       
    52         
    38     include = do
    53     include = do
    39         try $ string "INCLUDE"
    54         try $ string "INCLUDE"
    40         spaces
    55         spaces
    41         (char '"')
    56         (char '"')
    42         fn <- many1 $ noneOf "\"\n"
    57         fn <- many1 $ noneOf "\"\n"