Coccinelle release-1.0.0-rc11

[bpt/coccinelle.git] / parsing_cocci / iso_pattern.ml

diff --git a/parsing_cocci/iso_pattern.ml b/parsing_cocci/iso_pattern.ml
index 0aec0b1..2b53341 100644 (file)
--- a/parsing_cocci/iso_pattern.ml
+++ b/parsing_cocci/iso_pattern.ml
@@ -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
@@ -127,7 +129,6 @@ type reason =
   | Braces of Ast0.statement
   | Nest of Ast0.statement
   | Position of Ast.meta_name
-  | Multiposition
   | TypeMatch of reason list
 
 let rec interpret_reason name line reason printer =
@@ -169,9 +170,7 @@ let rec interpret_reason name line reason printer =
   | Position(rule,name) ->
       Printf.printf "position variable %s.%s conflicts with an isomorphism\n"
        rule name
-  | Multiposition _ ->
-      Printf.printf "multiple position variables conflict with an isomorphism\n"
-  | TypeMatch reason_list ->
+   | TypeMatch reason_list ->
       List.iter (function r -> interpret_reason name line r printer)
        reason_list
   | _ -> failwith "not possible"
@@ -325,16 +324,16 @@ let match_maker checks_needed context_required whencode_allowed =
     if checks_needed
     then
       match Ast0.get_pos cmc with
-       [(Ast0.MetaPos (name,_,_)) as x] ->
-         (match Ast0.get_pos pmc with
-           [Ast0.MetaPos (name1,_,_)] ->
-             add_binding name1 (Ast0.MetaPosTag x) binding
-         | [] ->
-             let (rule,name) = Ast0.unwrap_mcode name in
-             Fail (Position(rule,name))
-         | _ -> Fail Multiposition)
-      | [] -> OK binding
-      | _ -> Fail Multiposition
+       [] -> OK binding (* no hidden vars in smpl code, so nothing to do *)
+      |        ((a::_) as hidden_code) ->
+         let hidden_pattern =
+           List.filter (function Ast0.HiddenVarTag _ -> true | _ -> false)
+             (Ast0.get_pos pmc) in
+         (match hidden_pattern with
+           [Ast0.HiddenVarTag([Ast0.MetaPosTag(Ast0.MetaPos (name1,_,_))])] ->
+             add_binding name1 (Ast0.HiddenVarTag(hidden_code)) binding
+         | [] -> Fail(Position(Ast0.unwrap_mcode(Ast0.meta_pos_name a)))
+         | _ -> failwith "badly compiled iso - multiple hidden variable")
     else OK binding in
 
   let match_dots matcher is_list_matcher do_list_match d1 d2 =
@@ -659,6 +658,14 @@ let match_maker checks_needed context_required whencode_allowed =
                   [check_mcode opa opb; match_expr lefta leftb;
                     match_expr righta rightb]
               else return false
+         | (Ast0.Sequence(lefta,opa,righta),
+            Ast0.Sequence(leftb,opb,rightb)) ->
+              if mcode_equal opa opb
+              then
+                conjunct_many_bindings
+                  [check_mcode opa opb; match_expr lefta leftb;
+                    match_expr righta rightb]
+              else return false
          | (Ast0.CondExpr(exp1a,lp1,exp2a,rp1,exp3a),
             Ast0.CondExpr(exp1b,lp,exp2b,rp,exp3b)) ->
               conjunct_many_bindings
@@ -744,7 +751,8 @@ let match_maker checks_needed context_required whencode_allowed =
          | (Ast0.Estars(_,Some _),_) ->
              failwith "whencode not allowed in a pattern1"
          | (Ast0.OptExp(expa),Ast0.OptExp(expb))
-         | (Ast0.UniqueExp(expa),Ast0.UniqueExp(expb)) -> match_expr expa expb
+         | (Ast0.UniqueExp(expa),Ast0.UniqueExp(expb)) ->
+             match_expr expa expb
          | (_,Ast0.OptExp(expb))
          | (_,Ast0.UniqueExp(expb)) -> match_expr pattern expb
          | _ -> return false
@@ -881,6 +889,16 @@ let match_maker checks_needed context_required whencode_allowed =
                   check_mcode sc1 sc;
                   match_dots match_expr is_elist_matcher do_elist_match
                     argsa argsb]
+         | (Ast0.MacroDeclInit(namea,lp1,argsa,rp1,eq1,ini1,sc1),
+            Ast0.MacroDeclInit(nameb,lp,argsb,rp,eq,ini,sc)) ->
+              conjunct_many_bindings
+                [match_ident namea nameb;
+                  check_mcode lp1 lp; check_mcode rp1 rp;
+                  check_mcode eq1 eq;
+                  check_mcode sc1 sc;
+                  match_dots match_expr is_elist_matcher do_elist_match
+                    argsa argsb;
+                  match_init ini1 ini]
          | (Ast0.TyDecl(tya,sc1),Ast0.TyDecl(tyb,sc)) ->
              conjunct_bindings (check_mcode sc1 sc) (match_typeC tya tyb)
          | (Ast0.Typedef(stga,tya,ida,sc1),Ast0.Typedef(stgb,tyb,idb,sc)) ->
@@ -1537,19 +1555,24 @@ let lookup name bindings mv_bindings =
    isomorphism *)
 let instantiate bindings mv_bindings =
   let mcode x =
-    let pos_names =
-      List.map (function Ast0.MetaPos(name,_,_) -> name) (Ast0.get_pos x) in
+    let (hidden,others) =
+      List.partition
+       (function Ast0.HiddenVarTag _ -> true | _ -> false)
+       (Ast0.get_pos x) in
     let new_names =
-      List.fold_left
-       (function prev ->
-         function name ->
-           try
-             match lookup name bindings mv_bindings with
-               Common.Left(Ast0.MetaPosTag(id)) -> id::prev
-             | _ -> failwith "not possible"
-           with Not_found -> prev)
-       [] pos_names in
-    Ast0.set_pos new_names x in
+      match hidden with
+       [Ast0.HiddenVarTag([Ast0.MetaPosTag(Ast0.MetaPos (name,_,_))])] ->
+         (try
+         (* not at all sure that this is good enough *)
+           match lookup name bindings mv_bindings with
+             Common.Left(Ast0.HiddenVarTag(ids)) -> ids
+           | _ -> failwith "not possible"
+         with Not_found ->
+            (*can't fail because checks_needed could be false?*)
+           [])
+      |        [] -> [] (* no hidden metavars allowed *)
+      | _ -> failwith "badly compiled mcode" in
+    Ast0.set_pos (new_names@others) x in
   let donothing r k e = k e in
 
   (* cases where metavariables can occur *)
@@ -2598,6 +2621,7 @@ let rewrap_anything = function
   | Ast0.IsoWhenTag(_) | Ast0.IsoWhenTTag(_) | Ast0.IsoWhenFTag(_) ->
       failwith "only for isos within iso phase"
   | Ast0.MetaPosTag(p) -> Ast0.MetaPosTag(p)
+  | Ast0.HiddenVarTag(p) -> Ast0.HiddenVarTag(p) (* not sure it is possible *)
 
 (* --------------------------------------------------------------------- *)