- | [false,_ as a],[false,b2 as b] ->
- if path (true,b2) a then (raise (Failure "universe inconsistency"));
- leq_constraints := (a,b) :: !leq_constraints
- | _ -> assert false
+ | [false,a2],[false,b2] ->
+ if not (le_path_uri [] strict a2 b2) then (
+ if le_path_uri [] (not strict) b2 a2 then
+ (raise(BadConstraint(lazy("universe inconsistency adding "^pp_constraint strict a2 b2
+ ^ " to:\n" ^ pp_constraints ()))));
+ universes := a2 :: b2 ::
+ List.filter (fun x -> not (NUri.eq x a2 || NUri.eq x b2)) !universes;
+ le_constraints := (strict,a2,b2) :: !le_constraints)
+ | _ -> raise (BadConstraint
+ (lazy "trying to add a constraint on an inferred universe"))
+;;
+
+let sup l =
+ match l with
+ | [false,_] -> Some l
+ | l ->
+ let bigger_than acc (s1,n1) = List.filter (le_path_uri [] s1 n1) acc in
+ let solutions = List.fold_left bigger_than !universes l in
+ let rec aux = function
+ | [] -> None
+ | u :: tl ->
+ if List.exists (fun x -> le_path_uri [] true x u) solutions then aux tl
+ else Some [false,u]
+ in
+ aux solutions