(*
- * 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
| Braces of Ast0.statement
| Nest of Ast0.statement
| Position of Ast.meta_name
- | Multiposition
| TypeMatch of reason list
let rec interpret_reason name line reason printer =
| Position(rule,name) ->
Printf.printf "position variable %s.%s conflicts with an isomorphism\n"
rule name
- | Multiposition _ ->
- Printf.printf "multiple position variables conflict with an isomorphism\n"
- | TypeMatch reason_list ->
+ | TypeMatch reason_list ->
List.iter (function r -> interpret_reason name line r printer)
reason_list
| _ -> failwith "not possible"
| _ -> false)
| Ast0.MINUS(mc) ->
(match !mc with
- (* do better for the common case of replacing a stmt by another one *)
+ (* do better for the common case of replacing a stmt by another one *)
(Ast.REPLACEMENT([[Ast.StatementTag(s)]],_),_) ->
(match Ast.unwrap s with
Ast.IfThen(_,_,_) -> false (* potentially dangerous *)
if checks_needed
then
match Ast0.get_pos cmc with
- [(Ast0.MetaPos (name,_,_)) as x] ->
- (match Ast0.get_pos pmc with
- [Ast0.MetaPos (name1,_,_)] ->
- add_binding name1 (Ast0.MetaPosTag x) binding
- | [] ->
- let (rule,name) = Ast0.unwrap_mcode name in
- Fail (Position(rule,name))
- | _ -> Fail Multiposition)
- | [] -> OK binding
- | _ -> Fail Multiposition
+ [] -> OK binding (* no hidden vars in smpl code, so nothing to do *)
+ | ((a::_) as hidden_code) ->
+ let hidden_pattern =
+ List.filter (function Ast0.HiddenVarTag _ -> true | _ -> false)
+ (Ast0.get_pos pmc) in
+ (match hidden_pattern with
+ [Ast0.HiddenVarTag([Ast0.MetaPosTag(Ast0.MetaPos (name1,_,_))])] ->
+ add_binding name1 (Ast0.HiddenVarTag(hidden_code)) binding
+ | [] -> Fail(Position(Ast0.unwrap_mcode(Ast0.meta_pos_name a)))
+ | _ -> failwith "badly compiled iso - multiple hidden variable")
else OK binding in
let match_dots matcher is_list_matcher do_list_match d1 d2 =
attempts
then
(* not sure why this is ok. can there be more
- than one OK? *)
+ than one OK? *)
OK (List.concat
(List.map
(function Fail _ -> [] | OK x -> x)
[check_mcode opa opb; match_expr lefta leftb;
match_expr righta rightb]
else return false
+ | (Ast0.Sequence(lefta,opa,righta),
+ Ast0.Sequence(leftb,opb,rightb)) ->
+ if mcode_equal opa opb
+ then
+ conjunct_many_bindings
+ [check_mcode opa opb; match_expr lefta leftb;
+ match_expr righta rightb]
+ else return false
| (Ast0.CondExpr(exp1a,lp1,exp2a,rp1,exp3a),
Ast0.CondExpr(exp1b,lp,exp2b,rp,exp3b)) ->
conjunct_many_bindings
conjunct_many_bindings
[check_mcode lp1 lp; check_mcode rp1 rp;
check_mcode szf1 szf; match_typeC tya tyb]
+ | (Ast0.Constructor(lp1,tya,rp1,inita),
+ Ast0.Constructor(lp,tyb,rp,initb)) ->
+ conjunct_many_bindings
+ [check_mcode lp1 lp; check_mcode rp1 rp;
+ match_typeC tya tyb; match_init inita initb]
| (Ast0.TypeExp(tya),Ast0.TypeExp(tyb)) ->
match_typeC tya tyb
| (Ast0.EComma(cm1),Ast0.EComma(cm)) -> check_mcode cm1 cm
| (Ast0.Estars(_,Some _),_) ->
failwith "whencode not allowed in a pattern1"
| (Ast0.OptExp(expa),Ast0.OptExp(expb))
- | (Ast0.UniqueExp(expa),Ast0.UniqueExp(expb)) -> match_expr expa expb
+ | (Ast0.UniqueExp(expa),Ast0.UniqueExp(expb)) ->
+ match_expr expa expb
| (_,Ast0.OptExp(expb))
| (_,Ast0.UniqueExp(expb)) -> match_expr pattern expb
| _ -> return false
match_typeC tya tyb; match_option match_expr sizea sizeb]
| (Ast0.EnumName(kinda,Some namea),
Ast0.EnumName(kindb,Some nameb)) ->
- conjunct_bindings (check_mcode kinda kindb)
- (match_ident namea nameb)
+ conjunct_bindings (check_mcode kinda kindb)
+ (match_ident namea nameb)
| (Ast0.EnumDef(tya,lb1,idsa,rb1),
Ast0.EnumDef(tyb,lb,idsb,rb)) ->
conjunct_many_bindings
check_mcode sc1 sc;
match_dots match_expr is_elist_matcher do_elist_match
argsa argsb]
+ | (Ast0.MacroDeclInit(namea,lp1,argsa,rp1,eq1,ini1,sc1),
+ Ast0.MacroDeclInit(nameb,lp,argsb,rp,eq,ini,sc)) ->
+ conjunct_many_bindings
+ [match_ident namea nameb;
+ check_mcode lp1 lp; check_mcode rp1 rp;
+ check_mcode eq1 eq;
+ check_mcode sc1 sc;
+ match_dots match_expr is_elist_matcher do_elist_match
+ argsa argsb;
+ match_init ini1 ini]
| (Ast0.TyDecl(tya,sc1),Ast0.TyDecl(tyb,sc)) ->
conjunct_bindings (check_mcode sc1 sc) (match_typeC tya tyb)
| (Ast0.Typedef(stga,tya,ida,sc1),Ast0.Typedef(stgb,tyb,idb,sc)) ->
match_decl pattern declb
| _ -> return false
else return_false (ContextRequired (Ast0.DeclTag d))
-
+
and match_init pattern i =
match Ast0.unwrap pattern with
Ast0.MetaInit(name,pure) ->
single_statement can't deal with this case, perhaps because
it starts introducing too many braces? don't remember the
exact problem...
- *)
+ *)
conjunct_bindings (check_mcode lb1 lb)
(conjunct_bindings (check_mcode rb1 rb)
(if not(checks_needed) or is_minus s or
then
(match wc with
[] ->
- (* not sure this is correct, perhaps too restrictive *)
+ (* not sure this is correct, perhaps too restrictive *)
if not(checks_needed) or is_minus s or
(is_context s &&
List.for_all is_pure_context (Ast0.undots stmt_dotsb))
let mcodekind = Ast0.get_mcodekind_ref e in
match Ast0.unwrap e with
Ast0.Edots(d,whencode) ->
- (*don't recurse because whencode hasn't been processed by context_neg*)
+ (*don't recurse because whencode hasn't been processed by context_neg*)
update_mc mcodekind e; Ast0.rewrap e (Ast0.Edots(mcode d,whencode))
| Ast0.Ecircles(d,whencode) ->
- (*don't recurse because whencode hasn't been processed by context_neg*)
+ (*don't recurse because whencode hasn't been processed by context_neg*)
update_mc mcodekind e; Ast0.rewrap e (Ast0.Ecircles(mcode d,whencode))
| Ast0.Estars(d,whencode) ->
- (*don't recurse because whencode hasn't been processed by context_neg*)
+ (*don't recurse because whencode hasn't been processed by context_neg*)
update_mc mcodekind e; Ast0.rewrap e (Ast0.Estars(mcode d,whencode))
| Ast0.NestExpr(starter,expr_dots,ender,whencode,multi) ->
update_mc mcodekind e;
let mcodekind = Ast0.get_mcodekind_ref e in
match Ast0.unwrap e with
Ast0.Ddots(d,whencode) ->
- (*don't recurse because whencode hasn't been processed by context_neg*)
+ (*don't recurse because whencode hasn't been processed by context_neg*)
update_mc mcodekind e; Ast0.rewrap e (Ast0.Ddots(mcode d,whencode))
| _ -> donothing r k e in
let mcodekind = Ast0.get_mcodekind_ref e in
match Ast0.unwrap e with
Ast0.Dots(d,whencode) ->
- (*don't recurse because whencode hasn't been processed by context_neg*)
+ (*don't recurse because whencode hasn't been processed by context_neg*)
update_mc mcodekind e; Ast0.rewrap e (Ast0.Dots(mcode d,whencode))
| Ast0.Circles(d,whencode) ->
update_mc mcodekind e; Ast0.rewrap e (Ast0.Circles(mcode d,whencode))
let mcodekind = Ast0.get_mcodekind_ref e in
match Ast0.unwrap e with
Ast0.Idots(d,whencode) ->
- (*don't recurse because whencode hasn't been processed by context_neg*)
+ (*don't recurse because whencode hasn't been processed by context_neg*)
update_mc mcodekind e; Ast0.rewrap e (Ast0.Idots(mcode d,whencode))
| _ -> donothing r k e in
| Ast0.PLUS count ->
(* this function is used elsewhere where we need to rebuild the
indices, and so we allow PLUS code as well *)
- Ast0.PLUS count in
+ Ast0.PLUS count in
let mcode (term,arity,info,mcodekind,pos,adj) =
let info =
Common.Right (List.assoc (term name) mv_bindings)
(* mv_bindings is for the fresh metavariables that are introduced by the
-isomorphism *)
+ isomorphism *)
let instantiate bindings mv_bindings =
let mcode x =
- let pos_names =
- List.map (function Ast0.MetaPos(name,_,_) -> name) (Ast0.get_pos x) in
+ let (hidden,others) =
+ List.partition
+ (function Ast0.HiddenVarTag _ -> true | _ -> false)
+ (Ast0.get_pos x) in
let new_names =
- List.fold_left
- (function prev ->
- function name ->
- try
- match lookup name bindings mv_bindings with
- Common.Left(Ast0.MetaPosTag(id)) -> id::prev
- | _ -> failwith "not possible"
- with Not_found -> prev)
- [] pos_names in
- Ast0.set_pos new_names x in
+ match hidden with
+ [Ast0.HiddenVarTag([Ast0.MetaPosTag(Ast0.MetaPos (name,_,_))])] ->
+ (try
+ (* not at all sure that this is good enough *)
+ match lookup name bindings mv_bindings with
+ Common.Left(Ast0.HiddenVarTag(ids)) -> ids
+ | _ -> failwith "not possible"
+ with Not_found ->
+ (*can't fail because checks_needed could be false?*)
+ [])
+ | [] -> [] (* no hidden metavars allowed *)
+ | _ -> failwith "badly compiled mcode" in
+ Ast0.set_pos (new_names@others) x in
let donothing r k e = k e in
(* cases where metavariables can occur *)
Ast0.MetaParamList(name,lenname,pure) ->
failwith "meta_param_list in iso not supported"
(*match lookup name bindings mv_bindings with
- Common.Left(Ast0.DotsParamTag(param)) ->
+ Common.Left(Ast0.DotsParamTag(param)) ->
(match same_dots param with
- Some l -> l
+ Some l -> l
| None -> failwith "dots put in incompatible context")
- | Common.Left(Ast0.ParamTag(param)) -> [param]
- | Common.Left(_) -> failwith "not possible 1"
- | Common.Right(new_mv) ->
+ | Common.Left(Ast0.ParamTag(param)) -> [param]
+ | Common.Left(_) -> failwith "not possible 1"
+ | Common.Right(new_mv) ->
failwith "MetaExprList in SP not supported"*)
| _ -> [r.VT0.rebuilder_rec_parameter x])
| x::xs -> (r.VT0.rebuilder_rec_parameter x)::(plist r same_dots xs) in
let rec renamer = function
Type_cocci.MetaType(name,keep,inherited) ->
(match
- lookup (name,(),(),(),None,-1) bindings mv_bindings
+ lookup (name,(),(),(),None,-1)
+ bindings mv_bindings
with
Common.Left(Ast0.TypeCTag(t)) ->
Ast0.ast0_type_to_type t
surely has no + code) *)
match (newop,oldop) with
(Ast0.MINUS(x1),Ast0.MINUS(x2)) -> nomodif oldop
- | (Ast0.CONTEXT(x1),Ast0.CONTEXT(x2)) -> nomodif oldop
- | (Ast0.MIXED(x1),Ast0.MIXED(x2)) -> nomodif oldop
- | _ -> false in
+ | (Ast0.CONTEXT(x1),Ast0.CONTEXT(x2)) -> nomodif oldop
+ | (Ast0.MIXED(x1),Ast0.MIXED(x2)) -> nomodif oldop
+ | _ -> false in
if was_meta
then
let idcont x = x in
| (Ast.BEFOREAFTER(b,a1,it1),Ast.AFTER(a2,it2)) ->
Ast.BEFOREAFTER(b,a2@a1,Ast.lub_count it1 it2)
| (Ast.BEFOREAFTER(b1,a1,it1),Ast.BEFOREAFTER(b2,a2,it2)) ->
- Ast.BEFOREAFTER(b1@b2,a2@a1,Ast.lub_count it1 it2) in
+ Ast.BEFOREAFTER(b1@b2,a2@a1,Ast.lub_count it1 it2) in
emc := (merged,tb,ta)
| Ast0.MINUS(emc) ->
let (anything_bef_aft,_,_) = !mc in
{ Ast0.pos_info = new_pos_info;
Ast0.attachable_start = false; Ast0.attachable_end = false;
Ast0.mcode_start = []; Ast0.mcode_end = [];
- Ast0.strings_before = []; Ast0.strings_after = [] } in
+ Ast0.strings_before = []; Ast0.strings_after = [];
+ Ast0.isSymbolIdent = false; } in
Ast0.make_mcode_info "(" info
let disj_ender lst =
{ Ast0.pos_info = new_pos_info;
Ast0.attachable_start = false; Ast0.attachable_end = false;
Ast0.mcode_start = []; Ast0.mcode_end = [];
- Ast0.strings_before = []; Ast0.strings_after = [] } in
+ Ast0.strings_before = []; Ast0.strings_after = [];
+ Ast0.isSymbolIdent = false; } in
Ast0.make_mcode_info ")" info
let disj_mid _ = Ast0.make_mcode "|"
(rebuild_mcode start_line).VT0.rebuilder_rec_expression
name Unparse_ast0.expression extra_copy_other_plus update_others
(function x ->
- match Ast0.unwrap x with
- Ast0.MetaExpr _ | Ast0.MetaExprList _ | Ast0.MetaErr _ -> false
- | _ -> true)
+ match Ast0.unwrap x with
+ Ast0.MetaExpr _ | Ast0.MetaExprList _ | Ast0.MetaErr _ -> false
+ | _ -> true)
in
match alts with
(Ast0.ExprTag(_)::r)::rs ->
let (count,mv,res) =
match alts with
(Ast0.DotsStmtTag(_)::_)::_ ->
- (* start line is given to any leaves in the iso code *)
+ (* start line is given to any leaves in the iso code *)
let start_line =
Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in
let alts =
| Ast0.IsoWhenTag(_) | Ast0.IsoWhenTTag(_) | Ast0.IsoWhenFTag(_) ->
failwith "only for isos within iso phase"
| Ast0.MetaPosTag(p) -> Ast0.MetaPosTag(p)
+ | Ast0.HiddenVarTag(p) -> Ast0.HiddenVarTag(p) (* not sure it is possible *)
(* --------------------------------------------------------------------- *)
HCoop / bpt / coccinelle.git / blobdiff