tools/PascalPreprocessor.hs
author koda
Sat, 09 Mar 2013 00:57:09 +0100
changeset 8702 a28966180a29
parent 8138 cfb228baa598
permissions -rw-r--r--
have fpc work in the right directory instead of passing the full path of the main module (avoids having full paths in debug build backtraces for the first module only)
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", "")
7429
fcf13e40d6b6 Changes to pas2c - unreviewed apart from cursory glance and compile test.
xymeng
parents: 7315
diff changeset
    21
    , ("ENDIAN_LITTLE", "")
7038
d853e4385241 Some more definitions and slight fixes
unc0rr
parents: 6964
diff changeset
    22
    ]
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    23
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    24
preprocess :: String -> IO String
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    25
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
    26
    r <- runParserT (preprocessFile fn) (initDefines, [True]) "" ""
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    27
    case r of
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    28
         (Left a) -> do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    29
             hPutStrLn stderr (show a)
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    30
             return ""
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    31
         (Right a) -> return a
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    32
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    33
    where
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    34
    preprocessFile fn = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    35
        f <- liftIO (readFile fn)
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    36
        setInput f
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    37
        preprocessor
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    38
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    39
    preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    40
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    41
    preprocessor = chainr codeBlock (return (++)) ""
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    42
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    43
    codeBlock = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    44
        s <- choice [
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    45
            switch
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    46
            , comment
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    47
            , 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
    48
            , identifier >>= replace
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    49
            , noneOf "{" >>= \a -> return [a]
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    50
            ]
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    51
        (_, ok) <- getState
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    52
        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
    53
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    54
    --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
    55
    identifier = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    56
        c <- letter <|> oneOf "_"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    57
        s <- many (alphaNum <|> oneOf "_")
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    58
        return $ c:s
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    59
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    60
    switch = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    61
        try $ string "{$"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    62
        s <- choice [
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    63
            include
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    64
            , ifdef
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
    65
            , if'
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    66
            , elseSwitch
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    67
            , endIf
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    68
            , define
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    69
            , unknown
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    70
            ]
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    71
        return s
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    72
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    73
    include = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    74
        try $ string "INCLUDE"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    75
        spaces
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    76
        (char '"')
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    77
        fn <- many1 $ noneOf "\"\n"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    78
        char '"'
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    79
        spaces
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    80
        char '}'
6964
6dde80ae7049 Raise exception when .inc file isn't found
unc0rr
parents: 6891
diff changeset
    81
        f <- liftIO (readFile fn `catch` error ("File not found: " ++ fn))
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    82
        c <- getInput
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    83
        setInput $ f ++ c
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    84
        return ""
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    85
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    86
    ifdef = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    87
        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
    88
        let f = if s == "IFNDEF" then not else id
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    89
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    90
        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
    91
        d <- identifier
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    92
        spaces
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    93
        char '}'
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    94
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    95
        updateState $ \(m, b) ->
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    96
            (m, (f $ d `Map.member` m) : b)
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    97
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    98
        return ""
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
    99
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   100
    if' = do
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   101
        s <- try (string "IF" >> notFollowedBy alphaNum)
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
   102
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   103
        manyTill anyChar (char '}')
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   104
        --char '}'
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
   105
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   106
        updateState $ \(m, b) ->
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   107
            (m, False : b)
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
   108
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   109
        return ""
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   110
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   111
    elseSwitch = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   112
        try $ string "ELSE}"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   113
        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
   114
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   115
    endIf = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   116
        try $ string "ENDIF}"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   117
        updateState $ \(m, b:bs) -> (m, bs)
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   118
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   119
    define = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   120
        try $ string "DEFINE"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   121
        spaces
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
   122
        i <- identifier
7762
d2fd8040534f Better error handling
unc0rr
parents: 7429
diff changeset
   123
        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
   124
        char '}'
7067
f98ec3aecf4e A solution to char vs string problem: mark single-letter strings with _S macro
unc0rr
parents: 7059
diff changeset
   125
        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
   126
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   127
    replace s = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   128
        (m, _) <- getState
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   129
        return $ Map.findWithDefault s s m
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
   130
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   131
    unknown = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   132
        fn <- many1 $ noneOf "}\n"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   133
        char '}'
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   134
        return $ "{$" ++ fn ++ "}"