Do not wrap FProd return types in a closure.

There is little point to this as the type is dependent on an open value and
is never computed further.

1 files changed, 10 insertions, 7 deletions

diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 7e73609996..0679fc30d7 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -300,7 +300,7 @@ and fterm =
   | FCoFix of cofixpoint * fconstr subs
   | FCaseT of case_info * constr * fconstr * constr array * fconstr subs (* predicate and branches are closures *)
   | FLambda of int * (Name.t * constr) list * constr * fconstr subs
-  | FProd of Name.t * fconstr * fconstr
+  | FProd of Name.t * constr * constr * fconstr subs
   | FLetIn of Name.t * fconstr * fconstr * constr * fconstr subs
   | FEvar of existential * fconstr subs
   | FLIFT of int * fconstr
@@ -584,9 +584,12 @@ let rec to_constr lfts v =
         let tys = List.mapi (fun i (na, c) -> na, subst_constr (subs_liftn i subs) c) tys in
         let f = subst_constr (subs_liftn len subs) f in
         Term.compose_lam (List.rev tys) f
-    | FProd (n,t,c)   ->
-        mkProd (n, to_constr lfts t,
-                   to_constr (el_lift lfts) c)
+    | FProd (n, t, c, e) ->
+      if is_subs_id e && is_lift_id lfts then
+        mkProd (n, t, c)
+      else
+        let subs' = comp_subs lfts e in
+        mkProd (n, subst_constr subs' t, subst_constr (subs_lift subs') c)
     | FLetIn (n,b,t,f,e) ->
       let subs = comp_subs (el_lift lfts) (subs_lift e) in
         mkLetIn (n, to_constr lfts b,
@@ -869,7 +872,7 @@ and knht info e t stk =
     | CoFix cfx -> { norm = Cstr; term = FCoFix (cfx,e) }, stk
     | Lambda _ -> { norm = Cstr; term = mk_lambda e t }, stk
     | Prod (n, t, c) ->
-      { norm = Whnf; term = FProd (n, mk_clos e t, mk_clos (subs_lift e) c) }, stk
+      { norm = Whnf; term = FProd (n, t, c, e) }, stk
     | LetIn (n,b,t,c) ->
       { norm = Red; term = FLetIn (n, mk_clos e b, mk_clos e t, c, e) }, stk
     | Evar ev -> { norm = Red; term = FEvar (ev, e) }, stk
@@ -992,8 +995,8 @@ and norm_head info tab m =
       | FLetIn(na,a,b,f,e) ->
           let c = mk_clos (subs_lift e) f in
           mkLetIn(na, kl info tab a, kl info tab b, kl info tab c)
-      | FProd(na,dom,rng) ->
-          mkProd(na, kl info tab dom, kl info tab rng)
+      | FProd(na,dom,rng,e) ->
+          mkProd(na, kl info tab (mk_clos e dom), kl info tab (mk_clos (subs_lift e) rng))
       | FCoFix((n,(na,tys,bds)),e) ->
           let ftys = Array.Fun1.map mk_clos e tys in
           let fbds =