diff options
| author | Gaëtan Gilbert | 2020-02-06 17:52:29 +0100 |
|---|---|---|
| committer | Gaëtan Gilbert | 2020-02-06 21:17:56 +0100 |
| commit | af788fd0daeed459b98ed9acd3a0443f53666176 (patch) | |
| tree | 678a716ad9776d4acb93c5773d1bedb389949b83 /plugins | |
| parent | ebd1c087298a50f85d3f227452b8a3d1fb7a625c (diff) | |
unsafe_type_of -> type_of in Sequent.extend_with_auto_hints
+ fix evar leak in caller
Diffstat (limited to 'plugins')
| -rw-r--r-- | plugins/firstorder/g_ground.mlg | 2 | ||||
| -rw-r--r-- | plugins/firstorder/sequent.ml | 36 |
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= |
