X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/0708f913629519b5dbc99f68b6f3ea5ab068230c..9f8e26f459677a621822918b7539ae94214621ac:/parsing_cocci/lexer_cocci.mll
diff --git a/parsing_cocci/lexer_cocci.mll b/parsing_cocci/lexer_cocci.mll
index a9a31fb..6abc9b1 100644
--- a/parsing_cocci/lexer_cocci.mll
+++ b/parsing_cocci/lexer_cocci.mll
@@ -1,23 +1,23 @@
(*
-* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
-* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
-* This file is part of Coccinelle.
-*
-* Coccinelle is free software: you can redistribute it and/or modify
-* it under the terms of the GNU General Public License as published by
-* the Free Software Foundation, according to version 2 of the License.
-*
-* Coccinelle is distributed in the hope that it will be useful,
-* but WITHOUT ANY WARRANTY; without even the implied warranty of
-* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-* GNU General Public License for more details.
-*
-* You should have received a copy of the GNU General Public License
-* along with Coccinelle. If not, see .
-*
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
+ * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle. If not, see .
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
{
@@ -48,8 +48,8 @@ let get_current_line_type lexbuf =
let lex_start = Lexing.lexeme_start lexbuf in
let preceeding_spaces =
if !line_start < 0 then 0 else lex_start - !line_start in
- line_start := -1;
- prev_plus := (c = D.PLUS);
+ (*line_start := -1;*)
+ prev_plus := (c = D.PLUS) or (c = D.PLUSPLUS);
(c,l,ll,lex_start,preceeding_spaces,[],[],Ast0.NoMetaPos)
let current_line_started = ref false
let col_zero = ref true
@@ -87,6 +87,8 @@ let add_current_line_type x =
current_line_type := (D.OPTMINUS,ln,lln)
| (D.PLUS,(D.CONTEXT,ln,lln)) ->
current_line_type := (D.PLUS,ln,lln)
+ | (D.PLUSPLUS,(D.CONTEXT,ln,lln)) ->
+ current_line_type := (D.PLUSPLUS,ln,lln)
| (D.UNIQUE,(D.CONTEXT,ln,lln)) ->
current_line_type := (D.UNIQUE,ln,lln)
| (D.OPT,(D.CONTEXT,ln,lln)) ->
@@ -95,7 +97,7 @@ let add_current_line_type x =
let check_minus_context_linetype s =
match !current_line_type with
- (D.PLUS,_,_) -> lexerr "invalid in a + context: " s
+ (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> lexerr "invalid in a + context: " s
| _ -> ()
let check_context_linetype s =
@@ -105,17 +107,18 @@ let check_context_linetype s =
let check_plus_linetype s =
match !current_line_type with
- (D.PLUS,_,_) -> ()
+ (D.PLUS,_,_) | (D.PLUSPLUS,_,_) -> ()
| _ -> lexerr "invalid in a non + context: " s
let check_arity_context_linetype s =
match !current_line_type with
- (D.CONTEXT,_,_) | (D.PLUS,_,_) | (D.UNIQUE,_,_) | (D.OPT,_,_) -> ()
+ (D.CONTEXT,_,_) | (D.PLUS,_,_) | (D.PLUSPLUS,_,_)
+ | (D.UNIQUE,_,_) | (D.OPT,_,_) -> ()
| _ -> lexerr "invalid in a nonempty context: " s
let process_include start finish str =
(match !current_line_type with
- (D.PLUS,_,_) ->
+ (D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
(try
let _ = Str.search_forward (Str.regexp "\\.\\.\\.") str start in
lexerr "... not allowed in + include" ""
@@ -130,15 +133,20 @@ let pm = ref UNKNOWN
let patch_or_match = function
PATCH ->
- (match !pm with
- MATCH -> lexerr "- or + not allowed in the first column for a match" ""
- | PATCH -> ()
- | UNKNOWN -> Flag.sgrep_mode2 := false; pm := PATCH)
+ if not !D.ignore_patch_or_match
+ then
+ (match !pm with
+ MATCH ->
+ lexerr "- or + not allowed in the first column for a match" ""
+ | PATCH -> ()
+ | UNKNOWN -> Flag.sgrep_mode2 := false; pm := PATCH)
| MATCH ->
- (match !pm with
- PATCH -> lexerr "* not allowed in the first column for a patch" ""
- | MATCH -> ()
- | UNKNOWN -> Flag.sgrep_mode2 := true; pm := MATCH)
+ if not !D.ignore_patch_or_match
+ then
+ (match !pm with
+ PATCH -> lexerr "* not allowed in the first column for a patch" ""
+ | MATCH -> ()
+ | UNKNOWN -> Flag.sgrep_mode2 := true; pm := MATCH)
| _ -> failwith "unexpected argument"
(* ---------------------------------------------------------------------- *)
@@ -179,7 +187,7 @@ let id_tokens lexbuf =
let s = tok lexbuf in
let linetype = get_current_line_type lexbuf in
let in_rule_name = !Data.in_rule_name in
- let in_meta = !Data.in_meta in
+ let in_meta = !Data.in_meta && not !Data.saw_struct in
let in_iso = !Data.in_iso in
let in_prolog = !Data.in_prolog in
match s with
@@ -216,16 +224,19 @@ let id_tokens lexbuf =
| "words" when in_meta -> check_context_linetype s; TWords
| "using" when in_rule_name || in_prolog -> check_context_linetype s; TUsing
+ | "virtual" when in_prolog -> check_context_linetype s; TVirtual
| "disable" when in_rule_name -> check_context_linetype s; TDisable
| "extends" when in_rule_name -> check_context_linetype s; TExtends
| "depends" when in_rule_name -> check_context_linetype s; TDepends
| "on" when in_rule_name -> check_context_linetype s; TOn
| "ever" when in_rule_name -> check_context_linetype s; TEver
| "never" when in_rule_name -> check_context_linetype s; TNever
+ (* exists and forall for when are reparsed in parse_cocci.ml *)
| "exists" when in_rule_name -> check_context_linetype s; TExists
| "forall" when in_rule_name -> check_context_linetype s; TForall
- | "reverse" when in_rule_name -> check_context_linetype s; TReverse
- | "script" when in_rule_name -> check_context_linetype s; TScript
+ | "script" when in_rule_name -> check_context_linetype s; TScript
+ | "initialize" when in_rule_name -> check_context_linetype s; TInitialize
+ | "finalize" when in_rule_name -> check_context_linetype s; TFinalize
| "char" -> Tchar linetype
| "short" -> Tshort linetype
@@ -234,9 +245,11 @@ let id_tokens lexbuf =
| "float" -> Tfloat linetype
| "long" -> Tlong linetype
| "void" -> Tvoid linetype
- | "struct" -> Tstruct linetype
- | "union" -> Tunion linetype
- | "enum" -> Tenum linetype
+ (* in_meta is only for the first keyword; drop it now to allow any type
+ name *)
+ | "struct" -> Data.saw_struct := true; Tstruct linetype
+ | "union" -> Data.saw_struct := true; Tunion linetype
+ | "enum" -> Data.saw_struct := true; Tenum linetype
| "unsigned" -> Tunsigned linetype
| "signed" -> Tsigned linetype
@@ -289,17 +302,24 @@ let init _ =
Data.in_rule_name := false;
Data.in_meta := false;
Data.in_prolog := false;
+ Data.saw_struct := false;
Data.inheritable_positions := [];
Hashtbl.clear all_metavariables;
Hashtbl.clear Data.all_metadecls;
Hashtbl.clear metavariables;
Hashtbl.clear type_names;
Hashtbl.clear rule_names;
+ Hashtbl.clear iterator_names;
+ Hashtbl.clear declarer_names;
let get_name (_,x) = x in
Data.add_id_meta :=
(fun name constraints pure ->
let fn clt = TMetaId(name,constraints,pure,clt) in
Hashtbl.replace metavariables (get_name name) fn);
+ Data.add_fresh_id_meta :=
+ (fun name ->
+ let fn clt = TMetaId(name,Ast.IdNoConstraint,Ast0.Impure,clt) in
+ Hashtbl.replace metavariables (get_name name) fn);
Data.add_type_meta :=
(fun name pure ->
let fn clt = TMetaType(name,pure,clt) in
@@ -437,6 +457,8 @@ rule token = parse
then (start_line true; TArob)
else (check_minus_context_linetype "@"; TPArob) }
+ | "~=" { start_line true; TTildeEq (get_current_line_type lexbuf) }
+ | "!~=" { start_line true; TTildeExclEq (get_current_line_type lexbuf) }
| "WHEN" | "when"
{ start_line true; check_minus_context_linetype (tok lexbuf);
TWhen (get_current_line_type lexbuf) }
@@ -542,7 +564,12 @@ rule token = parse
TDmOp (Ast.Mod,get_current_line_type lexbuf) }
| '~' { start_line true; TTilde (get_current_line_type lexbuf) }
- | "++" { start_line true; TInc (get_current_line_type lexbuf) }
+ | "++" { pass_zero();
+ if !current_line_started
+ then
+ (start_line true; TInc (get_current_line_type lexbuf))
+ else (patch_or_match PATCH;
+ add_current_line_type D.PLUSPLUS; token lexbuf) }
| "--" { start_line true; TDec (get_current_line_type lexbuf) }
| "=" { start_line true; TEq (get_current_line_type lexbuf) }
@@ -563,8 +590,8 @@ rule token = parse
| ":" { start_line true; TDotDot (get_current_line_type lexbuf) }
- | "==" { start_line true; TEqEq (get_current_line_type lexbuf) }
- | "!=" { start_line true; TNotEq (get_current_line_type lexbuf) }
+ | "==" { start_line true; TEqEq (get_current_line_type lexbuf) }
+ | "!=" { start_line true; TNotEq (get_current_line_type lexbuf) }
| ">=" { start_line true;
TLogOp(Ast.SupEq,get_current_line_type lexbuf) }
| "<=" { start_line true;
@@ -585,30 +612,32 @@ rule token = parse
| "&" { start_line true; TAnd (get_current_line_type lexbuf) }
| "^" { start_line true; TXor(get_current_line_type lexbuf) }
- | ( ("#" [' ' '\t']* "define" [' ' '\t']+))
+ | "##" { start_line true; TCppConcatOp }
+ | (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def)
( (letter (letter |digit)*) as ident)
{ start_line true;
let (arity,line,lline,offset,col,strbef,straft,pos) as lt =
get_current_line_type lexbuf in
- let off = String.length "#define " in
+ let off = String.length def in
(* -1 in the code below because the ident is not at the line start *)
TDefine
(lt,
check_var ident
- (arity,line,lline,offset+off,(-1),[],[],Ast0.NoMetaPos)) }
- | ( ("#" [' ' '\t']* "define" [' ' '\t']+))
+ (arity,line,lline,offset+off,col+off,[],[],Ast0.NoMetaPos)) }
+ | (( ("#" [' ' '\t']* "define" [' ' '\t']+)) as def)
( (letter (letter | digit)*) as ident)
'('
{ start_line true;
let (arity,line,lline,offset,col,strbef,straft,pos) as lt =
get_current_line_type lexbuf in
- let off = String.length "#define " in
+ let off = String.length def in
TDefineParam
(lt,
check_var ident
(* why pos here but not above? *)
- (arity,line,lline,offset+off,(-1),strbef,straft,pos),
- offset + off + (String.length ident)) }
+ (arity,line,lline,offset+off,col+off,strbef,straft,pos),
+ offset + off + (String.length ident),
+ col + off + (String.length ident)) }
| "#" [' ' '\t']* "include" [' ' '\t']* '"' [^ '"']+ '"'
{ TIncludeL
(let str = tok lexbuf in
@@ -706,12 +735,13 @@ and string = parse
| ("\\" (_ as v)) as x
{
(match v with
- | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> ()
- | 'f' -> () | 'a' -> ()
- | '\\' -> () | '?' -> () | '\'' -> () | '"' -> ()
- | 'e' -> ()
- | '\n' -> ()
- | _ -> lexerr "unrecognised symbol:" (tok lexbuf)
+ | 'n' -> () | 't' -> () | 'v' -> () | 'b' -> () | 'r' -> ()
+ | 'f' -> () | 'a' -> ()
+ | '\\' -> () | '?' -> () | '\'' -> () | '"' -> ()
+ | 'e' -> ()
+ | '\n' -> ()
+ | '(' -> () | '|' -> () | ')' -> ()
+ | _ -> lexerr "unrecognised symbol:" (tok lexbuf)
);
x ^ string lexbuf
}
@@ -728,7 +758,7 @@ and comment = parse
(* noteopti: *)
| [^ '*'] { start_line true; let s = tok lexbuf in s ^ comment lexbuf }
| [ '*'] { start_line true; let s = tok lexbuf in s ^ comment lexbuf }
- | _
+ | _
{ start_line true; let s = tok lexbuf in
Common.pr2 ("LEXER: unrecognised symbol in comment:"^s);
s ^ comment lexbuf