Procedural: explicit flavour specification for constants is now working

[helm.git] / helm / software / components / ng_kernel / nCicEnvironment.ml

diff --git a/helm/software/components/ng_kernel/nCicEnvironment.ml b/helm/software/components/ng_kernel/nCicEnvironment.ml
index 57f130546d9ed4c5a663e88119fba719d6df2e7f..496ae54468471382ede458fc51fdd4c1bc0f96c4 100644 (file)
--- a/helm/software/components/ng_kernel/nCicEnvironment.ml
+++ b/helm/software/components/ng_kernel/nCicEnvironment.ml
@@ -43,12 +43,21 @@ let universe_leq a b =
 
 let universe_eq a b = universe_leq b a && universe_leq a b
 
+let pp_constraint b x y =  
+  NUri.name_of_uri x ^ (if b then " < " else " <= ") ^ NUri.name_of_uri y
+;;
+
+let pp_constraints () =
+  String.concat "\n" (List.map (fun (b,x,y) -> pp_constraint b x y) !le_constraints)
+;;
+
 let add_constraint strict a b = 
   match a,b with
   | [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")));
+         (raise(BadConstraint(lazy("universe inconsistency adding "^pp_constraint strict a2 b2
+           ^ " to:\n" ^ pp_constraints ()))));
         le_constraints := (strict,a2,b2) :: !le_constraints)
   | _ -> raise (BadConstraint
           (lazy "trying to add a constraint on an inferred universe"))