2 * Copyright 2010, INRIA, University of Copenhagen
3 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
4 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
5 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
6 * This file is part of Coccinelle.
8 * Coccinelle is free software: you can redistribute it and/or modify
9 * it under the terms of the GNU General Public License as published by
10 * the Free Software Foundation, according to version 2 of the License.
12 * Coccinelle is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
17 * You should have received a copy of the GNU General Public License
18 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
20 * The authors reserve the right to distribute this or future versions of
21 * Coccinelle under other licenses.
26 open Parser_cocci_menhir
28 module Ast = Ast_cocci
29 module Ast0 = Ast0_cocci
31 exception Lexical of string
32 let tok = Lexing.lexeme
35 let logical_line = ref 0
37 (* ---------------------------------------------------------------------- *)
41 type line_type = MINUS | OPTMINUS | UNIQUEMINUS | PLUS | CONTEXT | UNIQUE | OPT
44 let current_line_type = ref (D.CONTEXT,!line,!logical_line)
46 let prev_plus = ref false
47 let line_start = ref 0 (* offset of the beginning of the line *)
48 let get_current_line_type lexbuf =
49 let (c,l,ll) = !current_line_type in
50 let lex_start = Lexing.lexeme_start lexbuf in
51 let preceeding_spaces =
52 if !line_start < 0 then 0 else lex_start - !line_start in
54 prev_plus := (c = D.PLUS) or (c = D.PLUSPLUS);
55 (c,l,ll,lex_start,preceeding_spaces,[],[],Ast0.NoMetaPos)
56 let current_line_started = ref false
57 let col_zero = ref true
59 let reset_line lexbuf =
61 current_line_type := (D.CONTEXT,!line,!logical_line);
62 current_line_started := false;
64 line_start := Lexing.lexeme_start lexbuf + 1
66 let started_line = ref (-1)
68 let start_line seen_char =
69 current_line_started := true;
71 (if seen_char && not(!line = !started_line)
74 started_line := !line;
75 logical_line := !logical_line + 1
78 let pass_zero _ = col_zero := false
80 let lexerr s1 s2 = raise (Lexical (Printf.sprintf "%s%s" s1 s2))
82 let add_current_line_type x =
83 match (x,!current_line_type) with
84 (D.MINUS,(D.CONTEXT,ln,lln)) ->
85 current_line_type := (D.MINUS,ln,lln)
86 | (D.MINUS,(D.UNIQUE,ln,lln)) ->
87 current_line_type := (D.UNIQUEMINUS,ln,lln)
88 | (D.MINUS,(D.OPT,ln,lln)) ->
89 current_line_type := (D.OPTMINUS,ln,lln)
90 | (D.PLUS,(D.CONTEXT,ln,lln)) ->
91 current_line_type := (D.PLUS,ln,lln)
92 | (D.PLUSPLUS,(D.CONTEXT,ln,lln)) ->
93 current_line_type := (D.PLUSPLUS,ln,lln)
94 | (D.UNIQUE,(D.CONTEXT,ln,lln)) ->
95 current_line_type := (D.UNIQUE,ln,lln)
96 | (D.OPT,(D.CONTEXT,ln,lln)) ->
97 current_line_type := (D.OPT,ln,lln)
98 | _ -> lexerr "invalid control character combination" ""
100 let check_minus_context_linetype s =
101 match !current_line_type with
102 (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> lexerr "invalid in a + context: " s
105 let check_context_linetype s =
106 match !current_line_type with
107 (D.CONTEXT,_,_) -> ()
108 | _ -> lexerr "invalid in a nonempty context: " s
110 let check_plus_linetype s =
111 match !current_line_type with
112 (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> ()
113 | _ -> lexerr "invalid in a non + context: " s
115 let check_arity_context_linetype s =
116 match !current_line_type with
117 (D.CONTEXT,_,_) | (D.PLUS,_,_) | (D.PLUSPLUS,_,_)
118 | (D.UNIQUE,_,_) | (D.OPT,_,_) -> ()
119 | _ -> lexerr "invalid in a nonempty context: " s
121 let check_comment s =
122 if not !current_line_started
123 then lexerr "+ expected at the beginning of the line" s
125 let process_include start finish str =
126 (match !current_line_type with
127 (D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
129 let _ = Str.search_forward (Str.regexp "\\.\\.\\.") str start in
130 lexerr "... not allowed in + include" ""
131 with Not_found -> ())
133 String.sub str (start + 1) (finish - start - 1)
135 (* ---------------------------------------------------------------------- *)
136 type pm = PATCH | MATCH | UNKNOWN
140 let patch_or_match = function
142 if not !D.ignore_patch_or_match
146 lexerr "- or + not allowed in the first column for a match" ""
148 | UNKNOWN -> Flag.sgrep_mode2 := false; pm := PATCH)
150 if not !D.ignore_patch_or_match
153 PATCH -> lexerr "* not allowed in the first column for a patch" ""
155 | UNKNOWN -> Flag.sgrep_mode2 := true; pm := MATCH)
156 | _ -> failwith "unexpected argument"
158 (* ---------------------------------------------------------------------- *)
159 (* identifiers, including metavariables *)
161 let metavariables = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
163 let all_metavariables =
164 (Hashtbl.create(100) : (string,(string * (D.clt -> token)) list) Hashtbl.t)
166 let type_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
168 let declarer_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
170 let iterator_names = (Hashtbl.create(100) : (string, D.clt -> token) Hashtbl.t)
172 let rule_names = (Hashtbl.create(100) : (string, unit) Hashtbl.t)
174 let check_var s linetype =
176 if (!Data.in_prolog || !Data.in_rule_name) &&
177 Str.string_match (Str.regexp "<.*>") s 0
180 try (Hashtbl.find metavariables s) linetype
182 (try (Hashtbl.find type_names s) linetype
184 (try (Hashtbl.find declarer_names s) linetype
186 (try (Hashtbl.find iterator_names s) linetype
187 with Not_found -> TIdent (s,linetype)))) in
188 if !Data.in_meta or !Data.in_rule_name
189 then (try Hashtbl.find rule_names s; TRuleName s with Not_found -> fail())
192 let id_tokens lexbuf =
193 let s = tok lexbuf in
194 let linetype = get_current_line_type lexbuf in
195 let in_rule_name = !Data.in_rule_name in
196 let in_meta = !Data.in_meta && not !Data.saw_struct in
197 let in_iso = !Data.in_iso in
198 let in_prolog = !Data.in_prolog in
200 "identifier" when in_meta -> check_arity_context_linetype s; TIdentifier
201 | "type" when in_meta -> check_arity_context_linetype s; TType
202 | "parameter" when in_meta -> check_arity_context_linetype s; TParameter
203 | "constant" when in_meta -> check_arity_context_linetype s; TConstant
204 | "generated" when in_rule_name && not (!Flag.make_hrule = None) ->
205 check_arity_context_linetype s; TGenerated
206 | "expression" when in_meta || in_rule_name ->
207 check_arity_context_linetype s; TExpression
208 | "declaration" when in_meta || in_rule_name ->
209 check_arity_context_linetype s; TDeclaration
210 | "field" when in_meta || in_rule_name ->
211 check_arity_context_linetype s; TField
212 | "initialiser" when in_meta || in_rule_name ->
213 check_arity_context_linetype s; TInitialiser
214 | "initializer" when in_meta || in_rule_name ->
215 check_arity_context_linetype s; TInitialiser
216 | "idexpression" when in_meta ->
217 check_arity_context_linetype s; TIdExpression
218 | "statement" when in_meta -> check_arity_context_linetype s; TStatement
219 | "function" when in_meta -> check_arity_context_linetype s; TFunction
220 | "local" when in_meta -> check_arity_context_linetype s; TLocal
221 | "list" when in_meta -> check_arity_context_linetype s; Tlist
222 | "fresh" when in_meta -> check_arity_context_linetype s; TFresh
223 | "typedef" when in_meta -> check_arity_context_linetype s; TTypedef
224 | "declarer" when in_meta -> check_arity_context_linetype s; TDeclarer
225 | "iterator" when in_meta -> check_arity_context_linetype s; TIterator
226 | "name" when in_meta -> check_arity_context_linetype s; TName
227 | "position" when in_meta -> check_arity_context_linetype s; TPosition
228 | "any" when in_meta -> check_arity_context_linetype s; TPosAny
229 | "pure" when in_meta && in_iso ->
230 check_arity_context_linetype s; TPure
231 | "context" when in_meta && in_iso ->
232 check_arity_context_linetype s; TContext
233 | "error" when in_meta -> check_arity_context_linetype s; TError
234 | "words" when in_meta -> check_context_linetype s; TWords
236 | "using" when in_rule_name || in_prolog -> check_context_linetype s; TUsing
237 | "virtual" when in_prolog or in_rule_name or in_meta ->
238 (* don't want to allow virtual as a rule name *)
239 check_context_linetype s; TVirtual
240 | "disable" when in_rule_name -> check_context_linetype s; TDisable
241 | "extends" when in_rule_name -> check_context_linetype s; TExtends
242 | "depends" when in_rule_name -> check_context_linetype s; TDepends
243 | "on" when in_rule_name -> check_context_linetype s; TOn
244 | "ever" when in_rule_name -> check_context_linetype s; TEver
245 | "never" when in_rule_name -> check_context_linetype s; TNever
246 (* exists and forall for when are reparsed in parse_cocci.ml *)
247 | "exists" when in_rule_name -> check_context_linetype s; TExists
248 | "forall" when in_rule_name -> check_context_linetype s; TForall
249 | "script" when in_rule_name -> check_context_linetype s; TScript
250 | "initialize" when in_rule_name -> check_context_linetype s; TInitialize
251 | "finalize" when in_rule_name -> check_context_linetype s; TFinalize
253 | "char" -> Tchar linetype
254 | "short" -> Tshort linetype
255 | "int" -> Tint linetype
256 | "double" -> Tdouble linetype
257 | "float" -> Tfloat linetype
258 | "long" -> Tlong linetype
259 | "void" -> Tvoid linetype
260 | "size_t" -> Tsize_t linetype
261 | "ssize_t" -> Tssize_t linetype
262 | "ptrdiff_t" -> Tptrdiff_t linetype
263 (* in_meta is only for the first keyword; drop it now to allow any type
265 | "struct" -> Data.saw_struct := true; Tstruct linetype
266 | "union" -> Data.saw_struct := true; Tunion linetype
267 | "enum" -> Data.saw_struct := true; Tenum linetype
268 | "unsigned" -> Tunsigned linetype
269 | "signed" -> Tsigned linetype
271 | "auto" -> Tauto linetype
272 | "register" -> Tregister linetype
273 | "extern" -> Textern linetype
274 | "static" -> Tstatic linetype
275 | "inline" -> Tinline linetype
276 | "typedef" -> Ttypedef linetype
278 | "const" -> Tconst linetype
279 | "volatile" -> Tvolatile linetype
281 | "if" -> TIf linetype
282 | "else" -> TElse linetype
283 | "while" -> TWhile linetype
284 | "do" -> TDo linetype
285 | "for" -> TFor linetype
286 | "switch" -> TSwitch linetype
287 | "case" -> TCase linetype
288 | "default" -> TDefault linetype
289 | "return" -> TReturn linetype
290 | "break" -> TBreak linetype
291 | "continue" -> TContinue linetype
292 | "goto" -> TGoto linetype
294 | "sizeof" -> TSizeof linetype
296 | "Expression" when !Data.in_iso -> TIsoExpression
297 | "ArgExpression" when !Data.in_iso -> TIsoArgExpression
298 | "TestExpression" when !Data.in_iso -> TIsoTestExpression
299 | "ToTestExpression" when !Data.in_iso -> TIsoToTestExpression
300 | "Statement" when !Data.in_iso -> TIsoStatement
301 | "Declaration" when !Data.in_iso -> TIsoDeclaration
302 | "Type" when !Data.in_iso -> TIsoType
303 | "TopLevel" when !Data.in_iso -> TIsoTopLevel
305 | "_" when !Data.in_meta -> TUnderscore
307 | s -> check_var s linetype
309 let mkassign op lexbuf =
310 TAssign (Ast.OpAssign op, (get_current_line_type lexbuf))
317 current_line_started := false;
318 current_line_type := (D.CONTEXT,0,0);
321 Data.in_rule_name := false;
322 Data.in_meta := false;
323 Data.in_prolog := false;
324 Data.saw_struct := false;
325 Data.inheritable_positions := [];
326 Hashtbl.clear all_metavariables;
327 Hashtbl.clear Data.all_metadecls;
328 Hashtbl.clear metavariables;
329 Hashtbl.clear type_names;
330 Hashtbl.clear rule_names;
331 Hashtbl.clear iterator_names;
332 Hashtbl.clear declarer_names;
333 let get_name (_,x) = x in
335 (fun name constraints pure ->
336 let fn clt = TMetaId(name,constraints,pure,clt) in
337 Hashtbl.replace metavariables (get_name name) fn);
338 Data.add_virt_id_meta_found :=
340 let fn clt = TIdent(vl,clt) in
341 Hashtbl.replace metavariables name fn);
342 Data.add_virt_id_meta_not_found :=
344 let fn clt = TMetaId(name,Ast.IdNoConstraint,pure,clt) in
345 Hashtbl.replace metavariables (get_name name) fn);
346 Data.add_fresh_id_meta :=
348 let fn clt = TMetaId(name,Ast.IdNoConstraint,Ast0.Impure,clt) in
349 Hashtbl.replace metavariables (get_name name) fn);
350 Data.add_type_meta :=
352 let fn clt = TMetaType(name,pure,clt) in
353 Hashtbl.replace metavariables (get_name name) fn);
354 Data.add_init_meta :=
356 let fn clt = TMetaInit(name,pure,clt) in
357 Hashtbl.replace metavariables (get_name name) fn);
358 Data.add_param_meta :=
359 (function name -> function pure ->
360 let fn clt = TMetaParam(name,pure,clt) in
361 Hashtbl.replace metavariables (get_name name) fn);
362 Data.add_paramlist_meta :=
363 (function name -> function lenname -> function pure ->
364 let fn clt = TMetaParamList(name,lenname,pure,clt) in
365 Hashtbl.replace metavariables (get_name name) fn);
366 Data.add_const_meta :=
367 (fun tyopt name constraints pure ->
368 let fn clt = TMetaConst(name,constraints,pure,tyopt,clt) in
369 Hashtbl.replace metavariables (get_name name) fn);
371 (fun name constraints pure ->
372 let fn clt = TMetaErr(name,constraints,pure,clt) in
373 Hashtbl.replace metavariables (get_name name) fn);
375 (fun tyopt name constraints pure ->
376 let fn clt = TMetaExp(name,constraints,pure,tyopt,clt) in
377 Hashtbl.replace metavariables (get_name name) fn);
378 Data.add_idexp_meta :=
379 (fun tyopt name constraints pure ->
380 let fn clt = TMetaIdExp(name,constraints,pure,tyopt,clt) in
381 Hashtbl.replace metavariables (get_name name) fn);
382 Data.add_local_idexp_meta :=
383 (fun tyopt name constraints pure ->
384 let fn clt = TMetaLocalIdExp(name,constraints,pure,tyopt,clt) in
385 Hashtbl.replace metavariables (get_name name) fn);
386 Data.add_explist_meta :=
387 (function name -> function lenname -> function pure ->
388 let fn clt = TMetaExpList(name,lenname,pure,clt) in
389 Hashtbl.replace metavariables (get_name name) fn);
390 Data.add_decl_meta :=
391 (function name -> function pure ->
392 let fn clt = TMetaDecl(name,pure,clt) in
393 Hashtbl.replace metavariables (get_name name) fn);
394 Data.add_field_meta :=
395 (function name -> function pure ->
396 let fn clt = TMetaField(name,pure,clt) in
397 Hashtbl.replace metavariables (get_name name) fn);
399 (function name -> function pure ->
400 let fn clt = TMetaStm(name,pure,clt) in
401 Hashtbl.replace metavariables (get_name name) fn);
402 Data.add_stmlist_meta :=
403 (function name -> function pure ->
404 let fn clt = TMetaStmList(name,pure,clt) in
405 Hashtbl.replace metavariables (get_name name) fn);
406 Data.add_func_meta :=
407 (fun name constraints pure ->
408 let fn clt = TMetaFunc(name,constraints,pure,clt) in
409 Hashtbl.replace metavariables (get_name name) fn);
410 Data.add_local_func_meta :=
411 (fun name constraints pure ->
412 let fn clt = TMetaLocalFunc(name,constraints,pure,clt) in
413 Hashtbl.replace metavariables (get_name name) fn);
414 Data.add_iterator_meta :=
415 (fun name constraints pure ->
416 let fn clt = TMetaIterator(name,constraints,pure,clt) in
417 Hashtbl.replace metavariables (get_name name) fn);
418 Data.add_declarer_meta :=
419 (fun name constraints pure ->
420 let fn clt = TMetaDeclarer(name,constraints,pure,clt) in
421 Hashtbl.replace metavariables (get_name name) fn);
423 (fun name constraints any ->
424 let fn ((d,ln,_,_,_,_,_,_) as clt) =
428 (Printf.sprintf "%d: positions only allowed in minus code" ln));
429 TMetaPos(name,constraints,any,clt) in
430 Hashtbl.replace metavariables (get_name name) fn);
431 Data.add_type_name :=
433 let fn clt = TTypeId(name,clt) in
434 Hashtbl.replace type_names name fn);
435 Data.add_declarer_name :=
437 let fn clt = TDeclarerId(name,clt) in
438 Hashtbl.replace declarer_names name fn);
439 Data.add_iterator_name :=
441 let fn clt = TIteratorId(name,clt) in
442 Hashtbl.replace iterator_names name fn);
443 Data.init_rule := (function _ -> Hashtbl.clear metavariables);
444 Data.install_bindings :=
446 List.iter (function (name,fn) -> Hashtbl.add metavariables name fn)
447 (Hashtbl.find all_metavariables parent))
449 (* the following is needed to properly tokenize include files. Because an
450 include file is included after seeing a @, so current_line_started is true.
451 Current_line_started is not important for parsing the name of a rule, so we
452 don't have to reset this value to true after parsing an included file. *)
454 current_line_started := false
457 let len = String.length s in
462 if List.mem (String.get s n) [' ';'\t']
465 let start = loop 0 in
466 String.sub s start (len - start)
469 (* ---------------------------------------------------------------------- *)
472 let letter = ['A'-'Z' 'a'-'z' '_']
473 let digit = ['0'-'9']
477 let hex = ['0'-'9' 'a'-'f' 'A'-'F']
479 let decimal = ('0' | (['1'-'9'] dec*))
480 let octal = ['0'] oct+
481 let hexa = ("0x" |"0X") hex+
486 let exp = ['e''E'] sign? dec+
487 let real = pent exp | ((pent? '.' pfract | pent '.' pfract? ) exp?)
491 | [' ' '\t']* ['\n' '\r' '\011' '\012']
492 { let cls = !current_line_started in
497 match !current_line_type with
498 (D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
499 let info = get_current_line_type lexbuf in
501 TPragma (Ast.Noindent "", info)
502 | _ -> reset_line lexbuf; token lexbuf
504 else (reset_line lexbuf; token lexbuf) }
506 | [' ' '\t' ]+ { start_line false; token lexbuf }
509 match !current_line_type with
510 (D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
511 TPragma (Ast.Indent (tok lexbuf), get_current_line_type lexbuf)
512 | _ -> start_line false; token lexbuf }
514 | "@@" { start_line true; TArobArob }
516 if !Data.in_rule_name or not !current_line_started
517 then (start_line true; TArob)
518 else (check_minus_context_linetype "@"; TPArob) }
520 | "~=" { start_line true; TTildeEq (get_current_line_type lexbuf) }
521 | "!~=" { start_line true; TTildeExclEq (get_current_line_type lexbuf) }
523 { start_line true; check_minus_context_linetype (tok lexbuf);
524 TWhen (get_current_line_type lexbuf) }
527 { start_line true; check_minus_context_linetype (tok lexbuf);
528 TEllipsis (get_current_line_type lexbuf) }
531 { start_line true; check_minus_context_linetype (tok lexbuf);
532 TCircles (get_current_line_type lexbuf) }
535 { start_line true; check_minus_context_linetype (tok lexbuf);
536 TStars (get_current_line_type lexbuf) }
538 | "<..." { start_line true; check_context_linetype (tok lexbuf);
539 TOEllipsis (get_current_line_type lexbuf) }
540 | "...>" { start_line true; check_context_linetype (tok lexbuf);
541 TCEllipsis (get_current_line_type lexbuf) }
542 | "<+..." { start_line true; check_minus_context_linetype (tok lexbuf);
543 TPOEllipsis (get_current_line_type lexbuf) }
544 | "...+>" { start_line true; check_minus_context_linetype (tok lexbuf);
545 TPCEllipsis (get_current_line_type lexbuf) }
547 | "<ooo" { start_line true; check_context_linetype (tok lexbuf);
548 TOCircles (get_current_line_type lexbuf) }
549 | "ooo>" { start_line true; check_context_linetype (tok lexbuf);
550 TCCircles (get_current_line_type lexbuf) }
552 | "<***" { start_line true; check_context_linetype (tok lexbuf);
553 TOStars (get_current_line_type lexbuf) }
554 | "***>" { start_line true; check_context_linetype (tok lexbuf);
555 TCStars (get_current_line_type lexbuf) }
558 if !current_line_started
559 then (start_line true; TMinus (get_current_line_type lexbuf))
560 else (patch_or_match PATCH;
561 add_current_line_type D.MINUS; token lexbuf) }
563 if !current_line_started
564 then (start_line true; TPlus (get_current_line_type lexbuf))
565 else if !Data.in_meta
567 else (patch_or_match PATCH;
568 add_current_line_type D.PLUS; token lexbuf) }
570 if !current_line_started
571 then (start_line true; TWhy (get_current_line_type lexbuf))
572 else if !Data.in_meta
574 else (add_current_line_type D.OPT; token lexbuf) }
576 if !current_line_started
577 then (start_line true; TBang (get_current_line_type lexbuf))
578 else if !Data.in_meta
580 else (add_current_line_type D.UNIQUE; token lexbuf) }
581 | "(" { if !Data.in_meta or not !col_zero
582 then (start_line true; TOPar (get_current_line_type lexbuf))
584 (start_line true; check_context_linetype (tok lexbuf);
585 TOPar0 (get_current_line_type lexbuf))}
586 | "\\(" { start_line true; TOPar0 (get_current_line_type lexbuf) }
587 | "|" { if not (!col_zero)
588 then (start_line true; TOr(get_current_line_type lexbuf))
589 else (start_line true;
590 check_context_linetype (tok lexbuf);
591 TMid0 (get_current_line_type lexbuf))}
592 | "\\|" { start_line true; TMid0 (get_current_line_type lexbuf) }
593 | ")" { if not !col_zero
594 then (start_line true; TCPar (get_current_line_type lexbuf))
596 (start_line true; check_context_linetype (tok lexbuf);
597 TCPar0 (get_current_line_type lexbuf))}
598 | "\\)" { start_line true; TCPar0 (get_current_line_type lexbuf) }
600 | '[' { start_line true; TOCro (get_current_line_type lexbuf) }
601 | ']' { start_line true; TCCro (get_current_line_type lexbuf) }
602 | '{' { start_line true; TOBrace (get_current_line_type lexbuf) }
603 | '}' { start_line true; TCBrace (get_current_line_type lexbuf) }
605 | "->" { start_line true; TPtrOp (get_current_line_type lexbuf) }
606 | '.' { start_line true; TDot (get_current_line_type lexbuf) }
607 | ',' { start_line true; TComma (get_current_line_type lexbuf) }
608 | ";" { start_line true;
610 then TMPtVirg (* works better with tokens_all *)
611 else TPtVirg (get_current_line_type lexbuf) }
615 if !current_line_started
617 (start_line true; TMul (get_current_line_type lexbuf))
619 (patch_or_match MATCH;
620 add_current_line_type D.MINUS; token lexbuf) }
621 | '/' { start_line true;
622 TDmOp (Ast.Div,get_current_line_type lexbuf) }
623 | '%' { start_line true;
624 TDmOp (Ast.Mod,get_current_line_type lexbuf) }
625 | '~' { start_line true; TTilde (get_current_line_type lexbuf) }
627 | "++" { pass_zero();
628 if !current_line_started
630 (start_line true; TInc (get_current_line_type lexbuf))
631 else (patch_or_match PATCH;
632 add_current_line_type D.PLUSPLUS; token lexbuf) }
633 | "--" { start_line true; TDec (get_current_line_type lexbuf) }
635 | "=" { start_line true; TEq (get_current_line_type lexbuf) }
637 | "-=" { start_line true; mkassign Ast.Minus lexbuf }
638 | "+=" { start_line true; mkassign Ast.Plus lexbuf }
640 | "*=" { start_line true; mkassign Ast.Mul lexbuf }
641 | "/=" { start_line true; mkassign Ast.Div lexbuf }
642 | "%=" { start_line true; mkassign Ast.Mod lexbuf }
644 | "&=" { start_line true; mkassign Ast.And lexbuf }
645 | "|=" { start_line true; mkassign Ast.Or lexbuf }
646 | "^=" { start_line true; mkassign Ast.Xor lexbuf }
648 | "<<=" { start_line true; mkassign Ast.DecLeft lexbuf }
649 | ">>=" { start_line true; mkassign Ast.DecRight lexbuf }
651 | ":" { start_line true; TDotDot (get_current_line_type lexbuf) }
653 | "==" { start_line true; TEqEq (get_current_line_type lexbuf) }
654 | "!=" { start_line true; TNotEq (get_current_line_type lexbuf) }
655 | ">=" { start_line true;
656 TLogOp(Ast.SupEq,get_current_line_type lexbuf) }
657 | "<=" { start_line true;
659 then TSub(get_current_line_type lexbuf)
660 else TLogOp(Ast.InfEq,get_current_line_type lexbuf) }
661 | "<" { start_line true;
662 TLogOp(Ast.Inf,get_current_line_type lexbuf) }
663 | ">" { start_line true;
664 TLogOp(Ast.Sup,get_current_line_type lexbuf) }
666 | "&&" { start_line true; TAndLog (get_current_line_type lexbuf) }
667 | "||" { start_line true; TOrLog (get_current_line_type lexbuf) }
669 | ">>" { start_line true;
670 TShROp(Ast.DecRight,get_current_line_type lexbuf) }
671 | "<<" { start_line true;
672 TShLOp(Ast.DecLeft,get_current_line_type lexbuf) }
674 | "&" { start_line true; TAnd (get_current_line_type lexbuf) }
675 | "^" { start_line true; TXor(get_current_line_type lexbuf) }
677 | "##" { start_line true; TCppConcatOp }
678 | (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def)
679 ( (letter (letter |digit)*) as ident)
681 let (arity,line,lline,offset,col,strbef,straft,pos) as lt =
682 get_current_line_type lexbuf in
683 let off = String.length def in
684 (* -1 in the code below because the ident is not at the line start *)
688 (arity,line,lline,offset+off,col+off,[],[],Ast0.NoMetaPos)) }
689 | (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def)
690 ( (letter (letter | digit)*) as ident)
693 let (arity,line,lline,offset,col,strbef,straft,pos) as lt =
694 get_current_line_type lexbuf in
695 let off = String.length def in
699 (* why pos here but not above? *)
700 (arity,line,lline,offset+off,col+off,strbef,straft,pos),
701 offset + off + (String.length ident),
702 col + off + (String.length ident)) }
703 | "#" [' ' '\t']* "include" [' ' '\t']* '"' [^ '"']+ '"'
705 (let str = tok lexbuf in
706 let start = String.index str '"' in
707 let finish = String.rindex str '"' in
709 (process_include start finish str,get_current_line_type lexbuf)) }
710 | "#" [' ' '\t']* "include" [' ' '\t']* '<' [^ '>']+ '>'
712 (let str = tok lexbuf in
713 let start = String.index str '<' in
714 let finish = String.rindex str '>' in
716 (process_include start finish str,get_current_line_type lexbuf)) }
717 | "#" [' ' '\t']* "if" [^'\n']*
718 | "#" [' ' '\t']* "ifdef" [^'\n']*
719 | "#" [' ' '\t']* "ifndef" [^'\n']*
720 | "#" [' ' '\t']* "else" [^'\n']*
721 | "#" [' ' '\t']* "elif" [^'\n']*
722 | "#" [' ' '\t']* "endif" [^'\n']*
723 | "#" [' ' '\t']* "error" [^'\n']*
724 { start_line true; check_plus_linetype (tok lexbuf);
725 TPragma (Ast.Noindent(tok lexbuf), get_current_line_type lexbuf) }
727 { start_line true; check_plus_linetype (tok lexbuf);
728 (* second argument to TPragma is not quite right, because
729 it represents only the first token of the comment, but that
730 should be good enough *)
731 TPragma (Ast.Indent("/*"^(comment lexbuf)),
732 get_current_line_type lexbuf) }
734 { (if !current_line_started
735 then lexerr "--- must be at the beginning of the line" "");
738 (let str = tok lexbuf in
739 (drop_spaces(String.sub str 3 (String.length str - 3)),
740 (get_current_line_type lexbuf))) }
742 { (if !current_line_started
743 then lexerr "+++ must be at the beginning of the line" "");
746 (let str = tok lexbuf in
747 (drop_spaces(String.sub str 3 (String.length str - 3)),
748 (get_current_line_type lexbuf))) }
750 | letter (letter | digit)*
751 { start_line true; id_tokens lexbuf }
753 | "'" { start_line true;
754 TChar(char lexbuf,get_current_line_type lexbuf) }
755 | '"' { start_line true;
756 TString(string lexbuf,(get_current_line_type lexbuf)) }
757 | (real as x) { start_line true;
758 TFloat(x,(get_current_line_type lexbuf)) }
759 | ((( decimal | hexa | octal)
762 | (['l' 'L'] ['u' 'U'])
763 | (['u' 'U'] ['l' 'L'])
764 | (['u' 'U'] ['l' 'L'] ['l' 'L'])
765 | (['l' 'L'] ['l' 'L'])
767 ) as x) { start_line true; TInt(x,(get_current_line_type lexbuf)) }
774 | _ { lexerr "unrecognised symbol, in token rule: " (tok lexbuf) }
778 | (_ as x) "'" { String.make 1 x }
779 | (("\\" (oct | oct oct | oct oct oct)) as x "'") { x }
780 | (("\\x" (hex | hex hex)) as x "'") { x }
781 | (("\\" (_ as v)) as x "'")
783 | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> ()
784 | 'r' -> () | 'f' -> () | 'a' -> ()
785 | '\\' -> () | '?' -> () | '\'' -> () | '"' -> ()
787 | _ -> lexerr "unrecognised symbol: " (tok lexbuf)
791 | _ { lexerr "unrecognised symbol: " (tok lexbuf) }
795 | (_ as x) { Common.string_of_char x ^ string lexbuf }
796 | ("\\" (oct | oct oct | oct oct oct)) as x { x ^ string lexbuf }
797 | ("\\x" (hex | hex hex)) as x { x ^ string lexbuf }
798 | ("\\" (_ as v)) as x
801 | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> ()
802 | 'f' -> () | 'a' -> ()
803 | '\\' -> () | '?' -> () | '\'' -> () | '"' -> ()
806 | '(' -> () | '|' -> () | ')' -> ()
807 | _ -> lexerr "unrecognised symbol:" (tok lexbuf)
811 | _ { lexerr "unrecognised symbol: " (tok lexbuf) }
814 | "*/" { let s = tok lexbuf in check_comment s; start_line true; s }
815 | ['\n' '\r' '\011' '\012']
816 { let s = tok lexbuf in
817 (* even blank line should have a + *)
819 reset_line lexbuf; s ^ comment lexbuf }
821 if !current_line_started
822 then (start_line true; let s = tok lexbuf in s^(comment lexbuf))
823 else (start_line true; comment lexbuf) }
826 { let s = tok lexbuf in
827 check_comment s; start_line true; s ^ comment lexbuf }
829 { let s = tok lexbuf in
830 check_comment s; start_line true; s ^ comment lexbuf }
832 { start_line true; let s = tok lexbuf in
833 Common.pr2 ("LEXER: unrecognised symbol in comment:"^s);