(*
-* 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.
+ *)
(* Detects subtrees that are all minus/plus and nodes that are "binding
module Ast = Ast_cocci
module Ast0 = Ast0_cocci
module V0 = Visitor_ast0
+module VT0 = Visitor_ast0_types
module U = Unparse_ast0
(* --------------------------------------------------------------------- *)
| Ast0.CaseLineTag(d) -> Ast0.set_mcodekind d mcodekind
| Ast0.TopTag(d) -> Ast0.set_mcodekind d mcodekind
| Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
+ | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
+ | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
| Ast0.MetaPosTag(p) -> failwith "metapostag only within iso phase"
let set_index x index =
| Ast0.CaseLineTag(d) -> Ast0.set_index d index
| Ast0.TopTag(d) -> Ast0.set_index d index
| Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
+ | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
+ | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
| Ast0.MetaPosTag(p) -> failwith "metapostag only within iso phase"
let get_index = function
| Ast0.CaseLineTag(d) -> Index.case_line d
| Ast0.TopTag(d) -> Index.top_level d
| Ast0.IsoWhenTag(_) -> failwith "only within iso phase"
+ | Ast0.IsoWhenTTag(_) -> failwith "only within iso phase"
+ | Ast0.IsoWhenFTag(_) -> failwith "only within iso phase"
| Ast0.MetaPosTag(p) -> failwith "metapostag only within iso phase"
(* --------------------------------------------------------------------- *)
let bind x y = () in
let option_default = () in
let donothing r k e = k e in
- let mcode (_,_,info,mcodekind,_) =
+ let mcode (_,_,info,mcodekind,_,_) =
match mcodekind with
- Ast0.PLUS -> insert info.Ast0.line_start
+ Ast0.PLUS _ -> insert info.Ast0.pos_info.Ast0.line_start
| _ -> () in
let fn =
- 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
- fn.V0.combiner_top_level top
+ fn.VT0.combiner_rec_top_level top
(* --------------------------------------------------------------------- *)
-type kind = Neutral | AllMarked | NotAllMarked (* marked means + or - *)
+type kind =
+ Neutral | AllMarked of Ast.count | NotAllMarked (* marked means + or - *)
(* --------------------------------------------------------------------- *)
(* The first part analyzes each of the minus tree and the plus tree
let kind2c = function
Neutral -> "neutral"
- | AllMarked -> "allmarked"
+ | AllMarked _ -> "allmarked"
| NotAllMarked -> "notallmarked"
let node2c = function
let bind c1 c2 =
let lub = function
(k1,k2) when k1 = k2 -> k1
- | (Neutral,AllMarked) -> AllMarked
- | (AllMarked,Neutral) -> AllMarked
+ | (Neutral,AllMarked c) -> AllMarked c
+ | (AllMarked c,Neutral) -> AllMarked c
| _ -> NotAllMarked in
match (c1,c2) with
(* token/token *)
let option_default = (*Bind(Neutral,[],[],[],[],[])*)
Recursor(Neutral,[],[],[])
-let mcode (_,_,info,mcodekind,pos) =
- let offset = info.Ast0.offset in
+let mcode (_,_,info,mcodekind,pos,_) =
+ let offset = info.Ast0.pos_info.Ast0.offset in
match mcodekind with
- Ast0.MINUS(_) -> Token(AllMarked,offset,mcodekind,[])
- | Ast0.PLUS -> Token(AllMarked,offset,mcodekind,[])
+ Ast0.MINUS(_) -> Token(AllMarked Ast.ONE,offset,mcodekind,[])
+ | Ast0.PLUS c -> Token(AllMarked c,offset,mcodekind,[])
| Ast0.CONTEXT(_) -> Token(NotAllMarked,offset,mcodekind,[offset])
| _ -> failwith "not possible"
-let neutral_mcode (_,_,info,mcodekind,pos) =
- let offset = info.Ast0.offset in
+let neutral_mcode (_,_,info,mcodekind,pos,_) =
+ let offset = info.Ast0.pos_info.Ast0.offset in
match mcodekind with
Ast0.MINUS(_) -> Token(Neutral,offset,mcodekind,[])
- | Ast0.PLUS -> Token(Neutral,offset,mcodekind,[])
+ | Ast0.PLUS _ -> Token(Neutral,offset,mcodekind,[])
| Ast0.CONTEXT(_) -> Token(Neutral,offset,mcodekind,[offset])
| _ -> failwith "not possible"
+(* neutral for context; used for mcode in bef aft nodes that don't represent
+anything if they don't contain some information *)
+let nc_mcode (_,_,info,mcodekind,pos,_) =
+ (* distinguish from the offset of some real token *)
+ let offset = (-1) * info.Ast0.pos_info.Ast0.offset in
+ match mcodekind with
+ Ast0.MINUS(_) -> Token(AllMarked Ast.ONE,offset,mcodekind,[])
+ | Ast0.PLUS c -> Token(AllMarked c,offset,mcodekind,[])
+ | Ast0.CONTEXT(_) ->
+ (* Unlike the other mcode cases, we drop the offset from the context
+ offsets. This is because we don't know whether the term this is
+ associated with is - or context. In any case, the context offsets are
+ used for identification, and this invisible node should not be needed
+ for this purpose. *)
+ Token(Neutral,offset,mcodekind,[])
+ | _ -> failwith "not possible"
+
let is_context = function Ast0.CONTEXT(_) -> true | _ -> false
let union_all l = List.fold_left Common.union_set [] l
intermingled with plus code. it is used in disj_cases *)
let classify is_minus all_marked table code =
let mkres builder k il tl bil btl l e =
- (if k = AllMarked
- then Ast0.set_mcodekind e (all_marked()) (* definitive *)
- else
+ (match k with
+ AllMarked count ->
+ Ast0.set_mcodekind e (all_marked count) (* definitive *)
+ | _ ->
let check_index il tl =
if List.for_all is_context tl
then
try
let _ = Hashtbl.find table index in
failwith
- (Printf.sprintf "%d: index %s already used\n"
- (Ast0.get_info e).Ast0.line_start
+ (Printf.sprintf "line %d: index %s already used\n"
+ (Ast0.get_info e).Ast0.pos_info.Ast0.line_start
(String.concat " " (List.map string_of_int index)))
with Not_found -> Hashtbl.add table index (e1,l)) in
if il = [] then check_index bil btl else check_index il tl);
(* no whencode in plus tree so have to drop it *)
(* need special cases for dots, nests, and disjs *)
+ let ident r k e =
+ compute_result Ast0.ident e
+ (match Ast0.unwrap e with
+ Ast0.DisjId(starter,id_list,_,ender) ->
+ disj_cases e starter id_list r.VT0.combiner_rec_ident ender
+ | _ -> k e) in
+
let expression r k e =
compute_result Ast0.expr e
(match Ast0.unwrap e with
k (Ast0.rewrap e (Ast0.Ecircles(dots,None)))
| Ast0.Estars(dots,whencode) ->
k (Ast0.rewrap e (Ast0.Estars(dots,None)))
- | Ast0.DisjExpr(starter,expr_list,_,ender) ->
- disj_cases e starter expr_list r.V0.combiner_expression ender
+ | Ast0.DisjExpr(starter,expr_list,_,ender) ->
+ disj_cases e starter expr_list r.VT0.combiner_rec_expression ender
| _ -> k e) in
(* not clear why we have the next two cases, since DisjDecl and
compute_result Ast0.decl e
(match Ast0.unwrap e with
Ast0.DisjDecl(starter,decls,_,ender) ->
- disj_cases e starter decls r.V0.combiner_declaration ender
+ disj_cases e starter decls r.VT0.combiner_rec_declaration ender
| Ast0.Ddots(dots,whencode) ->
k (Ast0.rewrap e (Ast0.Ddots(dots,None)))
(* Need special cases for the following so that the type will be
reordering their components. *)
| Ast0.Init(stg,ty,id,eq,ini,sem) ->
bind (match stg with Some stg -> mcode stg | _ -> option_default)
- (bind (r.V0.combiner_typeC ty)
- (bind (r.V0.combiner_ident id)
+ (bind (r.VT0.combiner_rec_typeC ty)
+ (bind (r.VT0.combiner_rec_ident id)
(bind (mcode eq)
- (bind (r.V0.combiner_initialiser ini) (mcode sem)))))
+ (bind (r.VT0.combiner_rec_initialiser ini) (mcode sem)))))
| Ast0.UnInit(stg,ty,id,sem) ->
bind (match stg with Some stg -> mcode stg | _ -> option_default)
- (bind (r.V0.combiner_typeC ty)
- (bind (r.V0.combiner_ident id) (mcode sem)))
+ (bind (r.VT0.combiner_rec_typeC ty)
+ (bind (r.VT0.combiner_rec_ident id) (mcode sem)))
| _ -> k e) in
let param r k e =
(match Ast0.unwrap e with
Ast0.Param(ty,Some id) ->
(* needed for the same reason as in the Init and UnInit cases *)
- bind (r.V0.combiner_typeC ty) (r.V0.combiner_ident id)
+ bind (r.VT0.combiner_rec_typeC ty) (r.VT0.combiner_rec_ident id)
| _ -> k e) in
let typeC r k e =
compute_result Ast0.typeC e
(match Ast0.unwrap e with
Ast0.DisjType(starter,types,_,ender) ->
- disj_cases e starter types r.V0.combiner_typeC ender
+ disj_cases e starter types r.VT0.combiner_rec_typeC ender
| _ -> k e) in
let initialiser r k i =
k (Ast0.rewrap i (Ast0.Idots(dots,None)))
| _ -> k i) in
+ let case_line r k e =
+ compute_result Ast0.case_line e
+ (match Ast0.unwrap e with
+ Ast0.DisjCase(starter,case_list,_,ender) ->
+ disj_cases e starter case_list r.VT0.combiner_rec_case_line ender
+ | _ -> k e) in
+
let statement r k s =
compute_result Ast0.stmt s
(match Ast0.unwrap s with
| Ast0.Stars(dots,whencode) ->
k (Ast0.rewrap s (Ast0.Stars(dots,[])))
| Ast0.Disj(starter,statement_dots_list,_,ender) ->
- disj_cases s starter statement_dots_list r.V0.combiner_statement_dots
+ disj_cases s starter statement_dots_list r.VT0.combiner_rec_statement_dots
ender
-(* Why? There is nothing there
(* cases for everything with extra mcode *)
| Ast0.FunDecl((info,bef),_,_,_,_,_,_,_,_)
| Ast0.Decl((info,bef),_) ->
- bind (mcode ((),(),info,bef)) (k s)
+ bind (nc_mcode ((),(),info,bef,(),-1)) (k s)
| Ast0.IfThen(_,_,_,_,_,(info,aft))
| Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft))
- | Ast0.While(_,_,_,_,_,(info,aft)) ->
- | Ast0.For(_,_,_,_,_,_,_,_,_,(info,aft)) ->
- bind (k s) (mcode ((),(),info,aft))
| Ast0.Iterator(_,_,_,_,_,(info,aft))
-*)
+ | Ast0.While(_,_,_,_,_,(info,aft))
+ | Ast0.For(_,_,_,_,_,_,_,_,_,(info,aft)) ->
+ bind (k s) (nc_mcode ((),(),info,aft,(),-1))
| _ -> k s
) in
let do_top builder r k e = compute_result builder e (k e) in
- let combiner =
- V0.combiner bind option_default
+ let combiner =
+ V0.flat_combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- mcode
(do_nothing Ast0.dotsExpr) (do_nothing Ast0.dotsInit)
(do_nothing Ast0.dotsParam) (do_nothing Ast0.dotsStmt)
(do_nothing Ast0.dotsDecl) (do_nothing Ast0.dotsCase)
- (do_nothing Ast0.ident) expression typeC initialiser param declaration
- statement (do_nothing Ast0.case_line) (do_top Ast0.top) in
- combiner.V0.combiner_top_level code
+ ident expression typeC initialiser param declaration
+ statement case_line (do_top Ast0.top) in
+ combiner.VT0.combiner_rec_top_level code
(* --------------------------------------------------------------------- *)
(* Traverse the hash tables and find corresponding context nodes that have
(* this is just a sanity check - really only need to look at the top-level
structure *)
-let equal_mcode (_,_,info1,_,_) (_,_,info2,_,_) =
- info1.Ast0.offset = info2.Ast0.offset
+let equal_mcode (_,_,info1,_,_,_) (_,_,info2,_,_,_) =
+ info1.Ast0.pos_info.Ast0.offset = info2.Ast0.pos_info.Ast0.offset
let equal_option e1 e2 =
match (e1,e2) with
equal_mcode name1 name2
| (Ast0.MetaLocalFunc(name1,_,_),Ast0.MetaLocalFunc(name2,_,_)) ->
equal_mcode name1 name2
+ | (Ast0.DisjId(starter1,_,mids1,ender1),
+ Ast0.DisjId(starter2,_,mids2,ender2)) ->
+ equal_mcode starter1 starter2 &&
+ List.for_all2 equal_mcode mids1 mids2 &&
+ equal_mcode ender1 ender2
| (Ast0.OptIdent(_),Ast0.OptIdent(_)) -> true
| (Ast0.UniqueIdent(_),Ast0.UniqueIdent(_)) -> true
| _ -> false
| (Ast0.EComma(cm1),Ast0.EComma(cm2)) -> equal_mcode cm1 cm2
| (Ast0.DisjExpr(starter1,_,mids1,ender1),
Ast0.DisjExpr(starter2,_,mids2,ender2)) ->
- equal_mcode starter1 starter2 &&
+ equal_mcode starter1 starter2 &&
List.for_all2 equal_mcode mids1 mids2 &&
equal_mcode ender1 ender2
| (Ast0.NestExpr(starter1,_,ender1,_,m1),
let rec equal_typeC t1 t2 =
match (Ast0.unwrap t1,Ast0.unwrap t2) with
(Ast0.ConstVol(cv1,_),Ast0.ConstVol(cv2,_)) -> equal_mcode cv1 cv2
- | (Ast0.BaseType(ty1,sign1),Ast0.BaseType(ty2,sign2)) ->
- equal_mcode ty1 ty2 && equal_option sign1 sign2
- | (Ast0.ImplicitInt(sign1),Ast0.ImplicitInt(sign2)) ->
+ | (Ast0.BaseType(ty1,stringsa),Ast0.BaseType(ty2,stringsb)) ->
+ List.for_all2 equal_mcode stringsa stringsb
+ | (Ast0.Signed(sign1,_),Ast0.Signed(sign2,_)) ->
equal_mcode sign1 sign2
| (Ast0.Pointer(_,star1),Ast0.Pointer(_,star2)) ->
equal_mcode star1 star2
| (Ast0.Array(_,lb1,_,rb1),Ast0.Array(_,lb2,_,rb2)) ->
equal_mcode lb1 lb2 && equal_mcode rb1 rb2
+ | (Ast0.EnumName(kind1,_),Ast0.EnumName(kind2,_)) ->
+ equal_mcode kind1 kind2
+ | (Ast0.EnumDef(_,lb1,_,rb1),Ast0.EnumDef(_,lb2,_,rb2)) ->
+ equal_mcode lb1 lb2 && equal_mcode rb1 rb2
| (Ast0.StructUnionName(kind1,_),Ast0.StructUnionName(kind2,_)) ->
equal_mcode kind1 kind2
| (Ast0.FunctionType(ty1,lp1,p1,rp1),Ast0.FunctionType(ty2,lp2,p2,rp2)) ->
equal_mcode name1 name2
| (Ast0.DisjType(starter1,_,mids1,ender1),
Ast0.DisjType(starter2,_,mids2,ender2)) ->
- equal_mcode starter1 starter2 &&
+ equal_mcode starter1 starter2 &&
List.for_all2 equal_mcode mids1 mids2 &&
equal_mcode ender1 ender2
| (Ast0.OptType(_),Ast0.OptType(_)) -> true
let equal_declaration d1 d2 =
match (Ast0.unwrap d1,Ast0.unwrap d2) with
- (Ast0.Init(stg1,_,_,eq1,_,sem1),Ast0.Init(stg2,_,_,eq2,_,sem2)) ->
+ (Ast0.MetaDecl(name1,_),Ast0.MetaDecl(name2,_))
+ | (Ast0.MetaField(name1,_),Ast0.MetaField(name2,_))
+ | (Ast0.MetaFieldList(name1,_,_),Ast0.MetaFieldList(name2,_,_)) ->
+ equal_mcode name1 name2
+ | (Ast0.Init(stg1,_,_,eq1,_,sem1),Ast0.Init(stg2,_,_,eq2,_,sem2)) ->
equal_option stg1 stg2 && equal_mcode eq1 eq2 && equal_mcode sem1 sem2
| (Ast0.UnInit(stg1,_,_,sem1),Ast0.UnInit(stg2,_,_,sem2)) ->
equal_option stg1 stg2 && equal_mcode sem1 sem2
failwith "DisjDecl not expected here"
| _ -> false
+let equal_designator d1 d2 =
+ match (d1,d2) with
+ (Ast0.DesignatorField(dot1,_),Ast0.DesignatorField(dot2,_)) ->
+ equal_mcode dot1 dot2
+ | (Ast0.DesignatorIndex(lb1,_,rb1),Ast0.DesignatorIndex(lb2,_,rb2)) ->
+ (equal_mcode lb1 lb2) && (equal_mcode rb1 rb2)
+ | (Ast0.DesignatorRange(lb1,_,dots1,_,rb1),
+ Ast0.DesignatorRange(lb2,_,dots2,_,rb2)) ->
+ (equal_mcode lb1 lb2) && (equal_mcode dots1 dots2) &&
+ (equal_mcode rb1 rb2)
+ | _ -> false
+
let equal_initialiser i1 i2 =
match (Ast0.unwrap i1,Ast0.unwrap i2) with
- (Ast0.InitExpr(_),Ast0.InitExpr(_)) -> true
- | (Ast0.InitList(lb1,_,rb1),Ast0.InitList(lb2,_,rb2)) ->
+ (Ast0.MetaInit(name1,_),Ast0.MetaInit(name2,_)) ->
+ equal_mcode name1 name2
+ | (Ast0.MetaInitList(name1,_,_),Ast0.MetaInitList(name2,_,_)) ->
+ equal_mcode name1 name2
+ | (Ast0.InitExpr(_),Ast0.InitExpr(_)) -> true
+ | (Ast0.InitList(lb1,_,rb1,o1),Ast0.InitList(lb2,_,rb2,o2)) ->
+ (* can't compare orderedness, because this can differ between -
+ and + code *)
(equal_mcode lb1 lb2) && (equal_mcode rb1 rb2)
- | (Ast0.InitGccDotName(dot1,_,eq1,_),Ast0.InitGccDotName(dot2,_,eq2,_)) ->
- (equal_mcode dot1 dot2) && (equal_mcode eq1 eq2)
+ | (Ast0.InitGccExt(designators1,eq1,_),
+ Ast0.InitGccExt(designators2,eq2,_)) ->
+ (List.for_all2 equal_designator designators1 designators2) &&
+ (equal_mcode eq1 eq2)
| (Ast0.InitGccName(_,eq1,_),Ast0.InitGccName(_,eq2,_)) ->
equal_mcode eq1 eq2
- | (Ast0.InitGccIndex(lb1,_,rb1,eq1,_),Ast0.InitGccIndex(lb2,_,rb2,eq2,_)) ->
- (equal_mcode lb1 lb2) && (equal_mcode rb1 rb2) && (equal_mcode eq1 eq2)
- | (Ast0.InitGccRange(lb1,_,dots1,_,rb1,eq1,_),
- Ast0.InitGccRange(lb2,_,dots2,_,rb2,eq2,_)) ->
- (equal_mcode lb1 lb2) && (equal_mcode dots1 dots2) &&
- (equal_mcode rb1 rb2) && (equal_mcode eq1 eq2)
- | (Ast0.IComma(cm1),Ast0.IComma(cm2)) -> equal_mcode cm1 cm2
+ | (Ast0.IComma(cm1),Ast0.IComma(cm2)) -> equal_mcode cm1 cm2
| (Ast0.Idots(d1,_),Ast0.Idots(d2,_)) -> equal_mcode d1 d2
| (Ast0.OptIni(_),Ast0.OptIni(_)) -> true
| (Ast0.UniqueIni(_),Ast0.UniqueIni(_)) -> true
| _ -> false
-
+
let equal_parameterTypeDef p1 p2 =
match (Ast0.unwrap p1,Ast0.unwrap p2) with
(Ast0.VoidParam(_),Ast0.VoidParam(_)) -> true
equal_mcode rp1 rp2
| (Ast0.Iterator(nm1,lp1,_,rp1,_,_),Ast0.Iterator(nm2,lp2,_,rp2,_,_)) ->
equal_mcode lp1 lp2 && equal_mcode rp1 rp2
- | (Ast0.Switch(switch1,lp1,_,rp1,lb1,case1,rb1),
- Ast0.Switch(switch2,lp2,_,rp2,lb2,case2,rb2)) ->
+ | (Ast0.Switch(switch1,lp1,_,rp1,lb1,_,_,rb1),
+ Ast0.Switch(switch2,lp2,_,rp2,lb2,_,_,rb2)) ->
equal_mcode switch1 switch2 && equal_mcode lp1 lp2 &&
equal_mcode rp1 rp2 && equal_mcode lb1 lb2 &&
equal_mcode rb1 rb2
| (Ast0.MetaStmtList(name1,_),Ast0.MetaStmtList(name2,_)) ->
equal_mcode name1 name2
| (Ast0.Disj(starter1,_,mids1,ender1),Ast0.Disj(starter2,_,mids2,ender2)) ->
- equal_mcode starter1 starter2 &&
+ equal_mcode starter1 starter2 &&
List.for_all2 equal_mcode mids1 mids2 &&
equal_mcode ender1 ender2
| (Ast0.Nest(starter1,_,ender1,_,m1),Ast0.Nest(starter2,_,ender2,_,m2)) ->
| (Ast0.Exp(_),Ast0.Exp(_)) -> true
| (Ast0.TopExp(_),Ast0.TopExp(_)) -> true
| (Ast0.Ty(_),Ast0.Ty(_)) -> true
+ | (Ast0.TopInit(_),Ast0.TopInit(_)) -> true
| (Ast0.Dots(d1,_),Ast0.Dots(d2,_))
| (Ast0.Circles(d1,_),Ast0.Circles(d2,_))
| (Ast0.Stars(d1,_),Ast0.Stars(d2,_)) -> equal_mcode d1 d2
| (Ast0.Include(inc1,name1),Ast0.Include(inc2,name2)) ->
equal_mcode inc1 inc2 && equal_mcode name1 name2
+ | (Ast0.Undef(def1,_),Ast0.Undef(def2,_)) ->
+ equal_mcode def1 def2
| (Ast0.Define(def1,_,_,_),Ast0.Define(def2,_,_,_)) ->
equal_mcode def1 def2
| (Ast0.OptStm(_),Ast0.OptStm(_)) -> true
equal_mcode def1 def2 && equal_mcode colon1 colon2
| (Ast0.Case(case1,_,colon1,_),Ast0.Case(case2,_,colon2,_)) ->
equal_mcode case1 case2 && equal_mcode colon1 colon2
+ | (Ast0.DisjCase(starter1,_,mids1,ender1),
+ Ast0.DisjCase(starter2,_,mids2,ender2)) ->
+ equal_mcode starter1 starter2 &&
+ List.for_all2 equal_mcode mids1 mids2 &&
+ equal_mcode ender1 ender2
| (Ast0.OptCase(_),Ast0.OptCase(_)) -> true
| _ -> false
| (Ast0.DeclTag(d1),Ast0.DeclTag(d2)) -> equal_declaration d1 d2
| (Ast0.StmtTag(s1),Ast0.StmtTag(s2)) -> equal_statement s1 s2
| (Ast0.TopTag(t1),Ast0.TopTag(t2)) -> equal_top_level t1 t2
- | (Ast0.IsoWhenTag(_),_) | (_,Ast0.IsoWhenTag(_)) ->
+ | (Ast0.IsoWhenTag(_),_) | (_,Ast0.IsoWhenTag(_))
+ | (Ast0.IsoWhenTTag(_),_) | (_,Ast0.IsoWhenTTag(_))
+ | (Ast0.IsoWhenFTag(_),_) | (_,Ast0.IsoWhenFTag(_)) ->
failwith "only within iso phase"
| _ -> false
let mcode x = () in
let do_nothing r k e = Ast0.set_mcodekind e (default_context()); 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
do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
do_nothing do_nothing do_nothing
let contextify_whencode =
let bind x y = () in
let option_default = () in
- let mcode x = () in
- let do_nothing r k e = k e in
let expression r k e =
k e;
| Ast0.Edots(_,Some whencode)
| Ast0.Ecircles(_,Some whencode)
| Ast0.Estars(_,Some whencode) ->
- contextify_all.V0.combiner_expression whencode
+ contextify_all.VT0.combiner_rec_expression whencode
| _ -> () in
let initialiser r k i =
match Ast0.unwrap i with
Ast0.Idots(dots,Some whencode) ->
- contextify_all.V0.combiner_initialiser whencode
+ contextify_all.VT0.combiner_rec_initialiser whencode
| _ -> k i in
let whencode = function
- Ast0.WhenNot sd -> contextify_all.V0.combiner_statement_dots sd
- | Ast0.WhenAlways s -> contextify_all.V0.combiner_statement s
- | Ast0.WhenModifier(_) -> () in
+ Ast0.WhenNot sd -> contextify_all.VT0.combiner_rec_statement_dots sd
+ | Ast0.WhenAlways s -> contextify_all.VT0.combiner_rec_statement s
+ | Ast0.WhenModifier(_) -> ()
+ | Ast0.WhenNotTrue(e) -> contextify_all.VT0.combiner_rec_expression e
+ | Ast0.WhenNotFalse(e) -> contextify_all.VT0.combiner_rec_expression e in
let statement r k (s : Ast0.statement) =
k s;
List.iter whencode whn
| _ -> () in
- let combiner =
+ let combiner =
V0.combiner bind option_default
- mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- mcode
- do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
- do_nothing
- expression
- do_nothing initialiser do_nothing do_nothing statement do_nothing
- do_nothing in
- combiner.V0.combiner_top_level
+ {V0.combiner_functions with
+ VT0.combiner_exprfn = expression;
+ VT0.combiner_initfn = initialiser;
+ VT0.combiner_stmtfn = statement} in
+ combiner.VT0.combiner_rec_top_level
(* --------------------------------------------------------------------- *)
| _ -> failwith "no dots allowed in pure plus code")
| _ -> failwith "plus code is being discarded") in
let res =
- Compute_lines.statement_dots
+ Compute_lines.compute_statement_dots_lines false
(Ast0.rewrap (List.hd l) (Ast0.DOTS (loop l))) in
[Ast0.rewrap res (Ast0.CODE res)]
let collect_up_to m plus =
let minfo = Ast0.get_info m in
- let mend = minfo.Ast0.logical_end in
+ let mend = minfo.Ast0.pos_info.Ast0.logical_end in
let rec loop = function
[] -> ([],[])
- | p::plus ->
+ | p::plus ->
let pinfo = Ast0.get_info p in
- let pstart = pinfo.Ast0.logical_start in
+ let pstart = pinfo.Ast0.pos_info.Ast0.logical_start in
if pstart > mend
then ([],p::plus)
else let (plus,rest) = loop plus in (p::plus,rest) in
| Ast0.Disj(_,stmts,_,_) -> isall is_ty stmts
| _ -> false
+let rec is_init s =
+ match Ast0.unwrap s with
+ Ast0.TopInit(e) -> true
+ | Ast0.Disj(_,stmts,_,_) -> isall is_init stmts
+ | _ -> false
+
let rec is_decl s =
match Ast0.unwrap s with
Ast0.Decl(_,e) -> true
Ast0.FunCall(_,_,_,_) -> true
| _ -> false)
| Ast0.Include(_,_) -> true
+ | Ast0.Undef(_,_) -> true
| Ast0.Define(_,_,_,_) -> true
| _ -> false
let v2 = is_decl decl2 in
if v1 && not v2 then fail()
| (Ast0.CODE(code1),Ast0.CODE(code2)) ->
- let testers = [is_exp;is_ty] in
- List.iter
- (function tester ->
- let v1 = isonly tester code1 in
- let v2 = isonly tester code2 in
- if (v1 && not v2) or (!Flag.make_hrule = None && v2 && not v1)
- then fail())
- testers;
- let v1 = isonly is_fndecl code1 in
- let v2 = List.for_all is_toplevel (Ast0.undots code2) in
- if !Flag.make_hrule = None && v1 && not v2 then fail()
+ let v1 = isonly is_init code1 in
+ let v2a = isonly is_init code2 in
+ let v2b = isonly is_exp code2 in
+ if v1
+ then (if not (v2a || v2b) then fail())
+ else
+ let testers = [is_exp;is_ty] in
+ List.iter
+ (function tester ->
+ let v1 = isonly tester code1 in
+ let v2 = isonly tester code2 in
+ if (v1 && not v2) or (!Flag.make_hrule = None && v2 && not v1)
+ then fail())
+ testers;
+ let v1 = isonly is_fndecl code1 in
+ let v2 = List.for_all is_toplevel (Ast0.undots code2) in
+ if !Flag.make_hrule = None && v1 && not v2 then fail()
| (Ast0.FILEINFO(_,_),Ast0.FILEINFO(_,_)) -> ()
| (Ast0.OTHER(_),Ast0.OTHER(_)) -> ()
| _ -> fail()
| (((m::minus) as mall),((p::plus) as pall)) ->
let minfo = Ast0.get_info m in
let pinfo = Ast0.get_info p in
- let mstart = minfo.Ast0.logical_start in
- let mend = minfo.Ast0.logical_end in
- let pstart = pinfo.Ast0.logical_start in
- let pend = pinfo.Ast0.logical_end in
+ let mstart = minfo.Ast0.pos_info.Ast0.logical_start in
+ let mend = minfo.Ast0.pos_info.Ast0.logical_end in
+ let pstart = pinfo.Ast0.pos_info.Ast0.logical_start in
+ let pend = pinfo.Ast0.pos_info.Ast0.logical_end in
if (iscode m or iscode p) &&
(mend + 1 = pstart or pend + 1 = mstart or (* adjacent *)
(mstart <= pstart && mend >= pstart) or
classify true
(function _ -> Ast0.MINUS(ref([],Ast0.default_token_info)))
minus_table m in
- let _ = classify false (function _ -> Ast0.PLUS) plus_table p in
+ let _ = classify false (function c -> Ast0.PLUS c) plus_table p in
traverse minus_table plus_table;
(m,p)::loop(minus,plus)
end
HCoop / bpt / coccinelle.git / blobdiff