diff options
| author | Gaëtan Gilbert | 2020-02-27 14:06:16 +0100 |
|---|---|---|
| committer | Gaëtan Gilbert | 2020-03-31 14:39:43 +0200 |
| commit | 699152de685ba5e2dc05fd6248b17c3139987bb7 (patch) | |
| tree | 63cd99709c431fc6cb73886622bff9f22457be9e /pretyping | |
| parent | f19cf4259f63a9c0392c922527e0e9002192949e (diff) | |
Try only using TC for conversion in cominductive (not great but let's see)
Diffstat (limited to 'pretyping')
| -rw-r--r-- | pretyping/pretyping.ml | 24 | ||||
| -rw-r--r-- | pretyping/pretyping.mli | 4 |
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; |
