Commit a0171f82 authored by Pietro Abate's avatar Pietro Abate

[r2005-03-04 13:36:39 by afrisch] Clean

Original author: afrisch
Date: 2005-03-04 13:39:08+00:00
parent d5664653
Since 0.2.2
- Warning for capture variables and projections that always return the empty
sequence.
- Bug fixes when printing location in source code.
- Major rewrite of the support for XML Schema
* removed print_schema directive
* removed the "kind" selector (e.g. S # t as element)
* include,import implemented
*
- removed the syntax "external {...}", replaced with
"unit.val with { ty1 ty2 ... }"
- removed the syntax H:val, replaced with H.val
- removed the syntax S#t, replaced with S.t
- overloaded the dot (record field acces, CDuce, OCaml, Schema units)
- identifiers (for types, values) are now qualified names
- A new tool cduce_mktop produce CDuce toplevels with embeded OCaml functions
- several bug fixes
- validate renamed to cduce_validate
- more efficient hash-consing of types
- better error message with script on stdin
- a dot in an identifier must be escaped with a backslash, e.g. x\.y
- improved #print_type (does not use the abbreviation for the printed type)
- float_of: String -> Float
- Language:
* Warning for capture variables and projections that always return the empty
sequence.
* Major rewrite of the support for XML Schema
* removed print_schema directive
* removed the "kind" selector (e.g. S # t as element)
* include,import implemented
* support wildcards any,anyAttrivbute
* support xsi:nil
* support xsd:decimal,xsd:float
* many bug fixes
* Removed the syntax "external {...}", replaced with
"unit.val with { ty1 ty2 ... }".
* Removed the syntax H:val, replaced with H.val.
* Removed the syntax S#t, replaced with S.t.
* Overloaded the dot (record field acces, CDuce, OCaml, Schema units).
A dot in an identifier must now be escaped with a backslash, e.g. x\.y
* Identifiers (for types, values) are now qualified names.
* float_of: String -> Float
- Tools:
* A new tool cduce_mktop produce customized CDuce toplevels with embedded
OCaml externals.
* validate renamed to cduce_validate
- Implementation:
* Various bug fixes
* More efficient hash-consing of types
* improved #print_type (does not use the abbreviation for the printed type)
0.2.2
......
This diff is collapsed.
(** Schema common functionalities depending only on Schema_types *)
open Encodings
open Schema_types
(** {2 Exceptions} *)
exception XSD_validation_error of string
exception XSI_validation_error of string
(** {2 XSD printer *)
val print_schema : Format.formatter -> schema -> unit
val print_type : Format.formatter -> type_definition -> unit
val print_attribute : Format.formatter -> attribute_declaration -> unit
val print_element : Format.formatter -> element_declaration -> unit
val print_attribute_group :
Format.formatter -> attribute_group_definition -> unit
val print_model_group_def : Format.formatter -> model_group_definition -> unit
val print_simple_type : Format.formatter -> simple_type_definition -> unit
val print_complex_type : Format.formatter -> complex_type_definition -> unit
(** {2 Deconstruction functions} *)
(*
val get_simple_type: type_ref -> simple_type_definition
*)
val name_of_element_declaration : element_declaration -> Ns.qname
val name_of_type_definition : type_definition -> Ns.qname
val name_of_simple_type_definition : simple_type_definition -> Ns.qname
val name_of_complex_type_definition : complex_type_definition -> Ns.qname
val name_of_attribute_declaration : attribute_declaration -> Ns.qname
val name_of_attribute_use : attribute_use -> Ns.qname
val name_of_attribute_group_definition : attribute_group_definition -> Ns.qname
val name_of_model_group_definition : model_group_definition -> Ns.qname
val name_of_particle : particle -> Ns.qname
val string_of_component_kind : component_kind -> string
val variety_of_simple_type_definition : simple_type_definition -> variety
val facets_of_simple_type_definition : simple_type_definition -> facets
val simple_type_of_type : type_definition -> simple_type_definition
val complex_type_of_type : type_definition -> complex_type_definition
val content_type_of_type : type_definition -> content_type
(*
val get_type: Ns.qname -> schema -> type_definition
val get_attribute: Ns.qname -> schema -> attribute_declaration
val get_element: Ns.qname -> schema -> element_declaration
val get_attribute_group: Ns.qname -> schema -> attribute_group_definition
val get_model_group: Ns.qname -> schema -> model_group_definition
*)
val get_component: component_kind -> Ns.qname -> schema -> component
val iter_types: schema -> (type_definition -> unit) -> unit
val iter_attributes: schema -> (attribute_declaration -> unit) -> unit
val iter_elements: schema -> (element_declaration -> unit) -> unit
val iter_attribute_groups:
schema -> (attribute_group_definition -> unit) -> unit
val iter_model_groups: schema -> (model_group_definition -> unit) -> unit
val first_of_wildcard_constraint: wildcard_constraint -> Atoms.t
val first_of_particle: particle -> Atoms.t
val first_of_model_group: model_group -> Atoms.t
val nullable: particle -> bool
val first_of_wildcard_constraint: wildcard_constraint -> Atoms.t
val nullable_of_model_group: model_group -> bool
(** {2 Facets} *)
val merge_facets: facets -> facets -> facets
(*
val normalize_simple_type: simple_type_definition -> simple_type_definition
*)
(** {2 Miscellaneous} *)
(** empty set of facets (with the only exception of "whiteSpace", which is set
to <`Collapse, true>, the mandatory value for all non string derived simple
types) *)
(** empty set of facets (with the only exception of "whiteSpace", which is set
to <`Collapse, true>, the mandatory value for all non string derived simple
types) *)
val no_facets: facets
val anyType: type_definition
(** @return the integer interval corrisponding to boundary facets *)
val get_interval: facets -> Intervals.t
(** perform white space normalization according to XML recommendation *)
(** perform white space normalization according to XML recommendation *)
val normalize_white_space: white_space_handling -> Utf8.t -> Utf8.t
(** {2 event interface on top of CDuce values} *)
......@@ -97,12 +27,6 @@ val stream_of_value: Value.t -> event Stream.t
val string_of_event: event -> string
val print_model_group: Format.formatter -> model_group -> unit
val print_particle: Format.formatter -> particle -> unit
val simple_restrict:
Ns.qname option -> simple_type_definition -> facets -> simple_type_definition
val simple_list:
......
......@@ -126,9 +126,6 @@ let parse_facets base n =
in
_fold_elems n no_facets aux
let merge_facets' base new_facets =
merge_facets (facets_of_simple_type_definition base) new_facets
let default_fixed n f =
match _may_attr "default" n with
| Some v -> Some (`Default (f v))
......@@ -377,7 +374,7 @@ let schema_of_uri uri =
| Complex { ct_attrs = uses }, `Restriction ->
let ( &= ) u1 u2 =
(* by name equality over attribute uses *)
(name_of_attribute_use u1 = name_of_attribute_use u2)
(u1.attr_decl.attr_name = u2.attr_decl.attr_name)
in
let l =
List.filter
......@@ -514,7 +511,7 @@ let schema_of_uri uri =
| Some ref -> elt (resolve_elt ref) ref
| None ->
let decl = parse_elt_decl false n in
elt decl (name_of_element_declaration decl))
elt decl decl.elt_name)
| "xsd:group" -> model (resolve_model_group (_qname_attr "ref" n)).mg_def
| "xsd:all" | "xsd:sequence" | "xsd:choice" ->
model (parse_model_group n)
......
......@@ -143,19 +143,5 @@ type schema = {
type event =
| E_start_tag of Ns.qname
| E_end_tag of Ns.qname
| E_attribute of Ns.qname * Encodings.Utf8.t (* qualified name, value *)
| E_attribute of Ns.qname * Encodings.Utf8.t
| E_char_data of Encodings.Utf8.t
(** {2 Misc} *)
(* kind of a schema component *)
type component_kind =
[ `Type | `Element | `Attribute | `Attribute_group | `Model_group ] option
type component =
| Type of type_definition
| Element of element_declaration
| Attribute of attribute_declaration
| Attribute_group of attribute_group_definition
| Model_group of model_group_definition
......@@ -5,17 +5,8 @@
exceptions are available here. See Schema_common.
*)
(**
Glossary:
XSD XML Schema Document
PSV Post Schema Validation
PSVI Post Schema Validation Infoset
*)
open Encodings
(** {2 XSD representation} *)
type derivation_type = [ `Extension | `Restriction ]
type white_space_handling = [ `Preserve | `Replace | `Collapse ]
......@@ -138,24 +129,8 @@ type schema = {
model_groups: model_group_definition list;
}
(** {2 Events} see Schema_events module *)
type event =
| E_start_tag of Ns.qname
| E_end_tag of Ns.qname
| E_attribute of Ns.qname * Encodings.Utf8.t (* qualified name, value *)
| E_attribute of Ns.qname * Encodings.Utf8.t
| E_char_data of Encodings.Utf8.t
(** {2 Misc} *)
(* kind of a schema component *)
type component_kind =
[ `Type | `Element | `Attribute | `Attribute_group | `Model_group ] option
type component =
| Type of type_definition
| Element of element_declaration
| Attribute of attribute_declaration
| Attribute_group of attribute_group_definition
| Model_group of model_group_definition
......@@ -333,7 +333,7 @@ let next_tag ctx =
let validate_attribute_uses attrs (attr_uses,anyattr) =
let tbl = QTable.create 11 in
List.iter
(fun use -> QTable.add tbl (name_of_attribute_use use) use)
(fun use -> QTable.add tbl use.attr_decl.attr_name use)
attr_uses;
let attribs = ref [] in
List.iter
......@@ -417,13 +417,6 @@ and validate_content_type ctx content_type =
get ctx
and validate_particle ctx particle =
(*
Format.fprintf ppf "Particle first";
List.iter (fun n -> Format.fprintf ppf "%a;" Ns.QName.print n)
particle.part_first;
Format.fprintf ppf "@.";
*)
let rec validate_once ~cont_ok ~cont_failure =
do_pcdata ctx;
match peek ctx with
......@@ -472,7 +465,7 @@ and validate_term ctx term =
and validate_choice ctx particles =
(* TODO: Handle case when one of the choices is nullable *)
let tbl = Atoms.mk_map
(List.map (fun p -> first_of_particle p, p) particles) in
(List.map (fun p -> p.part_first, p) particles) in
do_pcdata ctx;
try
(match peek ctx with
......@@ -487,7 +480,7 @@ and validate_all_group ctx particles =
let tbl = QTable.create 20 in
let slots = List.map (fun p -> (p, ref None)) particles in
let tbl = Atoms.mk_map
(List.map (fun (p,slot) -> first_of_particle p, (p,slot)) slots) in
(List.map (fun (p,slot) -> p.part_first, (p,slot)) slots) in
let contents = ref Value.nil in
let rec aux () =
......@@ -509,7 +502,7 @@ and validate_all_group ctx particles =
(fun (p,slot) ->
match !slot with
| Some x -> concat ctx x
| None when nullable p -> ()
| None when p.part_nullable -> ()
| None -> error "One particle of the all group is missing"
) slots
......
......@@ -1845,9 +1845,9 @@ let register_schema schema_name uri schema =
) lst
in
defs "type" name_of_type_definition type_def validate_type schema.types;
defs "attribute" name_of_attribute_declaration att_decl
defs "attribute" (fun a -> a.attr_name) att_decl
(fun _ -> assert false) schema.attributes;
defs "element" name_of_element_declaration elt_decl
defs "element" (fun e -> e.elt_name) elt_decl
validate_element schema.elements;
defs "attribute group" (fun ag -> ag.ag_name) attr_group
validate_attribute_group schema.attribute_groups;
......
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