Coccinelle release-1.0.0-rc11
[bpt/coccinelle.git] / parsing_cocci / parse_cocci.ml
index 5359bbe..bc0af9b 100644 (file)
@@ -1,5 +1,7 @@
 (*
- * Copyright 2010, INRIA, University of Copenhagen
+ * Copyright 2012, INRIA
+ * Julia Lawall, Gilles Muller
+ * Copyright 2010-2011, INRIA, University of Copenhagen
  * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
  * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
  * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
@@ -220,7 +222,7 @@ let token2c (tok,_) =
   | PC.TMPtVirg -> ";"
   | PC.TArobArob -> "@@"
   | PC.TArob -> "@"
-  | PC.TPArob -> "P@"
+  | PC.TPArob clt -> "P@"
   | PC.TScript -> "script"
   | PC.TInitialize -> "initialize"
   | PC.TFinalize -> "finalize"
@@ -436,7 +438,7 @@ let get_clt (tok,_) =
   | PC.TPtrOp(clt)
 
   | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
-  | PC.TPtVirg(clt)
+  | PC.TPArob(clt) | PC.TPtVirg(clt)
 
   | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt)
   | PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
@@ -593,6 +595,7 @@ let update_clt (tok,x) clt =
   | PC.TAssign(s,_) -> (PC.TAssign(s,clt),x)
   | PC.TDot(_) -> (PC.TDot(clt),x)
   | PC.TComma(_) -> (PC.TComma(clt),x)
+  | PC.TPArob(_) -> (PC.TPArob(clt),x)
   | PC.TPtVirg(_) -> (PC.TPtVirg(clt),x)
 
   | PC.TLineEnd(_) -> (PC.TLineEnd(clt),x)
@@ -701,7 +704,7 @@ let split_token ((tok,_) as t) =
   | PC.TMetaDeclarer(_,_,_,clt) | PC.TMetaIterator(_,_,_,clt) -> split t clt
   | PC.TMPtVirg | PC.TArob | PC.TArobArob | PC.TScript
   | PC.TInitialize | PC.TFinalize -> ([t],[t])
-  | PC.TPArob | PC.TMetaPos(_,_,_,_) -> ([t],[])
+  | PC.TPArob clt | PC.TMetaPos(_,_,_,clt) -> split t clt
 
   | PC.TFunDecl(clt)
   | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt)
@@ -1018,7 +1021,7 @@ let token2line (tok,_) =
   | PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt)
 
   | PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
-  | PC.TPtVirg(clt) ->
+  | PC.TPArob(clt) | PC.TPtVirg(clt) ->
       let (_,line,_,_,_,_,_,_) = clt in Some line
 
   | _ -> None
@@ -1051,8 +1054,8 @@ and find_line_end inwhen line clt q = function
       (PC.TExists,a) :: (find_line_end inwhen line clt q xs)
   | ((PC.TComma(clt),a) as x)::xs when token2line x = line ->
       (PC.TComma(clt),a) :: (find_line_end inwhen line clt q xs)
