author  unc0rr 
Wed, 23 Nov 2011 20:12:16 +0300  
changeset 6414  8474b7fa84d6 
parent 6413  6714531e7bd2 
child 6425  1ef4192aa80d 
permissions  rwrr 
6412  1 
module PascalPreprocessor where 
2 

3 
import Text.Parsec 

4 
import Control.Monad.IO.Class 

6414
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

5 
import Control.Monad 
6412  6 
import System.IO 
7 
import qualified Data.Map as Map 

6414
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

8 
import Data.Char 
6412  9 

6413  10 

11 
 comments are removed 

12 
comment = choice [ 

13 
char '{' >> notFollowedBy (char '$') >> manyTill anyChar (try $ char '}') >> return "" 

14 
, (try $ string "(*") >> manyTill anyChar (try $ string "*)") >> return "" 

15 
, (try $ string "//") >> manyTill anyChar (try newline) >> return "\n" 

16 
] 

17 

6412  18 
preprocess :: String > IO String 
19 
preprocess fn = do 

6414
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

20 
r < runParserT (preprocessFile fn) (Map.empty, [True]) "" "" 
6412  21 
case r of 
22 
(Left a) > do 

23 
hPutStrLn stderr (show a) 

24 
return "" 

25 
(Right a) > return a 

26 

27 
where 

28 
preprocessFile fn = do 

29 
f < liftIO (readFile fn) 

30 
setInput f 

31 
preprocessor 

6413  32 

6414
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

33 
preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String 
6413  34 

6414
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

35 
preprocessor = chainr codeBlock (return (++)) "" 
6413  36 

6414
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

37 
codeBlock = do 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

38 
s < choice [ 
6412  39 
switch 
6413  40 
, comment 
6414
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

41 
, char '\'' >> many (noneOf "'\n") >>= \s > char '\'' >> return ('\'' : s ++ "'") 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

42 
, identifier >>= replace 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

43 
, noneOf "{" >>= \a > return [a] 
6412  44 
] 
6414
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

45 
(_, ok) < getState 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

46 
return $ if and ok then s else "" 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

47 

8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

48 
otherChar c = c `notElem` "{/('_" && not (isAlphaNum c) 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

49 
identifier = do 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

50 
c < letter <> oneOf "_" 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

51 
s < many (alphaNum <> oneOf "_") 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

52 
return $ c:s 
6413  53 

6412  54 
switch = do 
55 
try $ string "{$" 

56 
s < choice [ 

57 
include 

6414
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

58 
, ifdef 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

59 
, elseSwitch 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

60 
, endIf 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

61 
, define 
6412  62 
, unknown 
63 
] 

64 
return s 

6413  65 

6412  66 
include = do 
67 
try $ string "INCLUDE" 

68 
spaces 

69 
(char '"') 

70 
fn < many1 $ noneOf "\"\n" 

71 
char '"' 

72 
spaces 

73 
char '}' 

74 
f < liftIO (readFile fn) 

75 
c < getInput 

76 
setInput $ f ++ c 

77 
return "" 

78 

6414
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

79 
ifdef = do 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

80 
s < try (string "IFDEF") <> try (string "IFNDEF") 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

81 
let f = if s == "IFNDEF" then not else id 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

82 

8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

83 
spaces 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

84 
d < many1 alphaNum 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

85 
spaces 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

86 
char '}' 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

87 

8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

88 
updateState $ \(m, b) > 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

89 
(m, (f $ d `Map.member` m) : b) 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

90 

8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

91 

8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

92 
return "" 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

93 

8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

94 
elseSwitch = do 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

95 
try $ string "ELSE}" 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

96 
updateState $ \(m, b:bs) > (m, (not b):bs) 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

97 
return "" 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

98 
endIf = do 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

99 
try $ string "ENDIF}" 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

100 
updateState $ \(m, b:bs) > (m, bs) 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

101 
return "" 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

102 
define = do 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

103 
try $ string "DEFINE" 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

104 
spaces 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

105 
i < identifier 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

106 
d < option "" (string ":=" >> many (noneOf "}")) 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

107 
char '}' 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

108 
updateState $ \(m, b) > (if and b then Map.insert i d m else m, b) 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

109 
return "" 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

110 
replace s = do 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

111 
(m, _) < getState 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

112 
return $ Map.findWithDefault s s m 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

113 

6412  114 
unknown = do 
115 
fn < many1 $ noneOf "}\n" 

116 
char '}' 

6414
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

117 
return $ "{$" ++ fn ++ "}" 