From 4f0397e0faf85e400e244c815de4780660652faa Mon Sep 17 00:00:00 2001
From: Enrico Tassi <enrico.tassi@inria.fr>
Date: Tue, 9 Dec 2008 18:26:18 +0000
Subject: [PATCH] better max function (instead of @) for combining universes

---
 .../components/ng_kernel/nCicEnvironment.ml      | 16 +++++++++++++++-
 .../components/ng_kernel/nCicEnvironment.mli     |  1 +
 .../components/ng_kernel/nCicTypeChecker.ml      |  3 ++-
 3 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/helm/software/components/ng_kernel/nCicEnvironment.ml b/helm/software/components/ng_kernel/nCicEnvironment.ml
index 0ddd3601d..9cad0554c 100644
--- a/helm/software/components/ng_kernel/nCicEnvironment.ml
+++ b/helm/software/components/ng_kernel/nCicEnvironment.ml
@@ -21,6 +21,12 @@ exception BadConstraint of string Lazy.t;;
 
 let type0 = []
 
+let max l1 l2 =
+ HExtlib.list_uniq ~eq:(fun (b1,u1) (b2,u2) -> b1=b2 && NUri.eq u1 u2)
+  (List.sort (fun (b1,u1) (b2,u2) ->
+    let res = compare b1 b2 in if res = 0 then NUri.compare u1 u2 else res)
+      (l1 @ l2))
+
 let le_constraints = ref [] (* strict,a,b *)
 
 let rec le_path_uri avoid strict a b =
@@ -41,7 +47,15 @@ let universe_leq a b =
      raise (BadConstraint
       (lazy "trying to check if a universe is less or equal than an inferred universe"))
 
-let universe_eq a b = universe_leq b a && universe_leq a b
+let universe_eq a b = 
+  match a,b with 
+  | [(false,_)], [(false,_)] -> universe_leq b a && universe_leq a b
+  | _, [(false,_)]
+  | [(false,_)],_ -> false
+  | _ ->
+     raise (BadConstraint
+      (lazy "trying to check if two inferred universes are equal"))
+;;
 
 let pp_constraint b x y =  
   NUri.name_of_uri x ^ (if b then " < " else " <= ") ^ NUri.name_of_uri y
diff --git a/helm/software/components/ng_kernel/nCicEnvironment.mli b/helm/software/components/ng_kernel/nCicEnvironment.mli
index 758b44be9..1c530061a 100644
--- a/helm/software/components/ng_kernel/nCicEnvironment.mli
+++ b/helm/software/components/ng_kernel/nCicEnvironment.mli
@@ -21,6 +21,7 @@ val get_checked_obj: NUri.uri -> NCic.obj
 val get_relevance: NReference.reference -> bool list
 
 val type0: NCic.universe
+val max: NCic.universe -> NCic.universe -> NCic.universe
 (* universe_* raise BadConstraints if the second arg. is an inferred universe *)
 val universe_eq: NCic.universe -> NCic.universe -> bool
 val universe_leq: NCic.universe -> NCic.universe -> bool
diff --git a/helm/software/components/ng_kernel/nCicTypeChecker.ml b/helm/software/components/ng_kernel/nCicTypeChecker.ml
index c09b036b6..db449c16a 100644
--- a/helm/software/components/ng_kernel/nCicTypeChecker.ml
+++ b/helm/software/components/ng_kernel/nCicTypeChecker.ml
@@ -126,7 +126,8 @@ let sort_of_prod ~metasenv ~subst context (name,s) t (t1, t2) =
    let t2 = R.whd ~subst ((name,C.Decl s)::context) t2 in
    match t1, t2 with
    | C.Sort _, C.Sort C.Prop -> t2
-   | C.Sort (C.Type u1), C.Sort (C.Type u2) -> C.Sort (C.Type (u1@u2)) 
+   | C.Sort (C.Type u1), C.Sort (C.Type u2) ->
+      C.Sort (C.Type (NCicEnvironment.max u1 u2))
    | C.Sort C.Prop,C.Sort (C.Type _) -> t2
    | C.Meta (_,(_,(C.Irl 0 | C.Ctx []))), C.Sort _ -> t2
    | C.Meta (_,(_,(C.Irl 0 | C.Ctx []))), C.Meta (i,(_,(C.Irl 0 | C.Ctx [])))
-- 
2.39.2