aboutsummaryrefslogtreecommitdiff
path: root/scTypes.ml
diff options
context:
space:
mode:
Diffstat (limited to 'scTypes.ml')
-rwxr-xr-xscTypes.ml83
1 files changed, 46 insertions, 37 deletions
diff --git a/scTypes.ml b/scTypes.ml
index 81af61c..ca2b32f 100755
--- a/scTypes.ml
+++ b/scTypes.ml
@@ -22,12 +22,6 @@ let get_numeric_type: DataType.Num.t dataFormat -> numericType = function
| Date -> Date
| Number -> Number
-let priority: type a. a dataFormat -> int = function
- | Date -> 1
- | Number -> 0
- | String -> 0
- | Bool -> 0
-
type 'a types =
| Num : DataType.Num.t dataFormat * DataType.Num.t -> DataType.Num.t types (** A number *)
| Str : DataType.String.t -> DataType.String.t types (** A string *)
@@ -66,6 +60,49 @@ type result =
| Result : 'a types -> result
| Error : exn -> result
+module DataFormat = struct
+
+ type formats = F : 'a dataFormat -> formats [@@unboxed]
+
+ let priority: type a. a dataFormat -> int = function
+ | Date -> 1
+ | Number -> 0
+ | String -> 0
+ | Bool -> 0
+
+ let collect_format: DataType.Num.t dataFormat -> formats -> DataType.Num.t dataFormat = begin
+ fun dataFormat -> function
+ | F Date -> Date
+ | _ -> dataFormat
+ end
+
+ let guess_format_result: type a. a returnType -> (unit -> formats list) -> a dataFormat =
+ fun return params -> begin match return with
+ | Str -> String
+ | Bool -> Bool
+ | Num (Some x) -> x
+ | Num None -> List.fold_left collect_format Number (params ())
+ end
+
+ let default_value_for: type a. a dataFormat -> a = function
+ | Date -> DataType.Num.nan
+ | Number -> DataType.Num.nan
+ | Bool -> false
+ | String -> UTF8.empty
+
+ let compare_format: type a b. a dataFormat -> b dataFormat -> (a, b) equality =
+ fun a b -> begin match a, b with
+ | Date, Date -> Eq
+ | String, String -> Eq
+ | Number, Number -> Eq
+ | Date, Number -> Eq
+ | Number, Date -> Eq
+ | Bool, Bool -> Eq
+ | _, _ -> raise Errors.TypeError
+ end
+
+end
+
module Type = struct
(* Required because Num.Big_int cannot be compared with Pervasives.(=) *)
let (=) : type a b. a types -> b types -> bool = fun t1 t2 ->
@@ -113,23 +150,6 @@ module Type = struct
| Bool b -> Value (Bool, b)
end
- (*
- let guess_format_result:
- type a. a returnType -> t list -> (a -> a types) =
- fun return params -> begin match return with
- | Str -> fun value -> Str value
- | Bool -> fun value -> Bool value
- | Num (Some x) -> fun value -> Num (x, value)
- | Num None -> fun value -> Num (Number, value)
- end
- *)
-
- let default_value_for: type a. a dataFormat -> a = function
- | Date -> DataType.Num.nan
- | Number -> DataType.Num.nan
- | Bool -> false
- | String -> UTF8.empty
-
end
module Refs = struct
@@ -200,17 +220,6 @@ module Refs = struct
type ('a, 'b) equality = Eq : ('a, 'a) equality
- let compare_format: type a b. a dataFormat -> b dataFormat -> (a, b) equality =
- fun a b -> begin match a, b with
- | Date, Date -> Eq
- | String, String -> Eq
- | Number, Number -> Eq
- | Date, Number -> Eq
- | Number, Date -> Eq
- | Bool, Bool -> Eq
- | _, _ -> raise Errors.TypeError
- end
-
(** Add one element in a typed list.
The function will raise Error.TypeError if the elements does not match
@@ -219,12 +228,12 @@ module Refs = struct
let add_elem: type a b. a dataFormat * a list -> result option -> a dataFormat * a list =
fun (format, elements) result ->
begin match result with
- | None -> format, (Type.default_value_for format)::elements
+ | None -> format, (DataFormat.default_value_for format)::elements
| Some (Error x) -> raise x
| Some (Result r) ->
let Type.Value (format', element) = Type.get_content r in
- let Eq = compare_format format format' in
- let new_format = if (priority format) < (priority format') then
+ let Eq = DataFormat.compare_format format format' in
+ let new_format = if (DataFormat.priority format) > (DataFormat.priority format') then
format
else
format' in