tools/PascalPreprocessor.hs
author sheepluva
Thu, 24 Nov 2011 19:15:29 +0100
changeset 6418 f1a3c3aab5b4
parent 6414 8474b7fa84d6
child 6425 1ef4192aa80d
permissions -rw-r--r--
hide all context menu options for own nick, except for info
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     1
module PascalPreprocessor where
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     2
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     3
import Text.Parsec
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     4
import Control.Monad.IO.Class
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
     5
import Control.Monad
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     6
import System.IO
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     7
import qualified Data.Map as Map
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
     8
import Data.Char
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     9
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    10
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    11
-- comments are removed
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    12
comment = choice [
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    13
        char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return ""
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    14
        , (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return ""
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    15
        , (try $ string "//") >> manyTill anyChar (try newline) >> return "\n"
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    16
        ]
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    17
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    18
preprocess :: String -> IO String
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    19
preprocess fn = do
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    20
    r <- runParserT (preprocessFile fn) (Map.empty, [True]) "" ""
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    21
    case r of
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    22
         (Left a) -> do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    23
             hPutStrLn stderr (show a)
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    24
             return ""
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    25
         (Right a) -> return a
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    26
    
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    27
    where
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    28
    preprocessFile fn = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    29
        f <- liftIO (readFile fn)
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    30
        setInput f
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    31
        preprocessor
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    32
        
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    33
    preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    34
    
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    35
    preprocessor = chainr codeBlock (return (++)) ""
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    36
    
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    37
    codeBlock = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    38
        s <- choice [
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    39
            switch
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    40
            , comment
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    41
            , char '\'' >> many (noneOf "'\n") >>= \s -> char '\'' >> return ('\'' : s ++ "'")
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    42
            , identifier >>= replace
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    43
            , noneOf "{" >>= \a -> return [a]
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    44
            ]
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    45
        (_, ok) <- getState
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    46
        return $ if and ok then s else ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    47
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    48
    --otherChar c = c `notElem` "{/('_" && not (isAlphaNum c)
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    49
    identifier = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    50
        c <- letter <|> oneOf "_"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    51
        s <- many (alphaNum <|> oneOf "_")
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    52
        return $ c:s
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    53
            
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    54
    switch = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    55
        try $ string "{$"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    56
        s <- choice [
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    57
            include
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    58
            , ifdef
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    59
            , elseSwitch
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    60
            , endIf
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    61
            , define
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    62
            , unknown
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    63
            ]
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    64
        return s
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    65
        
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    66
    include = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    67
        try $ string "INCLUDE"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    68
        spaces
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    69
        (char '"')
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    70
        fn <- many1 $ noneOf "\"\n"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    71
        char '"'
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    72
        spaces
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    73
        char '}'
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    74
        f <- liftIO (readFile fn)
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    75
        c <- getInput
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    76
        setInput $ f ++ c
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    77
        return ""
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    78
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    79
    ifdef = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    80
        s <- try (string "IFDEF") <|> try (string "IFNDEF")
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    81
        let f = if s == "IFNDEF" then not else id
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    82
        
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    83
        spaces
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    84
        d <- many1 alphaNum
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    85
        spaces
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    86
        char '}'
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    87
        
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    88
        updateState $ \(m, b) ->
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    89
            (m, (f $ d `Map.member` m) : b)
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    90
        
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    91
      
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    92
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    93
        
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    94
    elseSwitch = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    95
        try $ string "ELSE}"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    96
        updateState $ \(m, b:bs) -> (m, (not b):bs)
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    97
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    98
    endIf = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    99
        try $ string "ENDIF}"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   100
        updateState $ \(m, b:bs) -> (m, bs)
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   101
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   102
    define = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   103
        try $ string "DEFINE"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   104
        spaces
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   105
        i <- identifier        
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   106
        d <- option "" (string ":=" >> many (noneOf "}"))
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   107
        char '}'
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   108
        updateState $ \(m, b) -> (if and b then Map.insert i d m else m, b)
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   109
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   110
    replace s = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   111
        (m, _) <- getState
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   112
        return $ Map.findWithDefault s s m
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   113
        
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   114
    unknown = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   115
        fn <- many1 $ noneOf "}\n"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   116
        char '}'
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   117
        return $ "{$" ++ fn ++ "}"