[r2003-11-24 16:03:12 by szach] use Utf8 everywhere in schema support

Original author: szach
Date: 2003-11-24 16:03:14+00:00

compile/lambda.ml

@@ -26,7 +26,7 @@ type expr =
   | Transform of expr * branches
   | Xtrans of expr * branches
   | Try of expr * branches
-  | Validate of expr * schema_component_kind * string * string
+  | Validate of expr * schema_component_kind * U.t * U.t
   | RemoveField of expr * label
   | Dot of expr * label
   | UnaryOp of int * expr

driver/cduce.ml

@@ -69,7 +69,7 @@ let dump_env ppf =
   Format.fprintf ppf "Namespace prefixes used for pretty-printing:@.%t"
     Ns.InternalPrinter.dump;
   Format.fprintf ppf "Schemas: %s@."
-    (String.concat " " (Typer.get_schema_names ()));
+    (String.concat " " (List.map U.get_str (Typer.get_schema_names ())));
   Format.fprintf ppf "Values:@.";
   Typer.iter_values !typing_env
     (fun x t -> dump_value ppf x t (get_global_value x))

parser/ast.ml

@@ -8,7 +8,7 @@ type pprog = pmodule_item list
 and pmodule_item = pmodule_item' located
 and pmodule_item' =
   | TypeDecl of id * ppat
-  | SchemaDecl of string * Schema_types.schema  (* name, schema *)
+  | SchemaDecl of U.t * Schema_types.schema  (* name, schema *)
   | LetDecl of ppat * pexpr
   | FunDecl of pexpr
   | Namespace of U.t * Ns.t
@@ -30,9 +30,9 @@ and toplevel_directive =
   | `Reinit_ns
   | `Help
   | `Dump of pexpr
-  | `Print_schema of string
-  | `Print_schema_type of Schema_types.component_kind * string * string
-  | `Print_type of string
+  | `Print_schema of U.t
+  | `Print_schema_type of Schema_types.component_kind * U.t * U.t
+  | `Print_type of U.t
   ]
 
 
@@ -59,7 +59,7 @@ and pexpr =
   | Map of pexpr * branches
   | Transform of pexpr * branches
   | Xtrans of pexpr * branches
-  | Validate of pexpr * Schema_types.component_kind * string * string
+  | Validate of pexpr * Schema_types.component_kind * U.t * U.t
       (* exp, schema component kind, schema name, element name *)
   | Dot of pexpr * label
   | RemoveField of pexpr * label
@@ -91,7 +91,7 @@ and ppat = ppat' located
 and ppat' =
   | PatVar of U.t
   | SchemaVar of  (* type/pattern schema variable *)
-      Schema_types.component_kind * string * string (* kind, schema, name *)
+      Schema_types.component_kind * U.t * U.t (* kind, schema, name *)
   | Cst of pexpr
   | NsT of U.t
   | Recurs of ppat * (id * ppat) list

parser/parser.ml

@@ -114,7 +114,7 @@ EXTEND
     | "schema"; name = IDENT; "="; uri = STRING2 ->
 	protect_op "schema";
         let schema = Schema_parser.schema_of_file uri in
-        [ mk loc (SchemaDecl (name, schema)) ]
+        [ mk loc (SchemaDecl (U.mk name, schema)) ]
     | (name,ns) = namespace_binding ->
 	[ mk loc (Namespace (name, ns)) ]
     | (name,ns) = namespace_binding; "in"; e2 = expr LEVEL "top" ->
@@ -127,7 +127,7 @@ EXTEND
     | DIRECTIVE "#quit" -> [ mk loc (Directive `Quit) ]
     | DIRECTIVE "#env" -> [ mk loc (Directive `Env) ]
     | DIRECTIVE "#print_schema"; name = IDENT ->
-        [ mk loc (Directive (`Print_schema name)) ]
+        [ mk loc (Directive (`Print_schema (U.mk name))) ]
     | DIRECTIVE "#print_type"; name = IDENT;
       schema_part = OPT [
         "#"; typ = [ IDENT | keyword ];
@@ -135,9 +135,10 @@ EXTEND
           (kind, typ)
       ] ->
         (match schema_part with
-        | None -> [ mk loc (Directive (`Print_type name)) ]
+        | None -> [ mk loc (Directive (`Print_type (U.mk name))) ]
         | Some (kind, typ) ->
-            [ mk loc (Directive (`Print_schema_type (kind, name, typ))) ])
+            [ mk loc
+              (Directive (`Print_schema_type (kind, U.mk name, U.mk typ))) ])
     | DIRECTIVE "#dump_value"; e = expr -> [ mk loc (Directive (`Dump e)) ]
     | DIRECTIVE "#reinit_ns" -> [ mk loc (Directive `Reinit_ns) ]
     | DIRECTIVE "#help" -> [ mk loc (Directive `Help) ]
