diff options
Diffstat (limited to 'scTypes.ml')
-rwxr-xr-x | scTypes.ml | 83 |
1 files changed, 46 insertions, 37 deletions
@@ -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 |