Commit 545658c5 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-11-26 16:22:19 by szach] added first related functions: first_of_particle,

first_of_model_group, is_in_first, nullable

Original author: szach
Date: 2003-11-26 16:22:19+00:00
parent 76c3cd04
......@@ -39,7 +39,7 @@ let name_of_attribute_use (_, (name, _, _), _) = name
let name_of_attribute_group_definition = fst
let name_of_model_group_definition = fst
let name_of_particle = function
| (_, _, Elt elt_decl_ref) -> name_of_element_declaration !elt_decl_ref
| (_, _, Elt elt_decl_ref, _) -> name_of_element_declaration !elt_decl_ref
| _ -> assert false
let variety_of_simple_type_definition = function
| (Primitive name) as st -> Atomic st
......@@ -85,6 +85,23 @@ let rec normalize_white_space =
let anySimpleType = Primitive (Encodings.Utf8.mk "xsd:anySimpleType")
let anyType = AnyType
let first_of_particle (_, _, _, first) = first
let nullable p = List.mem None (first_of_particle p)
let first_of_model_group = function
| All particles | Choice particles ->
List.concat (List.map first_of_particle particles)
| Sequence particles ->
let rec aux = function
| hd :: tl when nullable hd -> (first_of_particle hd) @ (aux tl)
| hd :: tl -> first_of_particle hd
| [] -> []
in
aux particles
let rec is_in_first tag = function
| [] -> false
| Some tag' :: rest when Utf8.equal tag' tag -> true
| _ :: rest -> is_in_first tag rest
let get_interval facets =
(* ASSUMPTION:
* not (facets.minInclusive = Some _ && facets.minExclusive = Some _)
......@@ -293,7 +310,7 @@ type to_be_visited =
let 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 *)
what has still to be visited *)
match !stack with
| (Fully ((Value.Xml (Value.Atom atom, attrs, _)) as v)) :: tl ->
stack := (Half v) :: tl;
......
......@@ -56,6 +56,11 @@ val iter_attribute_groups:
schema -> (attribute_group_definition -> unit) -> unit
val iter_model_groups: schema -> (model_group_definition -> unit) -> unit
val first_of_particle: particle -> first
val first_of_model_group: model_group -> first
val is_in_first: Utf8.t -> first -> bool
val nullable: particle -> bool
(** {2 Facets} *)
val merge_facets: facets -> facets -> facets
......@@ -80,8 +85,8 @@ val get_interval: facets -> Intervals.t
(** perform white space normalization according to XML recommendation *)
val normalize_white_space: white_space_handling -> Utf8.t -> Utf8.t
(** event interface on top of CDuce values *)
val stream_of_value: Value.t -> event Stream.t
(** {2 event interface on top of CDuce values} *)
val stream_of_value: Value.t -> event Stream.t
val string_of_event: event -> string
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