(*
-* 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
module Ast = Ast_cocci
module Ast0 = Ast0_cocci
module V0 = Visitor_ast0
+module VT0 = Visitor_ast0_types
let current_rule = ref ""
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.rebuilder
+ V0.flat_rebuilder
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
| (Ast0.DotsParamTag(d1),Ast0.DotsParamTag(d2)) ->
failwith "not a possible variable binding"
| (Ast0.DotsStmtTag(d1),Ast0.DotsStmtTag(d2)) ->
- (strip_info.V0.rebuilder_statement_dots d1) =
- (strip_info.V0.rebuilder_statement_dots d2)
+ (strip_info.VT0.rebuilder_rec_statement_dots d1) =
+ (strip_info.VT0.rebuilder_rec_statement_dots d2)
| (Ast0.DotsDeclTag(d1),Ast0.DotsDeclTag(d2)) ->
failwith "not a possible variable binding"
| (Ast0.DotsCaseTag(d1),Ast0.DotsCaseTag(d2)) ->
failwith "not a possible variable binding"
| (Ast0.IdentTag(d1),Ast0.IdentTag(d2)) ->
- (strip_info.V0.rebuilder_ident d1) = (strip_info.V0.rebuilder_ident d2)
+ (strip_info.VT0.rebuilder_rec_ident d1) =
+ (strip_info.VT0.rebuilder_rec_ident d2)
| (Ast0.ExprTag(d1),Ast0.ExprTag(d2)) ->
- (strip_info.V0.rebuilder_expression d1) =
- (strip_info.V0.rebuilder_expression d2)
+ (strip_info.VT0.rebuilder_rec_expression d1) =
+ (strip_info.VT0.rebuilder_rec_expression d2)
| (Ast0.ArgExprTag(_),_) | (_,Ast0.ArgExprTag(_)) ->
failwith "not possible - only in isos1"
| (Ast0.TestExprTag(_),_) | (_,Ast0.TestExprTag(_)) ->
failwith "not possible - only in isos1"
| (Ast0.TypeCTag(d1),Ast0.TypeCTag(d2)) ->
- (strip_info.V0.rebuilder_typeC d1) =
- (strip_info.V0.rebuilder_typeC d2)
+ (strip_info.VT0.rebuilder_rec_typeC d1) =
+ (strip_info.VT0.rebuilder_rec_typeC d2)
| (Ast0.InitTag(d1),Ast0.InitTag(d2)) ->
- (strip_info.V0.rebuilder_initialiser d1) =
- (strip_info.V0.rebuilder_initialiser d2)
+ (strip_info.VT0.rebuilder_rec_initialiser d1) =
+ (strip_info.VT0.rebuilder_rec_initialiser d2)
| (Ast0.ParamTag(d1),Ast0.ParamTag(d2)) ->
- (strip_info.V0.rebuilder_parameter d1) =
- (strip_info.V0.rebuilder_parameter d2)
+ (strip_info.VT0.rebuilder_rec_parameter d1) =
+ (strip_info.VT0.rebuilder_rec_parameter d2)
| (Ast0.DeclTag(d1),Ast0.DeclTag(d2)) ->
- (strip_info.V0.rebuilder_declaration d1) =
- (strip_info.V0.rebuilder_declaration d2)
+ (strip_info.VT0.rebuilder_rec_declaration d1) =
+ (strip_info.VT0.rebuilder_rec_declaration d2)
| (Ast0.StmtTag(d1),Ast0.StmtTag(d2)) ->
- (strip_info.V0.rebuilder_statement d1) =
- (strip_info.V0.rebuilder_statement d2)
+ (strip_info.VT0.rebuilder_rec_statement d1) =
+ (strip_info.VT0.rebuilder_rec_statement d2)
| (Ast0.CaseLineTag(d1),Ast0.CaseLineTag(d2)) ->
- (strip_info.V0.rebuilder_case_line d1) =
- (strip_info.V0.rebuilder_case_line d2)
+ (strip_info.VT0.rebuilder_rec_case_line d1) =
+ (strip_info.VT0.rebuilder_rec_case_line d2)
| (Ast0.TopTag(d1),Ast0.TopTag(d2)) ->
- (strip_info.V0.rebuilder_top_level d1) =
- (strip_info.V0.rebuilder_top_level d2)
+ (strip_info.VT0.rebuilder_rec_top_level d1) =
+ (strip_info.VT0.rebuilder_rec_top_level d2)
| (Ast0.IsoWhenTTag(_),_) | (_,Ast0.IsoWhenTTag(_)) ->
failwith "only for isos within iso phase"
| (Ast0.IsoWhenFTag(_),_) | (_,Ast0.IsoWhenFTag(_)) ->
failwith "only for isos within iso phase"
| _ -> false
-let term (var1,_,_,_,_) = var1
-let dot_term (var1,_,info,_,_) = ("", var1 ^ (string_of_int info.Ast0.offset))
+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 =
Ast0.MetaStmt(name,pure) | Ast0.MetaStmtList(name,pure) -> pure
| _ -> Ast0.Impure) in
- V0.combiner bind option_default
+ 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 donothing stmt donothing
match Ast0.unwrap sl with
Ast0.MetaStmtList(name,pure) ->
add_pure_list_binding name pure
- pure_sp_code.V0.combiner_statement
+ pure_sp_code.VT0.combiner_rec_statement
(function lst -> Ast0.StmtTag(List.hd lst))
(function lst -> Ast0.DotsStmtTag(build_dots builder lst))
lst
let rec match_ident pattern id =
match Ast0.unwrap pattern with
Ast0.MetaId(name,_,pure) ->
- (add_pure_binding name pure pure_sp_code.V0.combiner_ident
+ (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"
| Ast0.MetaLocalFunc(name,_,pure) -> failwith "metalocalfunc not supported"
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
let tyname = Ast0.rewrap_mcode name tyname in
conjunct_bindings
(add_pure_binding name pure
- pure_sp_code.V0.combiner_expression
+ pure_sp_code.VT0.combiner_rec_expression
(function expr -> Ast0.ExprTag expr)
expr)
(function bindings ->
if List.exists (function t -> Type_cocci.compatible t expty) ts
then
add_pure_binding name pure
- pure_sp_code.V0.combiner_expression
+ pure_sp_code.VT0.combiner_rec_expression
(function expr -> Ast0.ExprTag expr)
expr
else return false
| None ->
- add_pure_binding name pure pure_sp_code.V0.combiner_expression
+ add_pure_binding name pure
+ pure_sp_code.VT0.combiner_rec_expression
(function expr -> Ast0.ExprTag expr)
expr
else return false
(match Ast0.unwrap t with
Ast0.FunctionType(tya,lp1a,paramsa,rp1a) -> return false
| _ ->
- add_pure_binding name pure pure_sp_code.V0.combiner_typeC
+ add_pure_binding name pure pure_sp_code.VT0.combiner_rec_typeC
(function ty -> Ast0.TypeCTag ty)
t)
| up ->
and match_init pattern i =
match Ast0.unwrap pattern with
Ast0.MetaInit(name,pure) ->
- add_pure_binding name pure pure_sp_code.V0.combiner_initialiser
+ add_pure_binding name pure pure_sp_code.VT0.combiner_rec_initialiser
(function ini -> Ast0.InitTag ini)
i
| up ->
and match_param pattern p =
match Ast0.unwrap pattern with
Ast0.MetaParam(name,pure) ->
- add_pure_binding name pure pure_sp_code.V0.combiner_parameter
+ add_pure_binding name pure pure_sp_code.VT0.combiner_rec_parameter
(function p -> Ast0.ParamTag p)
p
| Ast0.MetaParamList(name,_,pure) -> failwith "metaparamlist not supported"
Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) ->
return false (* ... is not a single statement *)
| _ ->
- add_pure_binding name pure pure_sp_code.V0.combiner_statement
+ add_pure_binding name pure pure_sp_code.VT0.combiner_rec_statement
(function ty -> Ast0.StmtTag ty)
s)
| Ast0.MetaStmtList(name,pure) -> failwith "metastmtlist not supported"
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 =
update_mc mcodekind e;
Ast0.rewrap e
(Ast0.NestExpr(mcode starter,
- r.V0.rebuilder_expression_dots expr_dots,
+ r.VT0.rebuilder_rec_expression_dots expr_dots,
mcode ender,whencode,multi))
| _ -> donothing r k e in
| Ast0.Nest(starter,stmt_dots,ender,whencode,multi) ->
update_mc mcodekind e;
Ast0.rewrap e
- (Ast0.Nest(mcode starter,r.V0.rebuilder_statement_dots stmt_dots,
- mcode ender,whencode,multi))
+ (Ast0.Nest
+ (mcode starter,r.VT0.rebuilder_rec_statement_dots stmt_dots,
+ mcode ender,whencode,multi))
| _ -> donothing r k e in
let initialiser r k e =
failwith
(Printf.sprintf
"%d: make_minus donothingxxx: unexpected mcodekind: %s"
- info.Ast0.line_start (Dumper.dump e)))
+ info.Ast0.pos_info.Ast0.line_start (Dumper.dump e)))
| _ -> donothing r k e in
- V0.rebuilder
+ V0.flat_rebuilder
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
dots dots dots dots dots dots
donothing expression donothing initialiser donothing declaration
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 -> {info with Ast0.line_start = x; Ast0.line_end = x}
+ Some x ->
+ let new_pos_info =
+ {info.Ast0.pos_info with
+ Ast0.line_start = 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 info =
match start_line with
- Some x -> {old_info with Ast0.line_start = x; Ast0.line_end = x}
+ Some x ->
+ let new_pos_info =
+ {old_info.Ast0.pos_info with
+ Ast0.line_start = x;
+ Ast0.line_end = x; } in
+ {old_info with Ast0.pos_info = new_pos_info}
| None -> old_info in
{x with Ast0.info = info; Ast0.index = ref(Ast0.get_index x);
Ast0.mcodekind = ref (copy_mcodekind (Ast0.get_mcodekind x))} in
(match Ast0.get_dots_bef_aft res with
Ast0.NoDots -> Ast0.NoDots
| Ast0.AddingBetweenDots s ->
- Ast0.AddingBetweenDots(r.V0.rebuilder_statement s)
+ Ast0.AddingBetweenDots(r.VT0.rebuilder_rec_statement s)
| Ast0.DroppingBetweenDots s ->
- Ast0.DroppingBetweenDots(r.V0.rebuilder_statement s)) in
+ Ast0.DroppingBetweenDots(r.VT0.rebuilder_rec_statement s)) in
- V0.rebuilder
+ V0.flat_rebuilder
mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
donothing donothing donothing donothing donothing donothing
donothing donothing donothing donothing donothing
aren't allowed in isomorphisms for the moment. *)
let count_edots =
- let mcode x = 0 in
let option_default = 0 in
let bind x y = x + y in
- let donothing r k e = k e in
let exprfn r k e =
match Ast0.unwrap e with
Ast0.Edots(_,_) | Ast0.Ecircles(_,_) | Ast0.Estars(_,_) -> 1
| _ -> 0 in
V0.combiner bind option_default
- mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- donothing donothing donothing donothing donothing donothing
- donothing exprfn donothing donothing donothing donothing donothing
- donothing donothing
+ {V0.combiner_functions with VT0.combiner_exprfn = exprfn}
let count_idots =
- let mcode x = 0 in
let option_default = 0 in
let bind x y = x + y in
- let donothing r k e = k e in
let initfn r k e =
match Ast0.unwrap e with Ast0.Idots(_,_) -> 1 | _ -> 0 in
V0.combiner bind option_default
- mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- donothing donothing donothing donothing donothing donothing
- donothing donothing donothing initfn donothing donothing donothing
- donothing donothing
+ {V0.combiner_functions with VT0.combiner_initfn = initfn}
let count_dots =
- let mcode x = 0 in
let option_default = 0 in
let bind x y = x + y in
- let donothing r k e = k e in
let stmtfn r k e =
match Ast0.unwrap e with
Ast0.Dots(_,_) | Ast0.Circles(_,_) | Ast0.Stars(_,_) -> 1
| _ -> 0 in
V0.combiner bind option_default
- mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- donothing donothing donothing donothing donothing donothing
- donothing donothing donothing donothing donothing donothing stmtfn
- donothing donothing
+ {V0.combiner_functions with VT0.combiner_stmtfn = stmtfn}
(* --------------------------------------------------------------------- *)
let e = k e in
match Ast0.unwrap e with
Ast0.MetaId(name,constraints,pure) ->
- (rebuild_mcode None).V0.rebuilder_ident
+ (rebuild_mcode None).VT0.rebuilder_rec_ident
(match lookup name bindings mv_bindings with
Common.Left(Ast0.IdentTag(id)) -> id
| Common.Left(_) -> failwith "not possible 1"
| Common.Left(_) -> failwith "not possible 1"
| Common.Right(new_mv) ->
failwith "MetaExprList in SP not supported"*)
- | _ -> [r.V0.rebuilder_expression x])
- | x::xs -> (r.V0.rebuilder_expression x)::(elist r same_dots xs) in
+ | _ -> [r.VT0.rebuilder_rec_expression x])
+ | x::xs -> (r.VT0.rebuilder_rec_expression x)::(elist r same_dots xs) in
let rec plist r same_dots = function
[] -> []
| Common.Left(_) -> failwith "not possible 1"
| Common.Right(new_mv) ->
failwith "MetaExprList in SP not supported"*)
- | _ -> [r.V0.rebuilder_parameter x])
- | x::xs -> (r.V0.rebuilder_parameter x)::(plist r same_dots xs) in
+ | _ -> [r.VT0.rebuilder_rec_parameter x])
+ | x::xs -> (r.VT0.rebuilder_rec_parameter x)::(plist r same_dots xs) in
let rec slist r same_dots = function
[] -> []
| Common.Left(_) -> failwith "not possible 1"
| Common.Right(new_mv) ->
failwith "MetaExprList in SP not supported")
- | _ -> [r.V0.rebuilder_statement x])
- | x::xs -> (r.V0.rebuilder_statement x)::(slist r same_dots xs) in
+ | _ -> [r.VT0.rebuilder_rec_statement x])
+ | x::xs -> (r.VT0.rebuilder_rec_statement x)::(slist r same_dots xs) in
let same_dots d =
match Ast0.unwrap d with Ast0.DOTS(l) -> Some l |_ -> None in
let e1 =
match Ast0.unwrap e with
Ast0.MetaExpr(name,constraints,x,form,pure) ->
- (rebuild_mcode None).V0.rebuilder_expression
+ (rebuild_mcode None).VT0.rebuilder_rec_expression
(match lookup name bindings mv_bindings with
Common.Left(Ast0.ExprTag(exp)) -> exp
| Common.Left(_) -> failwith "not possible 1"
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 e = k e in
match Ast0.unwrap e with
Ast0.MetaType(name,pure) ->
- (rebuild_mcode None).V0.rebuilder_typeC
+ (rebuild_mcode None).VT0.rebuilder_rec_typeC
(match lookup name bindings mv_bindings with
Common.Left(Ast0.TypeCTag(ty)) -> ty
| Common.Left(_) -> failwith "not possible 1"
let e = k e in
match Ast0.unwrap e with
Ast0.MetaInit(name,pure) ->
- (rebuild_mcode None).V0.rebuilder_initialiser
+ (rebuild_mcode None).VT0.rebuilder_rec_initialiser
(match lookup name bindings mv_bindings with
Common.Left(Ast0.InitTag(ty)) -> ty
| Common.Left(_) -> failwith "not possible 1"
let e = k e in
match Ast0.unwrap e with
Ast0.MetaParam(name,pure) ->
- (rebuild_mcode None).V0.rebuilder_parameter
+ (rebuild_mcode None).VT0.rebuilder_rec_parameter
(match lookup name bindings mv_bindings with
Common.Left(Ast0.ParamTag(param)) -> param
| Common.Left(_) -> failwith "not possible 1"
let e = k e in
match Ast0.unwrap e with
Ast0.MetaStmt(name,pure) ->
- (rebuild_mcode None).V0.rebuilder_statement
+ (rebuild_mcode None).VT0.rebuilder_rec_statement
(match lookup name bindings mv_bindings with
Common.Left(Ast0.StmtTag(stm)) -> stm
| Common.Left(_) -> failwith "not possible 1"
(List.filter (function (x,v) -> x = (dot_term d)) bindings)))
| _ -> e in
- V0.rebuilder
+ V0.flat_rebuilder
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
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 get_name = function
Ast.MetaIdDecl(ar,nm) ->
(nm,function nm -> Ast.MetaIdDecl(ar,nm))
- | Ast.MetaFreshIdDecl(ar,nm) ->
- (nm,function nm -> Ast.MetaFreshIdDecl(ar,nm))
+ | Ast.MetaFreshIdDecl(nm,seed) ->
+ (nm,function nm -> Ast.MetaFreshIdDecl(nm,seed))
| Ast.MetaTypeDecl(ar,nm) ->
(nm,function nm -> Ast.MetaTypeDecl(ar,nm))
| Ast.MetaInitDecl(ar,nm) ->
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))))
- (Common.union_set [(name,mkiso a)] (Ast0.get_iso e)))
+ 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
let rec inner_loop all_alts prev_ecount prev_icount prev_dcount = function
| _ -> ());
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*) -> ([],e) (* nothing matched *)
+ [] | [[_]] (*only one alternative*) -> (0,[],e) (* nothing matched *)
| (alts::rest) as all_alts ->
match inner_loop all_alts prev_ecount prev_icount prev_dcount alts with
Common.Left(prev_ecount, prev_icount, prev_dcount) ->
outer_loop prev_ecount prev_icount prev_dcount rest
| Common.Right (new_metavars,res) ->
- (new_metavars,
+ (1,new_metavars,
copy_minus printer minusify e (disj_maker res)) in
- outer_loop 0 0 0 alts
+ let (count,metavars,e) = outer_loop 0 0 0 alts in
+ (count, metavars, e)
(* no one should ever look at the information stored in these mcodes *)
let disj_starter lst =
let old_info = Ast0.get_info(List.hd lst) in
+ let new_pos_info =
+ { old_info.Ast0.pos_info with
+ Ast0.line_end = old_info.Ast0.pos_info.Ast0.line_start;
+ Ast0.logical_end = old_info.Ast0.pos_info.Ast0.logical_start; } in
let info =
- { old_info with
- Ast0.line_end = old_info.Ast0.line_start;
- Ast0.logical_end = old_info.Ast0.logical_start;
+ { 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
let disj_ender lst =
let old_info = Ast0.get_info(List.hd lst) in
+ let new_pos_info =
+ { old_info.Ast0.pos_info with
+ Ast0.line_start = old_info.Ast0.pos_info.Ast0.line_end;
+ Ast0.logical_start = old_info.Ast0.pos_info.Ast0.logical_end; } in
let info =
- { old_info with
- Ast0.line_start = old_info.Ast0.line_end;
- Ast0.logical_start = old_info.Ast0.logical_end;
+ { 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
match alts with
(Ast0.TypeCTag(_)::_)::_ ->
(* start line is given to any leaves in the iso code *)
- let start_line = Some ((Ast0.get_info e).Ast0.line_start) in
+ let start_line =
+ Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in
let alts =
List.map
(List.map
(function
Ast0.TypeCTag(p) ->
- (p,count_edots.V0.combiner_typeC p,
- count_idots.V0.combiner_typeC p,
- count_dots.V0.combiner_typeC p)
+ (p,count_edots.VT0.combiner_rec_typeC p,
+ count_idots.VT0.combiner_rec_typeC p,
+ count_dots.VT0.combiner_rec_typeC p)
| _ -> failwith "invalid alt"))
alts in
mkdisj match_typeC metavars alts e
(function b -> function mv_b ->
- (instantiate b mv_b).V0.rebuilder_typeC)
+ (instantiate b mv_b).VT0.rebuilder_rec_typeC)
(function t -> Ast0.TypeCTag t)
- make_disj_type make_minus.V0.rebuilder_typeC
- (rebuild_mcode start_line).V0.rebuilder_typeC
+ 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
- | _ -> ([],e)
+ (function x ->
+ match Ast0.unwrap x with Ast0.MetaType _ -> false | _ -> true)
+ | _ -> (0,[],e)
let transform_expr (metavars,alts,name) e =
let process update_others =
(* start line is given to any leaves in the iso code *)
- let start_line = Some ((Ast0.get_info e).Ast0.line_start) in
+ let start_line =
+ Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in
let alts =
List.map
(List.map
(function
Ast0.ExprTag(p) | Ast0.ArgExprTag(p) | Ast0.TestExprTag(p) ->
- (p,count_edots.V0.combiner_expression p,
- count_idots.V0.combiner_expression p,
- count_dots.V0.combiner_expression p)
+ (p,count_edots.VT0.combiner_rec_expression p,
+ count_idots.VT0.combiner_rec_expression p,
+ count_dots.VT0.combiner_rec_expression p)
| _ -> failwith "invalid alt"))
alts in
mkdisj match_expr metavars alts e
(function b -> function mv_b ->
- (instantiate b mv_b).V0.rebuilder_expression)
+ (instantiate b mv_b).VT0.rebuilder_rec_expression)
(function e -> Ast0.ExprTag e)
(make_disj_expr e)
- make_minus.V0.rebuilder_expression
- (rebuild_mcode start_line).V0.rebuilder_expression
- name Unparse_ast0.expression extra_copy_other_plus update_others in
+ make_minus.VT0.rebuilder_rec_expression
+ (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)
+ 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
- | _ -> ([],e)
+ | _ -> (0,[],e)
let transform_decl (metavars,alts,name) e =
match alts with
(Ast0.DeclTag(_)::_)::_ ->
(* start line is given to any leaves in the iso code *)
- let start_line = Some (Ast0.get_info e).Ast0.line_start in
+ let start_line =
+ Some (Ast0.get_info e).Ast0.pos_info.Ast0.line_start in
let alts =
List.map
(List.map
(function
Ast0.DeclTag(p) ->
- (p,count_edots.V0.combiner_declaration p,
- count_idots.V0.combiner_declaration p,
- count_dots.V0.combiner_declaration p)
+ (p,count_edots.VT0.combiner_rec_declaration p,
+ count_idots.VT0.combiner_rec_declaration p,
+ count_dots.VT0.combiner_rec_declaration p)
| _ -> failwith "invalid alt"))
alts in
mkdisj match_decl metavars alts e
(function b -> function mv_b ->
- (instantiate b mv_b).V0.rebuilder_declaration)
+ (instantiate b mv_b).VT0.rebuilder_rec_declaration)
(function d -> Ast0.DeclTag d)
make_disj_decl
- make_minus.V0.rebuilder_declaration
- (rebuild_mcode start_line).V0.rebuilder_declaration
+ make_minus.VT0.rebuilder_rec_declaration
+ (rebuild_mcode start_line).VT0.rebuilder_rec_declaration
name Unparse_ast0.declaration extra_copy_other_plus do_nothing
- | _ -> ([],e)
+ (function _ -> true (* no metavars *))
+ | _ -> (0,[],e)
let transform_stmt (metavars,alts,name) e =
match alts with
(Ast0.StmtTag(_)::_)::_ ->
(* start line is given to any leaves in the iso code *)
- let start_line = Some (Ast0.get_info e).Ast0.line_start in
+ let start_line =
+ Some (Ast0.get_info e).Ast0.pos_info.Ast0.line_start in
let alts =
List.map
(List.map
(function
Ast0.StmtTag(p) ->
- (p,count_edots.V0.combiner_statement p,
- count_idots.V0.combiner_statement p,
- count_dots.V0.combiner_statement p)
+ (p,count_edots.VT0.combiner_rec_statement p,
+ count_idots.VT0.combiner_rec_statement p,
+ count_dots.VT0.combiner_rec_statement p)
| _ -> failwith "invalid alt"))
alts in
mkdisj match_statement metavars alts e
(function b -> function mv_b ->
- (instantiate b mv_b).V0.rebuilder_statement)
+ (instantiate b mv_b).VT0.rebuilder_rec_statement)
(function s -> Ast0.StmtTag s)
- make_disj_stmt make_minus.V0.rebuilder_statement
- (rebuild_mcode start_line).V0.rebuilder_statement
+ 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
- | _ -> ([],e)
+ (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 *)
let transform_top (metavars,alts,name) e =
| _ -> raise (Failure ""))
| _ -> raise (Failure "")))
alts in
- let (mv,s) = transform_stmt (metavars,strip alts,name) declstm in
- (mv,Ast0.rewrap e (Ast0.DECL(s)))
- with Failure _ -> ([],e))
+ let (count,mv,s) = transform_stmt (metavars,strip alts,name) declstm in
+ (count,mv,Ast0.rewrap e (Ast0.DECL(s)))
+ with Failure _ -> (0,[],e))
| Ast0.CODE(stmts) ->
- let (mv,res) =
+ let (count,mv,res) =
match alts with
(Ast0.DotsStmtTag(_)::_)::_ ->
(* start line is given to any leaves in the iso code *)
- let start_line = Some ((Ast0.get_info e).Ast0.line_start) in
+ let start_line =
+ Some ((Ast0.get_info e).Ast0.pos_info.Ast0.line_start) in
let alts =
List.map
(List.map
(function
Ast0.DotsStmtTag(p) ->
- (p,count_edots.V0.combiner_statement_dots p,
- count_idots.V0.combiner_statement_dots p,
- count_dots.V0.combiner_statement_dots p)
+ (p,count_edots.VT0.combiner_rec_statement_dots p,
+ count_idots.VT0.combiner_rec_statement_dots p,
+ count_dots.VT0.combiner_rec_statement_dots p)
| _ -> failwith "invalid alt"))
alts in
mkdisj match_statement_dots metavars alts stmts
(function b -> function mv_b ->
- (instantiate b mv_b).V0.rebuilder_statement_dots)
+ (instantiate b mv_b).VT0.rebuilder_rec_statement_dots)
(function s -> Ast0.DotsStmtTag s)
(function x ->
Ast0.rewrap e (Ast0.DOTS([make_disj_stmt_list x])))
(function x ->
- make_minus.V0.rebuilder_statement_dots x)
- (rebuild_mcode start_line).V0.rebuilder_statement_dots
+ 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
- | _ -> ([],stmts) in
- (mv,Ast0.rewrap e (Ast0.CODE res))
- | _ -> ([],e)
+ (function _ -> true)
+ | _ -> (0,[],stmts) in
+ (count,mv,Ast0.rewrap e (Ast0.CODE res))
+ | _ -> (0,[],e)
(* --------------------------------------------------------------------- *)
let transform (alts : isomorphism) t =
(* the following ugliness is because rebuilder only returns a new term *)
let extra_meta_decls = ref ([] : Ast_cocci.metavar list) in
- let mcode x = x in
- let donothing r k e = k e in
+ let in_limit n = function
+ None -> true
+ | Some n1 ->
+ n < n1 or
+ ((if !Flag_parsing_cocci.show_iso_failures
+ then Common.pr2_once "execeeded iso threshold, see -iso_limit option");
+ false) in
+ let bind x y = x + y in
+ let option_default = 0 in
let exprfn r k e =
- let (extra_meta,exp) = transform_expr alts (k e) in
- extra_meta_decls := extra_meta @ !extra_meta_decls;
- exp in
+ let (e_count,e) = k e in
+ if in_limit e_count !Flag_parsing_cocci.iso_limit
+ then
+ let (count,extra_meta,exp) = transform_expr alts e in
+ extra_meta_decls := extra_meta @ !extra_meta_decls;
+ (bind count e_count,exp)
+ else (e_count,e) in
let declfn r k e =
- let (extra_meta,dec) = transform_decl alts (k e) in
- extra_meta_decls := extra_meta @ !extra_meta_decls;
- dec in
+ let (e_count,e) = k e in
+ if in_limit e_count !Flag_parsing_cocci.iso_limit
+ then
+ let (count,extra_meta,dec) = transform_decl alts e in
+ extra_meta_decls := extra_meta @ !extra_meta_decls;
+ (bind count e_count,dec)
+ else (e_count,e) in
let stmtfn r k e =
- let (extra_meta,stm) = transform_stmt alts (k e) in
- extra_meta_decls := extra_meta @ !extra_meta_decls;
- stm in
+ let (e_count,e) = k e in
+ if in_limit e_count !Flag_parsing_cocci.iso_limit
+ then
+ let (count,extra_meta,stm) = transform_stmt alts e in
+ extra_meta_decls := extra_meta @ !extra_meta_decls;
+ (bind count e_count,stm)
+ else (e_count,e) in
let typefn r k e =
- let continue =
- match Ast0.unwrap e with
- Ast0.Signed(signb,tyb) ->
+ let (continue,e_count,e) =
+ match Ast0.unwrap e with
+ Ast0.Signed(signb,tyb) ->
(* Hack! How else to prevent iso from applying under an
unsigned??? *)
- e
- | _ -> k e in
- let (extra_meta,ty) = transform_type alts continue in
- extra_meta_decls := extra_meta @ !extra_meta_decls;
- ty in
+ (true,0,e)
+ | _ ->
+ let (e_count,e) = k e in
+ if in_limit e_count !Flag_parsing_cocci.iso_limit
+ then (true,e_count,e)
+ else (false,e_count,e) in
+ if continue
+ then
+ let (count,extra_meta,ty) = transform_type alts e in
+ extra_meta_decls := extra_meta @ !extra_meta_decls;
+ (bind count e_count,ty)
+ else (e_count,e) in
let topfn r k e =
- let (extra_meta,ty) = transform_top alts (k e) in
- extra_meta_decls := extra_meta @ !extra_meta_decls;
- ty in
+ let (e_count,e) = k e in
+ if in_limit e_count !Flag_parsing_cocci.iso_limit
+ then
+ let (count,extra_meta,ty) = transform_top alts e in
+ extra_meta_decls := extra_meta @ !extra_meta_decls;
+ (bind count e_count,ty)
+ else (e_count,e) in
let res =
- V0.rebuilder
- mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
- donothing donothing donothing donothing donothing donothing
- donothing exprfn typefn donothing donothing declfn stmtfn
- donothing topfn in
- let res = res.V0.rebuilder_top_level t in
+ V0.combiner_rebuilder bind option_default
+ {V0.combiner_rebuilder_functions with
+ VT0.combiner_rebuilder_exprfn = exprfn;
+ VT0.combiner_rebuilder_tyfn = typefn;
+ VT0.combiner_rebuilder_declfn = declfn;
+ VT0.combiner_rebuilder_stmtfn = stmtfn;
+ VT0.combiner_rebuilder_topfn = topfn} in
+ let (_,res) = res.VT0.top_level t in
(!extra_meta_decls,res)
(* --------------------------------------------------------------------- *)
(* 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.rebuilder
+ V0.flat_rebuilder
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
let rewrap_anything = function
Ast0.DotsExprTag(d) ->
- Ast0.DotsExprTag(rewrap.V0.rebuilder_expression_dots d)
+ Ast0.DotsExprTag(rewrap.VT0.rebuilder_rec_expression_dots d)
| Ast0.DotsInitTag(d) ->
- Ast0.DotsInitTag(rewrap.V0.rebuilder_initialiser_list d)
+ Ast0.DotsInitTag(rewrap.VT0.rebuilder_rec_initialiser_list d)
| Ast0.DotsParamTag(d) ->
- Ast0.DotsParamTag(rewrap.V0.rebuilder_parameter_list d)
+ Ast0.DotsParamTag(rewrap.VT0.rebuilder_rec_parameter_list d)
| Ast0.DotsStmtTag(d) ->
- Ast0.DotsStmtTag(rewrap.V0.rebuilder_statement_dots d)
+ Ast0.DotsStmtTag(rewrap.VT0.rebuilder_rec_statement_dots d)
| Ast0.DotsDeclTag(d) ->
- Ast0.DotsDeclTag(rewrap.V0.rebuilder_declaration_dots d)
+ Ast0.DotsDeclTag(rewrap.VT0.rebuilder_rec_declaration_dots d)
| Ast0.DotsCaseTag(d) ->
- Ast0.DotsCaseTag(rewrap.V0.rebuilder_case_line_dots d)
- | Ast0.IdentTag(d) -> Ast0.IdentTag(rewrap.V0.rebuilder_ident d)
- | Ast0.ExprTag(d) -> Ast0.ExprTag(rewrap.V0.rebuilder_expression d)
- | Ast0.ArgExprTag(d) -> Ast0.ArgExprTag(rewrap.V0.rebuilder_expression d)
- | Ast0.TestExprTag(d) -> Ast0.TestExprTag(rewrap.V0.rebuilder_expression d)
- | Ast0.TypeCTag(d) -> Ast0.TypeCTag(rewrap.V0.rebuilder_typeC d)
- | Ast0.InitTag(d) -> Ast0.InitTag(rewrap.V0.rebuilder_initialiser d)
- | Ast0.ParamTag(d) -> Ast0.ParamTag(rewrap.V0.rebuilder_parameter d)
- | Ast0.DeclTag(d) -> Ast0.DeclTag(rewrap.V0.rebuilder_declaration d)
- | Ast0.StmtTag(d) -> Ast0.StmtTag(rewrap.V0.rebuilder_statement d)
- | Ast0.CaseLineTag(d) -> Ast0.CaseLineTag(rewrap.V0.rebuilder_case_line d)
- | Ast0.TopTag(d) -> Ast0.TopTag(rewrap.V0.rebuilder_top_level d)
+ Ast0.DotsCaseTag(rewrap.VT0.rebuilder_rec_case_line_dots d)
+ | Ast0.IdentTag(d) -> Ast0.IdentTag(rewrap.VT0.rebuilder_rec_ident d)
+ | Ast0.ExprTag(d) -> Ast0.ExprTag(rewrap.VT0.rebuilder_rec_expression d)
+ | Ast0.ArgExprTag(d) ->
+ Ast0.ArgExprTag(rewrap.VT0.rebuilder_rec_expression d)
+ | Ast0.TestExprTag(d) ->
+ Ast0.TestExprTag(rewrap.VT0.rebuilder_rec_expression d)
+ | Ast0.TypeCTag(d) -> Ast0.TypeCTag(rewrap.VT0.rebuilder_rec_typeC d)
+ | Ast0.InitTag(d) -> Ast0.InitTag(rewrap.VT0.rebuilder_rec_initialiser 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.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)
(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
HCoop / bpt / coccinelle.git / blobdiff