(*
-* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
-* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
-* This file is part of Coccinelle.
-*
-* Coccinelle is free software: you can redistribute it and/or modify
-* it under the terms of the GNU General Public License as published by
-* the Free Software Foundation, according to version 2 of the License.
-*
-* Coccinelle is distributed in the hope that it will be useful,
-* but WITHOUT ANY WARRANTY; without even the implied warranty of
-* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-* GNU General Public License for more details.
-*
-* You should have received a copy of the GNU General Public License
-* along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
-*
-* The authors reserve the right to distribute this or future versions of
-* Coccinelle under other licenses.
-*)
+ * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
(* Potential problem: offset of mcode is not updated when an iso is
Ast_cocci.metavar list * Ast0_cocci.anything list list * string (* name *)
let strip_info =
- let mcode (term,_,_,_,_) =
- (term,Ast0.NONE,Ast0.default_info(),Ast0.PLUS,ref Ast0.NoMetaPos) in
+ let mcode (term,_,_,_,_,_) =
+ (term,Ast0.NONE,Ast0.default_info(),Ast0.PLUS Ast.ONE,
+ ref Ast0.NoMetaPos,-1) in
let donothing r k e =
let x = k e in
{(Ast0.wrap (Ast0.unwrap x)) with
- Ast0.mcodekind = ref Ast0.PLUS;
+ Ast0.mcodekind = ref (Ast0.PLUS Ast.ONE);
Ast0.true_if_test = x.Ast0.true_if_test} in
V0.flat_rebuilder
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
| (Ast0.DotsCaseTag(d1),Ast0.DotsCaseTag(d2)) ->
failwith "not a possible variable binding"
| (Ast0.IdentTag(d1),Ast0.IdentTag(d2)) ->
- (strip_info.VT0.rebuilder_rec_ident d1) = (strip_info.VT0.rebuilder_rec_ident d2)
+ (strip_info.VT0.rebuilder_rec_ident d1) =
+ (strip_info.VT0.rebuilder_rec_ident d2)
| (Ast0.ExprTag(d1),Ast0.ExprTag(d2)) ->
(strip_info.VT0.rebuilder_rec_expression d1) =
(strip_info.VT0.rebuilder_rec_expression d2)
failwith "only for isos within iso phase"
| _ -> false
-let term (var1,_,_,_,_) = var1
-let dot_term (var1,_,info,_,_) =
+let term (var1,_,_,_,_,_) = var1
+let dot_term (var1,_,info,_,_,_) =
("", var1 ^ (string_of_int info.Ast0.pos_info.Ast0.offset))
type reason =
- NotPure of Ast0.pure * (string * string) * Ast0.anything
- | NotPureLength of (string * string)
+ NotPure of Ast0.pure * Ast.meta_name * Ast0.anything
+ | NotPureLength of Ast.meta_name
| ContextRequired of Ast0.anything
| NonMatch
| Braces of Ast0.statement
- | Position of string * string
+ | Position of Ast.meta_name
| TypeMatch of reason list
let rec interpret_reason name line reason printer =
| [x] -> x
| x::xs -> conjunct_bindings x (conjunct_many_bindings xs)
-let mcode_equal (x,_,_,_,_) (y,_,_,_,_) = x = y
+let mcode_equal (x,_,_,_,_,_) (y,_,_,_,_,_) = x = y
let return b binding = if b then OK binding else Fail NonMatch
let return_false reason binding = Fail reason
(match Ast.unwrap s with
Ast.IfThen(_,_,_) -> false (* potentially dangerous *)
| _ -> true)
- | (_,_) -> false)
+ | (_,_) -> false)
| _ -> false))
let is_minus e =
| _ -> return false in
loop (la,lb)
+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 rec matches e =
match Ast0.unwrap e with
Ast0.Constant(c) -> true
+ | Ast0.Ident(c) ->
+ (match Ast0.unwrap c with
+ Ast0.Id(nm) ->
+ let nm = Ast0.unwrap_mcode nm in
+ (* all caps is a const *)
+ Str.string_match all_caps nm 0
+ | _ -> false)
| Ast0.Cast(lp,ty,rp,e) -> matches e
| Ast0.SizeOfExpr(se,exp) -> true
| Ast0.SizeOfType(se,lp,ty,rp) -> true
expr
else return false
| None ->
- add_pure_binding name pure pure_sp_code.VT0.combiner_rec_expression
+ add_pure_binding name pure
+ pure_sp_code.VT0.combiner_rec_expression
(function expr -> Ast0.ExprTag expr)
expr
else return false
match_dots match_expr is_elist_matcher do_elist_match
argsa argsb;
match_statement bodya bodyb]
- | (Ast0.Switch(s1,lp1,expa,rp1,lb1,casesa,rb1),
- Ast0.Switch(s,lp,expb,rp,lb,casesb,rb)) ->
+ | (Ast0.Switch(s1,lp1,expa,rp1,lb1,declsa,casesa,rb1),
+ Ast0.Switch(s,lp,expb,rp,lb,declsb,casesb,rb)) ->
conjunct_many_bindings
[check_mcode s1 s; check_mcode lp1 lp; check_mcode rp1 rp;
check_mcode lb1 lb; check_mcode rb1 rb;
match_expr expa expb;
+ match_dots match_statement is_slist_matcher do_slist_match
+ declsa declsb;
match_dots match_case_line no_list do_nolist_match
casesa casesb]
| (Ast0.Break(b1,sc1),Ast0.Break(b,sc))
[check_mcode ca1 ca; check_mcode c1 c; match_expr expa expb;
match_dots match_statement is_slist_matcher do_slist_match
codea codeb]
+ | (Ast0.DisjCase(_,case_linesa,_,_),_) ->
+ failwith "not allowed in the pattern of an isomorphism"
| (Ast0.OptCase(ca),Ast0.OptCase(cb)) -> match_case_line ca cb
| (_,Ast0.OptCase(cb)) -> match_case_line pattern cb
| _ -> return false
(* make an entire tree MINUS *)
let make_minus =
- let mcode (term,arity,info,mcodekind,pos) =
+ let mcode (term,arity,info,mcodekind,pos,adj) =
let new_mcodekind =
match mcodekind with
Ast0.CONTEXT(mc) ->
| _ -> failwith "make_minus: unexpected befaft")
| Ast0.MINUS(mc) -> mcodekind (* in the part copied from the src term *)
| _ -> failwith "make_minus mcode: unexpected mcodekind" in
- (term,arity,info,new_mcodekind,pos) in
+ (term,arity,info,new_mcodekind,pos,adj) in
let update_mc mcodekind e =
match !mcodekind with
mcodekind := Ast0.MINUS(ref([],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"
+ | Ast0.PLUS _ -> failwith "make_minus donothing: unexpected plus mcodekind"
| _ -> failwith "make_minus donothing: unexpected mcodekind" in
let donothing r k e =
let rebuild_mcode start_line =
let copy_mcodekind = function
Ast0.CONTEXT(mc) -> Ast0.CONTEXT(ref (!mc))
- | Ast0.MINUS(mc) -> Ast0.MINUS(ref (!mc))
- | Ast0.MIXED(mc) -> Ast0.MIXED(ref (!mc))
- | Ast0.PLUS ->
+ | Ast0.MINUS(mc) -> Ast0.MINUS(ref (!mc))
+ | Ast0.MIXED(mc) -> Ast0.MIXED(ref (!mc))
+ | 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 in
+ Ast0.PLUS count in
- let mcode (term,arity,info,mcodekind,pos) =
+ let mcode (term,arity,info,mcodekind,pos,adj) =
let info =
match start_line with
Some x ->
Ast0.line_end = x; } in
{info with Ast0.pos_info = new_pos_info}
| None -> info in
- (term,arity,info,copy_mcodekind mcodekind,pos) in
+ (term,arity,info,copy_mcodekind mcodekind,pos,adj) in
let copy_one x =
let old_info = Ast0.get_info x in
let rec renamer = function
Type_cocci.MetaType(name,keep,inherited) ->
(match
- lookup (name,(),(),(),None) bindings mv_bindings
+ lookup (name,(),(),(),None,-1) bindings mv_bindings
with
Common.Left(Ast0.TypeCTag(t)) ->
Ast0.ast0_type_to_type t
failwith "metaexprlist not supported"
| Ast0.Unary(exp,unop) ->
(match Ast0.unwrap_mcode unop with
+ (* propagate negation only when the propagated and the encountered
+ negation have the same transformation, when there is nothing
+ added to the original one, and when there is nothing added to
+ the expression into which we are doing the propagation. This
+ may be too conservative. *)
Ast.Not ->
let was_meta =
(* k e doesn't change the outer structure of the term,
Ast0.MetaExpr(name,constraints,x,form,pure) -> true
| _ -> false)
| _ -> failwith "not possible" in
- let nomodif e =
- let mc = Ast0.get_mcodekind exp in
- match mc with
+ let nomodif = function
Ast0.MINUS(x) ->
(match !x with
([],_) -> true
(Ast.NOTHING,_,_) -> true
| _ -> false)
| _ -> failwith "plus not possible" in
- if was_meta && nomodif exp && nomodif e
+ let same_modif newop oldop =
+ (* only propagate ! is they have the same modification
+ and no + code on the old one (the new one from the iso
+ 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
+ if was_meta
then
let idcont x = x in
let rec negate e (*for rewrapping*) res (*code to process*) k =
(* k accumulates parens, to keep negation outside if no
propagation is possible *)
- match Ast0.unwrap res with
- Ast0.Unary(e1,op) when Ast0.unwrap_mcode op = Ast.Not ->
- k (Ast0.rewrap e (Ast0.unwrap e1))
- | Ast0.Edots(_,_) -> k (Ast0.rewrap e (Ast0.unwrap res))
- | Ast0.Paren(lp,e,rp) ->
- negate e e
- (function x ->
- k (Ast0.rewrap res (Ast0.Paren(lp,x,rp))))
- | Ast0.Binary(e1,op,e2) ->
- let reb nop = Ast0.rewrap_mcode op (Ast.Logical(nop)) in
- let k1 x = k (Ast0.rewrap e x) in
- (match Ast0.unwrap_mcode op with
- Ast.Logical(Ast.Inf) ->
- k1 (Ast0.Binary(e1,reb Ast.SupEq,e2))
- | Ast.Logical(Ast.Sup) ->
- k1 (Ast0.Binary(e1,reb Ast.InfEq,e2))
- | Ast.Logical(Ast.InfEq) ->
- k1 (Ast0.Binary(e1,reb Ast.Sup,e2))
- | Ast.Logical(Ast.SupEq) ->
- k1 (Ast0.Binary(e1,reb Ast.Inf,e2))
- | Ast.Logical(Ast.Eq) ->
- k1 (Ast0.Binary(e1,reb Ast.NotEq,e2))
- | Ast.Logical(Ast.NotEq) ->
- k1 (Ast0.Binary(e1,reb Ast.Eq,e2))
- | Ast.Logical(Ast.AndLog) ->
- k1 (Ast0.Binary(negate e1 e1 idcont,reb Ast.OrLog,
- negate e2 e2 idcont))
- | Ast.Logical(Ast.OrLog) ->
- k1 (Ast0.Binary(negate e1 e1 idcont,reb Ast.AndLog,
- negate e2 e2 idcont))
- | _ ->
- Ast0.rewrap e
- (Ast0.Unary(k res,Ast0.rewrap_mcode op Ast.Not)))
- | Ast0.DisjExpr(lp,exps,mids,rp) ->
+ if nomodif (Ast0.get_mcodekind e)
+ then
+ match Ast0.unwrap res with
+ Ast0.Unary(e1,op) when Ast0.unwrap_mcode op = Ast.Not &&
+ same_modif
+ (Ast0.get_mcode_mcodekind unop)
+ (Ast0.get_mcode_mcodekind op) ->
+ k e1
+ | Ast0.Edots(_,_) -> k (Ast0.rewrap e (Ast0.unwrap res))
+ | Ast0.Paren(lp,e1,rp) ->
+ negate e e1
+ (function x ->
+ k (Ast0.rewrap res (Ast0.Paren(lp,x,rp))))
+ | Ast0.Binary(e1,op,e2) when
+ same_modif
+ (Ast0.get_mcode_mcodekind unop)
+ (Ast0.get_mcode_mcodekind op) ->
+ let reb nop =
+ Ast0.rewrap_mcode op (Ast.Logical(nop)) in
+ let k1 x = k (Ast0.rewrap e x) in
+ (match Ast0.unwrap_mcode op with
+ Ast.Logical(Ast.Inf) ->
+ k1 (Ast0.Binary(e1,reb Ast.SupEq,e2))
+ | Ast.Logical(Ast.Sup) ->
+ k1 (Ast0.Binary(e1,reb Ast.InfEq,e2))
+ | Ast.Logical(Ast.InfEq) ->
+ k1 (Ast0.Binary(e1,reb Ast.Sup,e2))
+ | Ast.Logical(Ast.SupEq) ->
+ k1 (Ast0.Binary(e1,reb Ast.Inf,e2))
+ | Ast.Logical(Ast.Eq) ->
+ k1 (Ast0.Binary(e1,reb Ast.NotEq,e2))
+ | Ast.Logical(Ast.NotEq) ->
+ k1 (Ast0.Binary(e1,reb Ast.Eq,e2))
+ | Ast.Logical(Ast.AndLog) ->
+ k1 (Ast0.Binary(negate_reb e e1 idcont,
+ reb Ast.OrLog,
+ negate_reb e e2 idcont))
+ | Ast.Logical(Ast.OrLog) ->
+ k1 (Ast0.Binary(negate_reb e e1 idcont,
+ reb Ast.AndLog,
+ negate_reb e e2 idcont))
+ | _ ->
+ Ast0.rewrap e
+ (Ast0.Unary(k res,
+ Ast0.rewrap_mcode op Ast.Not)))
+ | Ast0.DisjExpr(lp,exps,mids,rp) ->
(* use res because it is the transformed argument *)
- let exps = List.map (function e -> negate e e k) exps in
- Ast0.rewrap res (Ast0.DisjExpr(lp,exps,mids,rp))
- | _ ->
+ let exps =
+ List.map (function e1 -> negate_reb e e1 k) exps in
+ Ast0.rewrap res (Ast0.DisjExpr(lp,exps,mids,rp))
+ | _ ->
(*use e, because this might be the toplevel expression*)
- Ast0.rewrap e
- (Ast0.Unary(k res,Ast0.rewrap_mcode unop Ast.Not)) in
+ Ast0.rewrap e
+ (Ast0.Unary(k res,Ast0.rewrap_mcode unop Ast.Not))
+ else
+ Ast0.rewrap e
+ (Ast0.Unary(k res,Ast0.rewrap_mcode unop Ast.Not))
+ and negate_reb e e1 k =
+ (* used when ! is propagated to multiple places, to avoid
+ duplicating mcode cells *)
+ let start_line =
+ Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in
+ (rebuild_mcode start_line).VT0.rebuilder_rec_expression
+ (negate e e1 k) in
negate e exp idcont
else e
| _ -> e)
let merged =
match (mba,eba) with
(x,Ast.NOTHING) | (Ast.NOTHING,x) -> x
- | (Ast.BEFORE(b1),Ast.BEFORE(b2)) -> Ast.BEFORE(b1@b2)
- | (Ast.BEFORE(b),Ast.AFTER(a)) -> Ast.BEFOREAFTER(b,a)
- | (Ast.BEFORE(b1),Ast.BEFOREAFTER(b2,a)) ->
- Ast.BEFOREAFTER(b1@b2,a)
- | (Ast.AFTER(a),Ast.BEFORE(b)) -> Ast.BEFOREAFTER(b,a)
- | (Ast.AFTER(a1),Ast.AFTER(a2)) ->Ast.AFTER(a2@a1)
- | (Ast.AFTER(a1),Ast.BEFOREAFTER(b,a2)) -> Ast.BEFOREAFTER(b,a2@a1)
- | (Ast.BEFOREAFTER(b1,a),Ast.BEFORE(b2)) ->
- Ast.BEFOREAFTER(b1@b2,a)
- | (Ast.BEFOREAFTER(b,a1),Ast.AFTER(a2)) ->
- Ast.BEFOREAFTER(b,a2@a1)
- | (Ast.BEFOREAFTER(b1,a1),Ast.BEFOREAFTER(b2,a2)) ->
- Ast.BEFOREAFTER(b1@b2,a2@a1) in
+ | (Ast.BEFORE(b1,it1),Ast.BEFORE(b2,it2)) ->
+ Ast.BEFORE(b1@b2,Ast.lub_count it1 it2)
+ | (Ast.BEFORE(b,it1),Ast.AFTER(a,it2)) ->
+ Ast.BEFOREAFTER(b,a,Ast.lub_count it1 it2)
+ | (Ast.BEFORE(b1,it1),Ast.BEFOREAFTER(b2,a,it2)) ->
+ Ast.BEFOREAFTER(b1@b2,a,Ast.lub_count it1 it2)
+ | (Ast.AFTER(a,it1),Ast.BEFORE(b,it2)) ->
+ Ast.BEFOREAFTER(b,a,Ast.lub_count it1 it2)
+ | (Ast.AFTER(a1,it1),Ast.AFTER(a2,it2)) ->
+ Ast.AFTER(a2@a1,Ast.lub_count it1 it2)
+ | (Ast.AFTER(a1,it1),Ast.BEFOREAFTER(b,a2,it2)) ->
+ Ast.BEFOREAFTER(b,a2@a1,Ast.lub_count it1 it2)
+ | (Ast.BEFOREAFTER(b1,a,it1),Ast.BEFORE(b2,it2)) ->
+ Ast.BEFOREAFTER(b1@b2,a,Ast.lub_count it1 it2)
+ | (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
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.BEFORE(b,_) -> (b@anythings,t)
+ | Ast.AFTER(a,_) -> (anythings@a,t)
+ | Ast.BEFOREAFTER(b,a,_) -> (b@anythings@a,t)
| Ast.NOTHING -> (anythings,t))
+ | Ast0.MIXED(_) -> failwith "how did this become mixed?"
| _ -> failwith "not possible 7")
| Ast0.MIXED(_) -> failwith "not possible 8"
- | Ast0.PLUS -> failwith "not possible 9"
+ | Ast0.PLUS _ -> failwith "not possible 9"
let copy_plus printer minusify model e =
if !Flag.sgrep_mode2
then e (* no plus code, can cause a "not possible" error, so just avoid it *)
else
- let e =
- match Ast0.get_mcodekind model with
- Ast0.MINUS(mc) -> minusify e
- | Ast0.CONTEXT(mc) -> e
- | _ -> failwith "not possible: copy_plus\n" in
- merge_plus (Ast0.get_mcodekind model) (Ast0.get_mcodekind e);
- e
+ begin
+ let e =
+ match Ast0.get_mcodekind model with
+ Ast0.MINUS(mc) -> minusify e
+ | Ast0.CONTEXT(mc) -> e
+ | _ -> failwith "not possible: copy_plus\n" in
+ merge_plus (Ast0.get_mcodekind model) (Ast0.get_mcodekind e);
+ e
+ end
let copy_minus printer minusify model e =
match Ast0.get_mcodekind model with
if !Flag.sgrep_mode2
then e
else failwith "not possible 8"
- | Ast0.PLUS -> failwith "not possible 9"
+ | Ast0.PLUS _ -> failwith "not possible 9"
let whencode_allowed prev_ecount prev_icount prev_dcount
ecount icount dcount rest =
let do_nothing x = x
let mkdisj matcher metavars alts e instantiater mkiso disj_maker minusify
- rebuild_mcodes name printer extra_plus update_others =
- let call_instantiate bindings mv_bindings alts =
+ rebuild_mcodes name printer extra_plus update_others has_context =
+ let call_instantiate bindings mv_bindings alts has_context =
List.concat
(List.map
(function (a,_,_,_) ->
(* no need to create duplicates when the bindings have no effect *)
(List.map
(function bindings ->
- Ast0.set_iso
- (copy_plus printer minusify e
- (extra_plus e
- (instantiater bindings mv_bindings
- (rebuild_mcodes a))))
+ let instantiated =
+ instantiater bindings mv_bindings (rebuild_mcodes a) in
+ let plus_added =
+ if has_context (* ie if pat is not just a metavara *)
+ then
+ copy_plus printer minusify e (extra_plus e instantiated)
+ else instantiated in
+ Ast0.set_iso plus_added
((name,mkiso a)::(Ast0.get_iso e))) (* keep count, not U *)
bindings))
alts) in
| _ -> ());
inner_loop all_alts (prev_ecount + ecount) (prev_icount + icount)
(prev_dcount + dcount) rest
- | OK (bindings : (((string * string) * 'a) list list)) ->
+ | OK (bindings : ((Ast.meta_name * 'a) list list)) ->
let all_alts =
(* apply update_others to all patterns other than the matched
one. This is used to desigate the others as test
make_new_metavars metavars (nub(List.concat bindings)) in
Common.Right
(new_metavars,
- call_instantiate bindings mv_bindings all_alts))) in
+ call_instantiate bindings mv_bindings all_alts
+ (has_context pattern)))) in
let rec outer_loop prev_ecount prev_icount prev_dcount = function
[] | [[_]] (*only one alternative*) -> (0,[],e) (* nothing matched *)
| (alts::rest) as all_alts ->
make_disj_type make_minus.VT0.rebuilder_rec_typeC
(rebuild_mcode start_line).VT0.rebuilder_rec_typeC
name Unparse_ast0.typeC extra_copy_other_plus do_nothing
+ (function x ->
+ match Ast0.unwrap x with Ast0.MetaType _ -> false | _ -> true)
| _ -> (0,[],e)
(make_disj_expr e)
make_minus.VT0.rebuilder_rec_expression
(rebuild_mcode start_line).VT0.rebuilder_rec_expression
- name Unparse_ast0.expression extra_copy_other_plus update_others in
+ 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)
+ in
match alts with
- (Ast0.ExprTag(_)::_)::_ -> process do_nothing
+ (Ast0.ExprTag(_)::r)::rs ->
+ (* hack to accomodate ToTestExpression case, where the first pattern is
+ a normal expression, but the others are test expressions *)
+ let others = r @ (List.concat rs) in
+ let is_test = function Ast0.TestExprTag(_) -> true | _ -> false in
+ if List.for_all is_test others then process Ast0.set_test_exp
+ else if List.exists is_test others then failwith "inconsistent iso"
+ else process do_nothing
| (Ast0.ArgExprTag(_)::_)::_ when Ast0.get_arg_exp e -> process do_nothing
| (Ast0.TestExprTag(_)::_)::_ when Ast0.get_test_pos e ->
process Ast0.set_test_exp
make_minus.VT0.rebuilder_rec_declaration
(rebuild_mcode start_line).VT0.rebuilder_rec_declaration
name Unparse_ast0.declaration extra_copy_other_plus do_nothing
+ (function _ -> true (* no metavars *))
| _ -> (0,[],e)
let transform_stmt (metavars,alts,name) e =
make_disj_stmt make_minus.VT0.rebuilder_rec_statement
(rebuild_mcode start_line).VT0.rebuilder_rec_statement
name (Unparse_ast0.statement "") extra_copy_stmt_plus do_nothing
+ (function x ->
+ match Ast0.unwrap x with
+ Ast0.MetaStmt _ | Ast0.MetaStmtList _ -> false
+ | _ -> true)
| _ -> (0,[],e)
(* sort of a hack, because there is no disj at top level *)
make_minus.VT0.rebuilder_rec_statement_dots x)
(rebuild_mcode start_line).VT0.rebuilder_rec_statement_dots
name Unparse_ast0.statement_dots extra_copy_other_plus do_nothing
+ (function _ -> true)
| _ -> (0,[],stmts) in
(count,mv,Ast0.rewrap e (Ast0.CODE res))
| _ -> (0,[],e)
(* should be done by functorizing the parser to use wrap or context_wrap *)
let rewrap =
- let mcode (x,a,i,mc,pos) = (x,a,i,Ast0.context_befaft(),pos) in
+ let mcode (x,a,i,mc,pos,adj) = (x,a,i,Ast0.context_befaft(),pos,adj) in
let donothing r k e = Ast0.context_wrap(Ast0.unwrap(k e)) in
V0.flat_rebuilder
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
(new_extra_meta@extra_meta,t))
([],t) isos)
rule) in
- (List.concat extra_meta, Compute_lines.compute_lines rule)
+ (List.concat extra_meta, (Compute_lines.compute_lines true) rule)
end