Commit | Line | Data |
---|---|---|
34e49164 C |
1 | { |
2 | open Parser_cocci_menhir | |
3 | module D = Data | |
4 | module Ast = Ast_cocci | |
5 | module Ast0 = Ast0_cocci | |
6 | module P = Parse_aux | |
7 | exception Lexical of string | |
8 | let tok = Lexing.lexeme | |
9 | ||
10 | let line = ref 1 | |
11 | let logical_line = ref 0 | |
12 | ||
13 | (* ---------------------------------------------------------------------- *) | |
14 | (* control codes *) | |
15 | ||
16 | (* Defined in data.ml | |
17 | type line_type = MINUS | OPTMINUS | UNIQUEMINUS | PLUS | CONTEXT | UNIQUE | OPT | |
18 | *) | |
19 | ||
20 | let current_line_type = ref (D.CONTEXT,!line,!logical_line) | |
21 | ||
22 | let prev_plus = ref false | |
23 | let line_start = ref 0 (* offset of the beginning of the line *) | |
24 | let get_current_line_type lexbuf = | |
25 | let (c,l,ll) = !current_line_type in | |
26 | let lex_start = Lexing.lexeme_start lexbuf in | |
27 | let preceeding_spaces = | |
28 | if !line_start < 0 then 0 else lex_start - !line_start in | |
708f4980 | 29 | (*line_start := -1;*) |
951c7801 | 30 | prev_plus := (c = D.PLUS) or (c = D.PLUSPLUS); |
34e49164 C |
31 | (c,l,ll,lex_start,preceeding_spaces,[],[],Ast0.NoMetaPos) |
32 | let current_line_started = ref false | |
33 | let col_zero = ref true | |
34 | ||
35 | let reset_line lexbuf = | |
36 | line := !line + 1; | |
37 | current_line_type := (D.CONTEXT,!line,!logical_line); | |
38 | current_line_started := false; | |
39 | col_zero := true; | |
40 | line_start := Lexing.lexeme_start lexbuf + 1 | |
41 | ||
42 | let started_line = ref (-1) | |
43 | ||
44 | let start_line seen_char = | |
45 | current_line_started := true; | |
46 | col_zero := false; | |
47 | (if seen_char && not(!line = !started_line) | |
48 | then | |
49 | begin | |
50 | started_line := !line; | |
51 | logical_line := !logical_line + 1 | |
52 | end) | |
53 | ||
54 | let pass_zero _ = col_zero := false | |
55 | ||
56 | let lexerr s1 s2 = raise (Lexical (Printf.sprintf "%s%s" s1 s2)) | |
57 | ||
58 | let add_current_line_type x = | |
59 | match (x,!current_line_type) with | |
60 | (D.MINUS,(D.CONTEXT,ln,lln)) -> | |
61 | current_line_type := (D.MINUS,ln,lln) | |
62 | | (D.MINUS,(D.UNIQUE,ln,lln)) -> | |
63 | current_line_type := (D.UNIQUEMINUS,ln,lln) | |
64 | | (D.MINUS,(D.OPT,ln,lln)) -> | |
65 | current_line_type := (D.OPTMINUS,ln,lln) | |
66 | | (D.PLUS,(D.CONTEXT,ln,lln)) -> | |
67 | current_line_type := (D.PLUS,ln,lln) | |
951c7801 C |
68 | | (D.PLUSPLUS,(D.CONTEXT,ln,lln)) -> |
69 | current_line_type := (D.PLUSPLUS,ln,lln) | |
34e49164 C |
70 | | (D.UNIQUE,(D.CONTEXT,ln,lln)) -> |
71 | current_line_type := (D.UNIQUE,ln,lln) | |
72 | | (D.OPT,(D.CONTEXT,ln,lln)) -> | |
73 | current_line_type := (D.OPT,ln,lln) | |
74 | | _ -> lexerr "invalid control character combination" "" | |
75 | ||
76 | let check_minus_context_linetype s = | |
77 | match !current_line_type with | |
951c7801 | 78 | (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> lexerr "invalid in a + context: " s |
34e49164 C |
79 | | _ -> () |
80 | ||
81 | let check_context_linetype s = | |
82 | match !current_line_type with | |
83 | (D.CONTEXT,_,_) -> () | |
84 | | _ -> lexerr "invalid in a nonempty context: " s | |
85 | ||
86 | let check_plus_linetype s = | |
87 | match !current_line_type with | |
951c7801 | 88 | (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> () |
34e49164 C |
89 | | _ -> lexerr "invalid in a non + context: " s |
90 | ||
91 | let check_arity_context_linetype s = | |
92 | match !current_line_type with | |
951c7801 C |
93 | (D.CONTEXT,_,_) | (D.PLUS,_,_) | (D.PLUSPLUS,_,_) |
94 | | (D.UNIQUE,_,_) | (D.OPT,_,_) -> () | |
34e49164 C |
95 | | _ -> lexerr "invalid in a nonempty context: " s |
96 | ||
97 | let process_include start finish str = | |
98 | (match !current_line_type with | |
951c7801 | 99 | (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> |
34e49164 C |
100 | (try |
101 | let _ = Str.search_forward (Str.regexp "\\.\\.\\.") str start in | |
102 | lexerr "... not allowed in + include" "" | |
103 | with Not_found -> ()) | |
104 | | _ -> ()); | |
105 | String.sub str (start + 1) (finish - start - 1) | |
106 | ||
107 | (* ---------------------------------------------------------------------- *) | |
108 | type pm = PATCH | MATCH | UNKNOWN | |
109 | ||
110 | let pm = ref UNKNOWN | |
111 | ||
112 | let patch_or_match = function | |
113 | PATCH -> | |
7f004419 C |
114 | if not !D.ignore_patch_or_match |
115 | then | |
116 | (match !pm with | |
117 | MATCH -> | |
118 | lexerr "- or + not allowed in the first column for a match" "" | |
119 | | PATCH -> () | |
120 | | UNKNOWN -> Flag.sgrep_mode2 := false; pm := PATCH) | |
34e49164 | 121 | | MATCH -> |
7f004419 C |
122 | if not !D.ignore_patch_or_match |
123 | then | |
124 | (match !pm with | |
125 | PATCH -> lexerr "* not allowed in the first column for a patch" "" | |
126 | | MATCH -> () | |
127 | | UNKNOWN -> Flag.sgrep_mode2 := true; pm := MATCH) | |
34e49164 C |
128 | | _ -> failwith "unexpected argument" |
129 | ||
130 | (* ---------------------------------------------------------------------- *) | |
131 | (* identifiers, including metavariables *) | |
132 | ||
133 | let metavariables = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t) | |
134 | ||
135 | let all_metavariables = | |
136 | (Hashtbl.create(100) : (string,(string * (D.clt -> token)) list) Hashtbl.t) | |
137 | ||
138 | let type_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t) | |
139 | ||
140 | let declarer_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t) | |
141 | ||
142 | let iterator_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t) | |
143 | ||
144 | let rule_names = (Hashtbl.create(100) : (string, unit) Hashtbl.t) | |
145 | ||
146 | let check_var s linetype = | |
147 | let fail _ = | |
148 | if (!Data.in_prolog || !Data.in_rule_name) && | |
149 | Str.string_match (Str.regexp "<.*>") s 0 | |
150 | then TPathIsoFile s | |
151 | else | |
152 | try (Hashtbl.find metavariables s) linetype | |
153 | with Not_found -> | |
154 | (try (Hashtbl.find type_names s) linetype | |
155 | with Not_found -> | |
156 | (try (Hashtbl.find declarer_names s) linetype | |
faf9a90c | 157 | with Not_found -> |
34e49164 C |
158 | (try (Hashtbl.find iterator_names s) linetype |
159 | with Not_found -> TIdent (s,linetype)))) in | |
160 | if !Data.in_meta or !Data.in_rule_name | |
161 | then (try Hashtbl.find rule_names s; TRuleName s with Not_found -> fail()) | |
162 | else fail() | |
163 | ||
164 | let id_tokens lexbuf = | |
165 | let s = tok lexbuf in | |
166 | let linetype = get_current_line_type lexbuf in | |
167 | let in_rule_name = !Data.in_rule_name in | |
978fd7e5 | 168 | let in_meta = !Data.in_meta && not !Data.saw_struct in |
34e49164 C |
169 | let in_iso = !Data.in_iso in |
170 | let in_prolog = !Data.in_prolog in | |
171 | match s with | |
172 | "identifier" when in_meta -> check_arity_context_linetype s; TIdentifier | |
173 | | "type" when in_meta -> check_arity_context_linetype s; TType | |
174 | | "parameter" when in_meta -> check_arity_context_linetype s; TParameter | |
175 | | "constant" when in_meta -> check_arity_context_linetype s; TConstant | |
faf9a90c C |
176 | | "generated" when in_rule_name && not (!Flag.make_hrule = None) -> |
177 | check_arity_context_linetype s; TGenerated | |
34e49164 C |
178 | | "expression" when in_meta || in_rule_name -> |
179 | check_arity_context_linetype s; TExpression | |
113803cf C |
180 | | "initialiser" when in_meta || in_rule_name -> |
181 | check_arity_context_linetype s; TInitialiser | |
182 | | "initializer" when in_meta || in_rule_name -> | |
183 | check_arity_context_linetype s; TInitialiser | |
34e49164 C |
184 | | "idexpression" when in_meta -> |
185 | check_arity_context_linetype s; TIdExpression | |
186 | | "statement" when in_meta -> check_arity_context_linetype s; TStatement | |
187 | | "function" when in_meta -> check_arity_context_linetype s; TFunction | |
188 | | "local" when in_meta -> check_arity_context_linetype s; TLocal | |
189 | | "list" when in_meta -> check_arity_context_linetype s; Tlist | |
190 | | "fresh" when in_meta -> check_arity_context_linetype s; TFresh | |
191 | | "typedef" when in_meta -> check_arity_context_linetype s; TTypedef | |
192 | | "declarer" when in_meta -> check_arity_context_linetype s; TDeclarer | |
193 | | "iterator" when in_meta -> check_arity_context_linetype s; TIterator | |
194 | | "name" when in_meta -> check_arity_context_linetype s; TName | |
195 | | "position" when in_meta -> check_arity_context_linetype s; TPosition | |
196 | | "any" when in_meta -> check_arity_context_linetype s; TPosAny | |
197 | | "pure" when in_meta && in_iso -> | |
198 | check_arity_context_linetype s; TPure | |
199 | | "context" when in_meta && in_iso -> | |
200 | check_arity_context_linetype s; TContext | |
201 | | "error" when in_meta -> check_arity_context_linetype s; TError | |
202 | | "words" when in_meta -> check_context_linetype s; TWords | |
203 | ||
204 | | "using" when in_rule_name || in_prolog -> check_context_linetype s; TUsing | |
951c7801 | 205 | | "virtual" when in_prolog -> check_context_linetype s; TVirtual |
34e49164 C |
206 | | "disable" when in_rule_name -> check_context_linetype s; TDisable |
207 | | "extends" when in_rule_name -> check_context_linetype s; TExtends | |
208 | | "depends" when in_rule_name -> check_context_linetype s; TDepends | |
209 | | "on" when in_rule_name -> check_context_linetype s; TOn | |
210 | | "ever" when in_rule_name -> check_context_linetype s; TEver | |
211 | | "never" when in_rule_name -> check_context_linetype s; TNever | |
978fd7e5 | 212 | (* exists and forall for when are reparsed in parse_cocci.ml *) |
34e49164 C |
213 | | "exists" when in_rule_name -> check_context_linetype s; TExists |
214 | | "forall" when in_rule_name -> check_context_linetype s; TForall | |
b1b2de81 C |
215 | | "script" when in_rule_name -> check_context_linetype s; TScript |
216 | | "initialize" when in_rule_name -> check_context_linetype s; TInitialize | |
217 | | "finalize" when in_rule_name -> check_context_linetype s; TFinalize | |
34e49164 C |
218 | |
219 | | "char" -> Tchar linetype | |
220 | | "short" -> Tshort linetype | |
221 | | "int" -> Tint linetype | |
222 | | "double" -> Tdouble linetype | |
223 | | "float" -> Tfloat linetype | |
224 | | "long" -> Tlong linetype | |
225 | | "void" -> Tvoid linetype | |
978fd7e5 C |
226 | (* in_meta is only for the first keyword; drop it now to allow any type |
227 | name *) | |
228 | | "struct" -> Data.saw_struct := true; Tstruct linetype | |
229 | | "union" -> Data.saw_struct := true; Tunion linetype | |
230 | | "enum" -> Data.saw_struct := true; Tenum linetype | |
34e49164 C |
231 | | "unsigned" -> Tunsigned linetype |
232 | | "signed" -> Tsigned linetype | |
faf9a90c | 233 | |
34e49164 C |
234 | | "auto" -> Tauto linetype |
235 | | "register" -> Tregister linetype | |
236 | | "extern" -> Textern linetype | |
237 | | "static" -> Tstatic linetype | |
238 | | "inline" -> Tinline linetype | |
239 | | "typedef" -> Ttypedef linetype | |
240 | ||
241 | | "const" -> Tconst linetype | |
242 | | "volatile" -> Tvolatile linetype | |
243 | ||
244 | | "if" -> TIf linetype | |
245 | | "else" -> TElse linetype | |
246 | | "while" -> TWhile linetype | |
247 | | "do" -> TDo linetype | |
248 | | "for" -> TFor linetype | |
249 | | "switch" -> TSwitch linetype | |
250 | | "case" -> TCase linetype | |
251 | | "default" -> TDefault linetype | |
252 | | "return" -> TReturn linetype | |
253 | | "break" -> TBreak linetype | |
254 | | "continue" -> TContinue linetype | |
255 | | "goto" -> TGoto linetype | |
256 | ||
257 | | "sizeof" -> TSizeof linetype | |
258 | ||
259 | | "Expression" -> TIsoExpression | |
260 | | "ArgExpression" -> TIsoArgExpression | |
261 | | "TestExpression" -> TIsoTestExpression | |
262 | | "Statement" -> TIsoStatement | |
263 | | "Declaration" -> TIsoDeclaration | |
264 | | "Type" -> TIsoType | |
265 | | "TopLevel" -> TIsoTopLevel | |
266 | ||
267 | | s -> check_var s linetype | |
268 | ||
269 | let mkassign op lexbuf = | |
270 | TAssign (Ast.OpAssign op, (get_current_line_type lexbuf)) | |
271 | ||
272 | let init _ = | |
273 | line := 1; | |
274 | logical_line := 0; | |
275 | prev_plus := false; | |
276 | line_start := 0; | |
277 | current_line_started := false; | |
278 | col_zero := true; | |
279 | pm := UNKNOWN; | |
280 | Data.in_rule_name := false; | |
281 | Data.in_meta := false; | |
282 | Data.in_prolog := false; | |
978fd7e5 | 283 | Data.saw_struct := false; |
34e49164 C |
284 | Data.inheritable_positions := []; |
285 | Hashtbl.clear all_metavariables; | |
286 | Hashtbl.clear Data.all_metadecls; | |
287 | Hashtbl.clear metavariables; | |
288 | Hashtbl.clear type_names; | |
289 | Hashtbl.clear rule_names; | |
708f4980 C |
290 | Hashtbl.clear iterator_names; |
291 | Hashtbl.clear declarer_names; | |
34e49164 C |
292 | let get_name (_,x) = x in |
293 | Data.add_id_meta := | |
294 | (fun name constraints pure -> | |
295 | let fn clt = TMetaId(name,constraints,pure,clt) in | |
296 | Hashtbl.replace metavariables (get_name name) fn); | |
b1b2de81 C |
297 | Data.add_fresh_id_meta := |
298 | (fun name -> | |
951c7801 | 299 | let fn clt = TMetaId(name,Ast.IdNoConstraint,Ast0.Impure,clt) in |
b1b2de81 | 300 | Hashtbl.replace metavariables (get_name name) fn); |
34e49164 C |
301 | Data.add_type_meta := |
302 | (fun name pure -> | |
303 | let fn clt = TMetaType(name,pure,clt) in | |
304 | Hashtbl.replace metavariables (get_name name) fn); | |
113803cf C |
305 | Data.add_init_meta := |
306 | (fun name pure -> | |
307 | let fn clt = TMetaInit(name,pure,clt) in | |
308 | Hashtbl.replace metavariables (get_name name) fn); | |
34e49164 C |
309 | Data.add_param_meta := |
310 | (function name -> function pure -> | |
311 | let fn clt = TMetaParam(name,pure,clt) in | |
312 | Hashtbl.replace metavariables (get_name name) fn); | |
313 | Data.add_paramlist_meta := | |
314 | (function name -> function lenname -> function pure -> | |
315 | let fn clt = TMetaParamList(name,lenname,pure,clt) in | |
316 | Hashtbl.replace metavariables (get_name name) fn); | |
317 | Data.add_const_meta := | |
318 | (fun tyopt name constraints pure -> | |
319 | let fn clt = TMetaConst(name,constraints,pure,tyopt,clt) in | |
320 | Hashtbl.replace metavariables (get_name name) fn); | |
321 | Data.add_err_meta := | |
322 | (fun name constraints pure -> | |
323 | let fn clt = TMetaErr(name,constraints,pure,clt) in | |
324 | Hashtbl.replace metavariables (get_name name) fn); | |
325 | Data.add_exp_meta := | |
326 | (fun tyopt name constraints pure -> | |
327 | let fn clt = TMetaExp(name,constraints,pure,tyopt,clt) in | |
328 | Hashtbl.replace metavariables (get_name name) fn); | |
329 | Data.add_idexp_meta := | |
330 | (fun tyopt name constraints pure -> | |
331 | let fn clt = TMetaIdExp(name,constraints,pure,tyopt,clt) in | |
332 | Hashtbl.replace metavariables (get_name name) fn); | |
333 | Data.add_local_idexp_meta := | |
334 | (fun tyopt name constraints pure -> | |
335 | let fn clt = TMetaLocalIdExp(name,constraints,pure,tyopt,clt) in | |
336 | Hashtbl.replace metavariables (get_name name) fn); | |
337 | Data.add_explist_meta := | |
338 | (function name -> function lenname -> function pure -> | |
339 | let fn clt = TMetaExpList(name,lenname,pure,clt) in | |
340 | Hashtbl.replace metavariables (get_name name) fn); | |
341 | Data.add_stm_meta := | |
342 | (function name -> function pure -> | |
343 | let fn clt = TMetaStm(name,pure,clt) in | |
344 | Hashtbl.replace metavariables (get_name name) fn); | |
345 | Data.add_stmlist_meta := | |
346 | (function name -> function pure -> | |
347 | let fn clt = TMetaStmList(name,pure,clt) in | |
348 | Hashtbl.replace metavariables (get_name name) fn); | |
349 | Data.add_func_meta := | |
350 | (fun name constraints pure -> | |
351 | let fn clt = TMetaFunc(name,constraints,pure,clt) in | |
352 | Hashtbl.replace metavariables (get_name name) fn); | |
353 | Data.add_local_func_meta := | |
354 | (fun name constraints pure -> | |
355 | let fn clt = TMetaLocalFunc(name,constraints,pure,clt) in | |
356 | Hashtbl.replace metavariables (get_name name) fn); | |
357 | Data.add_iterator_meta := | |
358 | (fun name constraints pure -> | |
359 | let fn clt = TMetaIterator(name,constraints,pure,clt) in | |
360 | Hashtbl.replace metavariables (get_name name) fn); | |
361 | Data.add_declarer_meta := | |
362 | (fun name constraints pure -> | |
363 | let fn clt = TMetaDeclarer(name,constraints,pure,clt) in | |
364 | Hashtbl.replace metavariables (get_name name) fn); | |
365 | Data.add_pos_meta := | |
366 | (fun name constraints any -> | |
367 | let fn ((d,ln,_,_,_,_,_,_) as clt) = | |
368 | (if d = Data.PLUS | |
369 | then | |
370 | failwith | |
371 | (Printf.sprintf "%d: positions only allowed in minus code" ln)); | |
372 | TMetaPos(name,constraints,any,clt) in | |
373 | Hashtbl.replace metavariables (get_name name) fn); | |
374 | Data.add_type_name := | |
375 | (function name -> | |
376 | let fn clt = TTypeId(name,clt) in | |
377 | Hashtbl.replace type_names name fn); | |
378 | Data.add_declarer_name := | |
379 | (function name -> | |
380 | let fn clt = TDeclarerId(name,clt) in | |
381 | Hashtbl.replace declarer_names name fn); | |
382 | Data.add_iterator_name := | |
383 | (function name -> | |
384 | let fn clt = TIteratorId(name,clt) in | |
385 | Hashtbl.replace iterator_names name fn); | |
386 | Data.init_rule := (function _ -> Hashtbl.clear metavariables); | |
387 | Data.install_bindings := | |
388 | (function parent -> | |
389 | List.iter (function (name,fn) -> Hashtbl.add metavariables name fn) | |
390 | (Hashtbl.find all_metavariables parent)) | |
391 | ||
392 | let drop_spaces s = | |
393 | let len = String.length s in | |
394 | let rec loop n = | |
395 | if n = len | |
396 | then n | |
397 | else | |
398 | if List.mem (String.get s n) [' ';'\t'] | |
399 | then loop (n+1) | |
400 | else n in | |
401 | let start = loop 0 in | |
402 | String.sub s start (len - start) | |
403 | } | |
404 | ||
405 | (* ---------------------------------------------------------------------- *) | |
406 | (* tokens *) | |
407 | ||
408 | let letter = ['A'-'Z' 'a'-'z' '_'] | |
409 | let digit = ['0'-'9'] | |
410 | ||
411 | let dec = ['0'-'9'] | |
412 | let oct = ['0'-'7'] | |
413 | let hex = ['0'-'9' 'a'-'f' 'A'-'F'] | |
414 | ||
415 | let decimal = ('0' | (['1'-'9'] dec*)) | |
416 | let octal = ['0'] oct+ | |
faf9a90c | 417 | let hexa = ("0x" |"0X") hex+ |
34e49164 C |
418 | |
419 | let pent = dec+ | |
420 | let pfract = dec+ | |
421 | let sign = ['-' '+'] | |
422 | let exp = ['e''E'] sign? dec+ | |
423 | let real = pent exp | ((pent? '.' pfract | pent '.' pfract? ) exp?) | |
424 | ||
425 | ||
426 | rule token = parse | |
427 | | [' ' '\t' ]+ { start_line false; token lexbuf } | |
428 | | ['\n' '\r' '\011' '\012'] { reset_line lexbuf; token lexbuf } | |
429 | ||
430 | | "//" [^ '\n']* { start_line false; token lexbuf } | |
431 | ||
432 | | "@@" { start_line true; TArobArob } | |
433 | | "@" { pass_zero(); | |
434 | if !Data.in_rule_name or not !current_line_started | |
435 | then (start_line true; TArob) | |
436 | else (check_minus_context_linetype "@"; TPArob) } | |
437 | ||
951c7801 C |
438 | | "~=" { start_line true; TTildeEq (get_current_line_type lexbuf) } |
439 | | "!~=" { start_line true; TTildeExclEq (get_current_line_type lexbuf) } | |
34e49164 C |
440 | | "WHEN" | "when" |
441 | { start_line true; check_minus_context_linetype (tok lexbuf); | |
442 | TWhen (get_current_line_type lexbuf) } | |
443 | ||
444 | | "..." | |
445 | { start_line true; check_minus_context_linetype (tok lexbuf); | |
446 | TEllipsis (get_current_line_type lexbuf) } | |
447 | (* | |
448 | | "ooo" | |
449 | { start_line true; check_minus_context_linetype (tok lexbuf); | |
450 | TCircles (get_current_line_type lexbuf) } | |
451 | ||
452 | | "***" | |
453 | { start_line true; check_minus_context_linetype (tok lexbuf); | |
454 | TStars (get_current_line_type lexbuf) } | |
455 | *) | |
456 | | "<..." { start_line true; check_context_linetype (tok lexbuf); | |
457 | TOEllipsis (get_current_line_type lexbuf) } | |
458 | | "...>" { start_line true; check_context_linetype (tok lexbuf); | |
459 | TCEllipsis (get_current_line_type lexbuf) } | |
460 | | "<+..." { start_line true; check_context_linetype (tok lexbuf); | |
461 | TPOEllipsis (get_current_line_type lexbuf) } | |
462 | | "...+>" { start_line true; check_context_linetype (tok lexbuf); | |
463 | TPCEllipsis (get_current_line_type lexbuf) } | |
464 | (* | |
465 | | "<ooo" { start_line true; check_context_linetype (tok lexbuf); | |
466 | TOCircles (get_current_line_type lexbuf) } | |
467 | | "ooo>" { start_line true; check_context_linetype (tok lexbuf); | |
468 | TCCircles (get_current_line_type lexbuf) } | |
469 | ||
470 | | "<***" { start_line true; check_context_linetype (tok lexbuf); | |
471 | TOStars (get_current_line_type lexbuf) } | |
472 | | "***>" { start_line true; check_context_linetype (tok lexbuf); | |
473 | TCStars (get_current_line_type lexbuf) } | |
474 | *) | |
475 | | "-" { pass_zero(); | |
476 | if !current_line_started | |
477 | then (start_line true; TMinus (get_current_line_type lexbuf)) | |
478 | else (patch_or_match PATCH; | |
479 | add_current_line_type D.MINUS; token lexbuf) } | |
480 | | "+" { pass_zero(); | |
481 | if !current_line_started | |
482 | then (start_line true; TPlus (get_current_line_type lexbuf)) | |
483 | else if !Data.in_meta | |
484 | then TPlus0 | |
485 | else (patch_or_match PATCH; | |
486 | add_current_line_type D.PLUS; token lexbuf) } | |
487 | | "?" { pass_zero(); | |
488 | if !current_line_started | |
489 | then (start_line true; TWhy (get_current_line_type lexbuf)) | |
490 | else if !Data.in_meta | |
491 | then TWhy0 | |
492 | else (add_current_line_type D.OPT; token lexbuf) } | |
493 | | "!" { pass_zero(); | |
494 | if !current_line_started | |
495 | then (start_line true; TBang (get_current_line_type lexbuf)) | |
496 | else if !Data.in_meta | |
497 | then TBang0 | |
498 | else (add_current_line_type D.UNIQUE; token lexbuf) } | |
499 | | "(" { if not !col_zero | |
500 | then (start_line true; TOPar (get_current_line_type lexbuf)) | |
501 | else | |
502 | (start_line true; check_context_linetype (tok lexbuf); | |
503 | TOPar0 (get_current_line_type lexbuf))} | |
504 | | "\\(" { start_line true; TOPar0 (get_current_line_type lexbuf) } | |
505 | | "|" { if not (!col_zero) | |
506 | then (start_line true; TOr(get_current_line_type lexbuf)) | |
507 | else (start_line true; | |
508 | check_context_linetype (tok lexbuf); | |
509 | TMid0 (get_current_line_type lexbuf))} | |
510 | | "\\|" { start_line true; TMid0 (get_current_line_type lexbuf) } | |
511 | | ")" { if not !col_zero | |
512 | then (start_line true; TCPar (get_current_line_type lexbuf)) | |
513 | else | |
514 | (start_line true; check_context_linetype (tok lexbuf); | |
515 | TCPar0 (get_current_line_type lexbuf))} | |
516 | | "\\)" { start_line true; TCPar0 (get_current_line_type lexbuf) } | |
517 | ||
518 | | '[' { start_line true; TOCro (get_current_line_type lexbuf) } | |
519 | | ']' { start_line true; TCCro (get_current_line_type lexbuf) } | |
520 | | '{' { start_line true; TOBrace (get_current_line_type lexbuf) } | |
521 | | '}' { start_line true; TCBrace (get_current_line_type lexbuf) } | |
522 | ||
523 | | "->" { start_line true; TPtrOp (get_current_line_type lexbuf) } | |
524 | | '.' { start_line true; TDot (get_current_line_type lexbuf) } | |
525 | | ',' { start_line true; TComma (get_current_line_type lexbuf) } | |
526 | | ";" { start_line true; | |
527 | if !Data.in_meta | |
528 | then TMPtVirg (* works better with tokens_all *) | |
529 | else TPtVirg (get_current_line_type lexbuf) } | |
530 | ||
faf9a90c | 531 | |
34e49164 C |
532 | | '*' { pass_zero(); |
533 | if !current_line_started | |
534 | then | |
535 | (start_line true; TMul (get_current_line_type lexbuf)) | |
536 | else | |
537 | (patch_or_match MATCH; | |
538 | add_current_line_type D.MINUS; token lexbuf) } | |
539 | | '/' { start_line true; | |
faf9a90c | 540 | TDmOp (Ast.Div,get_current_line_type lexbuf) } |
34e49164 | 541 | | '%' { start_line true; |
faf9a90c C |
542 | TDmOp (Ast.Mod,get_current_line_type lexbuf) } |
543 | | '~' { start_line true; TTilde (get_current_line_type lexbuf) } | |
544 | ||
951c7801 C |
545 | | "++" { pass_zero(); |
546 | if !current_line_started | |
547 | then | |
548 | (start_line true; TInc (get_current_line_type lexbuf)) | |
549 | else (patch_or_match PATCH; | |
550 | add_current_line_type D.PLUSPLUS; token lexbuf) } | |
34e49164 | 551 | | "--" { start_line true; TDec (get_current_line_type lexbuf) } |
faf9a90c C |
552 | |
553 | | "=" { start_line true; TEq (get_current_line_type lexbuf) } | |
554 | ||
34e49164 C |
555 | | "-=" { start_line true; mkassign Ast.Minus lexbuf } |
556 | | "+=" { start_line true; mkassign Ast.Plus lexbuf } | |
faf9a90c | 557 | |
34e49164 C |
558 | | "*=" { start_line true; mkassign Ast.Mul lexbuf } |
559 | | "/=" { start_line true; mkassign Ast.Div lexbuf } | |
560 | | "%=" { start_line true; mkassign Ast.Mod lexbuf } | |
faf9a90c | 561 | |
34e49164 C |
562 | | "&=" { start_line true; mkassign Ast.And lexbuf } |
563 | | "|=" { start_line true; mkassign Ast.Or lexbuf } | |
564 | | "^=" { start_line true; mkassign Ast.Xor lexbuf } | |
faf9a90c | 565 | |
34e49164 C |
566 | | "<<=" { start_line true; mkassign Ast.DecLeft lexbuf } |
567 | | ">>=" { start_line true; mkassign Ast.DecRight lexbuf } | |
568 | ||
569 | | ":" { start_line true; TDotDot (get_current_line_type lexbuf) } | |
faf9a90c | 570 | |
951c7801 C |
571 | | "==" { start_line true; TEqEq (get_current_line_type lexbuf) } |
572 | | "!=" { start_line true; TNotEq (get_current_line_type lexbuf) } | |
34e49164 C |
573 | | ">=" { start_line true; |
574 | TLogOp(Ast.SupEq,get_current_line_type lexbuf) } | |
575 | | "<=" { start_line true; | |
576 | TLogOp(Ast.InfEq,get_current_line_type lexbuf) } | |
577 | | "<" { start_line true; | |
faf9a90c | 578 | TLogOp(Ast.Inf,get_current_line_type lexbuf) } |
34e49164 C |
579 | | ">" { start_line true; |
580 | TLogOp(Ast.Sup,get_current_line_type lexbuf) } | |
faf9a90c C |
581 | |
582 | | "&&" { start_line true; TAndLog (get_current_line_type lexbuf) } | |
34e49164 | 583 | | "||" { start_line true; TOrLog (get_current_line_type lexbuf) } |
faf9a90c | 584 | |
34e49164 C |
585 | | ">>" { start_line true; |
586 | TShOp(Ast.DecRight,get_current_line_type lexbuf) } | |
587 | | "<<" { start_line true; | |
588 | TShOp(Ast.DecLeft,get_current_line_type lexbuf) } | |
faf9a90c | 589 | |
34e49164 C |
590 | | "&" { start_line true; TAnd (get_current_line_type lexbuf) } |
591 | | "^" { start_line true; TXor(get_current_line_type lexbuf) } | |
592 | ||
978fd7e5 | 593 | | "##" { start_line true; TCppConcatOp } |
708f4980 | 594 | | (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def) |
faf9a90c | 595 | ( (letter (letter |digit)*) as ident) |
34e49164 C |
596 | { start_line true; |
597 | let (arity,line,lline,offset,col,strbef,straft,pos) as lt = | |
598 | get_current_line_type lexbuf in | |
708f4980 | 599 | let off = String.length def in |
34e49164 C |
600 | (* -1 in the code below because the ident is not at the line start *) |
601 | TDefine | |
602 | (lt, | |
603 | check_var ident | |
708f4980 C |
604 | (arity,line,lline,offset+off,col+off,[],[],Ast0.NoMetaPos)) } |
605 | | (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def) | |
faf9a90c | 606 | ( (letter (letter | digit)*) as ident) |
34e49164 C |
607 | '(' |
608 | { start_line true; | |
609 | let (arity,line,lline,offset,col,strbef,straft,pos) as lt = | |
610 | get_current_line_type lexbuf in | |
708f4980 | 611 | let off = String.length def in |
34e49164 C |
612 | TDefineParam |
613 | (lt, | |
614 | check_var ident | |
615 | (* why pos here but not above? *) | |
708f4980 C |
616 | (arity,line,lline,offset+off,col+off,strbef,straft,pos), |
617 | offset + off + (String.length ident), | |
618 | col + off + (String.length ident)) } | |
34e49164 C |
619 | | "#" [' ' '\t']* "include" [' ' '\t']* '"' [^ '"']+ '"' |
620 | { TIncludeL | |
621 | (let str = tok lexbuf in | |
622 | let start = String.index str '"' in | |
623 | let finish = String.rindex str '"' in | |
624 | start_line true; | |
625 | (process_include start finish str,get_current_line_type lexbuf)) } | |
626 | | "#" [' ' '\t']* "include" [' ' '\t']* '<' [^ '>']+ '>' | |
627 | { TIncludeNL | |
628 | (let str = tok lexbuf in | |
629 | let start = String.index str '<' in | |
630 | let finish = String.rindex str '>' in | |
631 | start_line true; | |
632 | (process_include start finish str,get_current_line_type lexbuf)) } | |
633 | | "#" [' ' '\t']* "if" [^'\n']* | |
634 | | "#" [' ' '\t']* "ifdef" [^'\n']* | |
635 | | "#" [' ' '\t']* "ifndef" [^'\n']* | |
636 | | "#" [' ' '\t']* "else" [^'\n']* | |
637 | | "#" [' ' '\t']* "elif" [^'\n']* | |
638 | | "#" [' ' '\t']* "endif" [^'\n']* | |
639 | | "#" [' ' '\t']* "error" [^'\n']* | |
640 | { start_line true; check_plus_linetype (tok lexbuf); | |
0708f913 C |
641 | TPragma (tok lexbuf, get_current_line_type lexbuf) } |
642 | | "/*" | |
643 | { start_line true; check_plus_linetype (tok lexbuf); | |
644 | (* second argument to TPragma is not quite right, because | |
645 | it represents only the first token of the comemnt, but that | |
646 | should be good enough *) | |
647 | TPragma ("/*"^(comment lexbuf), get_current_line_type lexbuf) } | |
34e49164 C |
648 | | "---" [^'\n']* |
649 | { (if !current_line_started | |
650 | then lexerr "--- must be at the beginning of the line" ""); | |
651 | start_line true; | |
652 | TMinusFile | |
653 | (let str = tok lexbuf in | |
654 | (drop_spaces(String.sub str 3 (String.length str - 3)), | |
655 | (get_current_line_type lexbuf))) } | |
656 | | "+++" [^'\n']* | |
657 | { (if !current_line_started | |
658 | then lexerr "+++ must be at the beginning of the line" ""); | |
659 | start_line true; | |
660 | TPlusFile | |
661 | (let str = tok lexbuf in | |
662 | (drop_spaces(String.sub str 3 (String.length str - 3)), | |
663 | (get_current_line_type lexbuf))) } | |
664 | ||
665 | | letter (letter | digit)* | |
faf9a90c | 666 | { start_line true; id_tokens lexbuf } |
34e49164 C |
667 | |
668 | | "'" { start_line true; | |
669 | TChar(char lexbuf,get_current_line_type lexbuf) } | |
670 | | '"' { start_line true; | |
671 | TString(string lexbuf,(get_current_line_type lexbuf)) } | |
672 | | (real as x) { start_line true; | |
673 | TFloat(x,(get_current_line_type lexbuf)) } | |
faf9a90c C |
674 | | ((( decimal | hexa | octal) |
675 | ( ['u' 'U'] | |
676 | | ['l' 'L'] | |
34e49164 C |
677 | | (['l' 'L'] ['u' 'U']) |
678 | | (['u' 'U'] ['l' 'L']) | |
679 | | (['u' 'U'] ['l' 'L'] ['l' 'L']) | |
680 | | (['l' 'L'] ['l' 'L']) | |
681 | )? | |
682 | ) as x) { start_line true; TInt(x,(get_current_line_type lexbuf)) } | |
683 | ||
684 | | "<=>" { TIso } | |
685 | | "=>" { TRightIso } | |
686 | ||
687 | | eof { EOF } | |
688 | ||
689 | | _ { lexerr "unrecognised symbol, in token rule: " (tok lexbuf) } | |
690 | ||
691 | ||
692 | and char = parse | |
693 | | (_ as x) "'" { String.make 1 x } | |
694 | | (("\\" (oct | oct oct | oct oct oct)) as x "'") { x } | |
695 | | (("\\x" (hex | hex hex)) as x "'") { x } | |
696 | | (("\\" (_ as v)) as x "'") | |
697 | { (match v with | |
698 | | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | |
699 | | 'r' -> () | 'f' -> () | 'a' -> () | |
700 | | '\\' -> () | '?' -> () | '\'' -> () | '"' -> () | |
701 | | 'e' -> () | |
702 | | _ -> lexerr "unrecognised symbol: " (tok lexbuf) | |
703 | ); | |
704 | x | |
faf9a90c | 705 | } |
34e49164 C |
706 | | _ { lexerr "unrecognised symbol: " (tok lexbuf) } |
707 | ||
708 | and string = parse | |
709 | | '"' { "" } | |
710 | | (_ as x) { Common.string_of_char x ^ string lexbuf } | |
711 | | ("\\" (oct | oct oct | oct oct oct)) as x { x ^ string lexbuf } | |
712 | | ("\\x" (hex | hex hex)) as x { x ^ string lexbuf } | |
faf9a90c C |
713 | | ("\\" (_ as v)) as x |
714 | { | |
34e49164 | 715 | (match v with |
faf9a90c | 716 | | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> () |
34e49164 C |
717 | | 'f' -> () | 'a' -> () |
718 | | '\\' -> () | '?' -> () | '\'' -> () | '"' -> () | |
719 | | 'e' -> () | |
faf9a90c | 720 | | '\n' -> () |
34e49164 C |
721 | | _ -> lexerr "unrecognised symbol:" (tok lexbuf) |
722 | ); | |
723 | x ^ string lexbuf | |
724 | } | |
725 | | _ { lexerr "unrecognised symbol: " (tok lexbuf) } | |
0708f913 C |
726 | |
727 | and comment = parse | |
728 | | "*/" { start_line true; tok lexbuf } | |
729 | | ['\n' '\r' '\011' '\012'] | |
730 | { reset_line lexbuf; let s = tok lexbuf in s ^ comment lexbuf } | |
731 | | "+" { pass_zero(); | |
732 | if !current_line_started | |
733 | then (start_line true; let s = tok lexbuf in s^(comment lexbuf)) | |
734 | else comment lexbuf } | |
735 | (* noteopti: *) | |
736 | | [^ '*'] { start_line true; let s = tok lexbuf in s ^ comment lexbuf } | |
737 | | [ '*'] { start_line true; let s = tok lexbuf in s ^ comment lexbuf } | |
951c7801 | 738 | | _ |
0708f913 C |
739 | { start_line true; let s = tok lexbuf in |
740 | Common.pr2 ("LEXER: unrecognised symbol in comment:"^s); | |
741 | s ^ comment lexbuf | |
742 | } | |
743 |