[r2005-02-17 09:28:18 by afrisch] Clean a little bit schema

Original author: afrisch
Date: 2005-02-17 09:28:19+00:00

Makefile.distrib

@@ -158,9 +158,10 @@ OBJECTS = \
  compile/lambda.cmo \
  runtime/value.cmo \
  \
+ parser/location.cmo \
  $(SCHEMA_OBJS) \
  \
- parser/location.cmo parser/url.cmo parser/ulexer.cmo parser/ast.cmo parser/parser.cmo \
+ parser/url.cmo parser/ulexer.cmo parser/ast.cmo parser/parser.cmo \
  \
  types/externals.cmo \
  typing/typed.cmo typing/typer.cmo \

schema/schema_parser.ml

@@ -9,7 +9,7 @@ open Schema_validator
 open Schema_xml
 open Schema_xml.Pxp_helpers
 
-let debug = true
+let debug = false
 let debug_print ?(n: pxp_node option) s =
   if debug then
     (match n with
@@ -842,18 +842,17 @@ let schema_of_node root =
     model_groups = resolver#model_groups
   }
 
+let wrap_err f x =
+  try f x
+  with exn -> raise (Location.Generic (Pxp_types.string_of_exn exn))
+
 let parse_schema source =
-(*  let config =
-    { new_xsd_config () with Pxp_types.enable_namespace_info = true }
-  in
-*)
-  let config = new_xsd_config () in
-  let schema = schema_of_node (pxp_node_of ~config source) in
+  let schema = schema_of_node (pxp_node_of source) in
   debug_print "parse_schema completed successfully";
   schema
 
-let schema_of_file fname = parse_schema (Pxp_types.from_file fname)
-
-let schema_of_string s = parse_schema (Pxp_types.from_string s)
-
+let schema_of_file =
+  wrap_err (fun fname -> parse_schema (Pxp_types.from_file fname))
 
+let schema_of_string =
+  wrap_err (fun s -> parse_schema (Pxp_types.from_string s))

schema/schema_parser.mli

-
 (** XML Schema Documents parsing *)
 
 open Schema_types
-open Schema_xml
-
-(*
-  (** parse a schema from a PXP source *)
-val parse_schema: Pxp_types.source -> schema
-
-  (** parse a schema from a PXP node *)
-val schema_of_node: pxp_node -> schema
-*)
 
-  (** shortand for "parse_schema (Pxp_types.from_file <fname>)" *)
 val schema_of_file: string -> schema
-
-  (** shortand for "parse_schema (Pxp_types.from_string <fname>)" *)
 val schema_of_string: string -> schema
-

schema/schema_xml.ml

-
 open Pxp_document
 open Pxp_ev_parser
 open Pxp_tree_parser
@@ -37,75 +36,9 @@ let new_xsd_config () =
       Pxp_types.enable_namespace_processing = Some ns_manager
   }
 
-let pxp_node_of ?(config = new_xsd_config ()) src =
-  parse_wfcontent_entity config src spec
-let pxp_document_of ?(config = new_xsd_config ()) src =
-  parse_wfdocument_entity config src spec
+let pxp_node_of src =
+  parse_wfcontent_entity (new_xsd_config ()) src spec
 
-let pxp_stream_of_file ?(config = new_xsd_config ()) fname =
-  let config = { config with drop_ignorable_whitespace = true } in
-  let entity_manager =
-    create_entity_manager ~is_document:true config (from_file fname)
-  in
-  let pull_parser =
-    create_pull_parser config
-      (`Entry_document [ `Extend_dtd_fully; `Parse_xml_decl ])
-      entity_manager
-  in
-  Stream.from (fun _ -> pull_parser ())
-
-(*
-class foo_entity_id = object end
-let eid = new foo_entity_id
-type to_be_visited =
-  | Fully of Value.t  (* xml values still to be visited *)
-  | Half of Value.t   (* xml values half visited (i.e. E_start_tag generated) *)
-  | Other of Value.t  (* other values *)
-
-let pxp_stream_of_value v =
-  let stack = ref [Fully v] in
-  let f _ = (* lazy visit of a tree of CDuce XML values, stack keeps track of
-            what is still to be visited *)
-    (match !stack with
-    | (Fully ((Value.Xml (Value.Atom a, attrs, _)) as v)) :: tl ->
-	let (ns,a) = Atoms.V.value a in
-	assert( ns == Ns.empty );
-        let tag_ascii = Encodings.Utf8.to_string a in
-        let attrs_ascii =
-          List.map (fun (k, v) -> (k, Value.get_string_latin1 v))
-            (Value.get_fields attrs)
-        in
-        let event = Some (E_start_tag (tag_ascii, attrs_ascii, eid)) in
-        stack := (Half v) :: tl;
-        let children = ref [] in  (* TODO inefficient *)
-        let push v = children := v :: !children in
-        Value.iter_xml
-          (fun pcdata -> push (Other (Value.string_utf8 pcdata)))
-          (fun v ->
-            match v with
-            | (Value.Xml (_, _, _)) as v -> push (Fully v)
-            | v -> raise (Invalid_argument "Schema_xml.pxp_stream_of_value"))
-          v;
-        stack := (List.rev !children) @ !stack;
-        event
-    | (Half (Value.Xml (Value.Atom a, _, _))) :: tl ->
-	let (ns,a) = Atoms.V.value a in
-	assert( ns == Ns.empty );
-        let tag_ascii = Encodings.Utf8.to_string a in
-        let event = Some (E_end_tag (tag_ascii, eid)) in
-        stack := tl;
-        event
-    | (Fully (Value.Xml (_, _, _)))::_ | (Half (Value.Xml (_, _, _)))::_ ->
-        failwith "Schema_xml.pxp_stream_of_value: non-atom-tag xml value"
-    | (Other v) :: tl ->
-        let event = Some (E_char_data (Value.get_string_latin1 v)) in
-        stack := tl;
-        event
-    | [] -> None
-    | _ -> assert false)
-  in
-  Stream.from f
-*)
 
 open Printf
 

schema/schema_xml.mli

-
 open Encodings
 
 type pxp_node =
@@ -6,19 +5,7 @@ type pxp_node =
 type pxp_document =
   ('a Pxp_document.node Pxp_document.extension as 'a) Pxp_document.document
 
-  (** create a new Pxp configuration. This configuration will be namespace
-   * enabled with a brand new namespace manager containing "xsi" and "xsd"
-   * schema prefixes declaration *)
-val new_xsd_config : unit -> Pxp_types.config
-
-val pxp_document_of :
-  ?config: Pxp_types.config -> Pxp_types.source -> pxp_document
-val pxp_node_of:
-  ?config: Pxp_types.config -> Pxp_types.source -> pxp_node
-val pxp_stream_of_file :
-  ?config: Pxp_types.config -> string -> Pxp_types.event Stream.t
-
-(* val pxp_stream_of_value : Value.t -> Pxp_yacc.event Stream.t *)
+val pxp_node_of: Pxp_types.source -> pxp_node
 
 module Pxp_helpers:
   sig