tools/pas2c/PascalPreprocessor.hs
author unc0rr
Fri, 05 Oct 2018 21:09:27 +0200
changeset 13880 885ee14fe640
parent 10240 bfae7354d42f
child 15988 24545642473f
permissions -rw-r--r--
Fix previous patch, add support for High(Longword)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
     1
{-# LANGUAGE ScopedTypeVariables #-}
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
     2
module PascalPreprocessor where
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
     3
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
     4
import Text.Parsec
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
     5
import Control.Monad.IO.Class
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
     6
import Control.Monad
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
     7
import System.IO
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
     8
import qualified Data.Map as Map
10119
7e05a397602f Fix build with old base package
unc0rr
parents: 10113
diff changeset
     9
import qualified Control.Exception as E
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    10
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    11
char' :: Char -> ParsecT String u IO ()
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    12
char' = void . char
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    13
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    14
string' :: String -> ParsecT String u IO ()
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    15
string' = void . string
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    16
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    17
-- comments are removed
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    18
comment :: ParsecT String u IO String
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    19
comment = choice [
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    20
        char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    21
        , (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    22
        , (try $ string "//") >> manyTill anyChar (try newline) >> return "\n"
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    23
        ]
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    24
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    25
preprocess :: String -> String -> String -> [String] -> IO String
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    26
preprocess inputPath alternateInputPath fn symbols = do
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    27
    r <- runParserT (preprocessFile (inputPath ++ fn)) (Map.fromList $ map (\s -> (s, "")) symbols, [True]) "" ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    28
    case r of
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    29
         (Left a) -> do
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    30
             hPutStrLn stderr (show a)
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    31
             return ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    32
         (Right a) -> return a
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    33
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    34
    where
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    35
    preprocessFile fn' = do
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    36
        f <- liftIO (readFile fn')
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    37
        setInput f
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    38
        preprocessor
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    39
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    40
    preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    41
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    42
    preprocessor = chainr codeBlock (return (++)) ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    43
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    44
    codeBlock = do
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    45
        s <- choice [
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    46
            switch
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    47
            , comment
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    48
            , char '\'' >> many (noneOf "'\n") >>= \s -> char '\'' >> return ('\'' : s ++ "'")
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    49
            , identifier >>= replace
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    50
            , noneOf "{" >>= \a -> return [a]
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    51
            ]
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    52
        (_, ok) <- getState
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    53
        return $ if and ok then s else ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    54
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    55
    --otherChar c = c `notElem` "{/('_" && not (isAlphaNum c)
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    56
    identifier = do
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    57
        c <- letter <|> oneOf "_"
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    58
        s <- many (alphaNum <|> oneOf "_")
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    59
        return $ c:s
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    60
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    61
    switch = do
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    62
        try $ string' "{$"
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    63
        s <- choice [
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    64
            include
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    65
            , ifdef
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    66
            , if'
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    67
            , elseSwitch
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    68
            , endIf
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    69
            , define
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    70
            , unknown
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    71
            ]
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    72
        return s
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    73
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    74
    include = do
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    75
        try $ string' "INCLUDE"
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    76
        spaces
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    77
        (char' '"')
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    78
        ifn <- many1 $ noneOf "\"\n"
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    79
        char' '"'
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    80
        spaces
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    81
        char' '}'
10119
7e05a397602f Fix build with old base package
unc0rr
parents: 10113
diff changeset
    82
        f <- liftIO (readFile (inputPath ++ ifn) 
7e05a397602f Fix build with old base package
unc0rr
parents: 10113
diff changeset
    83
            `E.catch` (\(_ :: E.IOException) -> readFile (alternateInputPath ++ ifn) 
10120
b7f632c12784 Pas2C recognizes ansistrings
unc0rr
parents: 10119
diff changeset
    84
                `E.catch` (\(_ :: E.IOException) -> error $ "File not found: " ++ ifn)
b7f632c12784 Pas2C recognizes ansistrings
unc0rr
parents: 10119
diff changeset
    85
                )
b7f632c12784 Pas2C recognizes ansistrings
unc0rr
parents: 10119
diff changeset
    86
            )
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    87
        c <- getInput
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    88
        setInput $ f ++ c
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    89
        return ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    90
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    91
    ifdef = do
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    92
        s <- try (string "IFDEF") <|> try (string "IFNDEF")
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    93
        let f = if s == "IFNDEF" then not else id
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    94
10240
bfae7354d42f Support OR operator in $IFDEF. Fixes pas2c builds.
unc0rr
parents: 10120
diff changeset
    95
        ds <- (spaces >> identifier) `sepBy` (spaces >> string "OR")
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    96
        spaces
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
    97
        char' '}'
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    98
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
    99
        updateState $ \(m, b) ->
10240
bfae7354d42f Support OR operator in $IFDEF. Fixes pas2c builds.
unc0rr
parents: 10120
diff changeset
   100
            (m, (f $ any (flip Map.member m) ds) : b)
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   101
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   102
        return ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   103
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   104
    if' = do
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
   105
        try (string' "IF" >> notFollowedBy alphaNum)
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   106
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
   107
        void $ manyTill anyChar (char' '}')
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   108
        --char '}'
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   109
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   110
        updateState $ \(m, b) ->
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   111
            (m, False : b)
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   112
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   113
        return ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   114
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   115
    elseSwitch = do
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
   116
        try $ string' "ELSE}"
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   117
        updateState $ \(m, b:bs) -> (m, (not b):bs)
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   118
        return ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   119
    endIf = do
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
   120
        try $ string' "ENDIF}"
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
   121
        updateState $ \(m, _:bs) -> (m, bs)
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   122
        return ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   123
    define = do
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
   124
        try $ string' "DEFINE"
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   125
        spaces
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   126
        i <- identifier
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   127
        d <- ((string ":=" >> return ()) <|> spaces) >> many (noneOf "}")
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
   128
        char' '}'
10015
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   129
        updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b)
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   130
        return ""
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   131
    replace s = do
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   132
        (m, _) <- getState
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   133
        return $ Map.findWithDefault s s m
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   134
4feced261c68 partial merge of the webgl branch
koda
parents: 9982
diff changeset
   135
    unknown = do
10113
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
   136
        un <- many1 $ noneOf "}\n"
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
   137
        char' '}'
b26c2772e754 Fix tons and tons of pas2c warnings (but still not all of them)
unc0rr
parents: 10015
diff changeset
   138
        return $ "{$" ++ un ++ "}"