HCoop / bpt / coccinelle.git / blob
? search:


f02c92380f38907d4e7a2c1bb823f6d035c19549
[bpt/coccinelle.git] / parsing_cocci / .#lexer_cocci.mll.1.86
1 (*
2 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
4 * This file is part of Coccinelle.
5 *
6 * Coccinelle is free software: you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation, according to version 2 of the License.
9 *
10 * Coccinelle is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
17 *
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
20 *)
21
22
23 {
24 open Parser_cocci_menhir
25 module D = Data
26 module Ast = Ast_cocci
27 module Ast0 = Ast0_cocci
28 module P = Parse_aux
29 exception Lexical of string
30 let tok = Lexing.lexeme
31
32 let line = ref 1
33 let logical_line = ref 0
34
35 (* ---------------------------------------------------------------------- *)
36 (* control codes *)
37
38 (* Defined in data.ml
39 type line_type = MINUS | OPTMINUS | UNIQUEMINUS | PLUS | CONTEXT | UNIQUE | OPT
40 *)
41
42 let current_line_type = ref (D.CONTEXT,!line,!logical_line)
43
44 let prev_plus = ref false
45 let line_start = ref 0 (* offset of the beginning of the line *)
46 let get_current_line_type lexbuf =
47 let (c,l,ll) = !current_line_type in
48 let lex_start = Lexing.lexeme_start lexbuf in
49 let preceeding_spaces =
50 if !line_start < 0 then 0 else lex_start - !line_start in
51 line_start := -1;
52 prev_plus := (c = D.PLUS);
53 (c,l,ll,lex_start,preceeding_spaces,[],[],Ast0.NoMetaPos)
54 let current_line_started = ref false
55 let col_zero = ref true
56
57 let reset_line lexbuf =
58 line := !line + 1;
59 current_line_type := (D.CONTEXT,!line,!logical_line);
60 current_line_started := false;
61 col_zero := true;
62 line_start := Lexing.lexeme_start lexbuf + 1
63
64 let started_line = ref (-1)
65
66 let start_line seen_char =
67 current_line_started := true;
68 col_zero := false;
69 (if seen_char && not(!line = !started_line)
70 then
71 begin
72 started_line := !line;
73 logical_line := !logical_line + 1
74 end)
75
76 let pass_zero _ = col_zero := false
77
78 let lexerr s1 s2 = raise (Lexical (Printf.sprintf "%s%s" s1 s2))
79
80 let add_current_line_type x =
81 match (x,!current_line_type) with
82 (D.MINUS,(D.CONTEXT,ln,lln)) ->
83 current_line_type := (D.MINUS,ln,lln)
84 | (D.MINUS,(D.UNIQUE,ln,lln)) ->
85 current_line_type := (D.UNIQUEMINUS,ln,lln)
86 | (D.MINUS,(D.OPT,ln,lln)) ->
87 current_line_type := (D.OPTMINUS,ln,lln)
88 | (D.PLUS,(D.CONTEXT,ln,lln)) ->
89 current_line_type := (D.PLUS,ln,lln)
90 | (D.UNIQUE,(D.CONTEXT,ln,lln)) ->
91 current_line_type := (D.UNIQUE,ln,lln)
92 | (D.OPT,(D.CONTEXT,ln,lln)) ->
93 current_line_type := (D.OPT,ln,lln)
94 | _ -> lexerr "invalid control character combination" ""
95
96 let check_minus_context_linetype s =
97 match !current_line_type with
98 (D.PLUS,_,_) -> lexerr "invalid in a + context: " s
99 | _ -> ()
100
101 let check_context_linetype s =
102 match !current_line_type with
103 (D.CONTEXT,_,_) -> ()
104 | _ -> lexerr "invalid in a nonempty context: " s
105
106 let check_plus_linetype s =
107 match !current_line_type with
108 (D.PLUS,_,_) -> ()
109 | _ -> lexerr "invalid in a non + context: " s
110
111 let check_arity_context_linetype s =
112 match !current_line_type with
113 (D.CONTEXT,_,_) | (D.PLUS,_,_) | (D.UNIQUE,_,_) | (D.OPT,_,_) -> ()
114 | _ -> lexerr "invalid in a nonempty context: " s
115
116 let process_include start finish str =
117 (match !current_line_type with
118 (D.PLUS,_,_) ->
119 (try
120 let _ = Str.search_forward (Str.regexp "\\.\\.\\.") str start in
121 lexerr "... not allowed in + include" ""
122 with Not_found -> ())
123 | _ -> ());
124 String.sub str (start + 1) (finish - start - 1)
125
126 (* ---------------------------------------------------------------------- *)
127 type pm = PATCH | MATCH | UNKNOWN
128
129 let pm = ref UNKNOWN
130
131 let patch_or_match = function
132 PATCH ->
133 (match !pm with
134 MATCH -> lexerr "- or + not allowed in the first column for a match" ""
135 | PATCH -> ()
136 | UNKNOWN -> Flag.sgrep_mode2 := false; pm := PATCH)
137 | MATCH ->
138 (match !pm with
139 PATCH -> lexerr "* not allowed in the first column for a patch" ""
140 | MATCH -> ()
141 | UNKNOWN -> Flag.sgrep_mode2 := true; pm := MATCH)
142 | _ -> failwith "unexpected argument"
143
144 (* ---------------------------------------------------------------------- *)
145 (* identifiers, including metavariables *)
146
147 let metavariables = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
148
149 let all_metavariables =
150 (Hashtbl.create(100) : (string,(string * (D.clt -> token)) list) Hashtbl.t)
151
152 let type_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
153
154 let declarer_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
155
156 let iterator_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
157
158 let rule_names = (Hashtbl.create(100) : (string, unit) Hashtbl.t)
159
160 let check_var s linetype =
161 let fail _ =
162 if (!Data.in_prolog || !Data.in_rule_name) &&
163 Str.string_match (Str.regexp "<.*>") s 0
164 then TPathIsoFile s
165 else
166 try (Hashtbl.find metavariables s) linetype
167 with Not_found ->
168 (try (Hashtbl.find type_names s) linetype
169 with Not_found ->
170 (try (Hashtbl.find declarer_names s) linetype
171 with Not_found ->
172 (try (Hashtbl.find iterator_names s) linetype
173 with Not_found -> TIdent (s,linetype)))) in
174 if !Data.in_meta or !Data.in_rule_name
175 then (try Hashtbl.find rule_names s; TRuleName s with Not_found -> fail())
176 else fail()
177
178 let id_tokens lexbuf =
179 let s = tok lexbuf in
180 let linetype = get_current_line_type lexbuf in
181 let in_rule_name = !Data.in_rule_name in
182 let in_meta = !Data.in_meta in
183 let in_iso = !Data.in_iso in
184 let in_prolog = !Data.in_prolog in
185 match s with
186 "identifier" when in_meta -> check_arity_context_linetype s; TIdentifier
187 | "type" when in_meta -> check_arity_context_linetype s; TType
188 | "parameter" when in_meta -> check_arity_context_linetype s; TParameter
189 | "constant" when in_meta -> check_arity_context_linetype s; TConstant
190 | "generated" when in_rule_name && not (!Flag.make_hrule = None) ->
191 check_arity_context_linetype s; TGenerated
192 | "expression" when in_meta || in_rule_name ->
193 check_arity_context_linetype s; TExpression
194 | "initialiser" when in_meta || in_rule_name ->
195 check_arity_context_linetype s; TInitialiser
196 | "initializer" when in_meta || in_rule_name ->
197 check_arity_context_linetype s; TInitialiser
198 | "idexpression" when in_meta ->
199 check_arity_context_linetype s; TIdExpression
200 | "statement" when in_meta -> check_arity_context_linetype s; TStatement
201 | "function" when in_meta -> check_arity_context_linetype s; TFunction
202 | "local" when in_meta -> check_arity_context_linetype s; TLocal
203 | "list" when in_meta -> check_arity_context_linetype s; Tlist
204 | "fresh" when in_meta -> check_arity_context_linetype s; TFresh
205 | "typedef" when in_meta -> check_arity_context_linetype s; TTypedef
206 | "declarer" when in_meta -> check_arity_context_linetype s; TDeclarer
207 | "iterator" when in_meta -> check_arity_context_linetype s; TIterator
208 | "name" when in_meta -> check_arity_context_linetype s; TName
209 | "position" when in_meta -> check_arity_context_linetype s; TPosition
210 | "any" when in_meta -> check_arity_context_linetype s; TPosAny
211 | "pure" when in_meta && in_iso ->
212 check_arity_context_linetype s; TPure
213 | "context" when in_meta && in_iso ->
214 check_arity_context_linetype s; TContext
215 | "error" when in_meta -> check_arity_context_linetype s; TError
216 | "words" when in_meta -> check_context_linetype s; TWords
217
218 | "using" when in_rule_name || in_prolog -> check_context_linetype s; TUsing
219 | "disable" when in_rule_name -> check_context_linetype s; TDisable
220 | "extends" when in_rule_name -> check_context_linetype s; TExtends
221 | "depends" when in_rule_name -> check_context_linetype s; TDepends
222 | "on" when in_rule_name -> check_context_linetype s; TOn
223 | "ever" when in_rule_name -> check_context_linetype s; TEver
224 | "never" when in_rule_name -> check_context_linetype s; TNever
225 | "exists" when in_rule_name -> check_context_linetype s; TExists
226 | "forall" when in_rule_name -> check_context_linetype s; TForall
227 | "reverse" when in_rule_name -> check_context_linetype s; TReverse
228 | "script" when in_rule_name -> check_context_linetype s; TScript
229
230 | "char" -> Tchar linetype
231 | "short" -> Tshort linetype
232 | "int" -> Tint linetype
233 | "double" -> Tdouble linetype
234 | "float" -> Tfloat linetype
235 | "long" -> Tlong linetype
236 | "void" -> Tvoid linetype
237 | "struct" -> Tstruct linetype
238 | "union" -> Tunion linetype
239 | "enum" -> Tenum linetype
240 | "unsigned" -> Tunsigned linetype
241 | "signed" -> Tsigned linetype
242
243 | "auto" -> Tauto linetype
244 | "register" -> Tregister linetype
245 | "extern" -> Textern linetype
246 | "static" -> Tstatic linetype
247 | "inline" -> Tinline linetype
248 | "typedef" -> Ttypedef linetype
249
250 | "const" -> Tconst linetype
251 | "volatile" -> Tvolatile linetype
252
253 | "if" -> TIf linetype
254 | "else" -> TElse linetype
255 | "while" -> TWhile linetype
256 | "do" -> TDo linetype
257 | "for" -> TFor linetype
258 | "switch" -> TSwitch linetype
259 | "case" -> TCase linetype
260 | "default" -> TDefault linetype
261 | "return" -> TReturn linetype
262 | "break" -> TBreak linetype
263 | "continue" -> TContinue linetype
264 | "goto" -> TGoto linetype
265
266 | "sizeof" -> TSizeof linetype
267
268 | "Expression" -> TIsoExpression
269 | "ArgExpression" -> TIsoArgExpression
270 | "TestExpression" -> TIsoTestExpression
271 | "Statement" -> TIsoStatement
272 | "Declaration" -> TIsoDeclaration
273 | "Type" -> TIsoType
274 | "TopLevel" -> TIsoTopLevel
275
276 | s -> check_var s linetype
277
278 let mkassign op lexbuf =
279 TAssign (Ast.OpAssign op, (get_current_line_type lexbuf))
280
281 let init _ =
282 line := 1;
283 logical_line := 0;
284 prev_plus := false;
285 line_start := 0;
286 current_line_started := false;
287 col_zero := true;
288 pm := UNKNOWN;
289 Data.in_rule_name := false;
290 Data.in_meta := false;
291 Data.in_prolog := false;
292 Data.inheritable_positions := [];
293 Hashtbl.clear all_metavariables;
294 Hashtbl.clear Data.all_metadecls;
295 Hashtbl.clear metavariables;
296 Hashtbl.clear type_names;
297 Hashtbl.clear rule_names;
298 let get_name (_,x) = x in
299 Data.add_id_meta :=
300 (fun name constraints pure ->
301 let fn clt = TMetaId(name,constraints,pure,clt) in
302 Hashtbl.replace metavariables (get_name name) fn);
303 Data.add_type_meta :=
304 (fun name pure ->
305 let fn clt = TMetaType(name,pure,clt) in
306 Hashtbl.replace metavariables (get_name name) fn);
307 Data.add_init_meta :=
308 (fun name pure ->
309 let fn clt = TMetaInit(name,pure,clt) in
310 Hashtbl.replace metavariables (get_name name) fn);
311 Data.add_param_meta :=
312 (function name -> function pure ->
313 let fn clt = TMetaParam(name,pure,clt) in
314 Hashtbl.replace metavariables (get_name name) fn);
315 Data.add_paramlist_meta :=
316 (function name -> function lenname -> function pure ->
317 let fn clt = TMetaParamList(name,lenname,pure,clt) in
318 Hashtbl.replace metavariables (get_name name) fn);
319 Data.add_const_meta :=
320 (fun tyopt name constraints pure ->
321 let fn clt = TMetaConst(name,constraints,pure,tyopt,clt) in
322 Hashtbl.replace metavariables (get_name name) fn);
323 Data.add_err_meta :=
324 (fun name constraints pure ->
325 let fn clt = TMetaErr(name,constraints,pure,clt) in
326 Hashtbl.replace metavariables (get_name name) fn);
327 Data.add_exp_meta :=
328 (fun tyopt name constraints pure ->
329 let fn clt = TMetaExp(name,constraints,pure,tyopt,clt) in
330 Hashtbl.replace metavariables (get_name name) fn);
331 Data.add_idexp_meta :=
332 (fun tyopt name constraints pure ->
333 let fn clt = TMetaIdExp(name,constraints,pure,tyopt,clt) in
334 Hashtbl.replace metavariables (get_name name) fn);
335 Data.add_local_idexp_meta :=
336 (fun tyopt name constraints pure ->
337 let fn clt = TMetaLocalIdExp(name,constraints,pure,tyopt,clt) in
338 Hashtbl.replace metavariables (get_name name) fn);
339 Data.add_explist_meta :=
340 (function name -> function lenname -> function pure ->
341 let fn clt = TMetaExpList(name,lenname,pure,clt) in
342 Hashtbl.replace metavariables (get_name name) fn);
343 Data.add_stm_meta :=
344 (function name -> function pure ->
345 let fn clt = TMetaStm(name,pure,clt) in
346 Hashtbl.replace metavariables (get_name name) fn);
347 Data.add_stmlist_meta :=
348 (function name -> function pure ->
349 let fn clt = TMetaStmList(name,pure,clt) in
350 Hashtbl.replace metavariables (get_name name) fn);
351 Data.add_func_meta :=
352 (fun name constraints pure ->
353 let fn clt = TMetaFunc(name,constraints,pure,clt) in
354 Hashtbl.replace metavariables (get_name name) fn);
355 Data.add_local_func_meta :=
356 (fun name constraints pure ->
357 let fn clt = TMetaLocalFunc(name,constraints,pure,clt) in
358 Hashtbl.replace metavariables (get_name name) fn);
359 Data.add_iterator_meta :=
360 (fun name constraints pure ->
361 let fn clt = TMetaIterator(name,constraints,pure,clt) in
362 Hashtbl.replace metavariables (get_name name) fn);
363 Data.add_declarer_meta :=
364 (fun name constraints pure ->
365 let fn clt = TMetaDeclarer(name,constraints,pure,clt) in
366 Hashtbl.replace metavariables (get_name name) fn);
367 Data.add_pos_meta :=
368 (fun name constraints any ->
369 let fn ((d,ln,_,_,_,_,_,_) as clt) =
370 (if d = Data.PLUS
371 then
372 failwith
373 (Printf.sprintf "%d: positions only allowed in minus code" ln));
374 TMetaPos(name,constraints,any,clt) in
375 Hashtbl.replace metavariables (get_name name) fn);
376 Data.add_type_name :=
377 (function name ->
378 let fn clt = TTypeId(name,clt) in
379 Hashtbl.replace type_names name fn);
380 Data.add_declarer_name :=
381 (function name ->
382 let fn clt = TDeclarerId(name,clt) in
383 Hashtbl.replace declarer_names name fn);
384 Data.add_iterator_name :=
385 (function name ->
386 let fn clt = TIteratorId(name,clt) in
387 Hashtbl.replace iterator_names name fn);
388 Data.init_rule := (function _ -> Hashtbl.clear metavariables);
389 Data.install_bindings :=
390 (function parent ->
391 List.iter (function (name,fn) -> Hashtbl.add metavariables name fn)
392 (Hashtbl.find all_metavariables parent))
393
394 let drop_spaces s =
395 let len = String.length s in
396 let rec loop n =
397 if n = len
398 then n
399 else
400 if List.mem (String.get s n) [' ';'\t']
401 then loop (n+1)
402 else n in
403 let start = loop 0 in
404 String.sub s start (len - start)
405 }
406
407 (* ---------------------------------------------------------------------- *)
408 (* tokens *)
409
410 let letter = ['A'-'Z' 'a'-'z' '_']
411 let digit = ['0'-'9']
412
413 let dec = ['0'-'9']
414 let oct = ['0'-'7']
415 let hex = ['0'-'9' 'a'-'f' 'A'-'F']
416
417 let decimal = ('0' | (['1'-'9'] dec*))
418 let octal = ['0'] oct+
419 let hexa = ("0x" |"0X") hex+
420
421 let pent = dec+
422 let pfract = dec+
423 let sign = ['-' '+']
424 let exp = ['e''E'] sign? dec+
425 let real = pent exp | ((pent? '.' pfract | pent '.' pfract? ) exp?)
426
427
428 rule token = parse
429 | [' ' '\t' ]+ { start_line false; token lexbuf }
430 | ['\n' '\r' '\011' '\012'] { reset_line lexbuf; token lexbuf }
431
432 | "//" [^ '\n']* { start_line false; token lexbuf }
433
434 | "@@" { start_line true; TArobArob }
435 | "@" { pass_zero();
436 if !Data.in_rule_name or not !current_line_started
437 then (start_line true; TArob)
438 else (check_minus_context_linetype "@"; TPArob) }
439
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
531
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;
540 TDmOp (Ast.Div,get_current_line_type lexbuf) }
541 | '%' { start_line true;
542 TDmOp (Ast.Mod,get_current_line_type lexbuf) }
543 | '~' { start_line true; TTilde (get_current_line_type lexbuf) }
544
545 | "++" { start_line true; TInc (get_current_line_type lexbuf) }
546 | "--" { start_line true; TDec (get_current_line_type lexbuf) }
547
548 | "=" { start_line true; TEq (get_current_line_type lexbuf) }
549
550 | "-=" { start_line true; mkassign Ast.Minus lexbuf }
551 | "+=" { start_line true; mkassign Ast.Plus lexbuf }
552
553 | "*=" { start_line true; mkassign Ast.Mul lexbuf }
554 | "/=" { start_line true; mkassign Ast.Div lexbuf }
555 | "%=" { start_line true; mkassign Ast.Mod lexbuf }
556
557 | "&=" { start_line true; mkassign Ast.And lexbuf }
558 | "|=" { start_line true; mkassign Ast.Or lexbuf }
559 | "^=" { start_line true; mkassign Ast.Xor lexbuf }
560
561 | "<<=" { start_line true; mkassign Ast.DecLeft lexbuf }
562 | ">>=" { start_line true; mkassign Ast.DecRight lexbuf }
563
564 | ":" { start_line true; TDotDot (get_current_line_type lexbuf) }
565
566 | "==" { start_line true; TEqEq (get_current_line_type lexbuf) }
567 | "!=" { start_line true; TNotEq (get_current_line_type lexbuf) }
568 | ">=" { start_line true;
569 TLogOp(Ast.SupEq,get_current_line_type lexbuf) }
570 | "<=" { start_line true;
571 TLogOp(Ast.InfEq,get_current_line_type lexbuf) }
572 | "<" { start_line true;
573 TLogOp(Ast.Inf,get_current_line_type lexbuf) }
574 | ">" { start_line true;
575 TLogOp(Ast.Sup,get_current_line_type lexbuf) }
576
577 | "&&" { start_line true; TAndLog (get_current_line_type lexbuf) }
578 | "||" { start_line true; TOrLog (get_current_line_type lexbuf) }
579
580 | ">>" { start_line true;
581 TShOp(Ast.DecRight,get_current_line_type lexbuf) }
582 | "<<" { start_line true;
583 TShOp(Ast.DecLeft,get_current_line_type lexbuf) }
584
585 | "&" { start_line true; TAnd (get_current_line_type lexbuf) }
586 | "^" { start_line true; TXor(get_current_line_type lexbuf) }
587
588 | ( ("#" [' ' '\t']* "define" [' ' '\t']+))
589 ( (letter (letter |digit)*) as ident)
590 { start_line true;
591 let (arity,line,lline,offset,col,strbef,straft,pos) as lt =
592 get_current_line_type lexbuf in
593 let off = String.length "#define " in
594 (* -1 in the code below because the ident is not at the line start *)
595 TDefine
596 (lt,
597 check_var ident
598 (arity,line,lline,offset+off,(-1),[],[],Ast0.NoMetaPos)) }
599 | ( ("#" [' ' '\t']* "define" [' ' '\t']+))
600 ( (letter (letter | digit)*) as ident)
601 '('
602 { start_line true;
603 let (arity,line,lline,offset,col,strbef,straft,pos) as lt =
604 get_current_line_type lexbuf in
605 let off = String.length "#define " in
606 TDefineParam
607 (lt,
608 check_var ident
609 (* why pos here but not above? *)
610 (arity,line,lline,offset+off,(-1),strbef,straft,pos),
611 offset + off + (String.length ident)) }
612 | "#" [' ' '\t']* "include" [' ' '\t']* '"' [^ '"']+ '"'
613 { TIncludeL
614 (let str = tok lexbuf in
615 let start = String.index str '"' in
616 let finish = String.rindex str '"' in
617 start_line true;
618 (process_include start finish str,get_current_line_type lexbuf)) }
619 | "#" [' ' '\t']* "include" [' ' '\t']* '<' [^ '>']+ '>'
620 { TIncludeNL
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']* "if" [^'\n']*
627 | "#" [' ' '\t']* "ifdef" [^'\n']*
628 | "#" [' ' '\t']* "ifndef" [^'\n']*
629 | "#" [' ' '\t']* "else" [^'\n']*
630 | "#" [' ' '\t']* "elif" [^'\n']*
631 | "#" [' ' '\t']* "endif" [^'\n']*
632 | "#" [' ' '\t']* "error" [^'\n']*
633 { start_line true; check_plus_linetype (tok lexbuf);
634 TPragma (tok lexbuf) }
635 | "---" [^'\n']*
636 { (if !current_line_started
637 then lexerr "--- must be at the beginning of the line" "");
638 start_line true;
639 TMinusFile
640 (let str = tok lexbuf in
641 (drop_spaces(String.sub str 3 (String.length str - 3)),
642 (get_current_line_type lexbuf))) }
643 | "+++" [^'\n']*
644 { (if !current_line_started
645 then lexerr "+++ must be at the beginning of the line" "");
646 start_line true;
647 TPlusFile
648 (let str = tok lexbuf in
649 (drop_spaces(String.sub str 3 (String.length str - 3)),
650 (get_current_line_type lexbuf))) }
651
652 | letter (letter | digit)*
653 { start_line true; id_tokens lexbuf }
654
655 | "'" { start_line true;
656 TChar(char lexbuf,get_current_line_type lexbuf) }
657 | '"' { start_line true;
658 TString(string lexbuf,(get_current_line_type lexbuf)) }
659 | (real as x) { start_line true;
660 TFloat(x,(get_current_line_type lexbuf)) }
661 | ((( decimal | hexa | octal)
662 ( ['u' 'U']
663 | ['l' 'L']
664 | (['l' 'L'] ['u' 'U'])
665 | (['u' 'U'] ['l' 'L'])
666 | (['u' 'U'] ['l' 'L'] ['l' 'L'])
667 | (['l' 'L'] ['l' 'L'])
668 )?
669 ) as x) { start_line true; TInt(x,(get_current_line_type lexbuf)) }
670
671 | "<=>" { TIso }
672 | "=>" { TRightIso }
673
674 | eof { EOF }
675
676 | _ { lexerr "unrecognised symbol, in token rule: " (tok lexbuf) }
677
678
679 and char = parse
680 | (_ as x) "'" { String.make 1 x }
681 | (("\\" (oct | oct oct | oct oct oct)) as x "'") { x }
682 | (("\\x" (hex | hex hex)) as x "'") { x }
683 | (("\\" (_ as v)) as x "'")
684 { (match v with
685 | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> ()
686 | 'r' -> () | 'f' -> () | 'a' -> ()
687 | '\\' -> () | '?' -> () | '\'' -> () | '"' -> ()
688 | 'e' -> ()
689 | _ -> lexerr "unrecognised symbol: " (tok lexbuf)
690 );
691 x
692 }
693 | _ { lexerr "unrecognised symbol: " (tok lexbuf) }
694
695 and string = parse
696 | '"' { "" }
697 | (_ as x) { Common.string_of_char x ^ string lexbuf }
698 | ("\\" (oct | oct oct | oct oct oct)) as x { x ^ string lexbuf }
699 | ("\\x" (hex | hex hex)) as x { x ^ string lexbuf }
700 | ("\\" (_ as v)) as x
701 {
702 (match v with
703 | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> ()
704 | 'f' -> () | 'a' -> ()
705 | '\\' -> () | '?' -> () | '\'' -> () | '"' -> ()
706 | 'e' -> ()
707 | '\n' -> ()
708 | _ -> lexerr "unrecognised symbol:" (tok lexbuf)
709 );
710 x ^ string lexbuf
711 }
712 | _ { lexerr "unrecognised symbol: " (tok lexbuf) }
Unnamed repository; edit this file 'description' to name the repository.