(*
- * 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.Decl((info,bef),_) ->
bind (nc_mcode ((),(),info,bef,(),-1)) (k s)
- | Ast0.IfThen(_,_,_,_,_,(info,aft))
- | Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft))
- | Ast0.Iterator(_,_,_,_,_,(info,aft))
- | Ast0.While(_,_,_,_,_,(info,aft))
- | Ast0.For(_,_,_,_,_,_,_,_,_,(info,aft)) ->
- bind (k s) (nc_mcode ((),(),info,aft,(),-1))
+ | Ast0.IfThen(_,_,_,_,_,(info,aft,adj))
+ | Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft,adj))
+ | Ast0.Iterator(_,_,_,_,_,(info,aft,adj))
+ | Ast0.While(_,_,_,_,_,(info,aft,adj))
+ | Ast0.For(_,_,_,_,_,_,_,_,(info,aft,adj)) ->
+ bind (k s) (nc_mcode ((),(),info,aft,(),adj))
| _ -> k s
) in
(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
(* --------------------------------------------------------------------- *)
let rec equal_ident i1 i2 =
match (Ast0.unwrap i1,Ast0.unwrap i2) with
(Ast0.Id(name1),Ast0.Id(name2)) -> equal_mcode name1 name2
- | (Ast0.MetaId(name1,_,_),Ast0.MetaId(name2,_,_)) ->
+ | (Ast0.MetaId(name1,_,_,_),Ast0.MetaId(name2,_,_,_)) ->
equal_mcode name1 name2
| (Ast0.MetaFunc(name1,_,_),Ast0.MetaFunc(name2,_,_)) ->
equal_mcode name1 name2
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 =
match (Ast0.unwrap i1,Ast0.unwrap i2) with
(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 -
| (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
let rec equal_top_level t1 t2 =
match (Ast0.unwrap t1,Ast0.unwrap t2) with
- (Ast0.DECL(_),Ast0.DECL(_)) -> true
+ (Ast0.NONDECL(_),Ast0.NONDECL(_)) -> true
| (Ast0.FILEINFO(old_file1,new_file1),Ast0.FILEINFO(old_file2,new_file2)) ->
equal_mcode old_file1 old_file2 && equal_mcode new_file1 new_file2
| (Ast0.CODE(_),Ast0.CODE(_)) -> true
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
let iscode t =
match Ast0.unwrap t with
- Ast0.DECL(_) -> true
+ Ast0.NONDECL(_) -> true
| Ast0.FILEINFO(_) -> true
| Ast0.ERRORWORDS(_) -> false
| Ast0.CODE(_) -> true
+ | Ast0.TOPCODE(_)
| Ast0.OTHER(_) -> failwith "unexpected top level code"
(* ------------------------------------------------------------------- *)
[] -> []
| x::rest ->
(match Ast0.unwrap x with
- Ast0.DECL(s) -> let stms = loop rest in s::stms
+ Ast0.NONDECL(s) -> let stms = loop rest in s::stms
| Ast0.CODE(ss) ->
let stms = loop rest in
(match Ast0.unwrap ss with
Ast0.Decl(_,e) -> true
| Ast0.FunDecl(_,_,_,_,_,_,_,_,_) -> true
| Ast0.Disj(_,stmts,_,_) -> isall is_toplevel stmts
- | Ast0.ExprStatement(fc,_) ->
+ | Ast0.ExprStatement(Some fc,_) ->
(match Ast0.unwrap fc with
Ast0.FunCall(_,_,_,_) -> true
| _ -> false)
| Ast0.Define(_,_,_,_) -> true
| _ -> false
+(* consider code and topcode to be the same; difference handled
+in top_level.ml *)
let check_compatible m p =
let fail _ =
failwith
"incompatible minus and plus code starting on lines %d and %d"
(Ast0.get_line m) (Ast0.get_line p)) in
match (Ast0.unwrap m, Ast0.unwrap p) with
- (Ast0.DECL(decl1),Ast0.DECL(decl2)) ->
+ (Ast0.NONDECL(decl1),Ast0.NONDECL(decl2)) ->
if not (is_decl decl1 && is_decl decl2)
then fail()
- | (Ast0.DECL(decl1),Ast0.CODE(code2)) ->
+ | (Ast0.NONDECL(decl1),Ast0.CODE(code2)) ->
+ (* This is probably the only important case. We don't want to
+ replace top-level declarations by arbitrary code. *)
let v1 = is_decl decl1 in
let v2 = List.for_all is_toplevel (Ast0.undots code2) in
- if !Flag.make_hrule = None && v1 && not v2 then fail()
- | (Ast0.CODE(code1),Ast0.DECL(decl2)) ->
+ if !Flag.make_hrule = None && v1 && not v2
+ then fail()
+ | (Ast0.CODE(code1),Ast0.NONDECL(decl2)) ->
let v1 = List.for_all is_toplevel (Ast0.undots code1) in
let v2 = is_decl decl2 in
- if v1 && not v2 then fail()
+ if v1 && not v2
+ then fail()
| (Ast0.CODE(code1),Ast0.CODE(code2)) ->
let v1 = isonly is_init code1 in
let v2a = isonly is_init code2 in
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()
+ if !Flag.make_hrule = None && v1 && not v2
+ then fail()
| (Ast0.FILEINFO(_,_),Ast0.FILEINFO(_,_)) -> ()
| (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
(function m ->
classify true
- (function _ -> Ast0.MINUS(ref([],Ast0.default_token_info)))
+ (function _ ->
+ Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)))
minus_table m)
minus in
[]
collect_plus_lines p;
let _ =
classify true
- (function _ -> Ast0.MINUS(ref([],Ast0.default_token_info)))
+ (function _ ->
+ Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info)))
minus_table m in
let _ = classify false (function c -> Ast0.PLUS c) plus_table p in
traverse minus_table plus_table;
plus_lines := [];
let _ =
classify true
- (function _ -> Ast0.MINUS(ref([],Ast0.default_token_info)))
+ (function _ ->
+ Ast0.MINUS(ref(Ast.NOREPLACEMENT,
+ Ast0.default_token_info)))
minus_table m in
loop(minus,pall)
end
HCoop / bpt / coccinelle.git / blobdiff