author  unc0rr 
Fri, 25 Nov 2011 18:36:12 +0300  
changeset 6425  1ef4192aa80d 
parent 6414  8474b7fa84d6 
child 6453  11c578d30bd3 
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 

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

18 
initDefines = Map.fromList [("FPC", "")] 
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 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

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

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

63 
, define 
6412  64 
, unknown 
65 
] 

66 
return s 

6413  67 

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

70 
spaces 

71 
(char '"') 

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

73 
char '"' 

74 
spaces 

75 
char '}' 

76 
f < liftIO (readFile fn) 

77 
c < getInput 

78 
setInput $ f ++ c 

79 
return "" 

80 

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

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

82 
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

83 
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

84 

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

85 
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

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

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

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

89 

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

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

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

92 

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 "" 
8474b7fa84d6
Finish preprocessor. Now it correctly handles $IFDEF, $IFNDEF, $ELSE, $ENDIF and $DEFINE.
unc0rr
parents:
6413
diff
changeset

95 

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

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

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

98 
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

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

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

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

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

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

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

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

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

107 
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

108 
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

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

110 
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

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

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

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

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

115 

6412  116 
unknown = do 
117 
fn < many1 $ noneOf "}\n" 

118 
char '}' 

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

119 
return $ "{$" ++ fn ++ "}" 