author | Wuzzy <almikes@aol.com> |
Wed, 03 May 2017 01:50:20 +0200 | |
changeset 12392 | 78ad1119eb6c |
parent 10240 | bfae7354d42f |
child 15958 | 24545642473f |
permissions | -rw-r--r-- |
10015 | 1 |
{-# LANGUAGE ScopedTypeVariables #-} |
2 |
module PascalPreprocessor where |
|
3 |
||
4 |
import Text.Parsec |
|
5 |
import Control.Monad.IO.Class |
|
6 |
import Control.Monad |
|
7 |
import System.IO |
|
8 |
import qualified Data.Map as Map |
|
10119 | 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 | 16 |
|
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 | 19 |
comment = choice [ |
20 |
char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return "" |
|
21 |
, (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return "" |
|
22 |
, (try $ string "//") >> manyTill anyChar (try newline) >> return "\n" |
|
23 |
] |
|
24 |
||
25 |
preprocess :: String -> String -> String -> [String] -> IO String |
|
26 |
preprocess inputPath alternateInputPath fn symbols = do |
|
27 |
r <- runParserT (preprocessFile (inputPath ++ fn)) (Map.fromList $ map (\s -> (s, "")) symbols, [True]) "" "" |
|
28 |
case r of |
|
29 |
(Left a) -> do |
|
30 |
hPutStrLn stderr (show a) |
|
31 |
return "" |
|
32 |
(Right a) -> return a |
|
33 |
||
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 | 37 |
setInput f |
38 |
preprocessor |
|
39 |
||
40 |
preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String |
|
41 |
||
42 |
preprocessor = chainr codeBlock (return (++)) "" |
|
43 |
||
44 |
codeBlock = do |
|
45 |
s <- choice [ |
|
46 |
switch |
|
47 |
, comment |
|
48 |
, char '\'' >> many (noneOf "'\n") >>= \s -> char '\'' >> return ('\'' : s ++ "'") |
|
49 |
, identifier >>= replace |
|
50 |
, noneOf "{" >>= \a -> return [a] |
|
51 |
] |
|
52 |
(_, ok) <- getState |
|
53 |
return $ if and ok then s else "" |
|
54 |
||
55 |
--otherChar c = c `notElem` "{/('_" && not (isAlphaNum c) |
|
56 |
identifier = do |
|
57 |
c <- letter <|> oneOf "_" |
|
58 |
s <- many (alphaNum <|> oneOf "_") |
|
59 |
return $ c:s |
|
60 |
||
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 | 63 |
s <- choice [ |
64 |
include |
|
65 |
, ifdef |
|
66 |
, if' |
|
67 |
, elseSwitch |
|
68 |
, endIf |
|
69 |
, define |
|
70 |
, unknown |
|
71 |
] |
|
72 |
return s |
|
73 |
||
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 | 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 | 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 | 82 |
f <- liftIO (readFile (inputPath ++ ifn) |
83 |
`E.catch` (\(_ :: E.IOException) -> readFile (alternateInputPath ++ ifn) |
|
10120 | 84 |
`E.catch` (\(_ :: E.IOException) -> error $ "File not found: " ++ ifn) |
85 |
) |
|
86 |
) |
|
10015 | 87 |
c <- getInput |
88 |
setInput $ f ++ c |
|
89 |
return "" |
|
90 |
||
91 |
ifdef = do |
|
92 |
s <- try (string "IFDEF") <|> try (string "IFNDEF") |
|
93 |
let f = if s == "IFNDEF" then not else id |
|
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 | 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 | 98 |
|
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 | 101 |
|
102 |
return "" |
|
103 |
||
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 | 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 | 108 |
--char '}' |
109 |
||
110 |
updateState $ \(m, b) -> |
|
111 |
(m, False : b) |
|
112 |
||
113 |
return "" |
|
114 |
||
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 | 117 |
updateState $ \(m, b:bs) -> (m, (not b):bs) |
118 |
return "" |
|
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 | 122 |
return "" |
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 | 125 |
spaces |
126 |
i <- identifier |
|
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 | 129 |
updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b) |
130 |
return "" |
|
131 |
replace s = do |
|
132 |
(m, _) <- getState |
|
133 |
return $ Map.findWithDefault s s m |
|
134 |
||
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 ++ "}" |