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

[r2005-02-25 13:23:48 by afrisch] xsi:nil

Original author: afrisch
Date: 2005-02-25 13:23:49+00:00
parent 463363bd
......@@ -92,48 +92,46 @@ parser/url.cmo: parser/location.cmi parser/url.cmi
parser/url.cmx: parser/location.cmx parser/url.cmi
schema/schema_pcre.cmo: misc/encodings.cmi schema/schema_pcre.cmi
schema/schema_pcre.cmx: misc/encodings.cmx schema/schema_pcre.cmi
schema/schema_types.cmo: misc/encodings.cmi types/intervals.cmi misc/ns.cmi \
schema/schema_types.cmo: types/atoms.cmi misc/encodings.cmi misc/ns.cmi \
runtime/value.cmi schema/schema_types.cmi
schema/schema_types.cmx: misc/encodings.cmx types/intervals.cmx misc/ns.cmx \
schema/schema_types.cmx: types/atoms.cmx misc/encodings.cmx misc/ns.cmx \
runtime/value.cmx schema/schema_types.cmi
schema/schema_xml.cmo: misc/encodings.cmi parser/location.cmi \
schema/schema_xml.cmo: misc/encodings.cmi parser/location.cmi misc/ns.cmi \
schema/schema_pcre.cmi parser/url.cmi schema/schema_xml.cmi
schema/schema_xml.cmx: misc/encodings.cmx parser/location.cmx \
schema/schema_xml.cmx: misc/encodings.cmx parser/location.cmx misc/ns.cmx \
schema/schema_pcre.cmx parser/url.cmx schema/schema_xml.cmi
schema/schema_common.cmo: types/atoms.cmi misc/encodings.cmi \
types/intervals.cmi misc/ns.cmi schema/schema_pcre.cmi \
schema/schema_types.cmi schema/schema_xml.cmi runtime/value.cmi \
schema/schema_common.cmi
schema/schema_types.cmi schema/schema_xml.cmi types/types.cmi \
runtime/value.cmi schema/schema_common.cmi
schema/schema_common.cmx: types/atoms.cmx misc/encodings.cmx \
types/intervals.cmx misc/ns.cmx schema/schema_pcre.cmx \
schema/schema_types.cmx schema/schema_xml.cmx runtime/value.cmx \
schema/schema_common.cmi
schema/schema_types.cmx schema/schema_xml.cmx types/types.cmx \
runtime/value.cmx schema/schema_common.cmi
schema/schema_builtin.cmo: types/atoms.cmi types/builtin_defs.cmi \
misc/encodings.cmi types/intervals.cmi misc/ns.cmi \
schema/schema_common.cmi schema/schema_pcre.cmi schema/schema_types.cmi \
types/sequence.cmi types/types.cmi runtime/value.cmi \
schema/schema_builtin.cmi
schema/schema_xml.cmi types/sequence.cmi types/types.cmi \
runtime/value.cmi schema/schema_builtin.cmi
schema/schema_builtin.cmx: types/atoms.cmx types/builtin_defs.cmx \
misc/encodings.cmx types/intervals.cmx misc/ns.cmx \
schema/schema_common.cmx schema/schema_pcre.cmx schema/schema_types.cmx \
types/sequence.cmx types/types.cmx runtime/value.cmx \
schema/schema_builtin.cmi
schema/schema_validator.cmo: types/atoms.cmi misc/encodings.cmi \
types/intervals.cmi misc/ns.cmi schema/schema_builtin.cmi \
schema/schema_common.cmi schema/schema_pcre.cmi schema/schema_types.cmi \
runtime/value.cmi schema/schema_validator.cmi
schema/schema_validator.cmx: types/atoms.cmx misc/encodings.cmx \
types/intervals.cmx misc/ns.cmx schema/schema_builtin.cmx \
schema/schema_common.cmx schema/schema_pcre.cmx schema/schema_types.cmx \
runtime/value.cmx schema/schema_validator.cmi
schema/schema_parser.cmo: misc/encodings.cmi types/intervals.cmi misc/ns.cmi \
schema/schema_xml.cmx types/sequence.cmx types/types.cmx \
runtime/value.cmx schema/schema_builtin.cmi
schema/schema_validator.cmo: types/atoms.cmi misc/encodings.cmi misc/ns.cmi \
schema/schema_builtin.cmi schema/schema_common.cmi schema/schema_pcre.cmi \
schema/schema_types.cmi runtime/value.cmi schema/schema_validator.cmi
schema/schema_validator.cmx: types/atoms.cmx misc/encodings.cmx misc/ns.cmx \
schema/schema_builtin.cmx schema/schema_common.cmx schema/schema_pcre.cmx \
schema/schema_types.cmx runtime/value.cmx schema/schema_validator.cmi
schema/schema_parser.cmo: types/atoms.cmi misc/encodings.cmi misc/ns.cmi \
schema/schema_builtin.cmi schema/schema_common.cmi schema/schema_pcre.cmi \
schema/schema_types.cmi schema/schema_validator.cmi schema/schema_xml.cmi \
parser/url.cmi runtime/value.cmi schema/schema_parser.cmi
schema/schema_parser.cmx: misc/encodings.cmx types/intervals.cmx misc/ns.cmx \
parser/url.cmi schema/schema_parser.cmi
schema/schema_parser.cmx: types/atoms.cmx misc/encodings.cmx misc/ns.cmx \
schema/schema_builtin.cmx schema/schema_common.cmx schema/schema_pcre.cmx \
schema/schema_types.cmx schema/schema_validator.cmx schema/schema_xml.cmx \
parser/url.cmx runtime/value.cmx schema/schema_parser.cmi
parser/url.cmx schema/schema_parser.cmi
parser/ulexer.cmo: parser/ulexer.cmi
parser/ulexer.cmx: parser/ulexer.cmi
parser/ast.cmo: types/builtin_defs.cmi types/chars.cmi types/ident.cmo \
......@@ -157,19 +155,19 @@ typing/typed.cmo: types/ident.cmo parser/location.cmi misc/ns.cmi \
typing/typed.cmx: types/ident.cmx parser/location.cmx misc/ns.cmx \
types/patterns.cmx schema/schema_types.cmx types/types.cmx
typing/typer.cmo: parser/ast.cmo types/atoms.cmi types/builtin_defs.cmi \
types/chars.cmi types/externals.cmi misc/html.cmi types/ident.cmo \
types/intervals.cmi parser/location.cmi misc/ns.cmi types/patterns.cmi \
types/chars.cmi misc/encodings.cmi types/externals.cmi misc/html.cmi \
types/ident.cmo parser/location.cmi misc/ns.cmi types/patterns.cmi \
schema/schema_builtin.cmi schema/schema_common.cmi \
schema/schema_parser.cmi schema/schema_types.cmi types/sequence.cmi \
misc/serialize.cmi misc/state.cmi misc/stats.cmi typing/typed.cmo \
types/types.cmi parser/url.cmi runtime/value.cmi typing/typer.cmi
schema/schema_parser.cmi schema/schema_types.cmi schema/schema_xml.cmi \
types/sequence.cmi misc/serialize.cmi misc/state.cmi typing/typed.cmo \
types/types.cmi runtime/value.cmi typing/typer.cmi
typing/typer.cmx: parser/ast.cmx types/atoms.cmx types/builtin_defs.cmx \
types/chars.cmx types/externals.cmx misc/html.cmx types/ident.cmx \
types/intervals.cmx parser/location.cmx misc/ns.cmx types/patterns.cmx \
types/chars.cmx misc/encodings.cmx types/externals.cmx misc/html.cmx \
types/ident.cmx parser/location.cmx misc/ns.cmx types/patterns.cmx \
schema/schema_builtin.cmx schema/schema_common.cmx \
schema/schema_parser.cmx schema/schema_types.cmx types/sequence.cmx \
misc/serialize.cmx misc/state.cmx misc/stats.cmx typing/typed.cmx \
types/types.cmx parser/url.cmx runtime/value.cmx typing/typer.cmi
schema/schema_parser.cmx schema/schema_types.cmx schema/schema_xml.cmx \
types/sequence.cmx misc/serialize.cmx misc/state.cmx typing/typed.cmx \
types/types.cmx runtime/value.cmx typing/typer.cmi
runtime/load_xml.cmo: types/atoms.cmi misc/encodings.cmi types/ident.cmo \
parser/location.cmi misc/ns.cmi parser/url.cmi runtime/value.cmi \
runtime/load_xml.cmi
......@@ -375,14 +373,16 @@ runtime/value.cmi: types/atoms.cmi types/chars.cmi misc/encodings.cmi \
types/types.cmi
parser/location.cmi: misc/html.cmi
schema/schema_pcre.cmi: misc/encodings.cmi
schema/schema_types.cmi: misc/encodings.cmi types/intervals.cmi misc/ns.cmi \
schema/schema_types.cmi: types/atoms.cmi misc/encodings.cmi misc/ns.cmi \
runtime/value.cmi
schema/schema_xml.cmi: misc/encodings.cmi misc/ns.cmi
schema/schema_common.cmi: types/atoms.cmi misc/encodings.cmi \
types/intervals.cmi misc/ns.cmi schema/schema_types.cmi types/types.cmi \
runtime/value.cmi
schema/schema_xml.cmi: misc/encodings.cmi
schema/schema_common.cmi: misc/encodings.cmi types/intervals.cmi \
schema/schema_types.cmi runtime/value.cmi
schema/schema_builtin.cmi: misc/encodings.cmi misc/ns.cmi \
schema/schema_types.cmi types/types.cmi runtime/value.cmi
schema/schema_validator.cmi: schema/schema_types.cmi runtime/value.cmi
schema/schema_validator.cmi: misc/encodings.cmi schema/schema_types.cmi \
runtime/value.cmi
schema/schema_parser.cmi: schema/schema_types.cmi
parser/parser.cmi: parser/ast.cmo
types/externals.cmi: types/types.cmi
......@@ -406,5 +406,5 @@ driver/cduce.cmi: misc/encodings.cmi runtime/value.cmi
ocamliface/mltypes.cmi: ocamliface/asttypes.cmo types/types.cmi
query/query.cmi: parser/ast.cmo
ocamliface/mltypes.cmi: ocamliface/asttypes.cmo types/types.cmi
schema/schema_types.cmi: misc/encodings.cmi types/intervals.cmi misc/ns.cmi \
schema/schema_types.cmi: types/atoms.cmi misc/encodings.cmi misc/ns.cmi \
runtime/value.cmi
......@@ -423,3 +423,8 @@ let simple_union name members =
st_facets = no_facets;
st_base = None }
let xsi_nil_qname = (Schema_xml.xsi,Utf8.mk "nil")
let xsi_nil_atom = Atoms.V.of_qname xsi_nil_qname
let xsi_nil_type = Types.atom (Atoms.atom xsi_nil_atom)
let xsi_nil_label = Ident.LabelPool.mk xsi_nil_qname
......@@ -110,3 +110,8 @@ val simple_list:
val simple_union:
Ns.qname option -> simple_type_definition list -> simple_type_definition
val xsi_nil_type: Types.t
val xsi_nil_qname: Ns.qname
val xsi_nil_atom: Atoms.V.t
val xsi_nil_label: Ident.label
......@@ -29,15 +29,25 @@ let check_force v =
with Lazy.Undefined -> failwith "Cyclic type definition"
let bool_attr attr n =
(* todo: normalization of whitespace ? *)
match _may_attr attr n with
| None -> false
| Some v -> (match Utf8.get_str v with
| "true" | "1" -> true
| "false" | "0" -> false
| _ -> failwith "Invalid boolean value")
(* element and complex type constructors which take cares of unique id *)
let element, complex =
let counter = ref 0 in
let element name type_def constr =
let element name type_def constr nillable =
incr counter;
{ elt_uid = !counter;
elt_name = name;
elt_typdef = type_def;
elt_cstr = constr }
elt_cstr = constr;
elt_nillable = nillable }
in
let complex name (type_def: type_definition) deriv attrs ct =
incr counter;
......@@ -70,7 +80,7 @@ let parse_facets base n =
i
in
let aux facets n tag =
let fixed = _is_attr "fixed" n "true" in
let fixed = bool_attr "fixed" n in
match tag with
| "xsd:length" ->
let length = parse_nonneg n in
......@@ -427,7 +437,7 @@ let schema_of_uri uri =
and parse_complex_content n content =
let derivation,derivation_type,base,uses = get_derivation content in
let mixed = _is_attr "mixed" content "true" || _is_attr "mixed" n "true" in
let mixed = bool_attr "mixed" content || bool_attr "mixed" n in
let particle_node = find_particle derivation in
let content_type =
match derivation_type, particle_node with
......@@ -454,7 +464,7 @@ let schema_of_uri uri =
and parse_other_content n =
let uses = parse_attribute_uses `Restriction AnyType n in
let mixed = _is_attr "mixed" n "true" in
let mixed = bool_attr "mixed" n in
let content_type =
match find_particle n with
| None -> CT_empty
......@@ -476,7 +486,8 @@ let schema_of_uri uri =
in
let type_def = find_element_type n in
let value_constr = parse_elt_value_constraint type_def n in
element (ns,local) type_def value_constr
let nillable = bool_attr "nillable" n in
element (ns,local) type_def value_constr nillable
(* look for a type definition, try "simpleType" child, try "complexType"
* child, try "type" attribute, return anyType *)
......
......@@ -89,7 +89,8 @@ and element_declaration =
{ elt_uid: int;
elt_name: Ns.qname;
elt_typdef: type_ref;
elt_cstr: value_constraint option }
elt_cstr: value_constraint option;
elt_nillable: bool }
and complex_type_definition =
{ ct_uid: int;
......
......@@ -89,7 +89,8 @@ and element_declaration =
{ elt_uid: int;
elt_name: Ns.qname;
elt_typdef: type_ref;
elt_cstr: value_constraint option }
elt_cstr: value_constraint option;
elt_nillable: bool }
and complex_type_definition =
{ ct_uid: int;
......
......@@ -114,6 +114,12 @@ let expect_end_tag ctx =
| E_end_tag _ -> ()
| ev -> error (sprintf "Expected end tag, found %s" (string_of_event ev))
let check_nil ctx =
match peek ctx with
| E_end_tag _ -> ()
| ev -> error (sprintf "Non-empty content with xsi:nil set : %s"
(string_of_event ev))
let expect_start_tag ctx tag =
match next ctx with
| E_start_tag t when Ns.QName.equal t tag -> ()
......@@ -127,15 +133,29 @@ let expect_any_start_tag ctx =
| ev -> error (sprintf "Expected start tag, found %s"
(string_of_event ev))
type attrs = {
xsi_nil: bool;
attrs: (Ns.qname * Utf8.t) list
}
let get_bool v =
match Utf8.get_str v with
| "true" | "1" -> true
| "false" | "0" -> false
| _ -> failwith "Invalid boolean value"
let get_attributes ctx =
let rec aux attrs =
let rec aux attrs nil =
match peek ctx with
| E_attribute (qname, value) ->
junk ctx;
aux ((qname,value)::attrs)
| _ -> attrs
| E_attribute (qname,value) when Ns.QName.equal qname xsi_nil_qname ->
junk ctx;
aux attrs (get_bool value)
| E_attribute (qname, value) ->
junk ctx;
aux ((qname,value)::attrs) nil
| _ -> { attrs = attrs; xsi_nil = nil }
in
aux []
aux [] false
let rec tries funs arg =
match funs with
......@@ -273,7 +293,7 @@ let validate_simple_type_wrapper ctx st_def =
let rec validate_any_type ctx =
(* assumption: attribute events (if any) come first *)
let attrs = get_attributes ctx in
let attrs = List.map (fun (n,v) -> (n,Value.string_utf8 v)) attrs in
let attrs = List.map (fun (n,v) -> (n,Value.string_utf8 v)) attrs.attrs in
let ctx = subctx true ctx in
let rec aux attrs =
......@@ -300,9 +320,9 @@ let validate_wildcard ctx w =
expect_end_tag ctx;
xml qname attrs content
let check_fixed ~ctx fixed value =
let check_fixed fixed value =
if not (Value.equal fixed value) then
error ~ctx (sprintf "Expected fixed value: %s; found %s"
error (sprintf "Expected fixed value: %s; found %s"
(string_of_value fixed) (string_of_value value))
......@@ -312,30 +332,30 @@ let next_tag ctx =
| E_start_tag qname -> qname
| _ -> raise Not_found
let validate_attribute_uses ctx attr_uses =
let validate_attribute_uses attrs attr_uses =
let tbl = QTable.create 11 in
List.iter
(fun use -> QTable.add tbl (name_of_attribute_use use) use)
attr_uses;
let attrs =
List.map
(fun (qname, value) ->
let { attr_decl = { attr_typdef = st_def };
attr_use_cstr = constr } =
try QTable.find tbl qname
with Not_found ->
error (sprintf "Unexpected attribute: %s"
(Ns.QName.to_string qname))
in
let value = validate_simple_type st_def value in
(match constr with (* check fixed constraint *)
| Some (`Fixed v) -> check_fixed ~ctx v value
| _ -> ());
QTable.remove tbl qname;
(qname, value)
) (get_attributes ctx);
in
let attrs = ref attrs in
let attribs = ref [] in
List.iter
(fun (qname, value) ->
let { attr_decl = { attr_typdef = st_def };
attr_use_cstr = constr } =
try QTable.find tbl qname
with Not_found ->
error (sprintf "Unexpected attribute: %s"
(Ns.QName.to_string qname))
in
let value = validate_simple_type st_def value in
(match constr with (* check fixed constraint *)
| Some (`Fixed v) -> check_fixed v value
| _ -> ());
QTable.remove tbl qname;
attribs := (qname, value) :: !attribs
) attrs.attrs;
if attrs.xsi_nil then
attribs := (xsi_nil_qname, Value.vtrue) :: !attribs;
QTable.iter
(fun qname at ->
if at.attr_required then (* check for missing required attributes *)
......@@ -343,36 +363,45 @@ let validate_attribute_uses ctx attr_uses =
(Ns.QName.to_string qname))
else (* add default values *)
match at.attr_use_cstr with
| Some (`Default v) -> attrs := (qname, v) :: !attrs
| Some (`Default v) -> attribs := (qname, v) :: !attribs
| _ -> ())
tbl;
Value.vrecord !attrs
Value.vrecord !attribs
let rec validate_element ctx elt =
expect_start_tag ctx elt.elt_name;
let (attrs, content) = validate_type_ref ctx elt.elt_typdef in
let attrs = get_attributes ctx in
if (attrs.xsi_nil && not elt.elt_nillable) then
error "xsi:nil attribute on non-nillable element";
let (attrs, content) = validate_type_ref ctx attrs elt.elt_typdef in
let content = (* use default if needed and check fixed constraints *)
match elt.elt_cstr with
| Some (`Default v) when Value.equal content empty_string -> v
| Some (`Fixed v) ->
check_fixed ~ctx v content;
content
| Some (`Fixed v) -> check_fixed v content; content
| _ -> content
in
expect_end_tag ctx;
xml elt.elt_name attrs content
and validate_type ctx = function
and validate_type ctx attrs = function
| AnyType -> validate_any_type ctx
| Simple st_def -> (empty_record, validate_simple_type_wrapper ctx st_def)
| Complex ct_def -> validate_complex_type ctx ct_def
and validate_type_ref ctx x =
validate_type ctx (Lazy.force x)
and validate_complex_type ctx ct =
let attrs = validate_attribute_uses ctx ct.ct_attrs in
let content = validate_content_type ctx ct.ct_content in
| Simple st_def ->
if (List.length attrs.attrs > 0) then
error "attribute on element with simple content";
if attrs.xsi_nil then (check_nil ctx;
Value.vrecord [xsi_nil_qname,Value.vtrue],
Value.nil)
else (empty_record, validate_simple_type_wrapper ctx st_def)
| Complex ct_def -> validate_complex_type ctx attrs ct_def
and validate_type_ref ctx attrs x =
validate_type ctx attrs (Lazy.force x)
and validate_complex_type ctx attrs ct =
let content =
if attrs.xsi_nil then (check_nil ctx; Value.nil)
else validate_content_type ctx ct.ct_content in
let attrs = validate_attribute_uses attrs ct.ct_attrs in
(attrs, content)
and validate_content_type ctx content_type =
......@@ -515,7 +544,8 @@ let validate_type def schema value =
| Complex ct_def ->
let ctx = ctx (stream_of_value value) schema in
let start_tag = expect_any_start_tag ctx in
let (attrs, content) = validate_complex_type ctx ct_def in
let attrs = get_attributes ctx in
let (attrs, content) = validate_complex_type ctx attrs ct_def in
expect_end_tag ctx;
Value.Xml (Value.Atom (Atoms.V.of_qname start_tag), attrs, content)
......@@ -568,7 +598,9 @@ let validate_attribute_group { ag_def = attr_uses } schema value =
error
"Only record values could be validated against attribute groups"
in
validate_attribute_uses (ctx stream schema) attr_uses
let ctx = ctx stream schema in
let attrs = get_attributes ctx in
validate_attribute_uses attrs attr_uses
let validate_model_group { mg_def = mg } schema value =
......
......@@ -138,3 +138,4 @@ let _qname_attr name n =
let xsd = Ns.mk xsd_namespace
let xsi = Ns.mk xsi_namespace
......@@ -32,3 +32,4 @@ val _may_qname_attr: string -> node -> Ns.qname option
val _qname_attr: string -> node -> Ns.qname
val xsd: Ns.t
val xsi: Ns.t
<person>
<name>John</name>
<height xmlns:xsi= "http://www.w3.org/2001/XMLSchema-instance"
xsi:nil="true" />
</person>
<xs:schema xmlns:xs= "http://www.w3.org/2001/XMLSchema">
<xs:element name="person" type="Person" nillable="true" />
<xs:complexType name="Person">
<xs:sequence>
<xs:element name= "name" type="xs:string"/>
<xs:element name= "height" type="xs:integer" nillable="true" />
</xs:sequence>
</xs:complexType>
</xs:schema>
......@@ -1563,7 +1563,7 @@ struct
Format.fprintf ppf "<%a%a>%a"
do_print_tag tag
do_print_attr attr
(do_print_slot 0) t
(do_print_slot 2) t
| Record (r,some,none) ->
if some then Format.fprintf ppf "@[{"
else Format.fprintf ppf "@[{|";
......
......@@ -1565,6 +1565,7 @@ module Schema_converter =
open Printf
open Schema_types
open Schema_common
open Encodings
open IType
......@@ -1606,6 +1607,12 @@ module Schema_converter =
| _ -> 1, Some 1 in
Sequence.repet min max base
let xsi_nil_field_map =
LabelMap.singleton xsi_nil_label (Types.cons Builtin_defs.true_type)
let xsi_nil_field_map' =
LabelMap.singleton xsi_nil_label (itype Builtin_defs.true_type, None)
let pcdata = PStar (PElem (itype (Types.char Chars.any)))
let mix_regexp regexp =
let rec aux = function
......@@ -1667,13 +1674,27 @@ module Schema_converter =
mk_len_regexp ?min:(Some p.part_min) ?max:p.part_max
(regexp_of_term p.part_term)
and complex ct =
and get_complex ct =
try Hashtbl.find complex_memo ct.ct_uid
with Not_found ->
let slot = delayed noloc in
Hashtbl.add complex_memo ct.ct_uid slot;
slot.desc <- ITimes (attr_uses ct.ct_attrs, content ct.ct_content);
slot
let attrs = attr_uses ct.ct_attrs in
let r = mk (ITimes (attrs,slot)) in
Hashtbl.add complex_memo ct.ct_uid r;
slot.desc <- ILink (content ct.ct_content);
r
and complex nil ct =
let c = get_complex ct in
if nil then
match c.desc with
| ITimes ({ desc = IRecord (o,fields) },content) ->
let fields =
LabelMap.union_disj fields xsi_nil_field_map' in
ior c (mk (ITimes (mk (IRecord (o,fields)),
itype Sequence.nil_type)))
| _ -> assert false
else c
and content = function
| CT_empty -> itype Sequence.nil_type
......@@ -1708,24 +1729,40 @@ module Schema_converter =
[(LabelPool.mk att.attr_name, (r,None))]))
and elt_decl elt =
let atom_type =
itype (Types.atom (Atoms.atom (Atoms.V.of_qname elt.elt_name)))
let atom_type =
itype (Types.atom (Atoms.atom (Atoms.V.of_qname elt.elt_name)))
in
let content =
match elt.elt_cstr with
| Some (`Fixed v) -> itype (Types.constant (Value.inv_const v))
| _ -> complex_type_def (Lazy.force elt.elt_typdef)
match elt.elt_cstr,elt.elt_nillable with
| Some (`Fixed _), true ->
failwith "Fixed value constraint and nillable are incompatible"
| Some (`Fixed v), false ->
itype (Types.constant (Value.inv_const v))
| _, nil -> complex_type_def nil (Lazy.force elt.elt_typdef)
in
mk (IXml (atom_type, content))
and complex_type_def = function
| AnyType -> itype xsd_any_type
| Simple st ->
and complex_type_def nil = function
| AnyType ->
itype (Types.times
(Types.cons Types.empty_closed_record)
(Types.cons (simple_type st)))
| Complex ct -> complex ct
let complex_type ct = mk (IXml (itype Types.any, complex ct))
(Types.cons Types.empty_opened_record)
(Types.cons xsd_any_type))
| Simple st ->
let nonnil =
Types.times
(Types.cons Types.empty_closed_record)
(Types.cons (simple_type st))
in
let t =
if nil then
Types.cup nonnil
(Types.times
(Types.cons (Types.record' (false,xsi_nil_field_map)))
(Types.cons Sequence.nil_type))
else nonnil in
itype t
| Complex ct -> complex nil ct
let complex_type ct = mk (IXml (itype Types.any, complex false ct))
let model_group g = rexp (regexp_of_model_group g)
......
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