@@ -483,7 +484,7 @@ EXTEND
   schema_ref: [
     [ schema = IDENT; "#"; typ = [ IDENT | keyword ];
       kind = OPT [ "as"; k = schema_kind -> k] ->
-        (kind, schema, typ)
+        (kind, U.mk schema, U.mk typ)
     ]
   ];
 
@@ -508,7 +509,7 @@ EXTEND
 	  mk loc (Constant (ident a,c))
       | schema = IDENT; "#"; typ = [ IDENT | keyword ];
         kind = OPT [ "as"; k = schema_kind -> k] ->
-          mk loc (SchemaVar (kind, schema, typ))
+          mk loc (SchemaVar (kind, U.mk schema, U.mk typ))
       | a = IDENT -> 
 	  mk loc (PatVar (U.mk a))
       | i = INT ; "--"; j = INT -> 

schema/schema_builtin.mli

 
+open Encodings
+
 (** all schema simple type names used in this API are prefixed with
  * Schema_xml.xsd_prefix *)
 
-exception Schema_builtin_error of string
+exception Schema_builtin_error of Utf8.t
 
-val is_builtin: string -> bool
-val get_builtin: string -> Schema_types.simple_type_definition
+val is_builtin: Utf8.t -> bool
+val get_builtin: Utf8.t -> Schema_types.simple_type_definition
 val iter_builtin: (Schema_types.simple_type_definition -> unit) -> unit
 
-val cd_type_of_builtin: string -> Types.descr
+val cd_type_of_builtin: Utf8.t -> Types.descr
 
