Commit 82ba4946 authored by Pietro Abate's avatar Pietro Abate
Browse files

[r2005-02-24 16:28:29 by afrisch] More builtin types

Original author: afrisch
Date: 2005-02-24 16:28:29+00:00
parent 30ec2f64
open Printf
open Encodings
......@@ -10,14 +9,14 @@ open Schema_types
(* TODO a lot of almost cut-and-paste code, expecially in gFoo types validation
*)
(* TODO: distinguish primitive and derived types in the interface *)
(** {2 Aux/Misc stuff} *)
let xsd = Schema_xml.xsd
let add_xsd_prefix s = (xsd, Utf8.mk s)
let unsupported =
List.map (fun s -> add_xsd_prefix s)
[ "decimal"; "float"; "double"; "NOTATION"; "QName" ]
let unsupported = [ "decimal"; "float"; "double"; "NOTATION"; "QName" ]
let is_empty s = Utf8.equal s (Utf8.mk "")
......@@ -412,11 +411,7 @@ module QTable = Hashtbl.Make(Ns.QName)
let builtins : t QTable.t = QTable.create 50
let reg = QTable.add builtins
(*
let alias alias name =
let (alias, name) = (add_xsd_prefix alias, add_xsd_prefix name) in
QTable.add builtins alias (QTable.find builtins name)
*)
let restrict name (base,_,_) facets cd v =
let name = add_xsd_prefix name in
......@@ -425,7 +420,14 @@ let restrict name (base,_,_) facets cd v =
reg name b;
b
let list name = simple_list (Some (add_xsd_prefix name))
let list name (item,_,_) cd v =
let name = add_xsd_prefix name in
let t = simple_list (Some name) item in
let b = (t,cd,v) in
reg name b;
b
let primitive name cd v =
let name = add_xsd_prefix name in
let rec t =
......@@ -437,6 +439,9 @@ let primitive name cd v =
reg name b;
b
let alias name b =
let name = add_xsd_prefix name in
reg name b
let any_simple_type =
primitive "anySimpleType" Builtin_defs.string validate_string
......@@ -470,14 +475,9 @@ let _ =
primitive "gDay" gDay_type validate_gDay
let _ =
primitive "gMonth" gMonth_type validate_gMonth
(*
(* TODO following types not yet supported (see "unsupported" above) *)
alias "decimal" "string";
alias "float" "string";
alias "double" "string";
alias "NOTATION" "string";
alias "QName" "string";
*)
let _ =
List.iter (fun n -> alias n string) unsupported
(* derived builtins *)
......@@ -530,20 +530,22 @@ let token =
{ no_facets with whiteSpace = `Collapse, false }
Builtin_defs.string validate_token
(*
alias "language" "token";
alias "Name" "token";
alias "NMTOKEN" "token";
alias "NCName" "token";
alias "ID" "token";
alias "IDREF" "token";
alias "ENTITY" "token";
reg "NMTOKENS"
(list' "NMTOKENS" "token",
string_list_type, validate_token_list);
alias "IDREFS" "NMTOKENS";
alias "ENTITIES" "NMTOKENS"
*)
let _ =
alias "language" token;
alias "Name" token;
alias "NMTOKEN" token;
alias "NCName" token;
alias "ID" token;
alias "IDREF" token;
alias "ENTITY" token
let nmtokens =
list "NMTOKENS" token string_list_type validate_token_list
let _ =
alias "IDREFS" nmtokens;
alias "ENTITIES" nmtokens
(** {2 Printing} *)
......
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