author  unc0rr 
Mon, 30 Apr 2012 16:55:02 +0400  
changeset 6964  6dde80ae7049 
parent 6891  ab9843957664 
child 7038  d853e4385241 
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 

6891
ab9843957664
Improve rendering of function types, ranges, and more
unc0rr
parents:
6453
diff
changeset

18 
initDefines = Map.fromList [("FPC", ""), ("PAS2C", "")] 
6425
1ef4192aa80d
 Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents:
6414
diff
changeset

19 

6412  20 
preprocess :: String > IO String 
21 
preprocess fn = do 

6425
1ef4192aa80d
 Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents:
6414
diff
changeset

22 
r < runParserT (preprocessFile fn) (initDefines, [True]) "" "" 
6412  23 
case r of 
24 
(Left a) > do 

25 
hPutStrLn stderr (show a) 

26 
return "" 

27 
(Right a) > return a 

28 

29 
where 

30 
preprocessFile fn = do 

31 
f < liftIO (readFile fn) 

32 
setInput f 

33 
preprocessor 

6413  34 

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

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

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

37 
preprocessor = chainr codeBlock (return (++)) "" 
6413  38 

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

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

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

43 
, 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

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

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

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

48 
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

49 

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

50 
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

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

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

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

54 
return $ c:s 
6413  55 

6412  56 
switch = do 
57 
try $ string "{$" 

58 
s < choice [ 

59 
include 

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

60 
, ifdef 
6453
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

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

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

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

64 
, define 
6412  65 
, unknown 
66 
] 

67 
return s 

6413  68 

6412  69 
include = do 
70 
try $ string "INCLUDE" 

71 
spaces 

72 
(char '"') 

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

74 
char '"' 

75 
spaces 

76 
char '}' 

6964  77 
f < liftIO (readFile fn `catch` error ("File not found: " ++ fn)) 
6412  78 
c < getInput 
79 
setInput $ f ++ c 

80 
return "" 

81 

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

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

83 
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

84 
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

85 

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

86 
spaces 
6425
1ef4192aa80d
 Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents:
6414
diff
changeset

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

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

89 
char '}' 
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 
updateState $ \(m, b) > 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

92 
(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

93 

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

94 
return "" 
6453
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

95 

11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

96 
if' = do 
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

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

98 

6453
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

99 
manyTill anyChar (char '}') 
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

100 
char '}' 
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

101 

11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

102 
updateState $ \(m, b) > 
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

103 
(m, False : b) 
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

104 

11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

105 
return "" 
11c578d30bd3
Countless imporvements to the parser and countless help to the parser in sources.
unc0rr
parents:
6425
diff
changeset

106 

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

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

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

109 
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

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

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

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

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

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

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

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

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

118 
i < identifier 
6425
1ef4192aa80d
 Parse unions, sets, function type, packed arrays and some more imporvements to the parser. Now it parses uVariable, uConsts and even SDLh.pas
unc0rr
parents:
6414
diff
changeset

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

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

121 
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

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

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

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

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

126 

6412  127 
unknown = do 
128 
fn < many1 $ noneOf "}\n" 

129 
char '}' 

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

130 
return $ "{$" ++ fn ++ "}" 