Commit f6ac979a authored by Pietro Abate's avatar Pietro Abate
Browse files

[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
parent a4f13d28
......@@ -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 \
......
......@@ -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))
(** 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
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
......
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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment