X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/b1b2de814d2c59af2526bc19d41bb22a0c1fd16d..3a31414346dd7d7e8baa4cb8b804a2d5e1797962:/parsing_cocci/insert_plus.ml

diff --git a/parsing_cocci/insert_plus.ml b/parsing_cocci/insert_plus.ml
index a6ddbfc..e19ab82 100644
--- a/parsing_cocci/insert_plus.ml
+++ b/parsing_cocci/insert_plus.ml
@@ -1,23 +1,25 @@
 (*
-* 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 <http://www.gnu.org/licenses/>.
-* 
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
+ * Copyright 2010, 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
+ * 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 <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
 
 
 (* The error message "no available token to attach to" often comes in an
@@ -158,7 +160,7 @@ let collect_minus_join_points root =
   let bind x y = x @ y in
   let option_default = [] in
 
-  let mcode (_,_,info,mcodekind,_) =
+  let mcode (x,_,info,mcodekind,_,_) =
     if List.mem (info.Ast0.pos_info.Ast0.offset) unfavored_tokens
     then [(Unfavored,info,mcodekind)]
     else [(Favored,info,mcodekind)] in
@@ -390,7 +392,7 @@ let verify l =
 		  then
 		    failwith
 		      (Printf.sprintf
-			 "error in collection of - tokens %d less than %d"
+			 "error in collection of - tokens: line %d less than line %d"
 			 (token_real_start_line cur) real_prev);
 		  (token_end_line cur,token_real_end_line cur))
 	      (token_end_line (List.hd l1), token_real_end_line (List.hd l1))
@@ -400,6 +402,7 @@ let verify l =
     l
 
 let process_minus minus =
+  Hashtbl.clear root_token_table;
   create_root_token_table minus;
   List.concat
     (List.map
@@ -467,20 +470,20 @@ let collect_plus_nodes root =
 	      Ast0.offset = first.Ast0.offset} in
 	  let new_info = {adjust_info with Ast0.pos_info = new_pos_info} in
 	  let string = List.map (function (s,_) -> s) strings_before in
-	  [(new_info, Ast.Pragma (string))] in
+	  [(new_info,Ast.ONE(*?*),Ast.Pragma (string))] in
     let bef = extract info.Ast0.strings_before in
     let aft = extract info.Ast0.strings_after in
     (bef,aft) in
 
-  let mcode fn (term,_,info,mcodekind,_) =
+  let mcode fn (term,_,info,mcodekind,_,_) =
     match mcodekind with
-      Ast0.PLUS -> [(info,fn term)]
+      Ast0.PLUS c -> [(info,c,fn term)]
     | Ast0.CONTEXT _ -> let (bef,aft) = extract_strings info in bef@aft
     | _ -> [] in
 
-  let imcode fn (term,_,info,mcodekind,_) =
+  let imcode fn (term,_,info,mcodekind,_,_) =
     match mcodekind with
-      Ast0.PLUS -> [(info,fn term (Ast0toast.convert_info info))]
+      Ast0.PLUS c -> [(info,c,fn term (Ast0toast.convert_info info))]
     | Ast0.CONTEXT _ -> let (bef,aft) = extract_strings info in bef@aft
     | _ -> [] in
 
@@ -489,7 +492,7 @@ let collect_plus_nodes root =
   let do_nothing fn r k e =
     match Ast0.get_mcodekind e with
       (Ast0.CONTEXT(_)) when not(Ast0.get_index e = root_index) -> []
-    | Ast0.PLUS -> [(Ast0.get_info e,fn e)]
+    | Ast0.PLUS c -> [(Ast0.get_info e,c,fn e)]
     | _ -> k e in
 
   (* case for everything that is just a wrapper for a simpler thing *)
@@ -547,7 +550,7 @@ let collect_plus_nodes root =
     stmt (do_nothing mk_case_line) toplevel
 
 let call_collect_plus context_nodes :
-    (int * (Ast0.info * Ast.anything) list) list =
+    (int * (Ast0.info * Ast.count * Ast.anything) list) list =
   List.map
     (function e ->
       match e with
@@ -624,35 +627,39 @@ let redo info start finish =
   {info with Ast0.pos_info = new_pos_info}
 
 let rec find_neighbors (index,l) :
-    int * (Ast0.info * (Ast.anything list list)) list =
+    int * (Ast0.info * Ast.count * (Ast.anything list list)) list =
   let rec loop = function
       [] -> []
-    | (i,x)::rest ->
+    | (i,c,x)::rest ->
 	(match loop rest with
-	  ((i1,(x1::rest_inner))::rest_middle)::rest_outer ->
+	  ((i1,c1,(x1::rest_inner))::rest_middle)::rest_outer ->
 	    let finish1 = logend i in
 	    let start2 = logstart i1 in
 	    if finish1 = start2
 	    then
-	      ((redo i (logstart i) (logend i1),(x::x1::rest_inner))
+	      ((if not (c = c1) then failwith "inconsistent + code");
+	      ((redo i (logstart i) (logend i1),c,(x::x1::rest_inner))
 	       ::rest_middle)
-	      ::rest_outer
+	      ::rest_outer)
 	    else if finish1 + 1 = start2
-	    then ((i,[x])::(i1,(x1::rest_inner))::rest_middle)::rest_outer
-	    else [(i,[x])]::((i1,(x1::rest_inner))::rest_middle)::rest_outer
-	| _ -> [[(i,[x])]]) (* rest must be [] *) in
+	    then ((i,c,[x])::(i1,c1,(x1::rest_inner))::rest_middle)::rest_outer
+	    else
+	      [(i,c,[x])]::((i1,c1,(x1::rest_inner))::rest_middle)::rest_outer
+	| _ -> [[(i,c,[x])]]) (* rest must be [] *) in
   let res =
     List.map
       (function l ->
-	let (start_info,_) = List.hd l in
-	let (end_info,_) = List.hd (List.rev l) in
+	let (start_info,start_count,_) = List.hd l in
+	let (end_info,end_count,_) = List.hd (List.rev l) in
+	(if not (start_count = end_count) then failwith "inconsistent + code");
 	(redo start_info (logstart start_info) (logend end_info),
-	 List.map (function (_,x) -> x) l))
+	 start_count,
+	 List.map (function (_,_,x) -> x) l))
       (loop l) in
   (index,res)
 
 let process_plus plus :
-    (int * (Ast0.info * Ast.anything list list) list) list =
+    (int * (Ast0.info * Ast.count * Ast.anything list list) list) list =
   List.concat
     (List.map
        (function x ->
@@ -693,7 +700,12 @@ let decl = function Decl -> true | Favored | Unfavored | Toplevel -> false
 let favored = function Favored -> true | Unfavored | Toplevel | Decl -> false
 
 let top_code =
-  List.for_all (List.for_all (function Ast.Code _ -> true | _ -> false))
+  List.for_all
+    (List.for_all (function Ast.Code _ | Ast.Pragma _ -> true | _ -> false))
+
+let storage_code =
+  List.for_all
+    (List.for_all (function Ast.StorageTag _ -> true | _ -> false))
 
 (* The following is probably not correct.  The idea is to detect what
 should be placed completely before the declaration.  So type/storage
@@ -769,48 +781,60 @@ let init thing info =
      Ast0.left_offset = info.Ast0.pos_info.Ast0.offset;
      Ast0.right_offset = info.Ast0.pos_info.Ast0.offset})
 
-let attachbefore (infop,p) = function
+let attachbefore (infop,c,p) = function
     Ast0.MINUS(replacements) ->
-      (match !replacements with
-	([],ti) -> replacements := init p infop
-      |	(repl,ti) -> replacements := insert p infop repl ti)
+      let (repl,ti) = !replacements in
+      let (bef,ti) =
+ 	match repl with
+ 	  [] -> init p infop
+ 	| repl -> insert p infop repl ti in
+      replacements := (bef,ti)
   | Ast0.CONTEXT(neighbors) ->
       let (repl,ti1,ti2) = !neighbors in
       (match repl with
-	Ast.BEFORE(bef) ->
+	Ast.BEFORE(bef,it) ->
 	  let (bef,ti1) = insert p infop bef ti1 in
-	  neighbors := (Ast.BEFORE(bef),ti1,ti2)
-      |	Ast.AFTER(aft) ->
+	  let it = Ast.lub_count it c in
+	  neighbors := (Ast.BEFORE(bef,it),ti1,ti2)
+      |	Ast.AFTER(aft,it) ->
 	  let (bef,ti1) = init p infop in
-	  neighbors := (Ast.BEFOREAFTER(bef,aft),ti1,ti2)
-      |	Ast.BEFOREAFTER(bef,aft) ->
+	  let it = Ast.lub_count it c in
+	  neighbors := (Ast.BEFOREAFTER(bef,aft,it),ti1,ti2)
+      |	Ast.BEFOREAFTER(bef,aft,it) ->
 	  let (bef,ti1) = insert p infop bef ti1 in
-	  neighbors := (Ast.BEFOREAFTER(bef,aft),ti1,ti2)
+	  let it = Ast.lub_count it c in
+	  neighbors := (Ast.BEFOREAFTER(bef,aft,it),ti1,ti2)
       |	Ast.NOTHING ->
 	  let (bef,ti1) = init p infop in
-	  neighbors := (Ast.BEFORE(bef),ti1,ti2))
+	  neighbors := (Ast.BEFORE(bef,c),ti1,ti2))
   | _ -> failwith "not possible for attachbefore"
 
