(*
- * Copyright 2010, INRIA, University of Copenhagen
+ * Copyright 2012, INRIA
+ * Julia Lawall, Gilles Muller
+ * Copyright 2010-2011, INRIA, University of Copenhagen
* Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
*)
+# 0 "./context_neg.ml"
(* Detects subtrees that are all minus/plus and nodes that are "binding
context nodes". The latter is a node whose structure and immediate tokens
are the same in the minus and plus trees, and such that for every child,
| Ast0.DeclTag(d) -> Ast0.set_mcodekind d mcodekind
| Ast0.InitTag(d) -> Ast0.set_mcodekind d mcodekind
| Ast0.StmtTag(d) -> Ast0.set_mcodekind d mcodekind
+ | Ast0.ForInfoTag(d) -> Ast0.set_mcodekind d mcodekind
| 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"
+ | Ast0.MetaPosTag(p) -> failwith "invisible at this stage"
+ | Ast0.HiddenVarTag(p) -> failwith "hiddenvar only within iso phase"
let set_index x index =
match x with
| Ast0.InitTag(d) -> Ast0.set_index d index
| Ast0.DeclTag(d) -> Ast0.set_index d index
| Ast0.StmtTag(d) -> Ast0.set_index d index
+ | Ast0.ForInfoTag(d) -> Ast0.set_index d 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"
+ | Ast0.MetaPosTag(p) -> failwith "invisible at this stage"
+ | Ast0.HiddenVarTag(p) -> failwith "hiddenvar only within iso phase"
let get_index = function
Ast0.DotsExprTag(d) -> Index.expression_dots d
| Ast0.InitTag(d) -> Index.initialiser d
| Ast0.DeclTag(d) -> Index.declaration d
| Ast0.StmtTag(d) -> Index.statement d
+ | Ast0.ForInfoTag(d) -> Index.forinfo d
| 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"
+ | Ast0.MetaPosTag(p) -> failwith "invisible at this stage"
+ | Ast0.HiddenVarTag(p) -> failwith "hiddenvar only within iso phase"
(* --------------------------------------------------------------------- *)
(* Collect the line numbers of the plus code. This is used for disjunctions.
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
+ donothing donothing donothing in
fn.VT0.combiner_rec_top_level top
(* --------------------------------------------------------------------- *)
(* not clear why we have the next two cases, since DisjDecl and
DisjType shouldn't have been constructed yet, as they only come from isos *)
+ (* actually, DisjDecl now allowed in source struct decls *)
let declaration r k e =
compute_result Ast0.decl e
(match Ast0.unwrap e 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.VT0.combiner_rec_statement_dots
+ disj_cases s starter statement_dots_list
+ r.VT0.combiner_rec_statement_dots
ender
(* cases for everything with extra mcode *)
| Ast0.FunDecl((info,bef),_,_,_,_,_,_,_,_)
| Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft))
| Ast0.Iterator(_,_,_,_,_,(info,aft))
| Ast0.While(_,_,_,_,_,(info,aft))
- | Ast0.For(_,_,_,_,_,_,_,_,_,(info,aft)) ->
+ | Ast0.For(_,_,_,_,_,_,_,_,(info,aft)) ->
bind (k s) (nc_mcode ((),(),info,aft,(),-1))
| _ -> k s
(do_nothing Ast0.dotsParam) (do_nothing Ast0.dotsStmt)
(do_nothing Ast0.dotsDecl) (do_nothing Ast0.dotsCase)
ident expression typeC initialiser param declaration
- statement case_line (do_top Ast0.top) in
+ statement (do_nothing Ast0.forinfo) case_line (do_top Ast0.top) in
combiner.VT0.combiner_rec_top_level code
(* --------------------------------------------------------------------- *)
equal_mcode lp1 lp2 && equal_mcode rp1 rp2
| (Ast0.Assignment(_,op1,_,_),Ast0.Assignment(_,op2,_,_)) ->
equal_mcode op1 op2
+ | (Ast0.Sequence(_,op1,_),Ast0.Sequence(_,op2,_)) ->
+ equal_mcode op1 op2
| (Ast0.CondExpr(_,why1,_,colon1,_),Ast0.CondExpr(_,why2,_,colon2,_)) ->
equal_mcode why1 why2 && equal_mcode colon1 colon2
| (Ast0.Postfix(_,op1),Ast0.Postfix(_,op2)) -> equal_mcode op1 op2
| (Ast0.SizeOfType(szf1,lp1,_,rp1),Ast0.SizeOfType(szf2,lp2,_,rp2)) ->
equal_mcode szf1 szf2 && equal_mcode lp1 lp2 && equal_mcode rp1 rp2
| (Ast0.TypeExp(_),Ast0.TypeExp(_)) -> true
+ | (Ast0.Constructor(lp1,_,rp1,_),Ast0.Constructor(lp2,_,rp2,_)) ->
+ equal_mcode lp1 lp2 && equal_mcode rp1 rp2
| (Ast0.MetaErr(name1,_,_),Ast0.MetaErr(name2,_,_))
| (Ast0.MetaExpr(name1,_,_,_,_),Ast0.MetaExpr(name2,_,_,_,_))
| (Ast0.MetaExprList(name1,_,_),Ast0.MetaExprList(name2,_,_)) ->
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
- | (Ast0.MacroDecl(nm1,lp1,_,rp1,sem1),Ast0.MacroDecl(nm2,lp2,_,rp2,sem2)) ->
+ | (Ast0.MacroDecl(nm1,lp1,_,rp1,sem1),Ast0.MacroDecl(nm2,lp2,_,rp2,sem2))->
equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode sem1 sem2
+ | (Ast0.MacroDeclInit(nm1,lp1,_,rp1,eq1,_,sem1),
+ Ast0.MacroDeclInit(nm2,lp2,_,rp2,eq2,_,sem2))->
+ equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode eq1 eq2
+ && equal_mcode sem1 sem2
| (Ast0.TyDecl(_,sem1),Ast0.TyDecl(_,sem2)) -> equal_mcode sem1 sem2
| (Ast0.Ddots(dots1,_),Ast0.Ddots(dots2,_)) -> equal_mcode dots1 dots2
| (Ast0.OptDecl(_),Ast0.OptDecl(_)) -> true
| (Ast0.UniqueDecl(_),Ast0.UniqueDecl(_)) -> true
- | (Ast0.DisjDecl _,_) | (_,Ast0.DisjDecl _) ->
- failwith "DisjDecl not expected here"
+ | (Ast0.DisjDecl(starter1,_,mids1,ender1),
+ Ast0.DisjDecl(starter2,_,mids2,ender2)) ->
+ equal_mcode starter1 starter2 &&
+ List.for_all2 equal_mcode mids1 mids2 &&
+ equal_mcode ender1 ender2
| _ -> false
let equal_designator d1 d2 =
| (Ast0.Do(d1,_,whl1,lp1,_,rp1,sem1),Ast0.Do(d2,_,whl2,lp2,_,rp2,sem2)) ->
equal_mcode whl1 whl2 && equal_mcode d1 d2 &&
equal_mcode lp1 lp2 && equal_mcode rp1 rp2 && equal_mcode sem1 sem2
- | (Ast0.For(fr1,lp1,_,sem11,_,sem21,_,rp1,_,_),
- Ast0.For(fr2,lp2,_,sem12,_,sem22,_,rp2,_,_)) ->
+ | (Ast0.For(fr1,lp1,first1,_,sem21,_,rp1,_,_),
+ Ast0.For(fr2,lp2,first2,_,sem22,_,rp2,_,_)) ->
+ let first =
+ match (Ast0.unwrap first1,Ast0.unwrap first2) with
+ (Ast0.ForExp(_,sem1),Ast0.ForExp(_,sem2)) ->
+ equal_mcode sem1 sem2
+ | (Ast0.ForDecl _,Ast0.ForDecl _) -> true
+ | _ -> false in
equal_mcode fr1 fr2 && equal_mcode lp1 lp2 &&
- equal_mcode sem11 sem12 && equal_mcode sem21 sem22 &&
+ first && equal_mcode sem21 sem22 &&
equal_mcode rp1 rp2
| (Ast0.Iterator(nm1,lp1,_,rp1,_,_),Ast0.Iterator(nm2,lp2,_,rp2,_,_)) ->
equal_mcode lp1 lp2 && equal_mcode rp1 rp2
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
+ do_nothing do_nothing do_nothing do_nothing
let contextify_whencode =
let bind x y = () in
| (Ast0.OTHER(_),Ast0.OTHER(_)) -> ()
| _ -> fail()
+(* can't just remove expressions or types, not sure if all cases are needed. *)
+let check_complete m =
+ match Ast0.unwrap m with
+ Ast0.NONDECL(code) ->
+ if is_exp code or is_ty code
+ then
+ failwith
+ (Printf.sprintf "invalid minus starting on line %d"
+ (Ast0.get_line m))
+ | Ast0.CODE(code) ->
+ if isonly is_exp code or isonly is_ty code
+ then
+ failwith
+ (Printf.sprintf "invalid minus starting on line %d"
+ (Ast0.get_line m))
+ | _ -> ()
+
(* ------------------------------------------------------------------- *)
(* returns a list of corresponding minus and plus trees *)
| ([],l) ->
failwith (Printf.sprintf "%d plus things remaining" (List.length l))
| (minus,[]) ->
+ List.iter check_complete minus;
plus_lines := [];
let _ =
List.map
HCoop / bpt / coccinelle.git / blobdiff