From f09ca438e24bc4016b4e778dd8fd4de4641b7636 Mon Sep 17 00:00:00 2001
From: filliatr
Date: Thu, 9 Dec 1999 09:59:27 +0000
Subject: Discharge (encore bugge)

git-svn-id: svn+ssh://scm.gforge.inria.fr/svn/coq/trunk@223 85f007b7-540e-0410-9357-904b9bb8a0f7
---
 kernel/typeops.ml  | 8 ++++++++
 kernel/typeops.mli | 2 ++
 2 files changed, 10 insertions(+)

(limited to 'kernel')

diff --git a/kernel/typeops.ml b/kernel/typeops.ml
index 46dd750781..5c2aa643b2 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -382,6 +382,14 @@ let sort_of_product domsort rangsort g =
            (* Product rule (Type_i,Type_i,Type_i) *) 
            | Type u1 -> let (u12,cst) = sup u1 u2 g in Type u12, cst)
 
+let sort_of_product_without_univ domsort rangsort =
+  match rangsort with
+    | Prop _ -> rangsort
+    | Type u2 ->
+        (match domsort with
+           | Prop _ -> rangsort
+           | Type u1 -> Type dummy_univ)
+
 let abs_rel env sigma name var j =
   let rngtyp = whd_betadeltaiota env sigma j.uj_kind in
   let cvar = incast_type var in
diff --git a/kernel/typeops.mli b/kernel/typeops.mli
index 9542dba9f8..20cec7273a 100644
--- a/kernel/typeops.mli
+++ b/kernel/typeops.mli
@@ -55,6 +55,8 @@ val gen_rel :
   env -> 'a evar_map -> name -> typed_type -> unsafe_judgment 
     -> unsafe_judgment * constraints
 
+val sort_of_product_without_univ : sorts -> sorts -> sorts
+
 val cast_rel : 
   env -> 'a evar_map -> unsafe_judgment -> unsafe_judgment 
     -> unsafe_judgment
-- 
cgit v1.2.3