5 import Control.Monad.IO.Class |
5 import Control.Monad.IO.Class |
6 import Control.Monad |
6 import Control.Monad |
7 import System.IO |
7 import System.IO |
8 import qualified Data.Map as Map |
8 import qualified Data.Map as Map |
9 import Control.Exception(catch, IOException) |
9 import Control.Exception(catch, IOException) |
10 import Data.Char |
10 import Prelude |
11 import Prelude hiding (catch) |
11 |
|
12 char' :: Char -> ParsecT String u IO () |
|
13 char' = void . char |
|
14 |
|
15 string' :: String -> ParsecT String u IO () |
|
16 string' = void . string |
12 |
17 |
13 -- comments are removed |
18 -- comments are removed |
|
19 comment :: ParsecT String u IO String |
14 comment = choice [ |
20 comment = choice [ |
15 char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return "" |
21 char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return "" |
16 , (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return "" |
22 , (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return "" |
17 , (try $ string "//") >> manyTill anyChar (try newline) >> return "\n" |
23 , (try $ string "//") >> manyTill anyChar (try newline) >> return "\n" |
18 ] |
24 ] |
25 hPutStrLn stderr (show a) |
31 hPutStrLn stderr (show a) |
26 return "" |
32 return "" |
27 (Right a) -> return a |
33 (Right a) -> return a |
28 |
34 |
29 where |
35 where |
30 preprocessFile fn = do |
36 preprocessFile fn' = do |
31 f <- liftIO (readFile fn) |
37 f <- liftIO (readFile fn') |
32 setInput f |
38 setInput f |
33 preprocessor |
39 preprocessor |
34 |
40 |
35 preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String |
41 preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String |
36 |
42 |
84 let f = if s == "IFNDEF" then not else id |
90 let f = if s == "IFNDEF" then not else id |
85 |
91 |
86 spaces |
92 spaces |
87 d <- identifier |
93 d <- identifier |
88 spaces |
94 spaces |
89 char '}' |
95 char' '}' |
90 |
96 |
91 updateState $ \(m, b) -> |
97 updateState $ \(m, b) -> |
92 (m, (f $ d `Map.member` m) : b) |
98 (m, (f $ d `Map.member` m) : b) |
93 |
99 |
94 return "" |
100 return "" |
95 |
101 |
96 if' = do |
102 if' = do |
97 s <- try (string "IF" >> notFollowedBy alphaNum) |
103 try (string' "IF" >> notFollowedBy alphaNum) |
98 |
104 |
99 manyTill anyChar (char '}') |
105 void $ manyTill anyChar (char' '}') |
100 --char '}' |
106 --char '}' |
101 |
107 |
102 updateState $ \(m, b) -> |
108 updateState $ \(m, b) -> |
103 (m, False : b) |
109 (m, False : b) |
104 |
110 |
105 return "" |
111 return "" |
106 |
112 |
107 elseSwitch = do |
113 elseSwitch = do |
108 try $ string "ELSE}" |
114 try $ string' "ELSE}" |
109 updateState $ \(m, b:bs) -> (m, (not b):bs) |
115 updateState $ \(m, b:bs) -> (m, (not b):bs) |
110 return "" |
116 return "" |
111 endIf = do |
117 endIf = do |
112 try $ string "ENDIF}" |
118 try $ string' "ENDIF}" |
113 updateState $ \(m, b:bs) -> (m, bs) |
119 updateState $ \(m, _:bs) -> (m, bs) |
114 return "" |
120 return "" |
115 define = do |
121 define = do |
116 try $ string "DEFINE" |
122 try $ string' "DEFINE" |
117 spaces |
123 spaces |
118 i <- identifier |
124 i <- identifier |
119 d <- ((string ":=" >> return ()) <|> spaces) >> many (noneOf "}") |
125 d <- ((string ":=" >> return ()) <|> spaces) >> many (noneOf "}") |
120 char '}' |
126 char' '}' |
121 updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b) |
127 updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b) |
122 return "" |
128 return "" |
123 replace s = do |
129 replace s = do |
124 (m, _) <- getState |
130 (m, _) <- getState |
125 return $ Map.findWithDefault s s m |
131 return $ Map.findWithDefault s s m |
126 |
132 |
127 unknown = do |
133 unknown = do |
128 fn <- many1 $ noneOf "}\n" |
134 un <- many1 $ noneOf "}\n" |
129 char '}' |
135 char' '}' |
130 return $ "{$" ++ fn ++ "}" |
136 return $ "{$" ++ un ++ "}" |