[r2003-11-28 11:18:14 by szach] better error message while referencing an unregistered schema

Original author: szach
Date: 2003-11-28 11:18:14+00:00

typing/typer.ml

@@ -172,6 +172,7 @@ let error loc msg = raise_loc loc (Error msg)
 
   (* just to remember imported schemas *)
 let schemas = State.ref "Typer.schemas" (Hashtbl.create 3)
+let is_registered_schema = Hashtbl.mem !schemas
 
 let schema_types = State.ref "Typer.schema_types" (Hashtbl.create 51)
 let schema_elements = State.ref "Typer.schema_elements" (Hashtbl.create 51)
@@ -208,8 +209,11 @@ let find_schema_descr' k s n =
   try
     find_schema_descr k s n
   with Not_found ->
-    raise (Error (Printf.sprintf "No %s named '%s' found in schema '%s'"
-      (Schema_common.string_of_component_kind k) (U.get_str n) (U.get_str s)))
+    if is_registered_schema s then
+      raise (Error (Printf.sprintf "No %s named '%s' found in schema '%s'"
+        (Schema_common.string_of_component_kind k) (U.get_str n) (U.get_str s)))
+    else
+      raise (Error (Printf.sprintf "%s: no such schema" (U.get_str s)))
 
 (* Eliminate Recursion, propagate Sequence Capture Variables *)
 
@@ -1533,7 +1537,7 @@ let get_schema name =
 let get_schema_names () = Hashtbl.fold (fun n _ acc -> n :: acc) !schemas []
 
 let register_schema schema_name schema =
-  if Hashtbl.mem !schemas schema_name then
+  if is_registered_schema schema_name then
     failwith ("Redefinition of schema " ^ U.get_str schema_name)
   else begin
     let log_schema_component kind schema name cd_type =

typing/typer.mli

@@ -61,6 +61,7 @@ val flatten: loc ->
 (** {2 Schema stuff} *)
 
 val register_schema: U.t -> Schema_types.schema -> unit
+val is_registered_schema: U.t -> bool
 val get_schema: U.t -> Schema_types.schema  (** lookup schema by name *)
 val get_schema_names: unit -> U.t list  (** registered schema names *)