-let attachafter (infop,p) = function
+let attachafter (infop,c,p) = function
     Ast0.MINUS(replacements) ->
-      (match !replacements with
-	([],ti) -> replacements := init p infop
-      |	(repl,ti) -> replacements := insert p infop repl ti)
+       let (repl,ti) = !replacements in
+       let (aft,ti) =
+ 	match repl with
+ 	  [] -> init p infop
+ 	| repl -> insert p infop repl ti in
+       replacements := (aft,ti)
   | Ast0.CONTEXT(neighbors) ->
       let (repl,ti1,ti2) = !neighbors in
       (match repl with
-	Ast.BEFORE(bef) ->
+	Ast.BEFORE(bef,it) ->
 	  let (aft,ti2) = init p infop in
-	  neighbors := (Ast.BEFOREAFTER(bef,aft),ti1,ti2)
-      |	Ast.AFTER(aft) ->
+	  let it = Ast.lub_count it c in
+	  neighbors := (Ast.BEFOREAFTER(bef,aft,it),ti1,ti2)
+      |	Ast.AFTER(aft,it) ->
 	  let (aft,ti2) = insert p infop aft ti2 in
-	  neighbors := (Ast.AFTER(aft),ti1,ti2)
-      |	Ast.BEFOREAFTER(bef,aft) ->
+	  let it = Ast.lub_count it c in
+	  neighbors := (Ast.AFTER(aft,it),ti1,ti2)
+      |	Ast.BEFOREAFTER(bef,aft,it) ->
 	  let (aft,ti2) = insert p infop aft ti2 in
-	  neighbors := (Ast.BEFOREAFTER(bef,aft),ti1,ti2)
+	  let it = Ast.lub_count it c in
+	  neighbors := (Ast.BEFOREAFTER(bef,aft,it),ti1,ti2)
       |	Ast.NOTHING ->
 	  let (aft,ti2) = init p infop in
-	  neighbors := (Ast.AFTER(aft),ti1,ti2))
+	  neighbors := (Ast.AFTER(aft,c),ti1,ti2))
   | _ -> failwith "not possible for attachbefore"
 
 let attach_all_before ps m =
@@ -822,7 +846,7 @@ let attach_all_after ps m =
 let split_at_end info ps =
   let split_point =  info.Ast0.pos_info.Ast0.logical_end in
   List.partition
-    (function (info,_) -> info.Ast0.pos_info.Ast0.logical_end < split_point)
+    (function (info,_,_) -> info.Ast0.pos_info.Ast0.logical_end < split_point)
     ps
 
 let allminus = function
@@ -831,21 +855,27 @@ let allminus = function
 
 let rec before_m1 ((f1,infom1,m1) as x1) ((f2,infom2,m2) as x2) rest = function
     [] -> ()
-  | (((infop,_) as p) :: ps) as all ->
+  | (((infop,_,pcode) as p) :: ps) as all ->
       if less_than_start infop infom1 or
 	(allminus m1 && less_than_end infop infom1) (* account for trees *)
       then
-	if good_start infom1
-	then (attachbefore p m1; before_m1 x1 x2 rest ps)
+	if toplevel f1
+	then
+	  if storage_code pcode
+	  then before_m2 x2 rest all (* skip fake token for storage *)
+	  else (attachbefore p m1; before_m1 x1 x2 rest ps)
 	else
-	  failwith
-	    (pr "%d: no available token to attach to"
-	       infop.Ast0.pos_info.Ast0.line_start)
+	  if good_start infom1
+	  then (attachbefore p m1; before_m1 x1 x2 rest ps)
+	  else
+	    failwith
+	      (pr "%d: no available token to attach to"
+		 infop.Ast0.pos_info.Ast0.line_start)
       else after_m1 x1 x2 rest all
 
 and after_m1 ((f1,infom1,m1) as x1) ((f2,infom2,m2) as x2) rest = function
     [] -> ()
-  | (((infop,pcode) as p) :: ps) as all ->
+  | (((infop,count,pcode) as p) :: ps) as all ->
       (* if the following is false, then some + code is stuck in the middle
 	 of some context code (m1).  could drop down to the token level.
 	 this might require adjustments in ast0toast as well, when + code on
@@ -900,10 +930,10 @@ and is_minus = function
   | _ -> false
 
 and before_m2 ((f2,infom2,m2) as x2) rest
-    (p : (Ast0.info * Ast.anything list list) list) =
+    (p : (Ast0.info * Ast.count * Ast.anything list list) list) =
   match (rest,p) with
     (_,[]) -> ()
-  | ([],((infop,_)::_)) ->
+  | ([],((infop,_,_)::_)) ->
       let (bef_m2,aft_m2) = split_at_end infom2 p in (* bef_m2 isn't empty *)
       if good_start infom2
       then (attach_all_before bef_m2 m2; after_m2 x2 rest aft_m2)
@@ -914,10 +944,10 @@ and before_m2 ((f2,infom2,m2) as x2) rest
   | (m::ms,_) -> before_m1 x2 m ms p
 
 and after_m2 ((f2,infom2,m2) as x2) rest
-    (p : (Ast0.info * Ast.anything list list) list) =
+    (p : (Ast0.info * Ast.count * Ast.anything list list) list) =
   match (rest,p) with
     (_,[]) -> ()
-  | ([],((infop,_)::_)) ->
+  | ([],((infop,_,_)::_)) ->
       if good_end infom2
       then attach_all_after p m2
       else
@@ -927,7 +957,8 @@ and after_m2 ((f2,infom2,m2) as x2) rest
   | (m::ms,_) -> after_m1 x2 m ms p
 
 let merge_one : (minus_join_point * Ast0.info * 'a) list *
-    (Ast0.info * Ast.anything list list) list -> unit = function (m,p) ->
+    (Ast0.info * Ast.count * Ast.anything list list) list -> unit =
+      function (m,p) ->
   (*
   Printf.printf "minus code\n";
   List.iter
@@ -940,7 +971,7 @@ let merge_one : (minus_join_point * Ast0.info * 'a) list *
     m;
   Printf.printf "plus code\n";
   List.iter
-    (function (info,p) ->
+    (function (info,_,p) ->
       Printf.printf "start %d end %d real_start %d real_end %d\n"
 	info.Ast0.pos_info.Ast0.logical_start
 	info.Ast0.pos_info.Ast0.logical_end
@@ -980,7 +1011,7 @@ let reevaluate_contextness =
    let bind = (@) in
    let option_default = [] in
 
-   let mcode (_,_,_,mc,_) =
+   let mcode (_,_,_,mc,_,_) =
      match mc with
        Ast0.CONTEXT(mc) -> let (ba,_,_) = !mc in [ba]
      | _ -> [] in