equal
deleted
inserted
replaced
17 |
17 |
18 initDefines = Map.fromList [ |
18 initDefines = Map.fromList [ |
19 ("FPC", "") |
19 ("FPC", "") |
20 , ("PAS2C", "") |
20 , ("PAS2C", "") |
21 ] |
21 ] |
22 |
22 |
23 preprocess :: String -> IO String |
23 preprocess :: String -> IO String |
24 preprocess fn = do |
24 preprocess fn = do |
25 r <- runParserT (preprocessFile fn) (initDefines, [True]) "" "" |
25 r <- runParserT (preprocessFile fn) (initDefines, [True]) "" "" |
26 case r of |
26 case r of |
27 (Left a) -> do |
27 (Left a) -> do |
28 hPutStrLn stderr (show a) |
28 hPutStrLn stderr (show a) |
29 return "" |
29 return "" |
30 (Right a) -> return a |
30 (Right a) -> return a |
31 |
31 |
32 where |
32 where |
33 preprocessFile fn = do |
33 preprocessFile fn = do |
34 f <- liftIO (readFile fn) |
34 f <- liftIO (readFile fn) |
35 setInput f |
35 setInput f |
36 preprocessor |
36 preprocessor |
37 |
37 |
38 preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String |
38 preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String |
39 |
39 |
40 preprocessor = chainr codeBlock (return (++)) "" |
40 preprocessor = chainr codeBlock (return (++)) "" |
41 |
41 |
42 codeBlock = do |
42 codeBlock = do |
43 s <- choice [ |
43 s <- choice [ |
44 switch |
44 switch |
45 , comment |
45 , comment |
46 , char '\'' >> many (noneOf "'\n") >>= \s -> char '\'' >> return ('\'' : s ++ "'") |
46 , char '\'' >> many (noneOf "'\n") >>= \s -> char '\'' >> return ('\'' : s ++ "'") |
53 --otherChar c = c `notElem` "{/('_" && not (isAlphaNum c) |
53 --otherChar c = c `notElem` "{/('_" && not (isAlphaNum c) |
54 identifier = do |
54 identifier = do |
55 c <- letter <|> oneOf "_" |
55 c <- letter <|> oneOf "_" |
56 s <- many (alphaNum <|> oneOf "_") |
56 s <- many (alphaNum <|> oneOf "_") |
57 return $ c:s |
57 return $ c:s |
58 |
58 |
59 switch = do |
59 switch = do |
60 try $ string "{$" |
60 try $ string "{$" |
61 s <- choice [ |
61 s <- choice [ |
62 include |
62 include |
63 , ifdef |
63 , ifdef |
66 , endIf |
66 , endIf |
67 , define |
67 , define |
68 , unknown |
68 , unknown |
69 ] |
69 ] |
70 return s |
70 return s |
71 |
71 |
72 include = do |
72 include = do |
73 try $ string "INCLUDE" |
73 try $ string "INCLUDE" |
74 spaces |
74 spaces |
75 (char '"') |
75 (char '"') |
76 fn <- many1 $ noneOf "\"\n" |
76 fn <- many1 $ noneOf "\"\n" |
83 return "" |
83 return "" |
84 |
84 |
85 ifdef = do |
85 ifdef = do |
86 s <- try (string "IFDEF") <|> try (string "IFNDEF") |
86 s <- try (string "IFDEF") <|> try (string "IFNDEF") |
87 let f = if s == "IFNDEF" then not else id |
87 let f = if s == "IFNDEF" then not else id |
88 |
88 |
89 spaces |
89 spaces |
90 d <- identifier |
90 d <- identifier |
91 spaces |
91 spaces |
92 char '}' |
92 char '}' |
93 |
93 |
94 updateState $ \(m, b) -> |
94 updateState $ \(m, b) -> |
95 (m, (f $ d `Map.member` m) : b) |
95 (m, (f $ d `Map.member` m) : b) |
96 |
96 |
97 return "" |
97 return "" |
98 |
98 |
99 if' = do |
99 if' = do |
100 s <- try (string "IF" >> notFollowedBy alphaNum) |
100 s <- try (string "IF" >> notFollowedBy alphaNum) |
101 |
101 |
102 manyTill anyChar (char '}') |
102 manyTill anyChar (char '}') |
103 --char '}' |
103 --char '}' |
104 |
104 |
105 updateState $ \(m, b) -> |
105 updateState $ \(m, b) -> |
106 (m, False : b) |
106 (m, False : b) |
107 |
107 |
108 return "" |
108 return "" |
109 |
109 |
110 elseSwitch = do |
110 elseSwitch = do |
111 try $ string "ELSE}" |
111 try $ string "ELSE}" |
112 updateState $ \(m, b:bs) -> (m, (not b):bs) |
112 updateState $ \(m, b:bs) -> (m, (not b):bs) |
116 updateState $ \(m, b:bs) -> (m, bs) |
116 updateState $ \(m, b:bs) -> (m, bs) |
117 return "" |
117 return "" |
118 define = do |
118 define = do |
119 try $ string "DEFINE" |
119 try $ string "DEFINE" |
120 spaces |
120 spaces |
121 i <- identifier |
121 i <- identifier |
122 d <- ((string ":=" >> return ())<|> spaces) >> many (noneOf "}") |
122 d <- ((string ":=" >> return ())<|> spaces) >> many (noneOf "}") |
123 char '}' |
123 char '}' |
124 updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b) |
124 updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b) |
125 return "" |
125 return "" |
126 replace s = do |
126 replace s = do |
127 (m, _) <- getState |
127 (m, _) <- getState |
128 return $ Map.findWithDefault s s m |
128 return $ Map.findWithDefault s s m |
129 |
129 |
130 unknown = do |
130 unknown = do |
131 fn <- many1 $ noneOf "}\n" |
131 fn <- many1 $ noneOf "}\n" |
132 char '}' |
132 char '}' |
133 return $ "{$" ++ fn ++ "}" |
133 return $ "{$" ++ fn ++ "}" |