(*
-* Copyright 2005-2008, 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 get_option f = function
None -> []
| Some x -> f x
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
- mcode
(donothing Ast0.dotsExpr) (donothing Ast0.dotsInit)
(donothing Ast0.dotsParam) (donothing Ast0.dotsStmt)
(donothing Ast0.dotsDecl) (donothing Ast0.dotsCase)
(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
- 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
(* --------------------------------------------------------------------- *)
(* collect the plus tokens *)
-let mk_baseType x = Ast.BaseTypeTag x
let mk_structUnion x = Ast.StructUnionTag x
let mk_sign x = Ast.SignTag x
let mk_ident x = Ast.IdentTag (Ast0toast.ident x)
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)
- (mcode mk_baseType) (mcode mk_sign) (mcode mk_structUnion)
+ (mcode mk_sign) (mcode mk_structUnion)
(mcode mk_storage) (mcode mk_inc_file)
(do_nothing mk_exprdots) initdots
(do_nothing mk_paramdots) stmt_dots (do_nothing mk_decldots)
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
what it can infer from something being CONTEXT with no top-level
modifications. for the moment, we thus give an error, asking the
user to rewrite the semantic patch. *)
- if greater_than_end infop infom1
+ if greater_than_end infop infom1 or is_minus m1 or !empty_isos
then
if less_than_start infop infom2
then
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."
end
+(* not sure this is safe. if have iso problems, consider changing this
+to always return false *)
+and is_minus = function
+ Ast0.MINUS _ -> true
+ | _ -> 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
- 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
(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)
-let insert_plus minus plus =
+let insert_plus minus plus ei =
+ empty_isos := ei;
let minus_stream = process_minus minus in
let plus_stream = process_plus plus in
merge minus_stream plus_stream;
HCoop / bpt / coccinelle.git / blobdiff