2 * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
3 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
4 * This file is part of Coccinelle.
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.
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.
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/>.
18 * The authors reserve the right to distribute this or future versions of
19 * Coccinelle under other licenses.
24 open Parser_cocci_menhir
26 module Ast = Ast_cocci
27 module Ast0 = Ast0_cocci
29 exception Lexical of string
30 let tok = Lexing.lexeme
33 let logical_line = ref 0
35 (* ---------------------------------------------------------------------- *)
39 type line_type = MINUS | OPTMINUS | UNIQUEMINUS | PLUS | CONTEXT | UNIQUE | OPT
42 let current_line_type = ref (D.CONTEXT,!line,!logical_line)
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
52 prev_plus := (c = D.PLUS) or (c = D.PLUSPLUS);
53 (c,l,ll,lex_start,preceeding_spaces,[],[],Ast0.NoMetaPos)
54 let current_line_started = ref false
55 let col_zero = ref true
57 let reset_line lexbuf =
59 current_line_type := (D.CONTEXT,!line,!logical_line);
60 current_line_started := false;
62 line_start := Lexing.lexeme_start lexbuf + 1
64 let started_line = ref (-1)
66 let start_line seen_char =
67 current_line_started := true;
69 (if seen_char && not(!line = !started_line)
72 started_line := !line;
73 logical_line := !logical_line + 1
76 let pass_zero _ = col_zero := false
78 let lexerr s1 s2 = raise (Lexical (Printf.sprintf "%s%s" s1 s2))
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.PLUSPLUS,(D.CONTEXT,ln,lln)) ->
91 current_line_type := (D.PLUSPLUS,ln,lln)
92 | (D.UNIQUE,(D.CONTEXT,ln,lln)) ->
93 current_line_type := (D.UNIQUE,ln,lln)
94 | (D.OPT,(D.CONTEXT,ln,lln)) ->
95 current_line_type := (D.OPT,ln,lln)
96 | _ -> lexerr "invalid control character combination" ""
98 let check_minus_context_linetype s =
99 match !current_line_type with
100 (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> lexerr "invalid in a + context: " s
103 let check_context_linetype s =
104 match !current_line_type with
105 (D.CONTEXT,_,_) -> ()
106 | _ -> lexerr "invalid in a nonempty context: " s
108 let check_plus_linetype s =
109 match !current_line_type with
110 (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> ()
111 | _ -> lexerr "invalid in a non + context: " s
113 let check_arity_context_linetype s =
114 match !current_line_type with
115 (D.CONTEXT,_,_) | (D.PLUS,_,_) | (D.PLUSPLUS,_,_)
116 | (D.UNIQUE,_,_) | (D.OPT,_,_) -> ()
117 | _ -> lexerr "invalid in a nonempty context: " s
119 let process_include start finish str =
120 (match !current_line_type with
121 (D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
123 let _ = Str.search_forward (Str.regexp "\\.\\.\\.") str start in
124 lexerr "... not allowed in + include" ""
125 with Not_found -> ())
127 String.sub str (start + 1) (finish - start - 1)
129 (* ---------------------------------------------------------------------- *)
130 type pm = PATCH | MATCH | UNKNOWN
134 let patch_or_match = function
136 if not !D.ignore_patch_or_match
140 lexerr "- or + not allowed in the first column for a match" ""
142 | UNKNOWN -> Flag.sgrep_mode2 := false; pm := PATCH)
144 if not !D.ignore_patch_or_match
147 PATCH -> lexerr "* not allowed in the first column for a patch" ""
149 | UNKNOWN -> Flag.sgrep_mode2 := true; pm := MATCH)
150 | _ -> failwith "unexpected argument"
152 (* ---------------------------------------------------------------------- *)
153 (* identifiers, including metavariables *)
155 let metavariables = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
157 let all_metavariables =
158 (Hashtbl.create(100) : (string,(string * (D.clt -> token)) list) Hashtbl.t)
160 let type_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
162 let declarer_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
164 let iterator_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
166 let rule_names = (Hashtbl.create(100) : (string, unit) Hashtbl.t)
168 let check_var s linetype =
170 if (!Data.in_prolog || !Data.in_rule_name) &&
171 Str.string_match (Str.regexp "<.*>") s 0
174 try (Hashtbl.find metavariables s) linetype
176 (try (Hashtbl.find type_names s) linetype
178 (try (Hashtbl.find declarer_names s) linetype
180 (try (Hashtbl.find iterator_names s) linetype
181 with Not_found -> TIdent (s,linetype)))) in
182 if !Data.in_meta or !Data.in_rule_name
183 then (try Hashtbl.find rule_names s; TRuleName s with Not_found -> fail())
186 let id_tokens lexbuf =
187 let s = tok lexbuf in
188 let linetype = get_current_line_type lexbuf in
189 let in_rule_name = !Data.in_rule_name in
190 let in_meta = !Data.in_meta && not !Data.saw_struct in
191 let in_iso = !Data.in_iso in
192 let in_prolog = !Data.in_prolog in
194 "identifier" when in_meta -> check_arity_context_linetype s; TIdentifier
195 | "type" when in_meta -> check_arity_context_linetype s; TType
196 | "parameter" when in_meta -> check_arity_context_linetype s; TParameter
197 | "constant" when in_meta -> check_arity_context_linetype s; TConstant
198 | "generated" when in_rule_name && not (!Flag.make_hrule = None) ->
199 check_arity_context_linetype s; TGenerated
200 | "expression" when in_meta || in_rule_name ->
201 check_arity_context_linetype s; TExpression
202 | "initialiser" when in_meta || in_rule_name ->
203 check_arity_context_linetype s; TInitialiser
204 | "initializer" when in_meta || in_rule_name ->
205 check_arity_context_linetype s; TInitialiser
206 | "idexpression" when in_meta ->
207 check_arity_context_linetype s; TIdExpression
208 | "statement" when in_meta -> check_arity_context_linetype s; TStatement
209 | "function" when in_meta -> check_arity_context_linetype s; TFunction
210 | "local" when in_meta -> check_arity_context_linetype s; TLocal
211 | "list" when in_meta -> check_arity_context_linetype s; Tlist
212 | "fresh" when in_meta -> check_arity_context_linetype s; TFresh
213 | "typedef" when in_meta -> check_arity_context_linetype s; TTypedef
214 | "declarer" when in_meta -> check_arity_context_linetype s; TDeclarer
215 | "iterator" when in_meta -> check_arity_context_linetype s; TIterator
216 | "name" when in_meta -> check_arity_context_linetype s; TName
217 | "position" when in_meta -> check_arity_context_linetype s; TPosition
218 | "any" when in_meta -> check_arity_context_linetype s; TPosAny
219 | "pure" when in_meta && in_iso ->
220 check_arity_context_linetype s; TPure
221 | "context" when in_meta && in_iso ->
222 check_arity_context_linetype s; TContext
223 | "error" when in_meta -> check_arity_context_linetype s; TError
224 | "words" when in_meta -> check_context_linetype s; TWords
226 | "using" when in_rule_name || in_prolog -> check_context_linetype s; TUsing
227 | "virtual" when in_prolog or in_rule_name or in_meta ->
228 (* don't want to allow virtual as a rule name *)
229 check_context_linetype s; TVirtual
230 | "disable" when in_rule_name -> check_context_linetype s; TDisable
231 | "extends" when in_rule_name -> check_context_linetype s; TExtends
232 | "depends" when in_rule_name -> check_context_linetype s; TDepends
233 | "on" when in_rule_name -> check_context_linetype s; TOn
234 | "ever" when in_rule_name -> check_context_linetype s; TEver
235 | "never" when in_rule_name -> check_context_linetype s; TNever
236 (* exists and forall for when are reparsed in parse_cocci.ml *)
237 | "exists" when in_rule_name -> check_context_linetype s; TExists
238 | "forall" when in_rule_name -> check_context_linetype s; TForall
239 | "script" when in_rule_name -> check_context_linetype s; TScript
240 | "initialize" when in_rule_name -> check_context_linetype s; TInitialize
241 | "finalize" when in_rule_name -> check_context_linetype s; TFinalize
243 | "char" -> Tchar linetype
244 | "short" -> Tshort linetype
245 | "int" -> Tint linetype
246 | "double" -> Tdouble linetype
247 | "float" -> Tfloat linetype
248 | "long" -> Tlong linetype
249 | "void" -> Tvoid linetype
250 (* in_meta is only for the first keyword; drop it now to allow any type
252 | "struct" -> Data.saw_struct := true; Tstruct linetype
253 | "union" -> Data.saw_struct := true; Tunion linetype
254 | "enum" -> Data.saw_struct := true; Tenum linetype
255 | "unsigned" -> Tunsigned linetype
256 | "signed" -> Tsigned linetype
258 | "auto" -> Tauto linetype
259 | "register" -> Tregister linetype
260 | "extern" -> Textern linetype
261 | "static" -> Tstatic linetype
262 | "inline" -> Tinline linetype
263 | "typedef" -> Ttypedef linetype
265 | "const" -> Tconst linetype
266 | "volatile" -> Tvolatile linetype
268 | "if" -> TIf linetype
269 | "else" -> TElse linetype
270 | "while" -> TWhile linetype
271 | "do" -> TDo linetype
272 | "for" -> TFor linetype
273 | "switch" -> TSwitch linetype
274 | "case" -> TCase linetype
275 | "default" -> TDefault linetype
276 | "return" -> TReturn linetype
277 | "break" -> TBreak linetype
278 | "continue" -> TContinue linetype
279 | "goto" -> TGoto linetype
281 | "sizeof" -> TSizeof linetype
283 | "Expression" -> TIsoExpression
284 | "ArgExpression" -> TIsoArgExpression
285 | "TestExpression" -> TIsoTestExpression
286 | "ToTestExpression" -> TIsoToTestExpression
287 | "Statement" -> TIsoStatement
288 | "Declaration" -> TIsoDeclaration
290 | "TopLevel" -> TIsoTopLevel
292 | s -> check_var s linetype
294 let mkassign op lexbuf =
295 TAssign (Ast.OpAssign op, (get_current_line_type lexbuf))
302 current_line_started := false;
303 current_line_type := (D.CONTEXT,0,0);
306 Data.in_rule_name := false;
307 Data.in_meta := false;
308 Data.in_prolog := false;
309 Data.saw_struct := false;
310 Data.inheritable_positions := [];
311 Hashtbl.clear all_metavariables;
312 Hashtbl.clear Data.all_metadecls;
313 Hashtbl.clear metavariables;
314 Hashtbl.clear type_names;
315 Hashtbl.clear rule_names;
316 Hashtbl.clear iterator_names;
317 Hashtbl.clear declarer_names;
318 let get_name (_,x) = x in
320 (fun name constraints pure ->
321 let fn clt = TMetaId(name,constraints,pure,clt) in
322 Hashtbl.replace metavariables (get_name name) fn);
323 Data.add_virt_id_meta_found :=
325 let fn clt = TIdent(vl,clt) in
326 Hashtbl.replace metavariables name fn);
327 Data.add_virt_id_meta_not_found :=
329 let fn clt = TMetaId(name,Ast.IdNoConstraint,pure,clt) in
330 Hashtbl.replace metavariables (get_name name) fn);
331 Data.add_fresh_id_meta :=
333 let fn clt = TMetaId(name,Ast.IdNoConstraint,Ast0.Impure,clt) in
334 Hashtbl.replace metavariables (get_name name) fn);
335 Data.add_type_meta :=
337 let fn clt = TMetaType(name,pure,clt) in
338 Hashtbl.replace metavariables (get_name name) fn);
339 Data.add_init_meta :=
341 let fn clt = TMetaInit(name,pure,clt) in
342 Hashtbl.replace metavariables (get_name name) fn);
343 Data.add_param_meta :=
344 (function name -> function pure ->
345 let fn clt = TMetaParam(name,pure,clt) in
346 Hashtbl.replace metavariables (get_name name) fn);
347 Data.add_paramlist_meta :=
348 (function name -> function lenname -> function pure ->
349 let fn clt = TMetaParamList(name,lenname,pure,clt) in
350 Hashtbl.replace metavariables (get_name name) fn);
351 Data.add_const_meta :=
352 (fun tyopt name constraints pure ->
353 let fn clt = TMetaConst(name,constraints,pure,tyopt,clt) in
354 Hashtbl.replace metavariables (get_name name) fn);
356 (fun name constraints pure ->
357 let fn clt = TMetaErr(name,constraints,pure,clt) in
358 Hashtbl.replace metavariables (get_name name) fn);
360 (fun tyopt name constraints pure ->
361 let fn clt = TMetaExp(name,constraints,pure,tyopt,clt) in
362 Hashtbl.replace metavariables (get_name name) fn);
363 Data.add_idexp_meta :=
364 (fun tyopt name constraints pure ->
365 let fn clt = TMetaIdExp(name,constraints,pure,tyopt,clt) in
366 Hashtbl.replace metavariables (get_name name) fn);
367 Data.add_local_idexp_meta :=
368 (fun tyopt name constraints pure ->
369 let fn clt = TMetaLocalIdExp(name,constraints,pure,tyopt,clt) in
370 Hashtbl.replace metavariables (get_name name) fn);
371 Data.add_explist_meta :=
372 (function name -> function lenname -> function pure ->
373 let fn clt = TMetaExpList(name,lenname,pure,clt) in
374 Hashtbl.replace metavariables (get_name name) fn);
376 (function name -> function pure ->
377 let fn clt = TMetaStm(name,pure,clt) in
378 Hashtbl.replace metavariables (get_name name) fn);
379 Data.add_stmlist_meta :=
380 (function name -> function pure ->
381 let fn clt = TMetaStmList(name,pure,clt) in
382 Hashtbl.replace metavariables (get_name name) fn);
383 Data.add_func_meta :=
384 (fun name constraints pure ->
385 let fn clt = TMetaFunc(name,constraints,pure,clt) in
386 Hashtbl.replace metavariables (get_name name) fn);
387 Data.add_local_func_meta :=
388 (fun name constraints pure ->
389 let fn clt = TMetaLocalFunc(name,constraints,pure,clt) in
390 Hashtbl.replace metavariables (get_name name) fn);
391 Data.add_iterator_meta :=
392 (fun name constraints pure ->
393 let fn clt = TMetaIterator(name,constraints,pure,clt) in
394 Hashtbl.replace metavariables (get_name name) fn);
395 Data.add_declarer_meta :=
396 (fun name constraints pure ->
397 let fn clt = TMetaDeclarer(name,constraints,pure,clt) in
398 Hashtbl.replace metavariables (get_name name) fn);
400 (fun name constraints any ->
401 let fn ((d,ln,_,_,_,_,_,_) as clt) =
405 (Printf.sprintf "%d: positions only allowed in minus code" ln));
406 TMetaPos(name,constraints,any,clt) in
407 Hashtbl.replace metavariables (get_name name) fn);
408 Data.add_type_name :=
410 let fn clt = TTypeId(name,clt) in
411 Hashtbl.replace type_names name fn);
412 Data.add_declarer_name :=
414 let fn clt = TDeclarerId(name,clt) in
415 Hashtbl.replace declarer_names name fn);
416 Data.add_iterator_name :=
418 let fn clt = TIteratorId(name,clt) in
419 Hashtbl.replace iterator_names name fn);
420 Data.init_rule := (function _ -> Hashtbl.clear metavariables);
421 Data.install_bindings :=
423 List.iter (function (name,fn) -> Hashtbl.add metavariables name fn)
424 (Hashtbl.find all_metavariables parent))
427 let len = String.length s in
432 if List.mem (String.get s n) [' ';'\t']
435 let start = loop 0 in
436 String.sub s start (len - start)
439 (* ---------------------------------------------------------------------- *)
442 let letter = ['A'-'Z' 'a'-'z' '_']
443 let digit = ['0'-'9']
447 let hex = ['0'-'9' 'a'-'f' 'A'-'F']
449 let decimal = ('0' | (['1'-'9'] dec*))
450 let octal = ['0'] oct+
451 let hexa = ("0x" |"0X") hex+
456 let exp = ['e''E'] sign? dec+
457 let real = pent exp | ((pent? '.' pfract | pent '.' pfract? ) exp?)
461 | [' ' '\t']* ['\n' '\r' '\011' '\012']
462 { let cls = !current_line_started in
467 match !current_line_type with
468 (D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
469 let info = get_current_line_type lexbuf in
471 TPragma (Ast.Noindent "", info)
472 | _ -> reset_line lexbuf; token lexbuf
474 else (reset_line lexbuf; token lexbuf) }
476 | [' ' '\t' ]+ { start_line false; token lexbuf }
479 match !current_line_type with
480 (D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
481 TPragma (Ast.Indent (tok lexbuf), get_current_line_type lexbuf)
482 | _ -> start_line false; token lexbuf }
484 | "@@" { start_line true; TArobArob }
486 if !Data.in_rule_name or not !current_line_started
487 then (start_line true; TArob)
488 else (check_minus_context_linetype "@"; TPArob) }
490 | "~=" { start_line true; TTildeEq (get_current_line_type lexbuf) }
491 | "!~=" { start_line true; TTildeExclEq (get_current_line_type lexbuf) }
493 { start_line true; check_minus_context_linetype (tok lexbuf);
494 TWhen (get_current_line_type lexbuf) }
497 { start_line true; check_minus_context_linetype (tok lexbuf);
498 TEllipsis (get_current_line_type lexbuf) }
501 { start_line true; check_minus_context_linetype (tok lexbuf);
502 TCircles (get_current_line_type lexbuf) }
505 { start_line true; check_minus_context_linetype (tok lexbuf);
506 TStars (get_current_line_type lexbuf) }
508 | "<..." { start_line true; check_context_linetype (tok lexbuf);
509 TOEllipsis (get_current_line_type lexbuf) }
510 | "...>" { start_line true; check_context_linetype (tok lexbuf);
511 TCEllipsis (get_current_line_type lexbuf) }
512 | "<+..." { start_line true; check_context_linetype (tok lexbuf);
513 TPOEllipsis (get_current_line_type lexbuf) }
514 | "...+>" { start_line true; check_context_linetype (tok lexbuf);
515 TPCEllipsis (get_current_line_type lexbuf) }
517 | "<ooo" { start_line true; check_context_linetype (tok lexbuf);
518 TOCircles (get_current_line_type lexbuf) }
519 | "ooo>" { start_line true; check_context_linetype (tok lexbuf);
520 TCCircles (get_current_line_type lexbuf) }
522 | "<***" { start_line true; check_context_linetype (tok lexbuf);
523 TOStars (get_current_line_type lexbuf) }
524 | "***>" { start_line true; check_context_linetype (tok lexbuf);
525 TCStars (get_current_line_type lexbuf) }
528 if !current_line_started
529 then (start_line true; TMinus (get_current_line_type lexbuf))
530 else (patch_or_match PATCH;
531 add_current_line_type D.MINUS; token lexbuf) }
533 if !current_line_started
534 then (start_line true; TPlus (get_current_line_type lexbuf))
535 else if !Data.in_meta
537 else (patch_or_match PATCH;
538 add_current_line_type D.PLUS; token lexbuf) }
540 if !current_line_started
541 then (start_line true; TWhy (get_current_line_type lexbuf))
542 else if !Data.in_meta
544 else (add_current_line_type D.OPT; token lexbuf) }
546 if !current_line_started
547 then (start_line true; TBang (get_current_line_type lexbuf))
548 else if !Data.in_meta
550 else (add_current_line_type D.UNIQUE; token lexbuf) }
551 | "(" { if not !col_zero
552 then (start_line true; TOPar (get_current_line_type lexbuf))
554 (start_line true; check_context_linetype (tok lexbuf);
555 TOPar0 (get_current_line_type lexbuf))}
556 | "\\(" { start_line true; TOPar0 (get_current_line_type lexbuf) }
557 | "|" { if not (!col_zero)
558 then (start_line true; TOr(get_current_line_type lexbuf))
559 else (start_line true;
560 check_context_linetype (tok lexbuf);
561 TMid0 (get_current_line_type lexbuf))}
562 | "\\|" { start_line true; TMid0 (get_current_line_type lexbuf) }
563 | ")" { if not !col_zero
564 then (start_line true; TCPar (get_current_line_type lexbuf))
566 (start_line true; check_context_linetype (tok lexbuf);
567 TCPar0 (get_current_line_type lexbuf))}
568 | "\\)" { start_line true; TCPar0 (get_current_line_type lexbuf) }
570 | '[' { start_line true; TOCro (get_current_line_type lexbuf) }
571 | ']' { start_line true; TCCro (get_current_line_type lexbuf) }
572 | '{' { start_line true; TOBrace (get_current_line_type lexbuf) }
573 | '}' { start_line true; TCBrace (get_current_line_type lexbuf) }
575 | "->" { start_line true; TPtrOp (get_current_line_type lexbuf) }
576 | '.' { start_line true; TDot (get_current_line_type lexbuf) }
577 | ',' { start_line true; TComma (get_current_line_type lexbuf) }
578 | ";" { start_line true;
580 then TMPtVirg (* works better with tokens_all *)
581 else TPtVirg (get_current_line_type lexbuf) }
585 if !current_line_started
587 (start_line true; TMul (get_current_line_type lexbuf))
589 (patch_or_match MATCH;
590 add_current_line_type D.MINUS; token lexbuf) }
591 | '/' { start_line true;
592 TDmOp (Ast.Div,get_current_line_type lexbuf) }
593 | '%' { start_line true;
594 TDmOp (Ast.Mod,get_current_line_type lexbuf) }
595 | '~' { start_line true; TTilde (get_current_line_type lexbuf) }
597 | "++" { pass_zero();
598 if !current_line_started
600 (start_line true; TInc (get_current_line_type lexbuf))
601 else (patch_or_match PATCH;
602 add_current_line_type D.PLUSPLUS; token lexbuf) }
603 | "--" { start_line true; TDec (get_current_line_type lexbuf) }
605 | "=" { start_line true; TEq (get_current_line_type lexbuf) }
607 | "-=" { start_line true; mkassign Ast.Minus lexbuf }
608 | "+=" { start_line true; mkassign Ast.Plus lexbuf }
610 | "*=" { start_line true; mkassign Ast.Mul lexbuf }
611 | "/=" { start_line true; mkassign Ast.Div lexbuf }
612 | "%=" { start_line true; mkassign Ast.Mod lexbuf }
614 | "&=" { start_line true; mkassign Ast.And lexbuf }
615 | "|=" { start_line true; mkassign Ast.Or lexbuf }
616 | "^=" { start_line true; mkassign Ast.Xor lexbuf }
618 | "<<=" { start_line true; mkassign Ast.DecLeft lexbuf }
619 | ">>=" { start_line true; mkassign Ast.DecRight lexbuf }
621 | ":" { start_line true; TDotDot (get_current_line_type lexbuf) }
623 | "==" { start_line true; TEqEq (get_current_line_type lexbuf) }
624 | "!=" { start_line true; TNotEq (get_current_line_type lexbuf) }
625 | ">=" { start_line true;
626 TLogOp(Ast.SupEq,get_current_line_type lexbuf) }
627 | "<=" { start_line true;
628 TLogOp(Ast.InfEq,get_current_line_type lexbuf) }
629 | "<" { start_line true;
630 TLogOp(Ast.Inf,get_current_line_type lexbuf) }
631 | ">" { start_line true;
632 TLogOp(Ast.Sup,get_current_line_type lexbuf) }
634 | "&&" { start_line true; TAndLog (get_current_line_type lexbuf) }
635 | "||" { start_line true; TOrLog (get_current_line_type lexbuf) }
637 | ">>" { start_line true;
638 TShOp(Ast.DecRight,get_current_line_type lexbuf) }
639 | "<<" { start_line true;
640 TShOp(Ast.DecLeft,get_current_line_type lexbuf) }
642 | "&" { start_line true; TAnd (get_current_line_type lexbuf) }
643 | "^" { start_line true; TXor(get_current_line_type lexbuf) }
645 | "##" { start_line true; TCppConcatOp }
646 | (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def)
647 ( (letter (letter |digit)*) as ident)
649 let (arity,line,lline,offset,col,strbef,straft,pos) as lt =
650 get_current_line_type lexbuf in
651 let off = String.length def in
652 (* -1 in the code below because the ident is not at the line start *)
656 (arity,line,lline,offset+off,col+off,[],[],Ast0.NoMetaPos)) }
657 | (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def)
658 ( (letter (letter | digit)*) as ident)
661 let (arity,line,lline,offset,col,strbef,straft,pos) as lt =
662 get_current_line_type lexbuf in
663 let off = String.length def in
667 (* why pos here but not above? *)
668 (arity,line,lline,offset+off,col+off,strbef,straft,pos),
669 offset + off + (String.length ident),
670 col + off + (String.length ident)) }
671 | "#" [' ' '\t']* "include" [' ' '\t']* '"' [^ '"']+ '"'
673 (let str = tok lexbuf in
674 let start = String.index str '"' in
675 let finish = String.rindex str '"' in
677 (process_include start finish str,get_current_line_type lexbuf)) }
678 | "#" [' ' '\t']* "include" [' ' '\t']* '<' [^ '>']+ '>'
680 (let str = tok lexbuf in
681 let start = String.index str '<' in
682 let finish = String.rindex str '>' in
684 (process_include start finish str,get_current_line_type lexbuf)) }
685 | "#" [' ' '\t']* "if" [^'\n']*
686 | "#" [' ' '\t']* "ifdef" [^'\n']*
687 | "#" [' ' '\t']* "ifndef" [^'\n']*
688 | "#" [' ' '\t']* "else" [^'\n']*
689 | "#" [' ' '\t']* "elif" [^'\n']*
690 | "#" [' ' '\t']* "endif" [^'\n']*
691 | "#" [' ' '\t']* "error" [^'\n']*
692 { start_line true; check_plus_linetype (tok lexbuf);
693 TPragma (Ast.Noindent(tok lexbuf), get_current_line_type lexbuf) }
695 { start_line true; check_plus_linetype (tok lexbuf);
696 (* second argument to TPragma is not quite right, because
697 it represents only the first token of the comemnt, but that
698 should be good enough *)
699 TPragma (Ast.Indent("/*"^(comment lexbuf)),
700 get_current_line_type lexbuf) }
702 { (if !current_line_started
703 then lexerr "--- must be at the beginning of the line" "");
706 (let str = tok lexbuf in
707 (drop_spaces(String.sub str 3 (String.length str - 3)),
708 (get_current_line_type lexbuf))) }
710 { (if !current_line_started
711 then lexerr "+++ must be at the beginning of the line" "");
714 (let str = tok lexbuf in
715 (drop_spaces(String.sub str 3 (String.length str - 3)),
716 (get_current_line_type lexbuf))) }
718 | letter (letter | digit)*
719 { start_line true; id_tokens lexbuf }
721 | "'" { start_line true;
722 TChar(char lexbuf,get_current_line_type lexbuf) }
723 | '"' { start_line true;
724 TString(string lexbuf,(get_current_line_type lexbuf)) }
725 | (real as x) { start_line true;
726 TFloat(x,(get_current_line_type lexbuf)) }
727 | ((( decimal | hexa | octal)
730 | (['l' 'L'] ['u' 'U'])
731 | (['u' 'U'] ['l' 'L'])
732 | (['u' 'U'] ['l' 'L'] ['l' 'L'])
733 | (['l' 'L'] ['l' 'L'])
735 ) as x) { start_line true; TInt(x,(get_current_line_type lexbuf)) }
742 | _ { lexerr "unrecognised symbol, in token rule: " (tok lexbuf) }
746 | (_ as x) "'" { String.make 1 x }
747 | (("\\" (oct | oct oct | oct oct oct)) as x "'") { x }
748 | (("\\x" (hex | hex hex)) as x "'") { x }
749 | (("\\" (_ as v)) as x "'")
751 | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> ()
752 | 'r' -> () | 'f' -> () | 'a' -> ()
753 | '\\' -> () | '?' -> () | '\'' -> () | '"' -> ()
755 | _ -> lexerr "unrecognised symbol: " (tok lexbuf)
759 | _ { lexerr "unrecognised symbol: " (tok lexbuf) }
763 | (_ as x) { Common.string_of_char x ^ string lexbuf }
764 | ("\\" (oct | oct oct | oct oct oct)) as x { x ^ string lexbuf }
765 | ("\\x" (hex | hex hex)) as x { x ^ string lexbuf }
766 | ("\\" (_ as v)) as x
769 | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> ()
770 | 'f' -> () | 'a' -> ()
771 | '\\' -> () | '?' -> () | '\'' -> () | '"' -> ()
774 | '(' -> () | '|' -> () | ')' -> ()
775 | _ -> lexerr "unrecognised symbol:" (tok lexbuf)
779 | _ { lexerr "unrecognised symbol: " (tok lexbuf) }
782 | "*/" { start_line true; tok lexbuf }
783 | ['\n' '\r' '\011' '\012']
784 { reset_line lexbuf; let s = tok lexbuf in s ^ comment lexbuf }
786 if !current_line_started
787 then (start_line true; let s = tok lexbuf in s^(comment lexbuf))
788 else comment lexbuf }
790 | [^ '*'] { start_line true; let s = tok lexbuf in s ^ comment lexbuf }
791 | [ '*'] { start_line true; let s = tok lexbuf in s ^ comment lexbuf }
793 { start_line true; let s = tok lexbuf in
794 Common.pr2 ("LEXER: unrecognised symbol in comment:"^s);