[r2005-03-06 19:30:34 by afrisch] interval types

Original author: afrisch
Date: 2005-03-06 19:30:34+00:00

schema/schema_builtin.ml

@@ -13,6 +13,8 @@ open Schema_types
 
   (** {2 Aux/Misc stuff} *)
 
+let zero = Intervals.V.mk "0"
+
 let xsd = Schema_xml.xsd
 let add_xsd_prefix s = (xsd, Utf8.mk s)
 
@@ -20,17 +22,21 @@ let unsupported = [ "NOTATION"; "QName" ]
 
 let is_empty s = Utf8.equal s (Utf8.mk "")
 
-let zero = Intervals.V.zero
-let one = (Intervals.V.succ Intervals.V.zero)
-let minus_one = (Intervals.V.pred Intervals.V.zero)
-let long_l = (Intervals.V.mk "-9223372036854775808")
-let long_r = (Intervals.V.mk "9223372036854775807")
-let int_l = (Intervals.V.mk "-2147483648")
-let int_r = (Intervals.V.mk "2147483647")
-let short_l = (Intervals.V.mk "-32768")
-let short_r = (Intervals.V.mk "32767")
-let byte_l = (Intervals.V.mk "-128")
-let byte_r = (Intervals.V.mk "127")
+let int_types = 
+  [ "integer", None, None;
+    "nonPositiveInteger", None, Some "0";
+    "negativeInteger", None, Some "-1";
+    "long", Some "-9223372036854775808", Some "9223372036854775807";
+    "int", Some "-2147483648", Some "2147483647"; 
+    "short", Some "-32768", Some "32767";
+    "byte", Some "-128", Some "127";
+    "nonNegativeInteger", Some "0", None;
+    "unsignedLong", Some "0", Some "18446744073709551615";
+    "unsignedInt", Some "0", Some "4294967295";
+    "unsignedShort", Some "0", Some "65535";
+    "unsignedByte", Some "0", Some "255";
+    "positiveInteger", Some "1", None ]
+
 
 let xml_S_RE = pcre_regexp "[ \\t\\r\\n]+"
   (* split a string at XML recommendation "S" production boundaries *)
@@ -204,19 +210,6 @@ let validate_interval interval type_name s =
     Value.Integer integer
   else
     simple_type_error type_name
-let validate_nonPositiveInteger =
-  validate_interval (Intervals.left Intervals.V.zero) "nonPositiveInteger"
-let validate_negativeInteger =
-  validate_interval (Intervals.left Intervals.V.minus_one) "negativeInteger"
-let validate_nonNegativeInteger =
-  validate_interval (Intervals.right Intervals.V.zero) "nonNegativeInteger"
-let validate_positiveInteger =
-  validate_interval (Intervals.right Intervals.V.one) "positiveInteger"
-let validate_long = validate_interval (Intervals.bounded long_l long_r) "long"
-let validate_int = validate_interval (Intervals.bounded int_l int_r) "int"
-let validate_short =
-  validate_interval (Intervals.bounded short_l short_r) "short"
-let validate_byte = validate_interval (Intervals.bounded byte_l byte_r) "byte"
 
 let validate_bool s =
   if Utf8.equal s (Utf8.mk "true") || Utf8.equal s (Utf8.mk "1") then
@@ -452,8 +445,10 @@ let any_simple_type =
   primitive "anySimpleType" Builtin_defs.string validate_string
 let string =
   primitive "string" Builtin_defs.string validate_string
+(*
 let integer =
   primitive "integer" Builtin_defs.int validate_integer
+*)
 let _ = 
   primitive "boolean" Builtin_defs.bool validate_bool
 let _ = 
@@ -493,6 +488,7 @@ let _ =
 
   (* derived builtins *)
 
+(*
 let nonpos = 
   restrict "nonPositiveInteger" integer
     { no_facets with maxInclusive = Some (Value.Integer zero, false) }
@@ -515,6 +511,12 @@ let long =
         minInclusive = Some (Value.Integer long_l, false);
         maxInclusive = Some (Value.Integer long_r, false)}
   long_type validate_long
+let ulong =
+  restrict "unsignedLong" nonneg
+    { no_facets with
+        minInclusive = Some (Value.Integer zero, false);
+        maxInclusive = Some (Value.Integer ulong, false)}
+  long_type validate_long
 let int =
   restrict "int" long
     { no_facets with
@@ -533,6 +535,28 @@ let _ =
         minInclusive = Some (Value.Integer byte_l, false);
         maxInclusive = Some (Value.Integer byte_r, false)}
     byte_type validate_short
+*)
+
+let _ =
+  List.iter
+    (fun (name,min,max) ->
+       let ival =
+	 match min,max with
+	   | Some min, Some max ->
+	       let min = Intervals.V.mk min and max = Intervals.V.mk max  in
+	       Intervals.bounded min max
+	   | None, Some max ->
+	       let max = Intervals.V.mk max  in
+	       Intervals.left max
+	   | Some min, None ->
+	       let min = Intervals.V.mk min  in
+	       Intervals.right min
+	   | None, None ->
+	       Intervals.any in
+       ignore (primitive name (Types.interval ival) (validate_interval ival name))
+    )
+
+
 let normalized_string = 
   restrict "normalizedString" string
     { no_facets with whiteSpace = `Replace, false }