(*
-* 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
module Ast = Ast_cocci
module Ast0 = Ast0_cocci
module V0 = Visitor_ast0
+module VT0 = Visitor_ast0_types
module CN = Context_neg
let empty_isos = ref false
let topfn r k e = Ast0.TopTag(e) :: (k e) in
let res =
- V0.combiner bind option_default
+ V0.flat_combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
(donothing Ast0.dotsExpr) (donothing Ast0.dotsInit)
(donothing Ast0.dotsParam) (donothing Ast0.dotsStmt)
(donothing Ast0.ident) expression (donothing Ast0.typeC) initialiser
(donothing Ast0.param) (donothing Ast0.decl) statement
(donothing Ast0.case_line) topfn in
- res.V0.combiner_top_level e
+ res.VT0.combiner_rec_top_level e
(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)
let bind x y = x @ y in
let option_default = [] in
- let mcode (_,_,info,mcodekind,_) =
- if List.mem (info.Ast0.offset) unfavored_tokens
+ 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
| Ast0.CIRCLES(l) -> multibind (List.map f l)
| Ast0.STARS(l) -> multibind (List.map f l) in
- let edots r k d = dots r.V0.combiner_expression k d in
- let idots r k d = dots r.V0.combiner_initialiser k d in
- let pdots r k d = dots r.V0.combiner_parameter k d in
- let sdots r k d = dots r.V0.combiner_statement k d in
- let ddots r k d = dots r.V0.combiner_declaration k d in
- let cdots r k d = dots r.V0.combiner_case_line k d in
+ let edots r k d = dots r.VT0.combiner_rec_expression k d in
+ let idots r k d = dots r.VT0.combiner_rec_initialiser k d in
+ let pdots r k d = dots r.VT0.combiner_rec_parameter k d in
+ let sdots r k d = dots r.VT0.combiner_rec_statement k d in
+ let ddots r k d = dots r.VT0.combiner_rec_declaration k d in
+ let cdots r k d = dots r.VT0.combiner_rec_case_line k d in
(* a case for everything that has a Opt *)
(Toplevel,info,bef)::(k s)
| Ast0.Decl((info,bef),decl) -> (Decl,info,bef)::(k s)
| Ast0.Nest(starter,stmt_dots,ender,whencode,multi) ->
- mcode starter @ r.V0.combiner_statement_dots stmt_dots @ mcode ender
+ mcode starter @ r.VT0.combiner_rec_statement_dots stmt_dots @
+ mcode ender
| Ast0.Dots(d,whencode) | Ast0.Circles(d,whencode)
| Ast0.Stars(d,whencode) -> mcode d (* ignore whencode *)
| Ast0.OptStm s | Ast0.UniqueStm s ->
(* put the + code on the thing, not on the opt *)
- r.V0.combiner_statement s
+ r.VT0.combiner_rec_statement s
| _ -> do_nothing r k s in
let expression r k e =
match Ast0.unwrap e with
Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) ->
mcode starter @
- r.V0.combiner_expression_dots expr_dots @ mcode ender
+ r.VT0.combiner_rec_expression_dots expr_dots @ mcode ender
| Ast0.Edots(d,whencode) | Ast0.Ecircles(d,whencode)
| Ast0.Estars(d,whencode) -> mcode d (* ignore whencode *)
| Ast0.OptExp e | Ast0.UniqueExp e ->
(* put the + code on the thing, not on the opt *)
- r.V0.combiner_expression e
+ r.VT0.combiner_rec_expression e
| _ -> do_nothing r k e in
let ident r k e =
match Ast0.unwrap e with
Ast0.OptIdent i | Ast0.UniqueIdent i ->
(* put the + code on the thing, not on the opt *)
- r.V0.combiner_ident i
+ r.VT0.combiner_rec_ident i
| _ -> do_nothing r k e in
let typeC r k e =
match Ast0.unwrap e with
Ast0.OptType t | Ast0.UniqueType t ->
(* put the + code on the thing, not on the opt *)
- r.V0.combiner_typeC t
+ r.VT0.combiner_rec_typeC t
| _ -> do_nothing r k e in
let decl r k e =
match Ast0.unwrap e with
Ast0.OptDecl d | Ast0.UniqueDecl d ->
(* put the + code on the thing, not on the opt *)
- r.V0.combiner_declaration d
+ r.VT0.combiner_rec_declaration d
| _ -> do_nothing r k e in
let initialiser r k e =
Ast0.Idots(d,whencode) -> mcode d (* ignore whencode *)
| Ast0.OptIni i | Ast0.UniqueIni i ->
(* put the + code on the thing, not on the opt *)
- r.V0.combiner_initialiser i
+ r.VT0.combiner_rec_initialiser i
| _ -> do_nothing r k e in
let param r k e =
match Ast0.unwrap e with
Ast0.OptParam p | Ast0.UniqueParam p ->
(* put the + code on the thing, not on the opt *)
- r.V0.combiner_parameter p
+ r.VT0.combiner_rec_parameter p
| _ -> do_nothing r k e in
let case_line r k e =
match Ast0.unwrap e with
Ast0.OptCase c ->
(* put the + code on the thing, not on the opt *)
- r.V0.combiner_case_line c
+ r.VT0.combiner_rec_case_line c
| _ -> do_nothing r k e in
let do_top r k (e: Ast0.top_level) = k e in
- V0.combiner bind option_default
+ V0.flat_combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
edots idots pdots sdots ddots cdots
ident expression typeC initialiser param decl statement case_line do_top
match e with
Ast0.DotsExprTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_expression_dots e)
+ (collect_minus_join_points e).VT0.combiner_rec_expression_dots e)
| Ast0.DotsInitTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_initialiser_list e)
+ (collect_minus_join_points e).VT0.combiner_rec_initialiser_list e)
| Ast0.DotsParamTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_parameter_list e)
+ (collect_minus_join_points e).VT0.combiner_rec_parameter_list e)
| Ast0.DotsStmtTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_statement_dots e)
+ (collect_minus_join_points e).VT0.combiner_rec_statement_dots e)
| Ast0.DotsDeclTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_declaration_dots e)
+ (collect_minus_join_points e).VT0.combiner_rec_declaration_dots e)
| Ast0.DotsCaseTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_case_line_dots e)
+ (collect_minus_join_points e).VT0.combiner_rec_case_line_dots e)
| Ast0.IdentTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_ident e)
+ (collect_minus_join_points e).VT0.combiner_rec_ident e)
| Ast0.ExprTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_expression e)
+ (collect_minus_join_points e).VT0.combiner_rec_expression e)
| Ast0.ArgExprTag(e) | Ast0.TestExprTag(e) ->
failwith "not possible - iso only"
| Ast0.TypeCTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_typeC e)
+ (collect_minus_join_points e).VT0.combiner_rec_typeC e)
| Ast0.ParamTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_parameter e)
+ (collect_minus_join_points e).VT0.combiner_rec_parameter e)
| Ast0.InitTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_initialiser e)
+ (collect_minus_join_points e).VT0.combiner_rec_initialiser e)
| Ast0.DeclTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_declaration e)
+ (collect_minus_join_points e).VT0.combiner_rec_declaration e)
| Ast0.StmtTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_statement e)
+ (collect_minus_join_points e).VT0.combiner_rec_statement e)
| Ast0.CaseLineTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_case_line e)
+ (collect_minus_join_points e).VT0.combiner_rec_case_line e)
| Ast0.TopTag(e) ->
(Ast0.get_index e,
- (collect_minus_join_points e).V0.combiner_top_level e)
+ (collect_minus_join_points e).VT0.combiner_rec_top_level e)
| Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
| Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
| Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
let get_info = function
(Favored,info,_) | (Unfavored,info,_) | (Toplevel,info,_)
| (Decl,info,_) -> info in
- let token_start_line x = (get_info x).Ast0.logical_start in
- let token_end_line x = (get_info x).Ast0.logical_end in
- let token_real_start_line x = (get_info x).Ast0.line_start in
- let token_real_end_line x = (get_info x).Ast0.line_end in
+ let token_start_line x = (get_info x).Ast0.pos_info.Ast0.logical_start in
+ let token_end_line x = (get_info x).Ast0.pos_info.Ast0.logical_end in
+ let token_real_start_line x = (get_info x).Ast0.pos_info.Ast0.line_start in
+ let token_real_end_line x = (get_info x).Ast0.pos_info.Ast0.line_end in
List.iter
(function
(index,((_::_) as l1)) ->
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))
l
let process_minus minus =
+ Hashtbl.clear root_token_table;
create_root_token_table minus;
List.concat
(List.map
let bind x y = x @ y in
let option_default = [] in
- let mcode fn (term,_,info,mcodekind,_) =
- match mcodekind with Ast0.PLUS -> [(info,fn term)] | _ -> [] in
+ let extract_strings info =
+ let adjust_info =
+ {info with Ast0.strings_before = []; Ast0.strings_after = []} in
+ let extract = function
+ [] -> []
+ | strings_before ->
+ let (_,first) = List.hd strings_before in
+ let (_,last) = List.hd (List.rev strings_before) in
+ let new_pos_info =
+ {Ast0.line_start = first.Ast0.line_start;
+ Ast0.line_end = last.Ast0.line_start;
+ Ast0.logical_start = first.Ast0.logical_start;
+ Ast0.logical_end = last.Ast0.logical_start;
+ Ast0.column = first.Ast0.column;
+ 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.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,_,_) =
+ match mcodekind with
+ 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
+ let info (i,_) = let (bef,aft) = extract_strings i in bef@aft in
+
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 *)
+ (* case for things with bef aft *)
let stmt r k e =
match Ast0.unwrap e with
- Ast0.Exp(exp) -> r.V0.combiner_expression exp
- | Ast0.TopExp(exp) -> r.V0.combiner_expression exp
- | Ast0.Ty(ty) -> r.V0.combiner_typeC ty
- | Ast0.TopInit(init) -> r.V0.combiner_initialiser init
- | Ast0.Decl(_,decl) -> r.V0.combiner_declaration decl
+ Ast0.Exp(exp) -> r.VT0.combiner_rec_expression exp
+ | Ast0.TopExp(exp) -> r.VT0.combiner_rec_expression exp
+ | Ast0.Ty(ty) -> r.VT0.combiner_rec_typeC ty
+ | Ast0.TopInit(init) -> r.VT0.combiner_rec_initialiser init
+ | Ast0.Decl(bef,decl) ->
+ (info bef) @ (do_nothing mk_statement r k e)
+ | Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) ->
+ (info bef) @ (do_nothing mk_statement r k e)
+ | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) ->
+ (do_nothing mk_statement r k e) @ (info aft)
+ | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) ->
+ (do_nothing mk_statement r k e) @ (info aft)
+ | Ast0.While(whl,lp,exp,rp,body,aft) ->
+ (do_nothing mk_statement r k e) @ (info aft)
+ | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,aft) ->
+ (do_nothing mk_statement r k e) @ (info aft)
+ | Ast0.Iterator(nm,lp,args,rp,body,aft) ->
+ (do_nothing mk_statement r k e) @ (info aft)
| _ -> do_nothing mk_statement r k e in
(* statementTag is preferred, because it indicates that one statement is
let stmt_dots r k e =
match Ast0.unwrap e with
Ast0.DOTS([s]) | Ast0.CIRCLES([s]) | Ast0.STARS([s]) ->
- r.V0.combiner_statement s
+ r.VT0.combiner_rec_statement s
| _ -> do_nothing mk_stmtdots r k e in
let toplevel r k e =
match Ast0.unwrap e with
- Ast0.DECL(s) -> r.V0.combiner_statement s
- | Ast0.CODE(sdots) -> r.V0.combiner_statement_dots sdots
+ Ast0.DECL(s) -> r.VT0.combiner_rec_statement s
+ | Ast0.CODE(sdots) -> r.VT0.combiner_rec_statement_dots sdots
| _ -> do_nothing mk_code r k e in
let initdots r k e = k e in
- V0.combiner bind option_default
+ V0.flat_combiner bind option_default
(imcode mk_meta) (imcode mk_token) (mcode mk_constant) (mcode mk_assignOp)
(mcode mk_fixOp)
(mcode mk_unaryOp) (mcode mk_binaryOp) (mcode mk_const_vol)
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
Ast0.DotsExprTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_expression_dots e)
+ (collect_plus_nodes e).VT0.combiner_rec_expression_dots e)
| Ast0.DotsInitTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_initialiser_list e)
+ (collect_plus_nodes e).VT0.combiner_rec_initialiser_list e)
| Ast0.DotsParamTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_parameter_list e)
+ (collect_plus_nodes e).VT0.combiner_rec_parameter_list e)
| Ast0.DotsStmtTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_statement_dots e)
+ (collect_plus_nodes e).VT0.combiner_rec_statement_dots e)
| Ast0.DotsDeclTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_declaration_dots e)
+ (collect_plus_nodes e).VT0.combiner_rec_declaration_dots e)
| Ast0.DotsCaseTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_case_line_dots e)
+ (collect_plus_nodes e).VT0.combiner_rec_case_line_dots e)
| Ast0.IdentTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_ident e)
+ (collect_plus_nodes e).VT0.combiner_rec_ident e)
| Ast0.ExprTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_expression e)
+ (collect_plus_nodes e).VT0.combiner_rec_expression e)
| Ast0.ArgExprTag(_) | Ast0.TestExprTag(_) ->
failwith "not possible - iso only"
| Ast0.TypeCTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_typeC e)
+ (collect_plus_nodes e).VT0.combiner_rec_typeC e)
| Ast0.InitTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_initialiser e)
+ (collect_plus_nodes e).VT0.combiner_rec_initialiser e)
| Ast0.ParamTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_parameter e)
+ (collect_plus_nodes e).VT0.combiner_rec_parameter e)
| Ast0.DeclTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_declaration e)
+ (collect_plus_nodes e).VT0.combiner_rec_declaration e)
| Ast0.StmtTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_statement e)
+ (collect_plus_nodes e).VT0.combiner_rec_statement e)
| Ast0.CaseLineTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_case_line e)
+ (collect_plus_nodes e).VT0.combiner_rec_case_line e)
| Ast0.TopTag(e) ->
(Ast0.get_index e,
- (collect_plus_nodes e).V0.combiner_top_level e)
+ (collect_plus_nodes e).VT0.combiner_rec_top_level e)
| Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
| Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
| Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
Outer list: For any pair of successive elements, n and n+1, the ending
line of n is more than one less than the starting line of n+1. *)
-let logstart info = info.Ast0.logical_start
-let logend info = info.Ast0.logical_end
+let logstart info = info.Ast0.pos_info.Ast0.logical_start
+let logend info = info.Ast0.pos_info.Ast0.logical_end
let redo info start finish =
- {{info with Ast0.logical_start = start} with Ast0.logical_end = finish}
+ let new_pos_info =
+ {info.Ast0.pos_info with
+ Ast0.logical_start = start;
+ Ast0.logical_end = finish} in
+ {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 ->
(* end of first argument < start/end of second argument *)
let less_than_start info1 info2 =
- info1.Ast0.logical_end < info2.Ast0.logical_start
+ info1.Ast0.pos_info.Ast0.logical_end < info2.Ast0.pos_info.Ast0.logical_start
let less_than_end info1 info2 =
- info1.Ast0.logical_end < info2.Ast0.logical_end
+ info1.Ast0.pos_info.Ast0.logical_end < info2.Ast0.pos_info.Ast0.logical_end
let greater_than_end info1 info2 =
- info1.Ast0.logical_start > info2.Ast0.logical_end
+ info1.Ast0.pos_info.Ast0.logical_start > info2.Ast0.pos_info.Ast0.logical_end
let good_start info = info.Ast0.attachable_start
let good_end info = info.Ast0.attachable_end
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
| Ast.StatementTag _
| Ast.Rule_elemTag _
| Ast.StmtDotsTag _
- | Ast.Code _ -> true
+ | Ast.Code _
+ | Ast.Pragma _ -> true
(* the following should definitely be false *)
| Ast.FullTypeTag _ | Ast.BaseTypeTag _ | Ast.StructUnionTag _
| Ast.SignTag _
let insert thing thinginfo into intoinfo =
let get_last l = let l = List.rev l in (List.rev(List.tl l),List.hd l) in
let get_first l = (List.hd l,List.tl l) in
- let thing_start = thinginfo.Ast0.logical_start in
- let thing_end = thinginfo.Ast0.logical_end in
- let thing_offset = thinginfo.Ast0.offset in
+ let thing_start = thinginfo.Ast0.pos_info.Ast0.logical_start in
+ let thing_end = thinginfo.Ast0.pos_info.Ast0.logical_end in
+ let thing_offset = thinginfo.Ast0.pos_info.Ast0.offset in
let into_start = intoinfo.Ast0.tline_start in
let into_end = intoinfo.Ast0.tline_end in
let into_left_offset = intoinfo.Ast0.left_offset in
let init thing info =
(thing,
- {Ast0.tline_start = info.Ast0.logical_start;
- Ast0.tline_end = info.Ast0.logical_end;
- Ast0.left_offset = info.Ast0.offset;
- Ast0.right_offset = info.Ast0.offset})
+ {Ast0.tline_start = info.Ast0.pos_info.Ast0.logical_start;
+ Ast0.tline_end = info.Ast0.pos_info.Ast0.logical_end;
+ 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 =
List.iter (function x -> attachafter x m) ps
let split_at_end info ps =
- let split_point = info.Ast0.logical_end in
+ let split_point = info.Ast0.pos_info.Ast0.logical_end in
List.partition
- (function (info,_) -> info.Ast0.logical_end < split_point)
+ (function (info,_,_) -> info.Ast0.pos_info.Ast0.logical_end < split_point)
ps
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.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
then before_m2 x2 rest all
else
failwith
- (pr "%d: no available token to attach to" infop.Ast0.line_start)
+ (pr "%d: no available token to attach to"
+ infop.Ast0.pos_info.Ast0.line_start)
else after_m2 x2 rest all
else
begin
Printf.printf "between: p start %d p end %d m1 start %d m1 end %d m2 start %d m2 end %d\n"
- infop.Ast0.line_start infop.Ast0.line_end
- infom1.Ast0.line_start infom1.Ast0.line_end
- infom2.Ast0.line_start infom2.Ast0.line_end;
+ infop.Ast0.pos_info.Ast0.line_start
+ infop.Ast0.pos_info.Ast0.line_end
+ infom1.Ast0.pos_info.Ast0.line_start
+ infom1.Ast0.pos_info.Ast0.line_end
+ infom2.Ast0.pos_info.Ast0.line_start
+ infom2.Ast0.pos_info.Ast0.line_end;
Pretty_print_cocci.print_anything "" pcode;
failwith
"The semantic patch is structured in a way that may give bad results with isomorphisms. Please try to rewrite it by moving + code out from -/context terms."
| _ -> 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)
else
failwith
- (pr "%d: no available token to attach to" infop.Ast0.line_start)
+ (pr "%d: no available token to attach to"
+ infop.Ast0.pos_info.Ast0.line_start)
| (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
failwith
- (pr "%d: no available token to attach to" infop.Ast0.line_start)
+ (pr "%d: no available token to attach to"
+ infop.Ast0.pos_info.Ast0.line_start)
| (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
(function (_,info,_) ->
Printf.printf "start %d end %d real_start %d real_end %d\n"
- info.Ast0.logical_start info.Ast0.logical_end
- info.Ast0.line_start info.Ast0.line_end)
+ info.Ast0.pos_info.Ast0.logical_start
+ info.Ast0.pos_info.Ast0.logical_end
+ info.Ast0.pos_info.Ast0.line_start
+ info.Ast0.pos_info.Ast0.line_end)
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.logical_start info.Ast0.logical_end
- info.Ast0.line_end info.Ast0.line_end;
+ info.Ast0.pos_info.Ast0.logical_start
+ info.Ast0.pos_info.Ast0.logical_end
+ info.Ast0.pos_info.Ast0.line_end
+ info.Ast0.pos_info.Ast0.line_end;
Pretty_print_cocci.print_anything "" p;
Format.print_newline())
p;
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
+
+ let info (_,mc) =
match mc with
Ast0.CONTEXT(mc) -> let (ba,_,_) = !mc in [ba]
| _ -> [] in
[]
| _ -> let _ = k e in [] in
+ (* a case for everything with bef or aft *)
+ let stmt r k e =
+ match Ast0.unwrap e with
+ Ast0.Decl(bef,decl) ->
+ (info bef) @ (donothing r k e)
+ | Ast0.FunDecl(bef,fi,name,lp,params,rp,lbrace,body,rbrace) ->
+ (info bef) @ (donothing r k e)
+ | Ast0.IfThen(iff,lp,exp,rp,branch1,aft) ->
+ (donothing r k e) @ (info aft)
+ | Ast0.IfThenElse(iff,lp,exp,rp,branch1,els,branch2,aft) ->
+ (donothing r k e) @ (info aft)
+ | Ast0.While(whl,lp,exp,rp,body,aft) ->
+ (donothing r k e) @ (info aft)
+ | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,aft) ->
+ (donothing r k e) @ (info aft)
+ | Ast0.Iterator(nm,lp,args,rp,body,aft) ->
+ (donothing r k e) @ (info aft)
+ | _ -> donothing r k e in
+
let res =
- V0.combiner bind option_default
+ V0.flat_combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
donothing donothing donothing donothing donothing donothing donothing
donothing
- donothing donothing donothing donothing donothing donothing donothing in
- res.V0.combiner_top_level
+ donothing donothing donothing donothing stmt donothing donothing in
+ res.VT0.combiner_rec_top_level
(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)