diff options
| author |  Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2016-10-02 15:45:17 +0200 |
|---|---|---|
| committer | Pierre-Marie Pédrot <pierre-marie.pedrot@inria.fr> | 2016-10-02 15:47:09 +0200 |
| commit | b46020a6ea52d77b49a12e6891575b3516b8d766 (patch) | |
| tree | bf1fe9bc6d70ac44111f755dca30ed3c4d90b286 /pretyping | |
| parent | d02c9c566c58e566a1453827038f2b49b695c0a5 (diff) | |
| parent | decdd5b3cc322936f7d1e7cc3bb363a2957d404e (diff) | |
Merge branch 'v8.6'
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/pretyping.ml | 6 | ||||
| -rw-r--r-- | pretyping/pretyping.mli | 4 | ||||
| -rw-r--r-- | pretyping/reductionops.ml | 7 |
3 files changed, 9 insertions, 8 deletions
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml index aee3405f0..1602f4262 100644 --- a/pretyping/pretyping.ml +++ b/pretyping/pretyping.ml @@ -239,10 +239,12 @@ let interp_elimination_sort = function | GSet -> InSet | GType _ -> InType +type inference_hook = env -> evar_map -> evar -> evar_map * constr + type inference_flags = { use_typeclasses : bool; use_unif_heuristics : bool; - use_hook : (env -> evar_map -> evar -> constr) option; + use_hook : inference_hook option; fail_evar : bool; expand_evars : bool } @@ -272,7 +274,7 @@ let apply_inference_hook hook evdref pending = if Evd.is_undefined sigma evk (* in particular not defined by side-effect *) then try - let c = hook sigma evk in + let sigma, c = hook sigma evk in Evd.define evk c sigma with Exit -> sigma diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli index f015813af..e09648ec3 100644 --- a/pretyping/pretyping.mli +++ b/pretyping/pretyping.mli @@ -47,10 +47,12 @@ val empty_lvar : ltac_var_map type glob_constr_ltac_closure = ltac_var_map * glob_constr type pure_open_constr = evar_map * constr +type inference_hook = env -> evar_map -> evar -> evar_map * constr + type inference_flags = { use_typeclasses : bool; use_unif_heuristics : bool; - use_hook : (env -> evar_map -> evar -> constr) option; + use_hook : inference_hook option; fail_evar : bool; expand_evars : bool } diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml index 494d27178..0ab941b34 100644 --- a/pretyping/reductionops.ml +++ b/pretyping/reductionops.ml @@ -166,9 +166,6 @@ module Cst_stack = struct let empty = [] let is_empty = CList.is_empty - let sanity x y = - assert(Term.eq_constr x y) - let drop_useless = function | _ :: ((_,_,[])::_ as q) -> q | l -> l @@ -177,9 +174,9 @@ module Cst_stack = struct let append2cst = function | (c,params,[]) -> (c, h::params, []) | (c,params,((i,t)::q)) when i = pred (Array.length t) -> - let () = sanity h t.(i) in (c, params, q) + (c, params, q) | (c,params,(i,t)::q) -> - let () = sanity h t.(i) in (c, params, (succ i,t)::q) + (c, params, (succ i,t)::q) in drop_useless (List.map append2cst cst_l) |