- transcript: patched to generate CoRN_notation.ma instead of CoRN.ma

[helm.git] / helm / software / components / cic / cicUniv.ml

diff --git a/helm/software/components/cic/cicUniv.ml b/helm/software/components/cic/cicUniv.ml
index 8ae118c9b1bb5ecf1d4c656ffcfb2bfb4ba15c86..d48772c27a40a0bea41d14eeb0e55de644fb1976 100644 (file)
--- a/helm/software/components/cic/cicUniv.ml
+++ b/helm/software/components/cic/cicUniv.ml
@@ -397,20 +397,22 @@ let add_gt fast u v b =
 (** Other real code                                                         **)
 (*****************************************************************************)
 
-exception UniverseInconsistency of string 
+exception UniverseInconsistency of string Lazy.t
 
 let error arc node1 closure_type node2 closure =
-  let s = "\n  ===== Universe Inconsistency detected =====\n\n" ^
-   "   Unable to add\n" ^ 
-   "\t" ^ (string_of_arc arc) ^ "\n" ^
-   "   cause\n" ^ 
-   "\t" ^ (string_of_universe node1) ^ "\n" ^
-   "   is in the " ^ closure_type ^ " closure\n" ^
-   "\t{" ^ (string_of_universe_set closure) ^ "}\n" ^ 
-   "   of\n" ^ 
-   "\t" ^ (string_of_universe node2) ^ "\n\n" ^
-   "  ===== Universe Inconsistency detected =====\n" in
-  prerr_endline s;
+  let s =
+   lazy
+    ("\n  ===== Universe Inconsistency detected =====\n\n" ^
+     "   Unable to add\n" ^ 
+     "\t" ^ (string_of_arc arc) ^ "\n" ^
+     "   cause\n" ^ 
+     "\t" ^ (string_of_universe node1) ^ "\n" ^
+     "   is in the " ^ closure_type ^ " closure\n" ^
+     "\t{" ^ (string_of_universe_set closure) ^ "}\n" ^ 
+     "   of\n" ^ 
+     "\t" ^ (string_of_universe node2) ^ "\n\n" ^
+     "  ===== Universe Inconsistency detected =====\n") in
+  prerr_endline (Lazy.force s);
   raise (UniverseInconsistency s)
 
 
@@ -554,6 +556,7 @@ let add_gt ?(fast=(!fast_implementation)) u v (b,already_contained) =
   end_spending ();
     rc,already_contained
     
+(* profiling code
 let profiler_eq = HExtlib.profile "CicUniv.add_eq"
 let profiler_ge = HExtlib.profile "CicUniv.add_ge"
 let profiler_gt = HExtlib.profile "CicUniv.add_gt"
@@ -563,6 +566,7 @@ let add_ge ?fast u v b =
   profiler_ge.HExtlib.profile (fun _ -> add_ge ?fast u v b) ()
 let add_eq ?fast u v b = 
   profiler_eq.HExtlib.profile (fun _ -> add_eq ?fast u v b) ()
+*)
 
 (*****************************************************************************)
 (** END: Decomment this for performance comparisons                         **)
@@ -600,10 +604,13 @@ let merge_ugraphs ~base_ugraph ~increment:(increment, uri_of_increment) =
     fst (merge_brutal increment base_ugraph), 
     UriManager.UriSet.add uri_of_increment already_contained
 
-let profiler_merge = HExtlib.profile "CicUniv.merge_graphs"
+(* profiling code; WARNING: the time spent during profiling can be
+   greater than the profiled time
+let profiler_merge = HExtlib.profile "CicUniv.merge_ugraphs"
 let merge_ugraphs ~base_ugraph ~increment =
   profiler_merge.HExtlib.profile 
   (fun _ -> merge_ugraphs ~base_ugraph ~increment) ()
+*)
 
 (*****************************************************************************)
 (** Xml sesialization and parsing                                           **)
@@ -942,7 +949,8 @@ let recons_graph (graph,uriset) =
 
 let assert_univ u =
     match u with 
-    | (_,None) -> raise (UniverseInconsistency "This universe graph has a hole")
+    | (_,None) ->
+       raise (UniverseInconsistency (lazy "This universe graph has a hole"))
     | _ -> ()
     
 let assert_univs_have_uri (graph,_) univlist =