-  | ((PC.TPArob,a) as x)::xs -> (* no line #, just assume on the same line *)
-      x :: (find_line_end inwhen line clt q xs)
+  | ((PC.TPArob(clt),a) as x)::xs when token2line x = line ->
+      (PC.TPArob(clt),a) :: (find_line_end inwhen line clt q xs)
   | x::xs when token2line x = line -> x :: (find_line_end inwhen line clt q xs)
   | xs -> (PC.TLineEnd(clt),q)::(insert_line_end xs)
 
@@ -1428,19 +1431,75 @@ let prepare_tokens tokens =
 let prepare_mv_tokens tokens =
   detect_types false (detect_attr tokens)
 
-let rec consume_minus_positions = function
+let unminus (d,x1,x2,x3,x4,x5,x6,x7) = (* for hidden variables *)
+  match d with
+    D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> (D.CONTEXT,x1,x2,x3,x4,x5,x6,x7)
+  | D.PLUS -> failwith "unexpected plus code"
+  | D.PLUSPLUS -> failwith "unexpected plus code"
+  | D.CONTEXT | D.UNIQUE | D.OPT -> (D.CONTEXT,x1,x2,x3,x4,x5,x6,x7)
+
+let process_minus_positions x name clt meta =
+  let (arity,ln,lln,offset,col,strbef,straft,pos) = get_clt x in
+  let name = Parse_aux.clt2mcode name (unminus clt) in
+  update_clt x (arity,ln,lln,offset,col,strbef,straft,meta name::pos)
+
+(* first attach positions, then the others, so that positions can refer to
+the larger term represented by the preceding metavariable *)
+let rec consume_minus_positions toks =
+  let rec loop_pos = function
+      [] -> []
+    | ((PC.TOPar0(_),_) as x)::xs | ((PC.TCPar0(_),_) as x)::xs
+    | ((PC.TMid0(_),_) as x)::xs -> x::loop_pos xs
+    | x::(PC.TPArob _,_)::(PC.TMetaPos(name,constraints,per,clt),_)::xs ->
+       let x =
+         process_minus_positions x name clt
+           (function name ->
+             Ast0.MetaPosTag(Ast0.MetaPos(name,constraints,per))) in
+       (loop_pos (x::xs))
+    | x::xs -> x::loop_pos xs in
+  let rec loop_other = function
+      [] -> []
+    | ((PC.TOPar0(_),_) as x)::xs | ((PC.TCPar0(_),_) as x)::xs
+    | ((PC.TMid0(_),_) as x)::xs -> x::loop_other xs
+    | x::(PC.TPArob _,_)::(PC.TMetaExp(name,constraints,pure,ty,clt),_)::xs ->
+       let x =
+         process_minus_positions x name clt
+           (function name ->
+             Ast0.ExprTag
+               (Ast0.wrap
+                  (Ast0.MetaExpr(name,constraints,ty,Ast.ANY,pure)))) in
+       (loop_other (x::xs))
+    | x::(PC.TPArob _,_)::(PC.TMetaInit(name,pure,clt),_)::xs ->
+       let x =
+         process_minus_positions x name clt
+           (function name ->
+             Ast0.InitTag(Ast0.wrap(Ast0.MetaInit(name,pure)))) in
+       (loop_other (x::xs))
+    | x::(PC.TPArob _,_)::(PC.TMetaType(name,pure,clt),_)::xs ->
+       let x =
+         process_minus_positions x name clt
+           (function name ->
+             Ast0.TypeCTag(Ast0.wrap(Ast0.MetaType(name,pure)))) in
+       (loop_other (x::xs))
+    | x::(PC.TPArob _,_)::(PC.TMetaDecl(name,pure,clt),_)::xs ->
+       let x =
+         process_minus_positions x name clt
+           (function name ->
+             Ast0.DeclTag(Ast0.wrap(Ast0.MetaDecl(name,pure)))) in
+       (loop_other (x::xs))
+    | x::(PC.TPArob _,_)::(PC.TMetaStm(name,pure,clt),_)::xs ->
+       let x =
+         process_minus_positions x name clt
+           (function name ->
+             Ast0.StmtTag(Ast0.wrap(Ast0.MetaStmt(name,pure)))) in
+       (loop_other (x::xs))
+    | x::xs -> x::loop_other xs in
+  loop_other(loop_pos toks)
+    
+let rec consume_plus_positions = function
     [] -> []
-  | ((PC.TOPar0(_),_) as x)::xs | ((PC.TCPar0(_),_) as x)::xs
-  | ((PC.TMid0(_),_) as x)::xs -> x::consume_minus_positions xs
-  | x::(PC.TPArob,_)::(PC.TMetaPos(name,constraints,per,clt),_)::xs ->
-      let (arity,ln,lln,offset,col,strbef,straft,pos) = get_clt x in
-      let name = Parse_aux.clt2mcode name clt in
-      let x =
-       update_clt x
-         (arity,ln,lln,offset,col,strbef,straft,
-          (Ast0.MetaPos(name,constraints,per)::pos)) in
-      (consume_minus_positions (x::xs))
-  | x::xs -> x::consume_minus_positions xs
+  | (PC.TPArob _,_)::x::xs -> consume_plus_positions xs
+  | x::xs -> x::consume_plus_positions xs
 
 let any_modif rule =
   let mcode x =
@@ -1572,7 +1631,7 @@ let parse_iso file =
            let tokens = prepare_tokens (start@tokens) in
             (*
               print_tokens "iso tokens" tokens;
-           å*)
+           *)
            let entry = parse_one "iso main" PC.iso_main file tokens in
            let entry = List.map (List.map Test_exps.process_anything) entry in
            if more
@@ -1588,6 +1647,7 @@ let parse_iso file =
            else [(iso_metavars,entry,rule_name)] in
          loop starts_with_name start
       | (false,_) -> [] in
+    List.iter Iso_compile.process res;
     res)
 
 let parse_iso_files existing_isos iso_files extra_path =
@@ -1714,6 +1774,7 @@ let parse file =
            *)
 
            let minus_tokens = consume_minus_positions minus_tokens in
+           let plus_tokens = consume_plus_positions plus_tokens in
            let minus_tokens = prepare_tokens minus_tokens in
            let plus_tokens = prepare_tokens plus_tokens in
 
@@ -1996,7 +2057,6 @@ let process file isofile verbose =
                   List.filter
                     (function (_,_,nm) -> not (List.mem nm dropiso))
                     chosen_isos in
-              List.iter Iso_compile.process chosen_isos;
               let dropped_isos =
                 match reserved_names with
                   "all"::others ->
@@ -2047,6 +2107,8 @@ let process file isofile verbose =
                 if !Flag.sgrep_mode2 then minus
                 else Single_statement.single_statement minus in
               let minus = Simple_assignments.simple_assignments minus in
+              (* has to be last, introduced AsExpr, etc *)
+              let minus = Get_metas.process minus in
               let minus_ast =
                 Ast0toast.ast0toast rule_name dependencies dropped_isos
                   exists minus is_exp ruletype in