From a7b09ef087d82e0b733356e6f22dd5a79b967788 Mon Sep 17 00:00:00 2001 From: Gaëtan Gilbert Date: Wed, 22 Aug 2018 15:49:30 +0200 Subject: Fix #8291: print universe names in universe context for Check. --- vernac/vernacentries.ml | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) (limited to 'vernac') diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index 5258ab2ea4..e1228e9d78 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -1692,36 +1692,36 @@ let query_command_selector ?loc = function let vernac_check_may_eval ~atts redexp glopt rc = let glopt = query_command_selector ?loc:atts.loc glopt in let (sigma, env) = get_current_context_of_args glopt in - let sigma', c = interp_open_constr env sigma rc in - let sigma' = Evarconv.solve_unif_constraints_with_heuristics env sigma' in - Evarconv.check_problems_are_solved env sigma'; - let sigma' = Evd.minimize_universes sigma' in - let uctx = Evd.universe_context_set sigma' in - let env = Environ.push_context_set uctx (Evarutil.nf_env_evar sigma' env) in + let sigma, c = interp_open_constr env sigma rc in + let sigma = Evarconv.solve_unif_constraints_with_heuristics env sigma in + Evarconv.check_problems_are_solved env sigma; + let sigma = Evd.minimize_universes sigma in + let uctx = Evd.universe_context_set sigma in + let env = Environ.push_context_set uctx (Evarutil.nf_env_evar sigma env) in let j = - if Evarutil.has_undefined_evars sigma' c then - Evarutil.j_nf_evar sigma' (Retyping.get_judgment_of env sigma' c) + if Evarutil.has_undefined_evars sigma c then + Evarutil.j_nf_evar sigma (Retyping.get_judgment_of env sigma c) else - let c = EConstr.to_constr sigma' c in + let c = EConstr.to_constr sigma c in (* OK to call kernel which does not support evars *) Termops.on_judgment EConstr.of_constr (Arguments_renaming.rename_typing env c) in match redexp with | None -> - let evars_of_term c = Evarutil.undefined_evars_of_term sigma' c in + let evars_of_term c = Evarutil.undefined_evars_of_term sigma c in let l = Evar.Set.union (evars_of_term j.Environ.uj_val) (evars_of_term j.Environ.uj_type) in - let j = { j with Environ.uj_type = Reductionops.nf_betaiota env sigma' j.Environ.uj_type } in - print_judgment env sigma' j ++ - pr_ne_evar_set (fnl () ++ str "where" ++ fnl ()) (mt ()) sigma' l ++ + let j = { j with Environ.uj_type = Reductionops.nf_betaiota env sigma j.Environ.uj_type } in + print_judgment env sigma j ++ + pr_ne_evar_set (fnl () ++ str "where" ++ fnl ()) (mt ()) sigma l ++ Printer.pr_universe_ctx_set sigma uctx | Some r -> - let (sigma',r_interp) = Hook.get f_interp_redexp env sigma' r in + let (sigma,r_interp) = Hook.get f_interp_redexp env sigma r in let redfun env evm c = let (redfun, _) = reduction_of_red_expr env r_interp in let (_, c) = redfun env evm c in c in - print_eval redfun env sigma' rc j + print_eval redfun env sigma rc j let vernac_declare_reduction ~atts s r = let local = make_locality atts.locality in -- cgit v1.2.3 From 3aa3c4590ce7d32657cd48ea021254e4215e2889 Mon Sep 17 00:00:00 2001 From: Gaëtan Gilbert Date: Wed, 22 Aug 2018 16:40:16 +0200 Subject: Close #8091: print universe context for Eval when option on. --- vernac/vernacentries.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'vernac') diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml index e1228e9d78..41586eed8b 100644 --- a/vernac/vernacentries.ml +++ b/vernac/vernacentries.ml @@ -1706,14 +1706,13 @@ let vernac_check_may_eval ~atts redexp glopt rc = (* OK to call kernel which does not support evars *) Termops.on_judgment EConstr.of_constr (Arguments_renaming.rename_typing env c) in - match redexp with + let pp = match redexp with | None -> let evars_of_term c = Evarutil.undefined_evars_of_term sigma c in let l = Evar.Set.union (evars_of_term j.Environ.uj_val) (evars_of_term j.Environ.uj_type) in let j = { j with Environ.uj_type = Reductionops.nf_betaiota env sigma j.Environ.uj_type } in print_judgment env sigma j ++ - pr_ne_evar_set (fnl () ++ str "where" ++ fnl ()) (mt ()) sigma l ++ - Printer.pr_universe_ctx_set sigma uctx + pr_ne_evar_set (fnl () ++ str "where" ++ fnl ()) (mt ()) sigma l | Some r -> let (sigma,r_interp) = Hook.get f_interp_redexp env sigma r in let redfun env evm c = @@ -1722,6 +1721,8 @@ let vernac_check_may_eval ~atts redexp glopt rc = c in print_eval redfun env sigma rc j + in + pp ++ Printer.pr_universe_ctx_set sigma uctx let vernac_declare_reduction ~atts s r = let local = make_locality atts.locality in -- cgit v1.2.3