tools/pas2c/PascalPreprocessor.hs
author Wuzzy <Wuzzy2@mail.ru>
Thu, 25 Apr 2019 23:01:05 +0200
changeset 14844 e239378a9400
parent 10240 bfae7354d42f
permissions -rw-r--r--
Prevent entering “/”, “\” and “:” in team and scheme names. The name of teams and schems is saved in the file name itself, so these characters would cause trouble as they are used in path names in Linux and Windows.
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 ++ "}"