-  (** @raise Schema_builtin_error [name] in case of validation error, where
+  (** validate_builtin <builtin> <string>
+   * validates <string> against builtin type <builtin> and return the resulting
+   * cduce value
+   * @raise Schema_builtin_error [name] in case of validation error, where
    * [name] is the name of a schema built in type prefixed with
    * Schema_xml.xsd_prefix *)
-val validate_builtin: string -> string -> Value.t
+val validate_builtin: Utf8.t -> Utf8.t -> Value.t
 

schema/schema_common.ml

 
 open Printf
 
+open Encodings
+open Encodings.Utf8.Pcre
 open Schema_types
 
 let no_facets = {
@@ -29,7 +31,7 @@ let name_of_complex_type_definition = function
   | _, Some name, _, _, _, _ -> name
   | _ -> raise (Invalid_argument "anonymous complex type definition")
 let name_of_type_definition = function
-  | AnyType -> "xsd:anyType"
+  | AnyType -> Encodings.Utf8.mk "xsd:anyType"
   | Simple st -> name_of_simple_type_definition st
   | Complex ct -> name_of_complex_type_definition ct
 let name_of_attribute_declaration (name, _, _) = name
@@ -63,26 +65,24 @@ let iter_attribute_groups schema f = List.iter f schema.attribute_groups
 let iter_model_groups schema f = List.iter f schema.model_groups
 
 exception XSD_validation_error of string
-exception XSI_validation_error of validation_context * string
-
-let regexp' s = Pcre.regexp ~flags:[`UTF8] s
+exception XSI_validation_error of string
 
 let rec normalize_white_space =
-  let ws_RE = regexp' "[\t\r\n]" in
-  let spaces_RE = regexp' "[ ]+" in
-  let margins_RE = regexp' "^ (.*) $" in
+  let ws_RE = pcre_regexp "[\t\r\n]" in
+  let spaces_RE = pcre_regexp "[ ]+" in
+  let margins_RE = pcre_regexp "^ (.*) $" in
   fun handling s ->
   match handling with
   | `Preserve -> s
-  | `Replace -> Pcre.replace ~rex:ws_RE ~templ:" " s
+  | `Replace -> pcre_replace ~rex:ws_RE ~templ:(Utf8.mk " ") s
   | `Collapse ->
       let s' =
-        Pcre.replace ~rex:spaces_RE ~templ:" "
+        pcre_replace ~rex:spaces_RE ~templ:(Utf8.mk " ")
           (normalize_white_space `Replace s)
       in
-      Pcre.replace ~rex:margins_RE ~templ:"$1" s'
+      pcre_replace ~rex:margins_RE ~templ:(Utf8.mk "$1") s'
 
-let anySimpleType = Primitive "xsd:anySimpleType"
+let anySimpleType = Primitive (Encodings.Utf8.mk "xsd:anySimpleType")
 let anyType = AnyType
 
 let get_interval facets =
@@ -113,22 +113,27 @@ let get_interval facets =
   | None, None -> Intervals.any
 
 let print_simple_type fmt = function
-  | Primitive name -> Format.fprintf fmt "%s" name
-  | Derived (Some name, _, _, _) -> Format.fprintf fmt "%s'" name
+  | Primitive name -> Format.fprintf fmt "%a" Encodings.Utf8.dump name
+  | Derived (Some name, _, _, _) ->
+      Format.fprintf fmt "%a'" Encodings.Utf8.dump name
   | Derived (None, _, _, _) -> Format.fprintf fmt "unnamed'"
 let print_complex_type fmt = function
-  | (id, Some name, _, _, _, _) -> Format.fprintf fmt "%d:%s" id name
+  | (id, Some name, _, _, _, _) ->
+      Format.fprintf fmt "%d:%a" id Encodings.Utf8.dump name
   | (id, None, _, _, _, _) -> Format.fprintf fmt "%d:unnamed'" id
 let print_type fmt = function
   | AnyType -> Format.fprintf fmt "xsd:anyType"
   | Simple t -> Format.fprintf fmt "S:%a" print_simple_type t
   | Complex t -> Format.fprintf fmt "C:%a" print_complex_type t
 let print_attribute fmt (name, t, _) =
-  Format.fprintf fmt "@@%s:%a" name print_simple_type t
-let print_element fmt (id, name, _, _) = Format.fprintf fmt "E:%d:<%s>" id name
+  Format.fprintf fmt "@@%a:%a" Utf8.dump name print_simple_type t
+let print_element fmt (id, name, _, _) =
+  Format.fprintf fmt "E:%d:<%a>" id Utf8.dump name
 let print_attributes fmt = List.iter (Format.fprintf fmt "%a" print_attribute)
-let print_attribute_group fmt (name, _) = Format.fprintf fmt "{agroup:%s}" name
-let print_model_group fmt (name, _) = Format.fprintf fmt "{mgroup:%s}" name
+let print_attribute_group fmt (name, _) =
+  Format.fprintf fmt "{agroup:%a}" Utf8.dump name
+let print_model_group fmt (name, _) =
+  Format.fprintf fmt "{mgroup:%a}" Utf8.dump name
 let print_schema fmt schema =
   let defined_types = (* filter out built-in types *)
     List.filter
@@ -277,4 +282,85 @@ let string_of_component_kind (kind: component_kind) =
   | Some `Model_group -> "model group"
   | None -> "component"
 
+(** Events *)
+
+type to_be_visited =
+  | Fully of Value.t  (* xml values still to be visited *)
+  | Half of Value.t   (* xml values half visited (i.e. E_start_tag generated) *)
+  | Other of Encodings.Utf8.t (* other values *)
+  | Backlog of event  (* old events not yet delivered *)
+
+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 *)
+    match !stack with
+    | (Fully ((Value.Xml (Value.Atom atom, attrs, _)) as v)) :: tl ->
+        stack := (Half v) :: tl;
+        let children = ref [] in  (* TODO inefficient *)
+        let push v s = (s := v :: !s) in
+        Value.iter_xml
+          (fun pcdata -> push (Other pcdata) children)
+          (fun v ->
+            match v with
+            | (Value.Xml (_, _, _)) as v -> push (Fully v) children
+            | v -> raise (Invalid_argument "Schema_events.stream_of_value"))
+          v;
+        stack := (List.rev !children) @ !stack;
+        List.iter (* push attributes as events on the stack *)
+          (fun (qname, v) ->
+            push (Backlog (E_attribute (qname, fst (Value.get_string_utf8 v))))
+              stack)
+          (Value.get_fields attrs);
+        Some (E_start_tag (Atoms.V.value atom))
+    | (Half (Value.Xml (Value.Atom atom, _, _))) :: tl ->
+        stack := tl;
+        Some (E_end_tag (Atoms.V.value atom))
+    | (Fully (Value.Xml (_, _, _)))::_ | (Half (Value.Xml (_, _, _)))::_ ->
+        failwith "Schema_xml.pxp_stream_of_value: non-atom-tag xml value"
+    | (Backlog ev) :: tl -> (* consume backlog *)
+        stack := tl;
+        Some ev
+    | (Other v) :: tl ->
+        stack := tl;
+        Some (E_char_data v)
+    | [] -> None
+    | _ -> assert false
+  in
+  Stream.from f
+
+let string_of_event = function
+  | E_start_tag qname -> sprintf "<%s>" (Ns.QName.to_string qname)
+  | E_end_tag qname -> sprintf "</%s>" (Ns.QName.to_string qname)
+  | E_attribute (qname, value) ->
+      sprintf "@%s=%s" (Ns.QName.to_string qname) (Utf8.to_string value)
+  | E_char_data value -> Utf8.to_string value
+
+(*
+let test v =
+  let s = stream_of_value v in
+  let rec aux () =
+    (match Stream.peek s with
+    | None -> ()
+    | Some (E_start_tag qname) ->
+        Ns.QName.print Format.std_formatter qname
+    | Some (E_end_tag qname) ->
+        Format.fprintf Format.std_formatter "/";
+        Ns.QName.print Format.std_formatter qname
+    | Some (E_attribute (qname, value)) ->
+        Format.fprintf Format.std_formatter "@@";
+        Ns.QName.print Format.std_formatter qname;
+        Format.fprintf Format.std_formatter " ";
+        Encodings.Utf8.print Format.std_formatter value
+    | Some (E_char_data value) ->
+        Encodings.Utf8.print Format.std_formatter value);
+    Format.fprintf Format.std_formatter "\n";
+    (match Stream.peek s with
+    | None -> ()
+    | _ ->
+      Stream.junk s;
+      aux ())
+  in
+  aux ()
+*)
 

schema/schema_common.mli

 
 (** 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 validation_context * string
+exception XSI_validation_error of string
 
 (** {2 XSD printer *)
 
@@ -22,15 +23,15 @@ val print_complex_type : Format.formatter -> complex_type_definition -> unit
 
 (** {2 Deconstruction functions} *)
 
-val name_of_element_declaration : element_declaration -> string
-val name_of_type_definition : type_definition -> string
-val name_of_simple_type_definition : simple_type_definition -> string
-val name_of_complex_type_definition : complex_type_definition -> string
-val name_of_attribute_declaration : attribute_declaration -> string
-val name_of_attribute_use : attribute_use -> string
-val name_of_attribute_group_definition : attribute_group_definition -> string
-val name_of_model_group_definition : model_group_definition -> string
-val name_of_particle : particle -> string
+val name_of_element_declaration : element_declaration -> Utf8.t
+val name_of_type_definition : type_definition -> Utf8.t
+val name_of_simple_type_definition : simple_type_definition -> Utf8.t
+val name_of_complex_type_definition : complex_type_definition -> Utf8.t
+val name_of_attribute_declaration : attribute_declaration -> Utf8.t
+val name_of_attribute_use : attribute_use -> Utf8.t
+val name_of_attribute_group_definition : attribute_group_definition -> Utf8.t
+val name_of_model_group_definition : model_group_definition -> Utf8.t
+val name_of_particle : particle -> Utf8.t
 
 val string_of_component_kind : component_kind -> string
 
@@ -40,13 +41,13 @@ 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: string -> schema -> type_definition
-val get_attribute: string -> schema -> attribute_declaration
-val get_element: string -> schema -> element_declaration
-val get_attribute_group: string -> schema -> attribute_group_definition
-val get_model_group: string -> schema -> model_group_definition
+val get_type: Utf8.t -> schema -> type_definition
+val get_attribute: Utf8.t -> schema -> attribute_declaration
+val get_element: Utf8.t -> schema -> element_declaration
+val get_attribute_group: Utf8.t -> schema -> attribute_group_definition
+val get_model_group: Utf8.t -> schema -> model_group_definition
 
-val get_component: component_kind -> string -> schema -> component
+val get_component: component_kind -> Utf8.t -> schema -> component
 
 val iter_types: schema -> (type_definition -> unit) -> unit
 val iter_attributes: schema -> (attribute_declaration -> unit) -> unit
@@ -61,7 +62,7 @@ val merge_facets: facets -> facets -> facets
 
   (** restrict base new_facets new_name
    *  Implements simple type derivition by restriction *)
-val restrict: simple_type_definition -> facets -> string option ->
+val restrict: simple_type_definition -> facets -> Utf8.t option ->
   simple_type_definition
 
 (** {2 Miscellaneous} *) 
@@ -77,5 +78,10 @@ val anyType: type_definition
 val get_interval: facets -> Intervals.t
 
   (** perform white space normalization according to XML recommendation *)
-val normalize_white_space: white_space_handling -> string -> string
+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
+
+val string_of_event: event -> string
 

schema/schema_parser.ml

@@ -2,6 +2,8 @@
 open Printf
 open Pxp_document
 
+open Encodings
+open Encodings.Utf8.Pcre
 open Schema_common
 open Schema_types
 open Schema_validator
@@ -18,9 +20,8 @@ let debug_print ?(n: pxp_node option) s =
         prerr_endline (sprintf "[%d] %s" line s);
         flush stderr)
 
-let regexp' s = Pcre.regexp ~flags:[`UTF8] s
-let space_RE = regexp' " "
-let split s = Pcre.split ~rex:space_RE s
+let space_RE = pcre_regexp " "
+let split s = pcre_split ~rex:space_RE s
 let hashtbl_deref tbl =
   (* ASSUMPTION: no multiple bindings *)
   let tbl' = Hashtbl.create 1024 in
@@ -34,15 +35,15 @@ class type resolver =
       @raise Osv_validation_error if the same node is seen twice *)
     method see : pxp_node -> unit
 
-    method resolve_att: ?fix_ns:bool -> string -> attribute_declaration
+    method resolve_att: ?fix_ns:bool -> Utf8.t -> attribute_declaration
     method resolve_elt:
-      ?fix_ns:bool -> now:bool -> string -> element_declaration ref
+      ?fix_ns:bool -> now:bool -> Utf8.t -> element_declaration ref
     method resolve_typ:
-      ?fix_ns:bool -> now:bool -> string -> type_definition ref
+      ?fix_ns:bool -> now:bool -> Utf8.t -> type_definition ref
     method resolve_att_group:
-      ?fix_ns:bool -> string -> attribute_group_definition
-    method resolve_model_group: ?fix_ns:bool -> string -> model_group_definition
-    method resolve_simple_typ: ?fix_ns:bool -> string -> simple_type_definition
+      ?fix_ns:bool -> Utf8.t -> attribute_group_definition
+    method resolve_model_group: ?fix_ns:bool -> Utf8.t -> model_group_definition
+    method resolve_simple_typ: ?fix_ns:bool -> Utf8.t -> simple_type_definition
   end
 
 module OrderedNode =
@@ -73,11 +74,14 @@ let parse_facets base n =
   debug_print ~n "Schema_parser.parse_facet"; 
   let validate_base_type = Schema_validator.validate_simple_type base in
   let validate_nonNegativeInteger =
-    Schema_builtin.validate_builtin "xsd:nonNegativeInteger"
+    Schema_builtin.validate_builtin
+      (Schema_xml.add_xsd_prefix (Utf8.mk "nonNegativeInteger"))
   in
   let facets = ref no_facets in
   n#iter_nodes (fun n ->
-    let fixed = (_has_attribute "fixed" n) && (_attribute "fixed" n = "true") in
+    let fixed =
+      (_has_attribute "fixed" n) && (_attribute "fixed" n = Utf8.mk "true")
+    in
     match n#node_type with
     | T_element "xsd:length" ->
         let value = _attribute "value" n in
@@ -92,7 +96,7 @@ let parse_facets base n =
         let length = integer_of_value_t (validate_nonNegativeInteger value) in
         facets := { !facets with maxLength = Some (length, fixed) }
     | T_element "xsd:enumeration" ->
-        let value = Value.string_latin1 (_attribute "value" n) in
+        let value = Value.string_utf8 (_attribute "value" n) in
         let value = validate_base_type value in
         let new_enumeration =
           (match !facets.enumeration with
@@ -101,7 +105,7 @@ let parse_facets base n =
         in
         facets := { !facets with enumeration = new_enumeration }
     | T_element "xsd:whiteSpace" ->
-        let value = _attribute "value" n in
+        let value = Utf8.get_str (_attribute "value" n) in
         facets := { !facets with whiteSpace =
           ((match value with
             | "collapse" -> `Collapse
@@ -110,19 +114,19 @@ let parse_facets base n =
             | _ -> assert false),
           fixed) }
     | T_element "xsd:maxInclusive" ->
-        let value = Value.string_latin1 (_attribute "value" n) in
+        let value = Value.string_utf8 (_attribute "value" n) in
         facets := { !facets with
           maxInclusive = Some (validate_base_type value, fixed) }
     | T_element "xsd:maxExclusive" ->
-        let value = Value.string_latin1 (_attribute "value" n) in
+        let value = Value.string_utf8 (_attribute "value" n) in
         facets := { !facets with
           maxExclusive = Some (validate_base_type value, fixed) }
     | T_element "xsd:minInclusive" ->
-        let value = Value.string_latin1 (_attribute "value" n) in
+        let value = Value.string_utf8 (_attribute "value" n) in
         facets := { !facets with
           minInclusive = Some (validate_base_type value, fixed) }
     | T_element "xsd:minExclusive" ->
-        let value = Value.string_latin1 (_attribute "value" n) in
+        let value = Value.string_utf8 (_attribute "value" n) in
         facets := { !facets with
           minExclusive = Some (validate_base_type value, fixed) }
     | _ -> ());
@@ -195,11 +199,11 @@ and find_member_types (resolver: resolver) n =
 let parse_att_value_constraint stype_def n =
   debug_print ~n "Schema_parser.parse_att_value_constraint";
   if _has_attribute "default" n then
-    let value = Value.string_latin1 (_attribute "default" n) in
+    let value = Value.string_utf8 (_attribute "default" n) in
     let value = validate_simple_type stype_def value in
     Some (`Default value)
   else if _has_attribute "fixed" n then
-    let value = Value.string_latin1 (_attribute "fixed" n) in
+    let value = Value.string_utf8 (_attribute "fixed" n) in
     let value = validate_simple_type stype_def value in
     Some (`Fixed value)
   else
@@ -212,14 +216,14 @@ let parse_elt_value_constraint type_def n =
     match type_def with
     | Simple st_def | Complex (_, _, _, _, _, CT_simple st_def) ->
         validate_simple_type st_def
-    | _ -> validate_simple_type (Primitive "xsd:string")
+    | _ -> validate_simple_type (Primitive (Utf8.mk "xsd:string"))
   in
   if _has_attribute "default" n then
-    let value = Value.string_latin1 (_attribute "default" n) in
+    let value = Value.string_utf8 (_attribute "default" n) in
     let value = validate_value value in
     Some (`Default value)
   else if _has_attribute "fixed" n then
-    let value = Value.string_latin1 (_attribute "fixed" n) in
+    let value = Value.string_utf8 (_attribute "fixed" n) in
     let value = validate_value value in
     Some (`Fixed value)
   else
@@ -246,7 +250,7 @@ let parse_att_decl (resolver: resolver) n =
 let parse_attribute_use (resolver: resolver) n =
   debug_print ~n "Schema_parser.parse_attribute_use";
   let required =
-    (_has_attribute "use" n) && (_attribute "use" n = "required")
+    (_has_attribute "use" n) && (_attribute "use" n = Utf8.mk "required")
   in
   let (name, type_def, value_constr) as att_decl =
     if _has_attribute "ref" n then
@@ -291,11 +295,11 @@ let parse_attribute_uses (resolver: resolver) derivation_type base n =
 
 let parse_min_max n =
   ((if _has_attribute "minOccurs" n then
-    Intervals.V.mk (_attribute "minOccurs" n)
+    Intervals.V.mk (Utf8.get_str (_attribute "minOccurs" n))
   else
     Intervals.V.one),
   (if _has_attribute "maxOccurs" n then
-    match _attribute "maxOccurs" n with
+    match Utf8.get_str (_attribute "maxOccurs" n) with
     | "unbounded" -> None
     | s -> Some (Intervals.V.mk s)
   else
@@ -366,8 +370,9 @@ let rec parse_complex_type (resolver: resolver) n =
     let base = resolver#resolve_typ ~now:true (_attribute "base" derivation) in
     let uses = parse_attribute_uses resolver derivation_type !base derivation in
     let mixed =
-      (_has_attribute "mixed" content && (_attribute "mixed" content = "true"))
-      || (_has_attribute "mixed" n && (_attribute "mixed" n = "true"))
+      (_has_attribute "mixed" content &&
+       (_attribute "mixed" content = Utf8.mk "true"))
+      || (_has_attribute "mixed" n && (_attribute "mixed" n = Utf8.mk "true"))
     in
     let particle_node = find_particle derivation in
     let content_type =
@@ -397,7 +402,9 @@ let rec parse_complex_type (resolver: resolver) n =
   else  (* neither simpleContent nor complexContent *)
     let base = anyType in
     let uses = parse_attribute_uses resolver `Restriction base n in
-    let mixed = _has_attribute "mixed" n && (_attribute "mixed" n = "true") in
+    let mixed =
+      _has_attribute "mixed" n && (_attribute "mixed" n = Utf8.mk "true")
+    in
     let content_type =
       match find_particle n with
       | None -> CT_empty
@@ -488,27 +495,29 @@ let parse_model_group_def (resolver: resolver) n =
   (** @param root schema document root node *)
 class lazy_resolver =
   let fake_type_def =
-    Complex (~-1, Some "   FAKE TYP   ", AnyType, `Restriction, [], CT_empty)
+    Complex (~-1, Some (Utf8.mk "   FAKE TYP   "), AnyType, `Restriction, [],
+      CT_empty)
   in
-  let fake_elt_decl = ~-2, "   FAKE ELT   ", ref fake_type_def, None in
+  let fake_elt_decl = ~-2, Utf8.mk "   FAKE ELT   ", ref fake_type_def, None in
   let is_fake_type_def = (==) fake_type_def in
   let is_fake_elt_decl = (==) fake_elt_decl in
   let validation_error s = raise (XSD_validation_error s) in
   let get_ns_prefix n =
     match n#node_type with T_namespace p -> p | _ -> assert false
   in
+  let (^^) x y = Utf8.concat x y in
   fun root ->
   object (self)
 
-    val typs: (string, type_definition ref) Hashtbl.t =
+    val typs: (Utf8.t, type_definition ref) Hashtbl.t =
       Hashtbl.create 17
-    val attrs: (string, attribute_declaration) Hashtbl.t =
+    val attrs: (Utf8.t, attribute_declaration) Hashtbl.t =
       Hashtbl.create 17
-    val elts: (string, element_declaration ref) Hashtbl.t =
+    val elts: (Utf8.t, element_declaration ref) Hashtbl.t =
       Hashtbl.create 17
-    val attr_groups: (string, attribute_group_definition) Hashtbl.t =
+    val attr_groups: (Utf8.t, attribute_group_definition) Hashtbl.t =
       Hashtbl.create 17