diff options
| author | Maxime Dénès | 2015-10-08 18:06:55 +0200 |
|---|---|---|
| committer | Maxime Dénès | 2015-10-15 14:36:30 +0200 |
| commit | 3116aeff0cdc51e6801f3e8ae4a6c0533e1a75ac (patch) | |
| tree | b6b33c6c6167656b1ca9799407eeb56aa1de749f /pretyping/reductionops.ml | |
| parent | d08aa6b4f742a7162e726920810765258802c176 (diff) | |
Fix #4346 1/2: native casts were not inferring universe constraints.
Diffstat (limited to 'pretyping/reductionops.ml')
| -rw-r--r-- | pretyping/reductionops.ml | 11 |
1 files changed, 7 insertions, 4 deletions
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml index dc70f36ccf..a24773b6e6 100644 --- a/pretyping/reductionops.ml +++ b/pretyping/reductionops.ml @@ -1295,8 +1295,8 @@ let sigma_univ_state = { Reduction.compare = sigma_compare_sorts; Reduction.compare_instances = sigma_compare_instances } -let infer_conv ?(catch_incon=true) ?(pb=Reduction.CUMUL) ?(ts=full_transparent_state) - env sigma x y = +let infer_conv_gen conv_fun ?(catch_incon=true) ?(pb=Reduction.CUMUL) + ?(ts=full_transparent_state) env sigma x y = try let b, sigma = let b, cstrs = @@ -1313,14 +1313,17 @@ let infer_conv ?(catch_incon=true) ?(pb=Reduction.CUMUL) ?(ts=full_transparent_s if b then sigma, true else let sigma' = - Reduction.generic_conv pb false (safe_evar_value sigma) ts + conv_fun pb ~l2r:false sigma ts env (sigma, sigma_univ_state) x y in sigma', true with | Reduction.NotConvertible -> sigma, false | Univ.UniverseInconsistency _ when catch_incon -> sigma, false | e when is_anomaly e -> error "Conversion test raised an anomaly" - + +let infer_conv = infer_conv_gen (fun pb ~l2r sigma -> + Reduction.generic_conv pb ~l2r (safe_evar_value sigma)) + (********************************************************************) (* Special-Purpose Reduction *) (********************************************************************) |