better max function (instead of @) for combining universes

diff --git a/helm/software/components/ng_kernel/nCicEnvironment.ml b/helm/software/components/ng_kernel/nCicEnvironment.ml
index 0ddd3601db02f4502f0cc0d9780adaff6b74584a..9cad0554cea2381845aaf63a654e008507481dbb 100644 (file)
--- 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 758b44be90b8c62096e32e851ad636eef906fde3..1c530061a469b9cb7e459d13f9e00230dd77d1a6 100644 (file)
--- 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 c09b036b67b21a9e93675cd6bb07eab59b02a81f..db449c16aaa2cabbd0427003f137d5f05c2059b2 100644 (file)
--- 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 [])))