1: # 39 "./lpsrc/flx_tokeniser.ipk"
2:
3: open Flx_parse
4: open Flx_exceptions
5: open List
6: open Flx_srcref
7:
8: (* remove comments, whitespace, newlines *)
9:
10: let filter_comments x =
11: let rec filter x' result =
12: match x' with
13: | COMMENT_NEWLINE _ :: t
14: | COMMENT _ :: t
15: | NEWLINE :: t
16: | WHITE _ :: t -> filter t result
17: | h :: t -> filter t (h::result)
18: | [] -> rev result
19: in filter x []
20:
21: (* remove comments, whitespace, newlines, trailing sloshes,
22: and a trailing hash on the first line
23: *)
24: let filter_preprocessor x =
25: let rec filter first_line x' result =
26: match x' with
27: | WHITE _ :: t
28: | COMMENT _ :: t
29: -> filter first_line t result
30:
31: | COMMENT_NEWLINE _ :: t
32: | NEWLINE :: t
33: | SLOSH :: NEWLINE :: t
34: | SLOSH :: WHITE _ :: NEWLINE :: t
35: -> filter false t result
36:
37: | HASH _ :: NEWLINE :: t
38: | HASH _ :: WHITE _ :: NEWLINE :: t
39: when first_line -> filter false t result
40:
41: | h :: t -> filter first_line t (h::result)
42: | [] -> rev result
43: in filter true x []
44:
45:
46: let compress_ctypes x =
47: let rec filter x' result =
48: match x' with
49: # 89 "./lpsrc/flx_tokeniser.ipk"
50: | NAME(sr,"unsigned") :: NAME(_,"long") :: NAME(_,"long") :: NAME(_,"int") :: t ->
51: # 89 "./lpsrc/flx_tokeniser.ipk"
52: filter t (NAME (sr, "uvlong") :: result)
53: # 89 "./lpsrc/flx_tokeniser.ipk"
54: | NAME(sr,"signed") :: NAME(_,"long") :: NAME(_,"long") :: NAME(_,"int") :: t ->
55: # 89 "./lpsrc/flx_tokeniser.ipk"
56: filter t (NAME (sr, "vlong") :: result)
57: # 89 "./lpsrc/flx_tokeniser.ipk"
58: | NAME(sr,"unsigned") :: NAME(_,"long") :: NAME(_,"long") :: t ->
59: # 89 "./lpsrc/flx_tokeniser.ipk"
60: filter t (NAME (sr, "uvlong") :: result)
61: # 89 "./lpsrc/flx_tokeniser.ipk"
62: | NAME(sr,"unsigned") :: NAME(_,"long") :: NAME(_,"int") :: t ->
63: # 89 "./lpsrc/flx_tokeniser.ipk"
64: filter t (NAME (sr, "ulong") :: result)
65: # 89 "./lpsrc/flx_tokeniser.ipk"
66: | NAME(sr,"signed") :: NAME(_,"long") :: NAME(_,"long") :: t ->
67: # 89 "./lpsrc/flx_tokeniser.ipk"
68: filter t (NAME (sr, "vlong") :: result)
69: # 89 "./lpsrc/flx_tokeniser.ipk"
70: | NAME(sr,"signed") :: NAME(_,"long") :: NAME(_,"int") :: t ->
71: # 89 "./lpsrc/flx_tokeniser.ipk"
72: filter t (NAME (sr, "long") :: result)
73: # 89 "./lpsrc/flx_tokeniser.ipk"
74: | NAME(sr,"long") :: NAME(_,"long") :: NAME(_,"int") :: t ->
75: # 89 "./lpsrc/flx_tokeniser.ipk"
76: filter t (NAME (sr, "vlong") :: result)
77: # 89 "./lpsrc/flx_tokeniser.ipk"
78: | NAME(sr,"long") :: NAME(_,"double") :: NAME(_,"float") :: t ->
79: # 89 "./lpsrc/flx_tokeniser.ipk"
80: filter t (NAME (sr, "ldouble") :: result)
81: # 89 "./lpsrc/flx_tokeniser.ipk"
82: | NAME(sr,"unsigned") :: NAME(_,"long") :: t ->
83: # 89 "./lpsrc/flx_tokeniser.ipk"
84: filter t (NAME (sr, "ulong") :: result)
85: # 89 "./lpsrc/flx_tokeniser.ipk"
86: | NAME(sr,"unsigned") :: NAME(_,"int") :: t ->
87: # 89 "./lpsrc/flx_tokeniser.ipk"
88: filter t (NAME (sr, "uint") :: result)
89: # 89 "./lpsrc/flx_tokeniser.ipk"
90: | NAME(sr,"unsigned") :: NAME(_,"char") :: t ->
91: # 89 "./lpsrc/flx_tokeniser.ipk"
92: filter t (NAME (sr, "utiny") :: result)
93: # 89 "./lpsrc/flx_tokeniser.ipk"
94: | NAME(sr,"signed") :: NAME(_,"long") :: t ->
95: # 89 "./lpsrc/flx_tokeniser.ipk"
96: filter t (NAME (sr, "long") :: result)
97: # 89 "./lpsrc/flx_tokeniser.ipk"
98: | NAME(sr,"signed") :: NAME(_,"int") :: t ->
99: # 89 "./lpsrc/flx_tokeniser.ipk"
100: filter t (NAME (sr, "int") :: result)
101: # 89 "./lpsrc/flx_tokeniser.ipk"
102: | NAME(sr,"signed") :: NAME(_,"char") :: t ->
103: # 89 "./lpsrc/flx_tokeniser.ipk"
104: filter t (NAME (sr, "tiny") :: result)
105: # 89 "./lpsrc/flx_tokeniser.ipk"
106: | NAME(sr,"long") :: NAME(_,"long") :: t ->
107: # 89 "./lpsrc/flx_tokeniser.ipk"
108: filter t (NAME (sr, "vlong") :: result)
109: # 89 "./lpsrc/flx_tokeniser.ipk"
110: | NAME(sr,"long") :: NAME(_,"int") :: t ->
111: # 89 "./lpsrc/flx_tokeniser.ipk"
112: filter t (NAME (sr, "long") :: result)
113: # 89 "./lpsrc/flx_tokeniser.ipk"
114: | NAME(sr,"float") :: NAME(_,"double") :: t ->
115: # 89 "./lpsrc/flx_tokeniser.ipk"
116: filter t (NAME (sr, "double") :: result)
117: # 89 "./lpsrc/flx_tokeniser.ipk"
118: | NAME(sr,"double") :: NAME(_,"float") :: t ->
119: # 89 "./lpsrc/flx_tokeniser.ipk"
120: filter t (NAME (sr, "double") :: result)
121: # 89 "./lpsrc/flx_tokeniser.ipk"
122: | NAME(sr,"unsigned") :: t ->
123: # 89 "./lpsrc/flx_tokeniser.ipk"
124: filter t (NAME (sr, "uint") :: result)
125: # 89 "./lpsrc/flx_tokeniser.ipk"
126: | NAME(sr,"long") :: t ->
127: # 89 "./lpsrc/flx_tokeniser.ipk"
128: filter t (NAME (sr, "long") :: result)
129: | h :: t -> filter t (h::result)
130: | [] -> rev result
131: in filter x []
132:
133: let translate ts =
134: let filters = [
135: (* 1 *) filter_comments ;
136: (* 2 *) compress_ctypes ;
137: ]
138: and reverse_apply dat fn = fn dat
139: in List.fold_left reverse_apply ts filters
140:
141: let translate_preprocessor ts =
142: let filters = [
143: (* 1 *) filter_preprocessor ;
144: (* 2 *) compress_ctypes ;
145: ]
146: and reverse_apply dat fn = fn dat
147: in List.fold_left reverse_apply ts filters
148: