/[svn]/schema/schema_common.ml
ViewVC logotype

Diff of /schema/schema_common.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1293 by abate, Tue Jul 10 18:06:44 2007 UTC revision 1294 by abate, Tue Jul 10 18:38:01 2007 UTC
# Line 22  Line 22 
22  *)  *)
23  }  }
24    
25  let name_of_element_declaration (_, name, _, _) = name  let name_of_element_declaration elt = elt.elt_name
26  let name_of_simple_type_definition = function  let name_of_simple_type_definition = function
27    | Primitive name -> name    | Primitive name -> name
28    | Derived (Some name, _, _, _) -> name    | Derived (Some name, _, _, _) -> name
29    | _ -> raise (Invalid_argument "anonymous simple type definition")    | _ -> raise (Invalid_argument "anonymous simple type definition")
30  let name_of_complex_type_definition = function  let name_of_complex_type_definition = function
31    | _, Some name, _, _, _, _ -> name    | { ct_name = Some name } -> name
32    | _ -> raise (Invalid_argument "anonymous complex type definition")    | _ -> raise (Invalid_argument "anonymous complex type definition")
33  let name_of_type_definition = function  let name_of_type_definition = function
34    | AnyType -> Encodings.Utf8.mk "xsd:anyType"    | AnyType -> Encodings.Utf8.mk "xsd:anyType"
35    | Simple st -> name_of_simple_type_definition st    | Simple st -> name_of_simple_type_definition st
36    | Complex ct -> name_of_complex_type_definition ct    | Complex ct -> name_of_complex_type_definition ct
37  let name_of_attribute_declaration (name, _, _) = name  let name_of_attribute_declaration a = a.attr_name
38  let name_of_attribute_use (_, (name, _, _), _) = name  let name_of_attribute_use { attr_decl = { attr_name = name } } = name
39  let name_of_attribute_group_definition = fst  let name_of_attribute_group_definition ag = ag.ag_name
40  let name_of_model_group_definition = fst  let name_of_model_group_definition mg = mg.mg_name
41  let name_of_particle = function  let name_of_particle = function
42    | (_, _, Elt elt_decl_ref, _) -> name_of_element_declaration !elt_decl_ref    | (_, _, Elt elt_decl_ref, _) -> name_of_element_declaration !elt_decl_ref
43    | _ -> assert false    | _ -> assert false
# Line 52  Line 52 
52    | _ -> raise (Invalid_argument "complex_type_of_type")    | _ -> raise (Invalid_argument "complex_type_of_type")
53  let content_type_of_type = function  let content_type_of_type = function
54    | AnyType -> assert false    | AnyType -> assert false
55    | Complex (_, _, _, _, _, ct) -> ct    | Complex { ct_content = ct } -> ct
56    | Simple st -> CT_simple st    | Simple st -> CT_simple st
57  let facets_of_simple_type_definition = function  let facets_of_simple_type_definition = function
58    | Primitive _ -> no_facets    | Primitive _ -> no_facets
# Line 135  Line 135 
135        Format.fprintf fmt "%a'" Encodings.Utf8.dump name        Format.fprintf fmt "%a'" Encodings.Utf8.dump name
136    | Derived (None, _, _, _) -> Format.fprintf fmt "unnamed'"    | Derived (None, _, _, _) -> Format.fprintf fmt "unnamed'"
137  let print_complex_type fmt = function  let print_complex_type fmt = function
138    | (id, Some name, _, _, _, _) ->    | { ct_uid = id; ct_name = Some name } ->
139        Format.fprintf fmt "%d:%a" id Encodings.Utf8.dump name        Format.fprintf fmt "%d:%a" id Encodings.Utf8.dump name
140    | (id, None, _, _, _, _) -> Format.fprintf fmt "%d:unnamed'" id    | { ct_uid = id } ->
141          Format.fprintf fmt "%d:unnamed'" id
142  let print_type fmt = function  let print_type fmt = function
143    | AnyType -> Format.fprintf fmt "xsd:anyType"    | AnyType -> Format.fprintf fmt "xsd:anyType"
144    | Simple t -> Format.fprintf fmt "S:%a" print_simple_type t    | Simple t -> Format.fprintf fmt "S:%a" print_simple_type t
145    | Complex t -> Format.fprintf fmt "C:%a" print_complex_type t    | Complex t -> Format.fprintf fmt "C:%a" print_complex_type t
146  let print_attribute fmt (name, t, _) =  let print_attribute fmt { attr_name = name; attr_typdef = t } =
147    Format.fprintf fmt "@@%a:%a" Utf8.dump name print_simple_type t    Format.fprintf fmt "@@%a:%a" Utf8.dump name print_simple_type t
148  let print_element fmt (id, name, _, _) =  let print_element fmt { elt_uid = id; elt_name = name } =
149    Format.fprintf fmt "E:%d:<%a>" id Utf8.dump name    Format.fprintf fmt "E:%d:<%a>" id Utf8.dump name
150  let print_attributes fmt = List.iter (Format.fprintf fmt "%a" print_attribute)  let print_attributes fmt = List.iter (Format.fprintf fmt "%a" print_attribute)
151  let print_attribute_group fmt (name, _) =  let print_attribute_group fmt ag =
152    Format.fprintf fmt "{agroup:%a}" Utf8.dump name    Format.fprintf fmt "{agroup:%a}" Utf8.dump ag.ag_name
153  let print_model_group fmt (name, _) =  let print_model_group fmt mg =
154    Format.fprintf fmt "{mgroup:%a}" Utf8.dump name    Format.fprintf fmt "{mgroup:%a}" Utf8.dump mg.mg_name
155  let print_schema fmt schema =  let print_schema fmt schema =
156    let defined_types = (* filter out built-in types *)    let defined_types = (* filter out built-in types *)
157      List.filter      List.filter
Legend:
Removed from v.1293  
changed lines
  Added in v.1294
CVS Admin">CVS Admin
 ViewVC Help
Powered by ViewVC 1.1.5