X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fcomponents%2Fng_kernel%2FnCicEnvironment.ml;h=f31c4e9b1ebbc71416ced0dbbc120e4bf60c7448;hb=718d9bcfb53dd76a5c0622aff9fed69a68769324;hp=0ddd3601db02f4502f0cc0d9780adaff6b74584a;hpb=1ee5193677b8e2a80d4f068ee79ecac335de1196;p=helm.git diff --git a/helm/software/components/ng_kernel/nCicEnvironment.ml b/helm/software/components/ng_kernel/nCicEnvironment.ml index 0ddd3601d..f31c4e9b1 100644 --- a/helm/software/components/ng_kernel/nCicEnvironment.ml +++ b/helm/software/components/ng_kernel/nCicEnvironment.ml @@ -16,11 +16,17 @@ module Ref = NReference 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 = @@ -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 @@ -126,11 +140,12 @@ let get_checked_obj u = 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