X-Git-Url: https://git.hcoop.net/bpt/coccinelle.git/blobdiff_plain/c491d8eea333ab3273dc415c7d7af192e1d0b682..17ba07880e1838028b4516ba7a2db2147b3aa1c9:/parsing_cocci/iso_pattern.ml diff --git a/parsing_cocci/iso_pattern.ml b/parsing_cocci/iso_pattern.ml index 6a63cda..2b53341 100644 --- a/parsing_cocci/iso_pattern.ml +++ b/parsing_cocci/iso_pattern.ml @@ -1,5 +1,7 @@ (* - * 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 @@ -49,7 +51,7 @@ type isomorphism = 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 @@ -167,8 +169,8 @@ let rec interpret_reason name line reason printer = 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" @@ -295,8 +297,8 @@ let rec is_pure_context s = | _ -> 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) @@ -318,18 +320,20 @@ let all_caps = Str.regexp "^[A-Z_][A-Z_0-9]*$" 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 = @@ -370,7 +374,9 @@ let match_maker checks_needed context_required whencode_allowed = (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 @@ -383,7 +389,7 @@ let match_maker checks_needed context_required whencode_allowed = 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 @@ -404,7 +410,7 @@ let match_maker checks_needed context_required whencode_allowed = 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 = @@ -416,7 +422,9 @@ let match_maker checks_needed context_required whencode_allowed = 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 = @@ -487,7 +495,7 @@ let match_maker checks_needed context_required whencode_allowed = 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" @@ -500,6 +508,8 @@ let match_maker checks_needed context_required whencode_allowed = 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 @@ -588,7 +598,7 @@ let match_maker checks_needed context_required whencode_allowed = 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) @@ -648,6 +658,14 @@ let match_maker checks_needed context_required whencode_allowed = [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 @@ -702,6 +720,11 @@ let match_maker checks_needed context_required whencode_allowed = 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 @@ -728,7 +751,8 @@ let match_maker checks_needed context_required whencode_allowed = | (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 @@ -791,8 +815,8 @@ let match_maker checks_needed context_required whencode_allowed = 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 @@ -816,7 +840,7 @@ let match_maker checks_needed context_required whencode_allowed = 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 @@ -835,6 +859,7 @@ let match_maker checks_needed context_required whencode_allowed = 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 @@ -864,12 +889,22 @@ let match_maker checks_needed context_required whencode_allowed = 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)) -> @@ -892,7 +927,7 @@ let match_maker checks_needed context_required whencode_allowed = 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) -> @@ -1032,7 +1067,7 @@ let match_maker checks_needed context_required whencode_allowed = 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 @@ -1043,7 +1078,8 @@ let match_maker checks_needed context_required whencode_allowed = 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 @@ -1119,7 +1155,7 @@ let match_maker checks_needed context_required whencode_allowed = 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)) @@ -1268,7 +1304,8 @@ let make_minus = 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 @@ -1279,7 +1316,8 @@ let make_minus = 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" @@ -1296,13 +1334,13 @@ let make_minus = 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; @@ -1316,7 +1354,7 @@ let make_minus = 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 @@ -1324,7 +1362,7 @@ let make_minus = 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)) @@ -1342,7 +1380,7 @@ let make_minus = 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 @@ -1360,7 +1398,8 @@ let make_minus = 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 *) @@ -1395,7 +1434,7 @@ let rebuild_mcode start_line = | 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 = @@ -1513,24 +1552,34 @@ let lookup name bindings mv_bindings = 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 @@ -1538,7 +1587,7 @@ let instantiate bindings mv_bindings = | 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 @@ -1569,13 +1618,13 @@ let instantiate bindings mv_bindings = 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 @@ -1628,7 +1677,8 @@ let instantiate bindings mv_bindings = 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 @@ -1673,7 +1723,7 @@ let instantiate bindings mv_bindings = let nomodif = function Ast0.MINUS(x) -> (match !x with - ([],_) -> true + (Ast.NOREPLACEMENT,_) -> true | _ -> false) | Ast0.CONTEXT(x) | Ast0.MIXED(x) -> (match !x with @@ -1686,9 +1736,9 @@ let instantiate bindings mv_bindings = 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 @@ -1828,6 +1878,8 @@ let instantiate bindings mv_bindings = | 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 @@ -1918,7 +1970,8 @@ let merge_plus model_mcode e_mcode = 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) -> @@ -1948,17 +2001,27 @@ let merge_plus model_mcode e_mcode = | (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" @@ -2043,7 +2106,9 @@ let new_mv (_,s) = "_"^s^"_"^(string_of_int ct) let get_name = function - Ast.MetaIdDecl(ar,nm) -> + Ast.MetaMetaDecl(ar,nm) -> + (nm,function nm -> Ast.MetaMetaDecl(ar,nm)) + | Ast.MetaIdDecl(ar,nm) -> (nm,function nm -> Ast.MetaIdDecl(ar,nm)) | Ast.MetaFreshIdDecl(nm,seed) -> (nm,function nm -> Ast.MetaFreshIdDecl(nm,seed)) @@ -2051,6 +2116,8 @@ let get_name = function (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) -> @@ -2071,6 +2138,8 @@ let get_name = function (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) -> @@ -2195,7 +2264,8 @@ let disj_starter 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_ender lst = @@ -2208,7 +2278,8 @@ 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 "|" @@ -2304,9 +2375,9 @@ let transform_expr (metavars,alts,name) e = (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 -> @@ -2381,7 +2452,7 @@ let transform_stmt (metavars,alts,name) e = (* 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 @@ -2394,13 +2465,13 @@ let transform_top (metavars,alts,name) e = | _ -> 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 = @@ -2550,6 +2621,7 @@ let rewrap_anything = function | 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 *) (* --------------------------------------------------------------------- *)