Commit 476f9fe4 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2003-11-21 12:51:57 by szach] qualify record fields and tagnames with targetNamespace namespace

Original author: szach
Date: 2003-11-21 12:51:57+00:00
parent c138e5f6
......@@ -1361,7 +1361,7 @@ module Schema_converter =
(* conversion functions *)
let rec cd_type_of_simple_type = function
let rec cd_type_of_simple_type ~schema = function
| Primitive name | Derived (Some name, _, _, _)
when Schema_builtin.is_builtin name ->
PType (Schema_builtin.cd_type_of_builtin name)
......@@ -1386,9 +1386,10 @@ module Schema_converter =
PType (Schema_builtin.cd_type_of_builtin name)
| Derived (_, Atomic _, facets, _) -> assert false
| Derived (_, List item, facets, _) ->
mk_seq_derecurs ~base:(PElem (cd_type_of_simple_type item)) facets
mk_seq_derecurs
~base:(PElem (cd_type_of_simple_type ~schema item)) facets
| Derived (_, Union items, facets, _) ->
(match List.map cd_type_of_simple_type items with
(match List.map (cd_type_of_simple_type ~schema) items with
| [] -> assert false (* vacuum union *)
| [t] -> t (* useless union *)
| hd::tl -> List.fold_left (fun acc x -> POr (x, acc)) hd tl)
......@@ -1396,69 +1397,72 @@ module Schema_converter =
let complex_memo = Hashtbl.create 213
let element_memo = Hashtbl.create 213
let rec regexp_of_term = function
| Model group -> regexp_of_model_group group
| Elt decl -> PElem (cd_type_of_elt_decl !decl)
let rec regexp_of_term ~schema = function
| Model group -> regexp_of_model_group ~schema group
| Elt decl -> PElem (cd_type_of_elt_decl ~schema !decl)
and regexp_of_model_group = function
and regexp_of_model_group ~schema = function
| All [] | Choice [] | Sequence [] -> PEpsilon
| Choice (hd :: tl) ->
List.fold_left
(fun acc particle -> PAlt (acc, regexp_of_particle particle))
(regexp_of_particle hd) tl
(fun acc particle ->
PAlt (acc, regexp_of_particle ~schema particle))
(regexp_of_particle ~schema hd) tl
| All (hd :: tl) | Sequence (hd :: tl) ->
List.fold_left
(fun acc particle -> PSeq (acc, regexp_of_particle particle))
(regexp_of_particle hd) tl
(fun acc particle ->
PSeq (acc, regexp_of_particle ~schema particle))
(regexp_of_particle ~schema hd) tl
and regexp_of_content_type = function
and regexp_of_content_type ~schema = function
| CT_empty -> PEpsilon
| CT_simple st -> PElem (cd_type_of_simple_type st)
| CT_simple st -> PElem (cd_type_of_simple_type ~schema st)
| CT_model (particle, mixed) ->
assert (not mixed); (* TODO mixed support *)
regexp_of_particle particle
regexp_of_particle ~schema particle
and regexp_of_particle (min, max, term) =
mk_len_regexp ?min:(Some min) ?max (regexp_of_term term)
and regexp_of_particle ~schema (min, max, term) =
mk_len_regexp ?min:(Some min) ?max (regexp_of_term ~schema term)
(** @return a pair composed by a type for the attributes (a record) and a
type for the content model (a sequence) *)
and cd_type_of_complex_type' (id, name, _, _, attr_uses, content) =
and cd_type_of_complex_type' ~schema (id, name, _, _, attr_uses, content) =
try
PAlias (Hashtbl.find complex_memo id)
with Not_found ->
let slot = mk_derecurs_slot noloc in
Hashtbl.add complex_memo id slot;
let content_re = regexp_of_content_type content in
let content_re = regexp_of_content_type ~schema content in
let content_ast_node = PRegexp (content_re, PType Sequence.nil_type) in
slot.pdescr <-
PTimes (cd_type_of_attr_uses attr_uses, content_ast_node);
PTimes (cd_type_of_attr_uses ~schema attr_uses, content_ast_node);
PAlias slot
(** @return a closed record *)
and cd_type_of_attr_uses attr_uses =
and cd_type_of_attr_uses ~schema attr_uses =
let fields =
List.map
(fun (required, (name, st, _), constr) ->
let r =
match constr with
| Some (`Fixed v) -> PType (Types.constant (Value.inv_const v))
| _ -> cd_type_of_simple_type st
| _ -> cd_type_of_simple_type ~schema st
in
let r = if required then r else POptional r in
(LabelPool.mk (Ns.empty, U.mk name), r)) (* TODO: NS *)
(LabelPool.mk (schema.targetNamespace, U.mk name), r))
attr_uses in
PRecord (false, LabelMap.from_list_disj fields)
and cd_type_of_att_decl (name, st, _) =
let r = cd_type_of_simple_type st in
and cd_type_of_att_decl ~schema (name, st, _) =
let r = cd_type_of_simple_type ~schema st in
PRecord (false,
LabelMap.from_list_disj [(LabelPool.mk (Ns.empty, U.mk name), r)])
(* TODO: NS *)
LabelMap.from_list_disj
[(LabelPool.mk (schema.targetNamespace, U.mk name), r)])
and cd_type_of_elt_decl (_, name, typ, constr) =
and cd_type_of_elt_decl ~schema (_, name, typ, constr) =
let atom_type =
PType (Types.atom (Atoms.atom (Atoms.V.mk Ns.empty (U.mk name))))
PType (Types.atom (Atoms.atom (Atoms.V.mk schema.targetNamespace
(U.mk name))))
in
let content =
match constr with
......@@ -1468,29 +1472,32 @@ module Schema_converter =
| AnyType -> PType (Schema_builtin.cd_type_of_builtin "xsd:anyType")
| Simple st ->
PTimes
(PType Types.empty_closed_record, cd_type_of_simple_type st)
| Complex ct -> cd_type_of_complex_type' ct)
(PType Types.empty_closed_record,
cd_type_of_simple_type ~schema st)
| Complex ct -> cd_type_of_complex_type' ~schema ct)
in
PXml (atom_type, content)
let cd_type_of_complex_type ct =
PXml (PType Types.any, cd_type_of_complex_type' ct)
let cd_type_of_complex_type ~schema ct =
PXml (PType Types.any, cd_type_of_complex_type' ~schema ct)
let cd_type_of_model_group g = PRegexp (regexp_of_model_group g, nil_type)
let cd_type_of_model_group ~schema g =
PRegexp (regexp_of_model_group ~schema g, nil_type)
let typ r = Types.descr (do_typ noloc r)
(* Schema_converter interface implementation.
* Shadows previous definitions.
*)
let cd_type_of_type_def = function
let cd_type_of_type_def ~schema = function
| AnyType -> Schema_builtin.cd_type_of_builtin "xsd:anyType"
| Simple st -> typ (cd_type_of_simple_type st)
| Complex ct -> typ (cd_type_of_complex_type ct)
let cd_type_of_elt_decl x = typ (cd_type_of_elt_decl x)
let cd_type_of_att_decl x = typ (cd_type_of_att_decl x)
let cd_type_of_attr_uses x = typ (cd_type_of_attr_uses x)
let cd_type_of_model_group x = typ (cd_type_of_model_group x)
| Simple st -> typ (cd_type_of_simple_type ~schema st)
| Complex ct -> typ (cd_type_of_complex_type ~schema ct)
let cd_type_of_elt_decl ~schema x = typ (cd_type_of_elt_decl ~schema x)
let cd_type_of_att_decl ~schema x = typ (cd_type_of_att_decl ~schema x)
let cd_type_of_attr_uses ~schema x = typ (cd_type_of_attr_uses ~schema x)
let cd_type_of_model_group ~schema x =
typ (cd_type_of_model_group ~schema x)
end
......@@ -1517,33 +1524,33 @@ let register_schema schema_name schema =
Hashtbl.add !schemas schema_name schema;
List.iter (* Schema types -> CDuce types *)
(fun type_def ->
let cd_type = Schema_converter.cd_type_of_type_def type_def in
let cd_type = Schema_converter.cd_type_of_type_def ~schema type_def in
let name = Schema_common.name_of_type_definition type_def in
log_schema_component "type" schema_name name cd_type;
Hashtbl.add !schema_types (schema_name, name) cd_type)
schema.Schema_types.types;
List.iter (* Schema attributes -> CDuce types *)
(fun (name, _, _) as att_decl ->
let cd_type = Schema_converter.cd_type_of_att_decl att_decl in
let cd_type = Schema_converter.cd_type_of_att_decl ~schema att_decl in
log_schema_component "attribute" schema_name name cd_type;
Hashtbl.add !schema_attributes (schema_name, name) cd_type)
schema.Schema_types.attributes;
List.iter (* Schema elements -> CDuce types *)
(fun elt_decl ->
let cd_type = Schema_converter.cd_type_of_elt_decl elt_decl in
let cd_type = Schema_converter.cd_type_of_elt_decl ~schema elt_decl in
let name = Schema_common.name_of_element_declaration elt_decl in
log_schema_component "element" schema_name name cd_type;
Hashtbl.add !schema_elements (schema_name, name) cd_type)
schema.Schema_types.elements;
List.iter (* Schema attribute groups -> CDuce types *)
(fun (name, uses) ->
let cd_type = Schema_converter.cd_type_of_attr_uses uses in
let cd_type = Schema_converter.cd_type_of_attr_uses ~schema uses in
log_schema_component "attribute group" schema_name name cd_type;
Hashtbl.add !schema_attribute_groups (schema_name, name) cd_type)
schema.Schema_types.attribute_groups;
List.iter (* Schema model groups -> CDuce types *)
(fun (name, group) ->
let cd_type = Schema_converter.cd_type_of_model_group group in
let cd_type = Schema_converter.cd_type_of_model_group ~schema group in
log_schema_component "model group" schema_name name cd_type;
Hashtbl.add !schema_model_groups (schema_name, name) cd_type)
schema.Schema_types.model_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