]> matita.cs.unibo.it Git - helm.git/commitdiff
added orrible hack to make the current uri visible in the parser so that named univer...
authorEnrico Tassi <enrico.tassi@inria.fr>
Fri, 29 Apr 2005 12:13:58 +0000 (12:13 +0000)
committerEnrico Tassi <enrico.tassi@inria.fr>
Fri, 29 Apr 2005 12:13:58 +0000 (12:13 +0000)
helm/ocaml/cic/cicParser3.ml
helm/ocaml/cic/cicParser3.mli
helm/ocaml/cic/cicUniv.ml
helm/ocaml/cic/cicUniv.mli

index 8e6d276d5c9ea003bc31a6df3197965b4ce5b080..940e03e2b8a8e6e8c3102d81084945cdeca5a595 100644 (file)
@@ -43,6 +43,11 @@ exception IllFormedXml of int;;
 
 (* Utility functions to map a markup attribute to something useful *)
 
+let uri = ref (UriManager.uri_of_string "cic:/none.con")
+
+let set_uri u = 
+  uri := u
+
 let cic_attr_of_xml_attr =
  function
     Pxp_types.Value s       -> Cic.Name s
@@ -53,7 +58,8 @@ let cic_sort_of_xml_attr =
  function
     Pxp_types.Value "Prop" -> Cic.Prop
   | Pxp_types.Value "Set"  -> Cic.Set
-  | Pxp_types.Value "Type" -> Cic.Type (CicUniv.fresh ()) (* TASSI: sure? *)
+  | Pxp_types.Value "Type" -> 
+      Cic.Type (CicUniv.fresh ~uri:!uri ()) (* ORRIBLE HACK *)
   | _            -> raise (IllFormedXml 2)
 
 let int_of_xml_attr =
index 3c2f5d94ccf4348d3bc23331bfb8bd4f7e491fa1..8fc0704d407eae9bcda01315cf97506151df610a 100644 (file)
@@ -61,3 +61,6 @@ class virtual cic_term :
 (* The definition of domspec, an hashtable that maps each node type to the *)
 (* object that must be linked to it. Used by markup.                       *)
 val domspec : cic_term Pxp_document.spec
+
+val set_uri: UriManager.uri -> unit
+
index 7f8266876ddbcaf891d03c8e8bc0bc8086eba685..c986ae866e03ad8759126c054f3707772c245967 100644 (file)
@@ -128,8 +128,8 @@ let are_ugraph_eq = are_ugraph_eq307
 let string_of_universe (i,u) = 
   match u with
       Some u ->
-       ((string_of_int i) ^ " " ^ (UriManager.string_of_uri u))
-    | None -> (string_of_int i)
+       "(" ^ ((string_of_int i) ^ "," ^ (UriManager.string_of_uri u) ^ ")")
+    | None -> "(" ^ (string_of_int i) ^ ",None)"
 
 let string_of_universe_set l = 
   SOF.fold (fun x s -> s ^ (string_of_universe x) ^ " ") l ""
@@ -142,7 +142,7 @@ let string_of_node n =
   "i_gegt: " ^ (string_of_universe_set n.in_gegt_of) ^ "}\n"
 
 let string_of_arc (a,u,v) = 
-  "(" ^ (string_of_universe u) ^ " " ^ a ^ " " ^ (string_of_universe v) ^ ")"
+  (string_of_universe u) ^ " " ^ a ^ " " ^ (string_of_universe v)
   
 let string_of_mal m =
   let rc = ref "" in
@@ -178,7 +178,7 @@ let partial = ref 0.0 ;;
 let reset_spent_time () = time_spent := 0.0;;
 let get_spent_time () = !time_spent ;;
 let begin_spending () =
-  assert (!partial = 0.0);
+  (*assert (!partial = 0.0);*)
   partial := Unix.gettimeofday ()
 ;;
 
@@ -419,11 +419,14 @@ exception UniverseInconsistency of string
 
 let error arc node1 closure_type node2 closure =
   let s = "\n  ===== Universe Inconsistency detected =====\n\n" ^
-   "\tUnable to add "^ (string_of_arc arc) ^ " cause " ^ 
-   (string_of_universe node1) ^ " is in the " ^
-   closure_type ^ " closure {" ^
-   (string_of_universe_set closure) ^ "} of " ^ 
-   (string_of_universe node2) ^ "\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;
   raise (UniverseInconsistency s)
@@ -463,13 +466,22 @@ type universe_graph = bag
 
 let empty_ugraph = empty_bag
 
-let current_index = ref (-1)
+let current_index_anon = ref (-1)
+let current_index_named = ref (-1)
 
-let restart_numbering () = current_index := (-1) 
+let restart_numbering () = current_index_named := (-1) 
 
-let fresh () =
-  current_index := !current_index + 1;
-  (!current_index,None)
+let fresh ?uri () =
+  let i =
+    match uri with
+    | None -> 
+        current_index_anon := !current_index_anon + 1;
+        !current_index_anon
+    | Some _ -> 
+        current_index_named := !current_index_named + 1;
+        !current_index_named
+  in
+  (i,uri)
 
 let print_ugraph g = 
   prerr_endline (string_of_bag g)
index 7bd224946afd02b181d58d38cbef232dc1d31d69..74af1ccc41114fd942eeb45c6ad54f88dc0a19e9 100644 (file)
@@ -43,7 +43,9 @@ type universe_graph
   returns a fresh universe
 *)
 val fresh: 
-  unit -> universe
+  ?uri:UriManager.uri ->
+  unit -> 
+    universe
 
 (*
   really useful at the begin and in all the functions that don't care