(*
- * 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 "./iso_pattern.ml"
(* Potential problem: offset of mcode is not updated when an iso is
instantiated, implying that a term may end up with many mcodes with the
same offset. On the other hand, at the moment offset only seems to be used
let strip_info =
let mcode (term,_,_,_,_,_) =
(term,Ast0.NONE,Ast0.default_info(),Ast0.PLUS Ast.ONE,
- ref Ast0.NoMetaPos,-1) in
+ ref [],-1) in
let donothing r k e =
let x = k e in
{(Ast0.wrap (Ast0.unwrap x)) with
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
+ donothing donothing donothing
let anything_equal = function
(Ast0.DotsExprTag(d1),Ast0.DotsExprTag(d2)) ->
Format.print_newline()
| Position(rule,name) ->
Printf.printf "position variable %s.%s conflicts with an isomorphism\n"
- rule name;
- | TypeMatch reason_list ->
+ rule name
+ | 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 *)
- ([[Ast.StatementTag(s)]],_) ->
+ (* 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 *)
| _ -> true)
let match_maker checks_needed context_required whencode_allowed =
- let check_mcode pmc cmc binding =
+ let check_mcode pmc (*pattern*) cmc (*code*) binding =
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
- | Ast0.NoMetaPos ->
- let (rule,name) = Ast0.unwrap_mcode name in
- Fail (Position(rule,name)))
- | Ast0.NoMetaPos -> OK binding
+ [] -> 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 =
(Ast.NOTHING,_,_) -> Ast0.PureContext
| _ -> Ast0.Context)
| Ast0.MINUS(mc) ->
- (match !mc with ([],_) -> Ast0.Pure | _ -> Ast0.Impure)
+ (match !mc with
+ (Ast.NOREPLACEMENT,_) -> Ast0.Pure
+ | _ -> Ast0.Impure)
| _ -> Ast0.Impure in
let donothing r k e =
bind (pure_mcodekind (Ast0.get_mcodekind e)) (k e) in
let ident r k i =
bind (bind (pure_mcodekind (Ast0.get_mcodekind i)) (k i))
(match Ast0.unwrap i with
- Ast0.MetaId(name,_,pure) | Ast0.MetaFunc(name,_,pure)
+ Ast0.MetaId(name,_,_,pure) | Ast0.MetaFunc(name,_,pure)
| Ast0.MetaLocalFunc(name,_,pure) -> pure
| _ -> Ast0.Impure) in
let init r k t =
bind (bind (pure_mcodekind (Ast0.get_mcodekind t)) (k t))
(match Ast0.unwrap t with
- Ast0.MetaInit(name,pure) -> pure
+ Ast0.MetaInit(name,pure) | Ast0.MetaInitList(name,_,pure) -> pure
| _ -> Ast0.Impure) in
let param r k p =
let decl r k d =
bind (bind (pure_mcodekind (Ast0.get_mcodekind d)) (k d))
(match Ast0.unwrap d with
- Ast0.MetaDecl(name,pure) | Ast0.MetaField(name,pure) -> pure
+ Ast0.MetaDecl(name,pure) | Ast0.MetaField(name,pure)
+ | Ast0.MetaFieldList(name,_,pure) ->
+ pure
| _ -> Ast0.Impure) in
let stmt r k s =
V0.flat_combiner bind option_default
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
donothing donothing donothing donothing donothing donothing
- ident expression typeC init param decl stmt donothing
+ ident expression typeC init param decl stmt donothing donothing
donothing in
let add_pure_list_binding name pure is_pure builder1 builder2 lst =
let rec match_ident pattern id =
match Ast0.unwrap pattern with
- Ast0.MetaId(name,_,pure) ->
+ Ast0.MetaId(name,_,_,pure) ->
(add_pure_binding name pure pure_sp_code.VT0.combiner_rec_ident
(function id -> Ast0.IdentTag id) id)
| Ast0.MetaFunc(name,_,pure) -> failwith "metafunc not supported"
if mcode_equal namea nameb
then check_mcode namea nameb
else return false
+ | (Ast0.DisjId(_,ids,_,_),_) ->
+ failwith "not allowed in the pattern of an isomorphism"
| (Ast0.OptIdent(ida),Ast0.OptIdent(idb))
| (Ast0.UniqueIdent(ida),Ast0.UniqueIdent(idb)) ->
match_ident ida idb
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
if mcode_equal namea nameb
then check_mcode namea nameb
else return false
- | (Ast0.DisjType(_,typesa,_,_),Ast0.DisjType(_,typesb,_,_)) ->
+ | (Ast0.DisjType(_,typesa,_,_),_) ->
failwith "not allowed in the pattern of an isomorphism"
| (Ast0.OptType(tya),Ast0.OptType(tyb))
| (Ast0.UniqueType(tya),Ast0.UniqueType(tyb)) -> match_typeC tya tyb
add_pure_binding name pure pure_sp_code.VT0.combiner_rec_declaration
(function d -> Ast0.DeclTag d)
d
+ | Ast0.MetaFieldList(name,_,pure) -> failwith "metafieldlist not supporte"
| up ->
if not(checks_needed) or not(context_required) or is_context d
then
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)) ->
conjunct_bindings (check_mcode sc1 sc)
(conjunct_bindings (match_typeC tya tyb) (match_typeC ida idb))
- | (Ast0.DisjDecl(_,declsa,_,_),Ast0.DisjDecl(_,declsb,_,_)) ->
+ | (Ast0.DisjDecl(_,declsa,_,_),_) ->
failwith "not allowed in the pattern of an isomorphism"
| (Ast0.Ddots(d1,None),Ast0.Ddots(d,None)) -> check_mcode d1 d
| (Ast0.Ddots(dd,None),Ast0.Ddots(d,Some wc)) ->
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
bodya bodyb
else return_false (Braces(s))))
| (Ast0.ExprStatement(expa,sc1),Ast0.ExprStatement(expb,sc)) ->
- conjunct_bindings (check_mcode sc1 sc) (match_expr expa expb)
+ conjunct_bindings (check_mcode sc1 sc)
+ (match_option match_expr expa expb)
| (Ast0.IfThen(if1,lp1,expa,rp1,branch1a,_),
Ast0.IfThen(if2,lp2,expb,rp2,branch1b,_)) ->
conjunct_many_bindings
[check_mcode d1 d; check_mcode w1 w; check_mcode lp1 lp;
check_mcode rp1 rp; match_statement bodya bodyb;
match_expr expa expb]
- | (Ast0.For(f1,lp1,e1a,sc1a,e2a,sc2a,e3a,rp1,bodya,_),
- Ast0.For(f,lp,e1b,sc1b,e2b,sc2b,e3b,rp,bodyb,_)) ->
+ | (Ast0.For(f1,lp1,firsta,e2a,sc2a,e3a,rp1,bodya,_),
+ Ast0.For(f,lp,firstb,e2b,sc2b,e3b,rp,bodyb,_)) ->
+ let first =
+ match (Ast0.unwrap firsta,Ast0.unwrap firstb) with
+ (Ast0.ForExp(e1a,sc1a),Ast0.ForExp(e1b,sc1b)) ->
+ conjunct_bindings
+ (check_mcode sc2a sc2b)
+ (match_option match_expr e1a e1b)
+ | (Ast0.ForDecl (_,decla),Ast0.ForDecl (_,declb)) ->
+ match_decl decla declb
+ | _ -> return false in
conjunct_many_bindings
- [check_mcode f1 f; check_mcode lp1 lp; check_mcode sc1a sc1b;
+ [check_mcode f1 f; check_mcode lp1 lp; first;
check_mcode sc2a sc2b; check_mcode rp1 rp;
- match_option match_expr e1a e1b;
match_option match_expr e2a e2b;
match_option match_expr e3a e3b;
match_statement bodya bodyb]
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))
match mcodekind with
Ast0.CONTEXT(mc) ->
(match !mc with
- (Ast.NOTHING,_,_) -> Ast0.MINUS(ref([],Ast0.default_token_info))
+ (Ast.NOTHING,_,_) ->
+ Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info))
| _ -> failwith "make_minus: unexpected befaft")
| Ast0.MINUS(mc) -> mcodekind (* in the part copied from the src term *)
| _ -> failwith "make_minus mcode: unexpected mcodekind" in
Ast0.CONTEXT(mc) ->
(match !mc with
(Ast.NOTHING,_,_) ->
- mcodekind := Ast0.MINUS(ref([],Ast0.default_token_info))
+ mcodekind :=
+ Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info))
| _ -> failwith "make_minus: unexpected befaft")
| Ast0.MINUS(_mc) -> () (* in the part copied from the src term *)
| Ast0.PLUS _ -> failwith "make_minus donothing: unexpected plus mcodekind"
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.MIXED(mc) | Ast0.CONTEXT(mc) ->
(match !mc with
(Ast.NOTHING,_,_) ->
- mcodekind := Ast0.MINUS(ref([],Ast0.default_token_info));
+ mcodekind :=
+ Ast0.MINUS(ref(Ast.NOREPLACEMENT,Ast0.default_token_info));
e
| _ -> failwith "make_minus: unexpected befaft")
(* code already processed by an enclosing iso *)
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
dots dots dots dots dots dots
donothing expression donothing initialiser donothing declaration
- statement donothing donothing
+ statement donothing donothing donothing
(* --------------------------------------------------------------------- *)
(* rebuild mcode cells in an instantiated alt *)
| 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 =
(match Ast0.unwrap s with
Ast0.Decl((info,mc),decl) ->
Ast0.Decl((info,copy_mcodekind mc),decl)
- | Ast0.IfThen(iff,lp,tst,rp,branch,(info,mc)) ->
- Ast0.IfThen(iff,lp,tst,rp,branch,(info,copy_mcodekind mc))
- | Ast0.IfThenElse(iff,lp,tst,rp,branch1,els,branch2,(info,mc)) ->
+ | Ast0.IfThen(iff,lp,tst,rp,branch,(info,mc,adj)) ->
+ Ast0.IfThen(iff,lp,tst,rp,branch,(info,copy_mcodekind mc,adj))
+ | Ast0.IfThenElse(iff,lp,tst,rp,branch1,els,branch2,(info,mc,adj))->
Ast0.IfThenElse(iff,lp,tst,rp,branch1,els,branch2,
- (info,copy_mcodekind mc))
- | Ast0.While(whl,lp,exp,rp,body,(info,mc)) ->
- Ast0.While(whl,lp,exp,rp,body,(info,copy_mcodekind mc))
- | Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,(info,mc)) ->
- Ast0.For(fr,lp,e1,sem1,e2,sem2,e3,rp,body,
- (info,copy_mcodekind mc))
- | Ast0.Iterator(nm,lp,args,rp,body,(info,mc)) ->
- Ast0.Iterator(nm,lp,args,rp,body,(info,copy_mcodekind mc))
+ (info,copy_mcodekind mc,adj))
+ | Ast0.While(whl,lp,exp,rp,body,(info,mc,adj)) ->
+ Ast0.While(whl,lp,exp,rp,body,(info,copy_mcodekind mc,adj))
+ | Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,(info,mc,adj)) ->
+ Ast0.For(fr,lp,first,e2,sem2,e3,rp,body,
+ (info,copy_mcodekind mc,adj))
+ | Ast0.Iterator(nm,lp,args,rp,body,(info,mc,adj)) ->
+ Ast0.Iterator(nm,lp,args,rp,body,(info,copy_mcodekind mc,adj))
| Ast0.FunDecl
((info,mc),fninfo,name,lp,params,rp,lbrace,body,rbrace) ->
Ast0.FunDecl
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
donothing donothing donothing donothing donothing donothing
donothing donothing donothing donothing donothing
- donothing statement donothing donothing
+ donothing statement donothing donothing donothing
(* --------------------------------------------------------------------- *)
(* The problem of whencode. If an isomorphism contains dots in multiple
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 =
- match Ast0.get_pos x with
- Ast0.MetaPos(name,_,_) ->
- (try
- match lookup name bindings mv_bindings with
- Common.Left(Ast0.MetaPosTag(id)) -> Ast0.set_pos id x
- | _ -> failwith "not possible"
- with Not_found -> Ast0.set_pos Ast0.NoMetaPos x)
- | _ -> x in
+ let (hidden,others) =
+ List.partition
+ (function Ast0.HiddenVarTag _ -> true | _ -> false)
+ (Ast0.get_pos x) in
+ let new_names =
+ 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 *)
let identfn r k e =
let e = k e in
match Ast0.unwrap e with
- Ast0.MetaId(name,constraints,pure) ->
+ Ast0.MetaId(name,constraints,seed,pure) ->
(rebuild_mcode None).VT0.rebuilder_rec_ident
(match lookup name bindings mv_bindings with
Common.Left(Ast0.IdentTag(id)) -> id
| Common.Right(new_mv) ->
Ast0.rewrap e
(Ast0.MetaId
- (Ast0.set_mcode_data new_mv name,constraints,pure)))
+ (Ast0.set_mcode_data new_mv name,constraints,seed,pure)))
| Ast0.MetaFunc(name,_,pure) -> failwith "metafunc not supported"
| Ast0.MetaLocalFunc(name,_,pure) -> failwith "metalocalfunc not supported"
| _ -> e in
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
let nomodif = function
Ast0.MINUS(x) ->
(match !x with
- ([],_) -> true
+ (Ast.NOREPLACEMENT,_) -> true
| _ -> false)
| Ast0.CONTEXT(x) | Ast0.MIXED(x) ->
(match !x with
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
| Common.Right(new_mv) ->
Ast0.rewrap e
(Ast0.MetaField(Ast0.set_mcode_data new_mv name, pure)))
+ | Ast0.MetaFieldList(name,lenname,pure) ->
+ failwith "metafieldlist not supported"
| Ast0.Ddots(d,_) ->
(try
(match List.assoc (dot_term d) bindings with
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
(dots elist) donothing (dots plist) (dots slist) donothing donothing
identfn exprfn tyfn initfn paramfn declfn stmtfn donothing donothing
+ donothing
(* --------------------------------------------------------------------- *)
Ast0.MINUS(emc) ->
emc :=
(match (!mc,!emc) with
- (([],_),(x,t)) | ((x,_),([],t)) -> (x,t)
+ ((Ast.NOREPLACEMENT,_),(x,t))
+ | ((x,_),(Ast.NOREPLACEMENT,t)) -> (x,t)
| _ -> failwith "how can we combine minuses?")
| _ -> failwith "not possible 6")
| Ast0.CONTEXT(mc) ->
| (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
let (anythings,t) = !emc in
- emc :=
- (match anything_bef_aft with
- Ast.BEFORE(b,_) -> (b@anythings,t)
- | Ast.AFTER(a,_) -> (anythings@a,t)
- | Ast.BEFOREAFTER(b,a,_) -> (b@anythings@a,t)
- | Ast.NOTHING -> (anythings,t))
+ (match (anything_bef_aft,anythings) with
+ (Ast.BEFORE(b1,it1),Ast.NOREPLACEMENT) ->
+ emc := (Ast.REPLACEMENT(b1,it1),t)
+ | (Ast.AFTER(a1,it1),Ast.NOREPLACEMENT) ->
+ emc := (Ast.REPLACEMENT(a1,it1),t)
+ | (Ast.BEFOREAFTER(b1,a1,it1),Ast.NOREPLACEMENT) ->
+ emc := (Ast.REPLACEMENT(b1@a1,it1),t)
+ | (Ast.NOTHING,Ast.NOREPLACEMENT) ->
+ emc := (Ast.NOREPLACEMENT,t)
+ | (Ast.BEFORE(b1,it1),Ast.REPLACEMENT(a2,it2)) ->
+ emc := (Ast.REPLACEMENT(b1@a2,Ast.lub_count it1 it2),t)
+ | (Ast.AFTER(a1,it1),Ast.REPLACEMENT(a2,it2)) ->
+ emc := (Ast.REPLACEMENT(a2@a1,Ast.lub_count it1 it2),t)
+ | (Ast.BEFOREAFTER(b1,a1,it1),Ast.REPLACEMENT(a2,it2)) ->
+ emc := (Ast.REPLACEMENT(b1@a2@a1,Ast.lub_count it1 it2),t)
+ | (Ast.NOTHING,Ast.REPLACEMENT(a2,it2)) -> ()) (* no change *)
| Ast0.MIXED(_) -> failwith "how did this become mixed?"
| _ -> failwith "not possible 7")
| Ast0.MIXED(_) -> failwith "not possible 8"
| Ast0.Decl((info,bef1),_) ->
merge_plus bef bef1
| _ -> merge_plus bef (Ast0.get_mcodekind e))
- | Ast0.IfThen(_,_,_,_,_,(info,aft))
- | Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft))
- | Ast0.While(_,_,_,_,_,(info,aft))
- | Ast0.For(_,_,_,_,_,_,_,_,_,(info,aft))
- | Ast0.Iterator(_,_,_,_,_,(info,aft)) ->
+ | Ast0.IfThen(_,_,_,_,_,(_,aft,_))
+ | Ast0.IfThenElse(_,_,_,_,_,_,_,(_,aft,_))
+ | Ast0.While(_,_,_,_,_,(_,aft,_))
+ | Ast0.For(_,_,_,_,_,_,_,_,(_,aft,_))
+ | Ast0.Iterator(_,_,_,_,_,(_,aft,_)) ->
(match Ast0.unwrap e with
- Ast0.IfThen(_,_,_,_,_,(info,aft1))
- | Ast0.IfThenElse(_,_,_,_,_,_,_,(info,aft1))
- | Ast0.While(_,_,_,_,_,(info,aft1))
- | Ast0.For(_,_,_,_,_,_,_,_,_,(info,aft1))
- | Ast0.Iterator(_,_,_,_,_,(info,aft1)) ->
+ Ast0.IfThen(_,_,_,_,_,(_,aft1,_))
+ | Ast0.IfThenElse(_,_,_,_,_,_,_,(_,aft1,_))
+ | Ast0.While(_,_,_,_,_,(_,aft1,_))
+ | Ast0.For(_,_,_,_,_,_,_,_,(_,aft1,_))
+ | Ast0.Iterator(_,_,_,_,_,(_,aft1,_)) ->
merge_plus aft aft1
| _ -> merge_plus aft (Ast0.get_mcodekind e))
| _ -> ()));
(nm,function nm -> Ast.MetaTypeDecl(ar,nm))
| Ast.MetaInitDecl(ar,nm) ->
(nm,function nm -> Ast.MetaInitDecl(ar,nm))
+ | Ast.MetaInitListDecl(ar,nm,nm1) ->
+ (nm,function nm -> Ast.MetaInitListDecl(ar,nm,nm1))
| Ast.MetaListlenDecl(nm) ->
failwith "should not be rebuilt"
| Ast.MetaParamDecl(ar,nm) ->
(nm,function nm -> Ast.MetaExpListDecl(ar,nm,nm1))
| Ast.MetaDeclDecl(ar,nm) ->
(nm,function nm -> Ast.MetaDeclDecl(ar,nm))
+ | Ast.MetaFieldListDecl(ar,nm,nm1) ->
+ (nm,function nm -> Ast.MetaFieldListDecl(ar,nm,nm1))
| Ast.MetaFieldDecl(ar,nm) ->
(nm,function nm -> Ast.MetaFieldDecl(ar,nm))
| Ast.MetaStmDecl(ar,nm) ->
(nm,function nm -> Ast.MetaLocalFuncDecl(ar,nm))
| Ast.MetaPosDecl(ar,nm) ->
(nm,function nm -> Ast.MetaPosDecl(ar,nm))
+ | Ast.MetaAnalysisDecl(ar,nm) ->
+ (nm,function nm -> Ast.MetaAnalysisDecl(ar,nm))
| Ast.MetaDeclarerDecl(ar,nm) ->
(nm,function nm -> Ast.MetaDeclarerDecl(ar,nm))
| Ast.MetaIteratorDecl(ar,nm) ->
{ 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 ->
(* sort of a hack, because there is no disj at top level *)
let transform_top (metavars,alts,name) e =
match Ast0.unwrap e with
- Ast0.DECL(declstm) ->
+ Ast0.NONDECL(declstm) ->
(try
let strip alts =
List.map
| _ -> raise (Failure "")))
alts in
let (count,mv,s) = transform_stmt (metavars,strip alts,name) declstm in
- (count,mv,Ast0.rewrap e (Ast0.DECL(s)))
+ (count,mv,Ast0.rewrap e (Ast0.NONDECL(s)))
with Failure _ -> (0,[],e))
| Ast0.CODE(stmts) ->
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 =
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
+ donothing donothing donothing
let rewrap_anything = function
Ast0.DotsExprTag(d) ->
| Ast0.ParamTag(d) -> Ast0.ParamTag(rewrap.VT0.rebuilder_rec_parameter d)
| Ast0.DeclTag(d) -> Ast0.DeclTag(rewrap.VT0.rebuilder_rec_declaration d)
| Ast0.StmtTag(d) -> Ast0.StmtTag(rewrap.VT0.rebuilder_rec_statement d)
+ | Ast0.ForInfoTag(d) -> Ast0.ForInfoTag(rewrap.VT0.rebuilder_rec_forinfo d)
| Ast0.CaseLineTag(d) ->
Ast0.CaseLineTag(rewrap.VT0.rebuilder_rec_case_line d)
| Ast0.TopTag(d) -> Ast0.TopTag(rewrap.VT0.rebuilder_rec_top_level d)
| 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 *)
(* --------------------------------------------------------------------- *)