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.

---
 test-suite/output/UnivBinders.out | 15 +++++++++------
 test-suite/output/UnivBinders.v   |  3 +++
 vernac/vernacentries.ml           | 30 +++++++++++++++---------------
 3 files changed, 27 insertions(+), 21 deletions(-)

diff --git a/test-suite/output/UnivBinders.out b/test-suite/output/UnivBinders.out
index 6f41b2fcf9..66b2a12c60 100644
--- a/test-suite/output/UnivBinders.out
+++ b/test-suite/output/UnivBinders.out
@@ -48,6 +48,9 @@ Type@{Top.17} -> Type@{v} -> Type@{u}
 (* u Top.17 v |=  *)
 
 foo is universe polymorphic
+Type@{i} -> Type@{j}
+     : Type@{max(i+1,j+1)}
+(* {j i} |=  *)
 Monomorphic mono = Type@{mono.u}
      : Type@{mono.u+1}
 (* {mono.u} |=  *)
@@ -149,24 +152,24 @@ inmod@{u} -> Type@{v}
 (* u v |=  *)
 
 Applied.infunct is universe polymorphic
-axfoo@{i Top.44 Top.45} : Type@{Top.44} -> Type@{i}
-(* i Top.44 Top.45 |=  *)
+axfoo@{i Top.46 Top.47} : Type@{Top.46} -> Type@{i}
+(* i Top.46 Top.47 |=  *)
 
 axfoo is universe polymorphic
 Argument scope is [type_scope]
 Expands to: Constant Top.axfoo
-axbar@{i Top.44 Top.45} : Type@{Top.45} -> Type@{i}
-(* i Top.44 Top.45 |=  *)
+axbar@{i Top.46 Top.47} : Type@{Top.47} -> Type@{i}
+(* i Top.46 Top.47 |=  *)
 
 axbar is universe polymorphic
 Argument scope is [type_scope]
 Expands to: Constant Top.axbar
-axfoo' : Type@{Top.47} -> Type@{axbar'.i}
+axfoo' : Type@{Top.49} -> Type@{axbar'.i}
 
 axfoo' is not universe polymorphic
 Argument scope is [type_scope]
 Expands to: Constant Top.axfoo'
-axbar' : Type@{Top.47} -> Type@{axbar'.i}
+axbar' : Type@{Top.49} -> Type@{axbar'.i}
 
 axbar' is not universe polymorphic
 Argument scope is [type_scope]
diff --git a/test-suite/output/UnivBinders.v b/test-suite/output/UnivBinders.v
index c6efc240a6..c6a6b8231f 100644
--- a/test-suite/output/UnivBinders.v
+++ b/test-suite/output/UnivBinders.v
@@ -30,6 +30,9 @@ Unset Strict Universe Declaration.
    order of appearance. *)
 Definition foo@{u +} := Type -> Type@{v} -> Type@{u}.
 Print foo.
+
+Check Type@{i} -> Type@{j}.
+
 Set Strict Universe Declaration.
 
 (* Binders even work with monomorphic definitions! *)
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.

---
 test-suite/output/UnivBinders.out | 15 +++++++++------
 test-suite/output/UnivBinders.v   |  2 ++
 vernac/vernacentries.ml           |  7 ++++---
 3 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/test-suite/output/UnivBinders.out b/test-suite/output/UnivBinders.out
index 66b2a12c60..926114a1e1 100644
--- a/test-suite/output/UnivBinders.out
+++ b/test-suite/output/UnivBinders.out
@@ -50,6 +50,9 @@ Type@{Top.17} -> Type@{v} -> Type@{u}
 foo is universe polymorphic
 Type@{i} -> Type@{j}
      : Type@{max(i+1,j+1)}
+(* {j i} |=  *)
+     = Type@{i} -> Type@{j}
+     : Type@{max(i+1,j+1)}
 (* {j i} |=  *)
 Monomorphic mono = Type@{mono.u}
      : Type@{mono.u+1}
@@ -152,24 +155,24 @@ inmod@{u} -> Type@{v}
 (* u v |=  *)
 
 Applied.infunct is universe polymorphic
-axfoo@{i Top.46 Top.47} : Type@{Top.46} -> Type@{i}
-(* i Top.46 Top.47 |=  *)
+axfoo@{i Top.48 Top.49} : Type@{Top.48} -> Type@{i}
+(* i Top.48 Top.49 |=  *)
 
 axfoo is universe polymorphic
 Argument scope is [type_scope]
 Expands to: Constant Top.axfoo
-axbar@{i Top.46 Top.47} : Type@{Top.47} -> Type@{i}
-(* i Top.46 Top.47 |=  *)
+axbar@{i Top.48 Top.49} : Type@{Top.49} -> Type@{i}
+(* i Top.48 Top.49 |=  *)
 
 axbar is universe polymorphic
 Argument scope is [type_scope]
 Expands to: Constant Top.axbar
-axfoo' : Type@{Top.49} -> Type@{axbar'.i}
+axfoo' : Type@{Top.51} -> Type@{axbar'.i}
 
 axfoo' is not universe polymorphic
 Argument scope is [type_scope]
 Expands to: Constant Top.axfoo'
-axbar' : Type@{Top.49} -> Type@{axbar'.i}
+axbar' : Type@{Top.51} -> Type@{axbar'.i}
 
 axbar' is not universe polymorphic
 Argument scope is [type_scope]
diff --git a/test-suite/output/UnivBinders.v b/test-suite/output/UnivBinders.v
index c6a6b8231f..f806a9f4f7 100644
--- a/test-suite/output/UnivBinders.v
+++ b/test-suite/output/UnivBinders.v
@@ -33,6 +33,8 @@ Print foo.
 
 Check Type@{i} -> Type@{j}.
 
+Eval cbv in Type@{i} -> Type@{j}.
+
 Set Strict Universe Declaration.
 
 (* Binders even work with monomorphic definitions! *)
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