aboutsummaryrefslogtreecommitdiff
path: root/pretyping
diff options
context:
space:
mode:
authorGaëtan Gilbert2020-02-27 14:06:16 +0100
committerGaëtan Gilbert2020-03-31 14:39:43 +0200
commit699152de685ba5e2dc05fd6248b17c3139987bb7 (patch)
tree63cd99709c431fc6cb73886622bff9f22457be9e /pretyping
parentf19cf4259f63a9c0392c922527e0e9002192949e (diff)
Try only using TC for conversion in cominductive (not great but let's see)
Diffstat (limited to 'pretyping')
-rw-r--r--pretyping/pretyping.ml24
-rw-r--r--pretyping/pretyping.mli4
2 files changed, 18 insertions, 10 deletions
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index 52122c09df..015c26531a 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -189,8 +189,10 @@ let interp_sort_info ?loc evd l =
type inference_hook = env -> evar_map -> Evar.t -> (evar_map * constr) option
+type use_typeclasses = NoUseTC | UseTCForConv | UseTC
+
type inference_flags = {
- use_typeclasses : bool;
+ use_typeclasses : use_typeclasses;
solve_unification_constraints : bool;
fail_evar : bool;
expand_evars : bool;
@@ -312,9 +314,9 @@ let solve_remaining_evars ?hook flags env ?initial sigma =
let program_mode = flags.program_mode in
let frozen = frozen_and_pending_holes (initial, sigma) in
let sigma =
- if flags.use_typeclasses
- then apply_typeclasses ~fail_evar:false ~program_mode env sigma frozen
- else sigma
+ match flags.use_typeclasses with
+ | UseTC -> apply_typeclasses ~program_mode ~fail_evar:false env sigma frozen
+ | NoUseTC | UseTCForConv -> sigma
in
let sigma = match hook with
| None -> sigma
@@ -1287,21 +1289,25 @@ let ise_pretype_gen flags env sigma lvar kind c =
if program_mode then ProgramNaming else KeepUserNameAndRenameExistingButSectionNames
in
let env = GlobEnv.make ~hypnaming env sigma lvar in
+ let use_tc = match flags.use_typeclasses with
+ | NoUseTC -> false
+ | UseTC | UseTCForConv -> true
+ in
let sigma', c', c'_ty = match kind with
| WithoutTypeConstraint | UnknownIfTermOrType ->
- let sigma, j = pretype ~program_mode ~poly flags.use_typeclasses empty_tycon env sigma c in
+ let sigma, j = pretype ~program_mode ~poly use_tc empty_tycon env sigma c in
sigma, j.uj_val, j.uj_type
| OfType exptyp ->
- let sigma, j = pretype ~program_mode ~poly flags.use_typeclasses (mk_tycon exptyp) env sigma c in
+ let sigma, j = pretype ~program_mode ~poly use_tc (mk_tycon exptyp) env sigma c in
sigma, j.uj_val, j.uj_type
| IsType ->
- let sigma, tj = pretype_type ~program_mode ~poly flags.use_typeclasses empty_valcon env sigma c in
+ let sigma, tj = pretype_type ~program_mode ~poly use_tc empty_valcon env sigma c in
sigma, tj.utj_val, mkSort tj.utj_type
in
process_inference_flags flags !!env sigma (sigma',c',c'_ty)
let default_inference_flags fail = {
- use_typeclasses = true;
+ use_typeclasses = UseTC;
solve_unification_constraints = true;
fail_evar = fail;
expand_evars = true;
@@ -1310,7 +1316,7 @@ let default_inference_flags fail = {
}
let no_classes_no_fail_inference_flags = {
- use_typeclasses = false;
+ use_typeclasses = NoUseTC;
solve_unification_constraints = true;
fail_evar = false;
expand_evars = true;
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index abbb745161..3396c5a0e7 100644
--- a/pretyping/pretyping.mli
+++ b/pretyping/pretyping.mli
@@ -44,8 +44,10 @@ type typing_constraint =
| OfType of types (** A term of the expected type *)
| WithoutTypeConstraint (** A term of unknown expected type *)
+type use_typeclasses = NoUseTC | UseTCForConv | UseTC
+
type inference_flags = {
- use_typeclasses : bool;
+ use_typeclasses : use_typeclasses;
solve_unification_constraints : bool;
fail_evar : bool;
expand_evars : bool;