tools/PascalPreprocessor.hs
author nemo
Sat, 09 Jun 2012 10:28:45 -0400
changeset 7208 62e36dc45098
parent 7067 f98ec3aecf4e
child 7315 59b5b19e6604
permissions -rw-r--r--
Ignore all objects for fall tracing with shove to avoid considering checkins as obstacles. many objects will get knocked by the kick anyway, so end result should be pretty good. Oh, and ditch the sniper rifle doubling.
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
7038
d853e4385241 Some more definitions and slight fixes
unc0rr
parents: 6964
diff changeset
    18
initDefines = Map.fromList [
d853e4385241 Some more definitions and slight fixes
unc0rr
parents: 6964
diff changeset
    19
    ("FPC", "")
d853e4385241 Some more definitions and slight fixes
unc0rr
parents: 6964
diff changeset
    20
    , ("PAS2C", "")
d853e4385241 Some more definitions and slight fixes
unc0rr
parents: 6964
diff changeset
    21
    ]
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6414
diff changeset
    22
        
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    23
preprocess :: String -> IO String
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    24
preprocess fn = do
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6414
diff changeset
    25
    r <- runParserT (preprocessFile fn) (initDefines, [True]) "" ""
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    26
    case r of
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    27
         (Left a) -> do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    28
             hPutStrLn stderr (show a)
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    29
             return ""
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    30
         (Right a) -> return a
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    31
    
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    32
    where
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    33
    preprocessFile fn = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    34
        f <- liftIO (readFile fn)
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    35
        setInput f
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    36
        preprocessor
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    37
        
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    38
    preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    39
    
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    40
    preprocessor = chainr codeBlock (return (++)) ""
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    41
    
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    42
    codeBlock = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    43
        s <- choice [
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    44
            switch
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    45
            , comment
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    46
            , 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
    47
            , identifier >>= replace
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    48
            , noneOf "{" >>= \a -> return [a]
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    49
            ]
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    50
        (_, ok) <- getState
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    51
        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
    52
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    53
    --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
    54
    identifier = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    55
        c <- letter <|> oneOf "_"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    56
        s <- many (alphaNum <|> oneOf "_")
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    57
        return $ c:s
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    58
            
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    59
    switch = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    60
        try $ string "{$"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    61
        s <- choice [
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    62
            include
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    63
            , ifdef
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
    64
            , if'
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    65
            , elseSwitch
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    66
            , endIf
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    67
            , define
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    68
            , unknown
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    69
            ]
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    70
        return s
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    71
        
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    72
    include = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    73
        try $ string "INCLUDE"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    74
        spaces
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    75
        (char '"')
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    76
        fn <- many1 $ noneOf "\"\n"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    77
        char '"'
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    78
        spaces
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    79
        char '}'
6964
6dde80ae7049 Raise exception when .inc file isn't found
unc0rr
parents: 6891
diff changeset
    80
        f <- liftIO (readFile fn `catch` error ("File not found: " ++ fn))
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    81
        c <- getInput
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    82
        setInput $ f ++ c
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    83
        return ""
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    84
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    85
    ifdef = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    86
        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
    87
        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
    88
        
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    89
        spaces
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6414
diff changeset
    90
        d <- identifier
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    91
        spaces
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    92
        char '}'
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
        updateState $ \(m, b) ->
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    95
            (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
    96
      
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    97
        return ""
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
    98
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
    99
    if' = do
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   100
        s <- try (string "IF" >> notFollowedBy alphaNum)
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   101
        
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   102
        manyTill anyChar (char '}')
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   103
        --char '}'
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   104
        
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   105
        updateState $ \(m, b) ->
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   106
            (m, False : b)
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   107
      
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   108
        return ""
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   109
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   110
    elseSwitch = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   111
        try $ string "ELSE}"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   112
        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
   113
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   114
    endIf = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   115
        try $ string "ENDIF}"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   116
        updateState $ \(m, b:bs) -> (m, bs)
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   117
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   118
    define = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   119
        try $ string "DEFINE"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   120
        spaces
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   121
        i <- identifier        
6425
1ef4192aa80d - Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents: 6414
diff changeset
   122
        d <- ((string ":=" >> return ())<|> spaces) >> many (noneOf "}")
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   123
        char '}'
7067
f98ec3aecf4e A solution to char vs string problem: mark single-letter strings with _S macro
unc0rr
parents: 7059
diff changeset
   124
        updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b)
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   125
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   126
    replace s = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   127
        (m, _) <- getState
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   128
        return $ Map.findWithDefault s s m
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   129
        
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   130
    unknown = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   131
        fn <- many1 $ noneOf "}\n"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   132
        char '}'
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   133
        return $ "{$" ++ fn ++ "}"