aboutsummaryrefslogtreecommitdiff
path: root/pretyping
diff options
context:
space:
mode:
authorPierre-Marie Pédrot2017-03-22 19:06:54 +0100
committerPierre-Marie Pédrot2017-03-23 11:54:48 +0100
commit8cfe40dbc02156228a529c01190c50d825495013 (patch)
treef40da159fed52eb9db479180bd323d59ba9245df /pretyping
parent8b73fd7c6ce423f8c8a2594e90200f2407795d52 (diff)
Ensuring static invariants about handling of pending evars in Pretyping.
All functions where actually called with the second argument of the pending problem being the current evar map. We simply remove this useless and error-prone second component.
Diffstat (limited to 'pretyping')
-rw-r--r--pretyping/pretyping.ml10
-rw-r--r--pretyping/pretyping.mli4
-rw-r--r--pretyping/unification.ml4
-rw-r--r--pretyping/unification.mli4
4 files changed, 11 insertions, 11 deletions
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index f92110ea56..2e215b605d 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -333,8 +333,8 @@ let check_evars_are_solved env current_sigma frozen pending =
(* Try typeclasses, hooks, unification heuristics ... *)
-let solve_remaining_evars flags env current_sigma pending =
- let frozen,pending = frozen_and_pending_holes pending in
+let solve_remaining_evars flags env current_sigma init_sigma =
+ let frozen,pending = frozen_and_pending_holes (init_sigma, current_sigma) in
let evdref = ref current_sigma in
if flags.use_typeclasses then apply_typeclasses env evdref frozen false;
if Option.has_some flags.use_hook then
@@ -343,12 +343,12 @@ let solve_remaining_evars flags env current_sigma pending =
if flags.fail_evar then check_evars_are_solved env !evdref frozen pending;
!evdref
-let check_evars_are_solved env current_sigma pending =
- let frozen,pending = frozen_and_pending_holes pending in
+let check_evars_are_solved env current_sigma init_sigma =
+ let frozen,pending = frozen_and_pending_holes (init_sigma, current_sigma) in
check_evars_are_solved env current_sigma frozen pending
let process_inference_flags flags env initial_sigma (sigma,c) =
- let sigma = solve_remaining_evars flags env sigma (initial_sigma, sigma) in
+ let sigma = solve_remaining_evars flags env sigma initial_sigma in
let c = if flags.expand_evars then nf_evar sigma c else c in
sigma,c
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index 2c6aa7a21b..23957d5575 100644
--- a/pretyping/pretyping.mli
+++ b/pretyping/pretyping.mli
@@ -129,13 +129,13 @@ val type_uconstr :
[pending], however, it can contain more evars than the pending ones. *)
val solve_remaining_evars : inference_flags ->
- env -> (* initial map *) evar_map -> (* map to solve *) pending -> evar_map
+ env -> (* current map *) evar_map -> (* initial map *) evar_map -> evar_map
(** Checking evars and pending conversion problems are all solved,
reporting an appropriate error message *)
val check_evars_are_solved :
- env -> (* current map: *) evar_map -> (* map to check: *) pending -> unit
+ env -> (* current map: *) evar_map -> (* initial map: *) evar_map -> unit
(** [check_evars env initial_sigma extended_sigma c] fails if some
new unresolved evar remains in [c] *)
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index a91c30df6f..11771f7bac 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -1520,7 +1520,7 @@ let default_matching_merge_flags sigma =
use_pattern_unification = true;
}
-let default_matching_flags (sigma,_) =
+let default_matching_flags sigma =
let flags = default_matching_core_flags sigma in {
core_unify_flags = flags;
merge_unify_flags = default_matching_merge_flags sigma;
@@ -1658,7 +1658,7 @@ let make_abstraction_core name (test,out) env sigma c ty occs check_occs concl =
type prefix_of_inductive_support_flag = bool
type abstraction_request =
-| AbstractPattern of prefix_of_inductive_support_flag * (types -> bool) * Name.t * pending_constr * clause * bool
+| AbstractPattern of prefix_of_inductive_support_flag * (types -> bool) * Name.t * (evar_map * constr) * clause * bool
| AbstractExact of Name.t * constr * types option * clause * bool
type 'r abstraction_result =
diff --git a/pretyping/unification.mli b/pretyping/unification.mli
index 0ad882a9ff..c63502eae1 100644
--- a/pretyping/unification.mli
+++ b/pretyping/unification.mli
@@ -71,11 +71,11 @@ exception PatternNotFound
type prefix_of_inductive_support_flag = bool
type abstraction_request =
-| AbstractPattern of prefix_of_inductive_support_flag * (types -> bool) * Names.Name.t * pending_constr * Locus.clause * bool
+| AbstractPattern of prefix_of_inductive_support_flag * (types -> bool) * Names.Name.t * (evar_map * constr) * Locus.clause * bool
| AbstractExact of Names.Name.t * constr * types option * Locus.clause * bool
val finish_evar_resolution : ?flags:Pretyping.inference_flags ->
- env -> 'r Sigma.t -> pending_constr -> (constr, 'r) Sigma.sigma
+ env -> 'r Sigma.t -> (evar_map * constr) -> (constr, 'r) Sigma.sigma
type 'r abstraction_result =
Names.Id.t * named_context_val *