From e82962fe44c35b5ae6e6a68e8719e5d77aaf9e55 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Mon, 6 Nov 2017 17:39:53 +0100
Subject: Simplify type deduction

---
 scTypes.ml | 83 ++++++++++++++++++++++++++++++++++----------------------------
 1 file changed, 46 insertions(+), 37 deletions(-)

(limited to 'scTypes.ml')

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
-- 
cgit v1.2.3