[r2003-11-28 11:19:27 by szach] - use string for unsupported builtins

- added warning when using an unsupported builtin

Original author: szach
Date: 2003-11-28 11:19:27+00:00

schema/schema_builtin.ml

@@ -14,6 +14,10 @@ open Schema_types
 
 let add_xsd_prefix s = Schema_xml.add_xsd_prefix (Utf8.mk s)
 
+let unsupported =
+  List.map (fun s -> add_xsd_prefix s)
+    [ "decimal"; "float"; "double"; "NOTATION"; "QName" ]
+
 let is_empty s = Utf8.equal s (Utf8.mk "")
 
 let zero = Intervals.V.zero
@@ -130,8 +134,6 @@ let validate_integer s =
   with Failure _ -> simple_type_error "integer"
 
 let strip_decimal_RE = Pcre.regexp "\\..*$"
-let validate_decimal s =
-  validate_integer (pcre_replace ~rex:strip_decimal_RE s)
 
 let parse_date =
   let rex = Pcre.regexp (add_limits date_RE_raw) in
@@ -416,8 +418,6 @@ let list' name itemname =
 let fill () = (* fill "builtins" hashtbl *)
   let primitive name = Primitive (add_xsd_prefix name) in
 
-  (* TODO missing built-in simple types: float, double, QName, NOTATION *)
-
   (* primitive builtins *)
 
   reg "anySimpleType"
@@ -425,9 +425,14 @@ let fill () = (* fill "builtins" hashtbl *)
   alias "anyType" "anySimpleType";  (* TODO BUG HERE *)
   reg "string"
     (primitive "string", Builtin_defs.string, validate_string);
-  reg "decimal"
-    (* collapsed in CDuce to an integer, since CDuce has no decimal numbers *)
-    (primitive "decimal", Builtin_defs.int, validate_decimal);
+
+    (* TODO following types not yet supported (see "unsupported" above) *)
+  alias "decimal" "string";
+  alias "float" "string";
+  alias "double" "string";
+  alias "NOTATION" "string";
+  alias "QName" "string";
+
   reg "boolean"
     (primitive "boolean", Builtin_defs.bool, validate_bool);
   reg "hexBinary"
@@ -536,6 +541,11 @@ let snd (_,y,_) = y
 let trd (_,_,z) = z
 
 let get_builtin name          = fst (lookup name)
-let cd_type_of_builtin name   = snd (lookup name)
+let cd_type_of_builtin name   =
+  if List.mem name unsupported then
+    Format.fprintf Format.err_formatter
+      "Warning: %s isn't properly supported and is thread as a string by CDuce@."
+      (Utf8.get_str name);
+  snd (lookup name)
 let validate_builtin name     = trd (lookup name)