exception CircularDependency of string Lazy.t;;
exception ObjectNotFound of string Lazy.t;;
-exception BadDependency of string Lazy.t;;
+exception BadDependency of string Lazy.t * exn;;
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 =
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
Sys.Break as e ->
frozen_list := saved_frozen_list;
raise e
- | Propagate (u',_) as e' ->
+ | Propagate (u',old_exn) as e' ->
frozen_list := saved_frozen_list;
let exn = `Exn (BadDependency (lazy (NUri.string_of_uri u ^
" depends (recursively) on " ^ NUri.string_of_uri u' ^
- " which is not well-typed"))) in
+ " which is not well-typed"),
+ match old_exn with BadDependency (_,e) -> e | _ -> old_exn)) in
NUri.UriHash.add cache u exn;
if saved_frozen_list = [] then
exn