tools/pas2c/PascalPreprocessor.hs
author unc0rr
Tue, 07 Jan 2014 22:08:02 +0400
branchwebgl
changeset 9966 01e198990211
parent 9199 9ed29795d2a3
child 9982 24ea101fdc7f
permissions -rw-r--r--
pas2c engine now writes debug log
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
9164
d923ba9d1145 Allow building with modern 'base' package
unc0rr
parents: 8330
diff changeset
     1
{-# LANGUAGE ScopedTypeVariables #-}
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     2
module PascalPreprocessor where
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     3
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     4
import Text.Parsec
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     5
import Control.Monad.IO.Class
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
     6
import Control.Monad
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     7
import System.IO
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
     8
import qualified Data.Map as Map
9164
d923ba9d1145 Allow building with modern 'base' package
unc0rr
parents: 8330
diff changeset
     9
import Control.Exception(catch, IOException)
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    10
import Data.Char
9199
9ed29795d2a3 pas2c import
unC0Rr
parents: 9164
diff changeset
    11
import Prelude hiding (catch)
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    12
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    13
-- comments are removed
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    14
comment = choice [
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    15
        char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return ""
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    16
        , (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return ""
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    17
        , (try $ string "//") >> manyTill anyChar (try newline) >> return "\n"
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    18
        ]
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    19
8020
00b1facf2805 merge xymeng pas2c
koda
parents: 7969
diff changeset
    20
7038
d853e4385241 Some more definitions and slight fixes
unc0rr
parents: 6964
diff changeset
    21
initDefines = Map.fromList [
d853e4385241 Some more definitions and slight fixes
unc0rr
parents: 6964
diff changeset
    22
    ("FPC", "")
d853e4385241 Some more definitions and slight fixes
unc0rr
parents: 6964
diff changeset
    23
    , ("PAS2C", "")
9966
01e198990211 pas2c engine now writes debug log
unc0rr
parents: 9199
diff changeset
    24
    , ("DEBUGFILE", "")
8020
00b1facf2805 merge xymeng pas2c
koda
parents: 7969
diff changeset
    25
--    , ("WEBGL", "")
00b1facf2805 merge xymeng pas2c
koda
parents: 7969
diff changeset
    26
--    , ("AI_MAINTHREAD", "")
7429
fcf13e40d6b6 Changes to pas2c - unreviewed apart from cursory glance and compile test.
xymeng
parents: 7315
diff changeset
    27
    , ("ENDIAN_LITTLE", "")
7038
d853e4385241 Some more definitions and slight fixes
unc0rr
parents: 6964
diff changeset
    28
    ]
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    29
7961
620331af6b9a pas2c can search for inc files in alternate folders (needed for out of source builds)
koda
parents: 7957
diff changeset
    30
preprocess :: String -> String -> String -> IO String
620331af6b9a pas2c can search for inc files in alternate folders (needed for out of source builds)
koda
parents: 7957
diff changeset
    31
preprocess inputPath alternateInputPath fn = do
7957
497ec84e0c21 pas2c can read files without changing the process directory
koda
parents: 7762
diff changeset
    32
    r <- runParserT (preprocessFile (inputPath ++ fn)) (initDefines, [True]) "" ""
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    33
    case r of
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    34
         (Left a) -> do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    35
             hPutStrLn stderr (show a)
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    36
             return ""
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    37
         (Right a) -> return a
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    38
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    39
    where
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    40
    preprocessFile fn = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    41
        f <- liftIO (readFile fn)
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    42
        setInput f
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    43
        preprocessor
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    44
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    45
    preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    46
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    47
    preprocessor = chainr codeBlock (return (++)) ""
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    48
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    49
    codeBlock = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    50
        s <- choice [
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    51
            switch
6413
6714531e7bd2 Preprocessor strips comments
unc0rr
parents: 6412
diff changeset
    52
            , comment
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    53
            , 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
    54
            , identifier >>= replace
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    55
            , noneOf "{" >>= \a -> return [a]
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    56
            ]
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    57
        (_, ok) <- getState
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    58
        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
    59
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    60
    --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
    61
    identifier = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    62
        c <- letter <|> oneOf "_"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    63
        s <- many (alphaNum <|> oneOf "_")
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    64
        return $ c:s
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    65
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    66
    switch = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    67
        try $ string "{$"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    68
        s <- choice [
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    69
            include
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    70
            , ifdef
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
    71
            , if'
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    72
            , elseSwitch
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    73
            , endIf
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    74
            , define
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    75
            , unknown
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    76
            ]
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    77
        return s
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    78
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    79
    include = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    80
        try $ string "INCLUDE"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    81
        spaces
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    82
        (char '"')
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    83
        fn <- many1 $ noneOf "\"\n"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    84
        char '"'
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    85
        spaces
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    86
        char '}'
9164
d923ba9d1145 Allow building with modern 'base' package
unc0rr
parents: 8330
diff changeset
    87
        f <- liftIO (readFile (inputPath ++ fn) `catch` (\(exc :: IOException) -> readFile (alternateInputPath ++ fn) `catch` (\(_ :: IOException) -> error ("File not found: " ++ fn))))
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    88
        c <- getInput
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    89
        setInput $ f ++ c
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    90
        return ""
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
    91
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    92
    ifdef = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    93
        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
    94
        let f = if s == "IFNDEF" then not else id
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
    95
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    96
        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
    97
        d <- identifier
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    98
        spaces
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
    99
        char '}'
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
   100
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   101
        updateState $ \(m, b) ->
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   102
            (m, (f $ d `Map.member` m) : b)
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
   103
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   104
        return ""
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   105
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   106
    if' = do
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   107
        s <- try (string "IF" >> notFollowedBy alphaNum)
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
        manyTill anyChar (char '}')
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   110
        --char '}'
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
   111
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   112
        updateState $ \(m, b) ->
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   113
            (m, False : b)
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
   114
6453
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   115
        return ""
11c578d30bd3 Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents: 6425
diff changeset
   116
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   117
    elseSwitch = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   118
        try $ string "ELSE}"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   119
        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
   120
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   121
    endIf = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   122
        try $ string "ENDIF}"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   123
        updateState $ \(m, b:bs) -> (m, bs)
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   124
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   125
    define = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   126
        try $ string "DEFINE"
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   127
        spaces
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
   128
        i <- identifier
7762
d2fd8040534f Better error handling
unc0rr
parents: 7429
diff changeset
   129
        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
   130
        char '}'
7067
f98ec3aecf4e A solution to char vs string problem: mark single-letter strings with _S macro
unc0rr
parents: 7059
diff changeset
   131
        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
   132
        return ""
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   133
    replace s = do
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   134
        (m, _) <- getState
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   135
        return $ Map.findWithDefault s s m
7315
59b5b19e6604 Remove trailing spaces
unc0rr
parents: 7067
diff changeset
   136
6412
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   137
    unknown = do
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   138
        fn <- many1 $ noneOf "}\n"
4b9a59116535 - Split PascalParser into modules
unc0rr
parents:
diff changeset
   139
        char '}'
6414
8474b7fa84d6 Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents: 6413
diff changeset
   140
        return $ "{$" ++ fn ++ "}"