aboutsummaryrefslogtreecommitdiff
path: root/plugins/firstorder
diff options
context:
space:
mode:
authorGaëtan Gilbert2020-02-06 17:52:29 +0100
committerGaëtan Gilbert2020-02-06 21:17:56 +0100
commitaf788fd0daeed459b98ed9acd3a0443f53666176 (patch)
tree678a716ad9776d4acb93c5773d1bedb389949b83 /plugins/firstorder
parentebd1c087298a50f85d3f227452b8a3d1fb7a625c (diff)
unsafe_type_of -> type_of in Sequent.extend_with_auto_hints
+ fix evar leak in caller
Diffstat (limited to 'plugins/firstorder')
-rw-r--r--plugins/firstorder/g_ground.mlg2
-rw-r--r--plugins/firstorder/sequent.ml36
2 files changed, 19 insertions, 19 deletions
diff --git a/plugins/firstorder/g_ground.mlg b/plugins/firstorder/g_ground.mlg
index 8946587a02..9d208e1c86 100644
--- a/plugins/firstorder/g_ground.mlg
+++ b/plugins/firstorder/g_ground.mlg
@@ -88,7 +88,7 @@ let gen_ground_tac flag taco ids bases =
Proofview.Goal.enter begin fun gl ->
let seq=empty_seq !ground_depth in
let seq, sigma = extend_with_ref_list (pf_env gl) (project gl) ids seq in
- let seq, sigma = extend_with_auto_hints (pf_env gl) (project gl) bases seq in
+ let seq, sigma = extend_with_auto_hints (pf_env gl) sigma bases seq in
tclTHEN (Proofview.Unsafe.tclEVARS sigma) (k seq)
end
in
diff --git a/plugins/firstorder/sequent.ml b/plugins/firstorder/sequent.ml
index 7d84ee6851..65af123d9c 100644
--- a/plugins/firstorder/sequent.ml
+++ b/plugins/firstorder/sequent.ml
@@ -204,28 +204,28 @@ let extend_with_ref_list env sigma l seq =
open Hints
let extend_with_auto_hints env sigma l seq =
- let seqref=ref seq in
- let f p_a_t =
+ let f (seq,sigma) p_a_t =
match repr_hint p_a_t.code with
- Res_pf (c,_) | Give_exact (c,_)
- | Res_pf_THEN_trivial_fail (c,_) ->
- let (c, _, _) = c in
- (try
- let (gr, _) = Termops.global_of_constr sigma c in
- let typ=(Typing.unsafe_type_of env sigma c) in
- seqref:=add_formula env sigma Hint gr typ !seqref
- with Not_found->())
- | _-> () in
- let g _ _ l = List.iter f l in
- let h dbname=
- let hdb=
+ | Res_pf (c,_) | Give_exact (c,_)
+ | Res_pf_THEN_trivial_fail (c,_) ->
+ let (c, _, _) = c in
+ (try
+ let (gr, _) = Termops.global_of_constr sigma c in
+ let sigma, typ = Typing.type_of env sigma c in
+ add_formula env sigma Hint gr typ seq, sigma
+ with Not_found -> seq, sigma)
+ | _ -> seq, sigma
+ in
+ let h acc dbname =
+ let hdb =
try
searchtable_map dbname
with Not_found->
- user_err Pp.(str ("Firstorder: "^dbname^" : No such Hint database")) in
- Hint_db.iter g hdb in
- List.iter h l;
- !seqref, sigma (*FIXME: forgetting about universes*)
+ user_err Pp.(str ("Firstorder: "^dbname^" : No such Hint database"))
+ in
+ Hint_db.fold (fun _ _ l acc -> List.fold_left f acc l) hdb acc
+ in
+ List.fold_left h (seq,sigma) l
let print_cmap map=
let print_entry c l s=