From 55ce117e8083477593cf1ff2e51a3641c7973830 Mon Sep 17 00:00:00 2001 From: Samuel Mimram Date: Tue, 13 Feb 2007 13:48:12 +0000 Subject: Imported Upstream version 8.1+dfsg --- kernel/environ.ml | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) (limited to 'kernel/environ.ml') diff --git a/kernel/environ.ml b/kernel/environ.ml index e73f5848..87a6e485 100644 --- a/kernel/environ.ml +++ b/kernel/environ.ml @@ -6,7 +6,7 @@ (* * GNU Lesser General Public License Version 2.1 *) (************************************************************************) -(* $Id: environ.ml 9201 2006-10-03 16:47:40Z notin $ *) +(* $Id: environ.ml 9573 2007-01-31 20:18:18Z notin $ *) open Util open Names @@ -241,9 +241,9 @@ let global_vars_set env constr = let rec filtrec acc c = let vl = vars_of_global env c in let acc = List.fold_right Idset.add vl acc in - fold_constr filtrec acc c + fold_constr filtrec acc c in - filtrec Idset.empty constr + filtrec Idset.empty constr (* like [global_vars] but don't get through evars *) let global_vars_set_drop_evar env constr = @@ -339,18 +339,6 @@ type unsafe_type_judgment = { let compile_constant_body = Cbytegen.compile_constant_body -(*s Special functions for the refiner (logic.ml) *) - -let clear_hyps ids check (ctxt,vals) = - let ctxt,vals,rmv = - List.fold_right2 (fun (id,_,_ as d) v (ctxt,vals,rmv) -> - if List.mem id ids then (ctxt,vals,id::rmv) - else begin - check rmv d; - (d::ctxt,v::vals,rmv) - end) ctxt vals ([],[],[]) - in ((ctxt,vals),rmv) - exception Hyp_not_found let rec apply_to_hyp (ctxt,vals) id f = @@ -393,3 +381,16 @@ let insert_after_hyp (ctxt,vals) id d check = | [],[] -> raise Hyp_not_found | _, _ -> assert false in aux ctxt vals + +(* To be used in Logic.clear_hyps *) +let remove_hyps ids check (ctxt, vals) = + let ctxt,vals,rmv = + List.fold_right2 (fun (id,_,_ as d) v (ctxt,vals,rmv) -> + if List.mem id ids then + (ctxt,vals,id::rmv) + else + let nd = check d in + (nd::ctxt,v::vals,rmv)) + ctxt vals ([],[],[]) + in ((ctxt,vals),rmv) + -- cgit v1.2.3