Moved range extraction function in ScTypes.ml

4 files changed, 128 insertions, 78 deletions

diff --git a/evaluator.ml b/evaluator.ml
index 46123cb..0d8c0f7 100755
--- a/evaluator.ml
+++ b/evaluator.ml
@@ -29,8 +29,7 @@ let typ_of_format: type a. a ScTypes.dataFormat -> a typ = function
   | ScTypes.String -> String

   | ScTypes.Bool -> Bool

 

-let rec compare_typ:

-type a b. a typ -> b typ -> (a, b) T.cmp =

+let rec compare_typ: type a b. a typ -> b typ -> (a, b) T.cmp =

 begin fun a b ->

   match a, b with

   | Unit, Unit     -> T.Eq

@@ -56,13 +55,6 @@ fun printer typ -> match typ with
   | List t -> Format.fprintf printer "List[%a]"

                 print_typ t

 

-let default_format_for_type: type a. a typ -> a ScTypes.dataFormat = function

-  | Num -> ScTypes.Date

-  | String -> ScTypes.String

-  | Bool -> ScTypes.Bool

-  | List _ -> raise Errors.TypeError

-  | Unit -> raise Errors.TypeError

-

 type 'a returnType = 'a ScTypes.returnType

 

 let specialize_result: type a. a ScTypes.returnType -> a ScTypes.dataFormat -> a ScTypes.returnType =

@@ -127,7 +119,7 @@ fun init_typ currentResult value ->
       | Bool b -> ScTypes.Bool

       | String s -> ScTypes.Str

       | Num (f, v) -> specialize_result currentResult f

-      (* There is no possibility to get init_typ as List typ*)

+      (* There is no possibility to get init_typ as List typ *)

       | List (f, v) -> raise Errors.TypeError

       | Matrix (f, v) -> raise Errors.TypeError

       end

@@ -244,25 +236,6 @@ let repr mapper value = begin
     | ScTypes.Error x -> raise x

   end in

 

-  let add_elem: type a. a Data.typ -> a list * a Data.dataFormat -> ScTypes.result option -> a list * a Data.dataFormat =

-  begin fun type_of (result, format_of) next ->

-    let Result r = match next with

-    | Some x -> extract_value x

-    | None -> begin match type_of with

-      | Data.Num  ->   Result (Data.Num (ScTypes.Number, D.Num.nan))

-      | Data.Bool ->   Result (Data.Bool false)

-      | Data.String -> Result (Data.String (UTF8.empty))

-      | Data.List x  -> Result (Data.List ((Data.default_format_for_type x), []))

-      | Data.Unit -> raise Errors.TypeError

-    end in

-    begin match Data.compare_typ type_of (Data.type_of_value r) with

-    | T.Eq ->

-      let l' = (Data.get_value_content r)::result in

-      l' , (Data.most_generic_format (Data.format_of_value r) format_of)

-    | _ -> raise Errors.TypeError

-    end

-  end in

-

   (** Extract the value from an expression.

       [extract typ expr] will evaluate the expression and return it. If the

       result cannot be evaluated (because of references pointing to missing

@@ -270,44 +243,27 @@ let repr mapper value = begin
    *)

   let rec extract = begin function

     (* For a reference to an external we first extract the value pointed  *)

-    | ScTypes.Ref r ->

-        begin match mapper r with

-        | ScTypes.Refs.Single v ->

-            begin match v with

-            | None -> raise Errors.TypeError

-            | Some v -> extract_value v

+    | ScTypes.Ref r -> ScTypes.Refs.(

+        begin match ScTypes.Refs.get_content @@ mapper r with

+        | C (Value (format, f)) -> begin match format with

+            | ScTypes.Date -> Result (Data.Num (format, f))

+            | ScTypes.Number -> Result (Data.Num (format, f))

+            | ScTypes.String -> Result (Data.String f)

+            | ScTypes.Bool -> Result (Data.Bool f)

             end

-        | ScTypes.Refs.Array1 l ->

-          (* Guess the list type from it's first defined element *)

-          let Result r = extract_value (Tools.List.find_map (fun x -> x) l) in

-          let format_of = Data.format_of_value r

-          and type_of = Data.type_of_value r in

-          (* Build the list with all the elements *)

-          let elems, format = List.fold_left (add_elem type_of) ([], format_of) l in

-          Result (Data.List (format, elems))

-        | ScTypes.Refs.Array2 l ->

-          (* Guess the list type from it's first defined element *)

-          let Result r = extract_value (Tools.List.find_map2 (fun x -> x) l) in

-

-          let format_of = Data.format_of_value r

-          and type_of = Data.type_of_value r in

-          (* Build the list with all the elements *)

-          let elems, format = List.fold_left (fun (result, format_of) elems ->

-            let elems, format = List.fold_left (add_elem type_of) ([], format_of) elems in

-            elems::result, (Data.most_generic_format format_of format)

-          ) ([], format_of) l in

-          Result (Data.Matrix (format, elems))

-        end

+        | C (List (format, l)) -> Result (Data.List (format, l))

+        | C (Matrix (format, l)) -> Result (Data.Matrix (format, l))

+        end)

 

     (* Evaluate the expression *)

     | ScTypes.Expression e -> extract e

     | ScTypes.Value v -> extract_value (ScTypes.Result v)

     | ScTypes.Call (name, args) ->

-        let args' = List.map extract args in

+      let args' = List.map extract args in

         call name args'

     end

   in

-  let Result r = (extract value) in

+  let Result r = ((extract[@tailrec]) value) in

   begin match r with

   | Data.Bool b ->  ScTypes.Result (ScTypes.boolean b)

   | Data.String s -> ScTypes.Result (ScTypes.string s)

diff --git a/scTypes.ml b/scTypes.ml
index ff0af83..f79b4ef 100644..100755
--- a/scTypes.ml
+++ b/scTypes.ml
@@ -8,8 +8,6 @@ type cell = Cell.t
 
 type ident = UTF8.t
 
-type 'a number_format = (float -> 'a, Format.formatter, unit) format
-
 type _ dataFormat =
   | Date:   DataType.Num.t dataFormat   (* Date *)
   | Number: DataType.Num.t dataFormat   (* Number *)
@@ -53,18 +51,6 @@ let f_number: DataType.Num.t returnType = Num (Some Number)
 let f_string: DataType.String.t returnType = Str
 let f_bool: DataType.Bool.t returnType = Bool
 
-type typeContainer =
-  | Value: 'a types -> typeContainer
-
-let guess_format_result:
-  type a. a returnType -> typeContainer 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
-
 type refs =
   | Cell of cell                                      (** A cell *)
   | Range of cell * cell                              (** An area of cells *)
@@ -118,6 +104,32 @@ module Type = struct
         UTF8.Printf.bprintf buffer "%d/%d/%d" y m d
   end
 
+  type t =
+    | Value: 'a dataFormat * 'a -> t
+
+  let get_content : type a. a types -> t = begin function
+    | Num (format, data) -> Value (format, data)
+    | Str s -> Value (String, s)
+    | 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
@@ -178,6 +190,77 @@ module Refs = struct
         Tools.Tuple2.printb ~first:"" ~last:"" ~sep:":" Cell.to_buffer Cell.to_buffer buffer (f,t)
   end
 
+  type 'a content =
+    | Value: 'a dataFormat * 'a -> 'a content
+    | List: 'a dataFormat * 'a list -> 'a list content
+    | Matrix: 'a dataFormat * 'a list list -> 'a list list content
+
+  type refContent =
+    | C: 'a content -> refContent
+
+  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
+      with the list type.
+  *)
+  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
+    | 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
+          format
+        else
+          format' in
+      new_format, element::elements
+    end
+
+  let get_content = begin function
+  | Single None -> raise Errors.TypeError
+  | Single (Some (Error x)) -> raise x
+  | Single (Some (Result r)) ->
+    let Type.Value (format, c) = Type.get_content r in C (Value (format, c))
+  | Array1 l ->
+    (* Get the first element in the list in order to get the format *)
+    let Type.Value (format, _) =
+      begin match (Tools.List.find_map (fun x -> x) l) with
+      | Error x -> raise x
+      | Result r -> Type.get_content r
+      end in
+    (* Then build an unified list (if we can) *)
+    let format, values =  List.fold_left add_elem (format, []) l in
+    C (List(format, List.rev values))
+  | Array2 l ->
+    (* Get the first element in the list *)
+    let Type.Value (format, _) =
+      begin match (Tools.List.find_map2 (fun x -> x) l) with
+      | Error x -> raise x
+      | Result r -> Type.get_content r
+      end in
+    (* Then build an unified list *)
+    let format, values =  List.fold_left (fun (format, result) elems ->
+        let format, elems = List.fold_left add_elem (format, []) elems in
+        (format, List.rev (elems::result))
+      )(format, []) l in
+    C (Matrix(format, List.rev values))
+  end
+
 end
 
 module Result = struct
diff --git a/scTypes.mli b/scTypes.mli
index 5e5b378..de0d6f2 100644..100755
--- a/scTypes.mli
+++ b/scTypes.mli
@@ -6,8 +6,6 @@ type cell = (int * int) * (bool * bool)
 

 type ident = UTF8.t

 

-type 'a number_format = (float -> 'a, Format.formatter, unit) format

-

 type 'a dataFormat =

   | Date: DataType.Num.t dataFormat    (* A date in julian day *)

   | Number: DataType.Num.t dataFormat  (* Number *)

@@ -35,9 +33,6 @@ val string: DataType.String.t -> DataType.String.t types
 val boolean: DataType.Bool.t -> DataType.Bool.t types

 val date: DataType.Num.t -> DataType.Num.t types

 

-type typeContainer =

-  | Value: 'a types -> typeContainer

-

 

 (** Numeric (any format) *)

 val f_num: DataType.Num.t returnType

@@ -72,6 +67,8 @@ type result =
 

 module Type : sig

 

+  type t = Value: 'a dataFormat * 'a -> t

+

   val (=) : 'a types -> 'b types -> bool

 

   val show: UTF8.Buffer.buffer -> 'a types -> unit

@@ -91,6 +88,20 @@ module Refs : sig
   

   val shift: (int * int) -> refs -> refs

 

+  type 'a content =

+    | Value: 'a dataFormat * 'a -> 'a content

+    | List: 'a dataFormat * 'a list -> 'a list content

+    | Matrix: 'a dataFormat * 'a list list -> 'a list list content

+

+  type refContent =

+    | C: 'a content -> refContent

+

+  (** extract the content from a range.

+

+      May raise Errors.TypeError if the range cannot be unified.

+  *)

+  val get_content : result option range -> refContent

+

 end

 

 val show_expr: UTF8.Buffer.buffer -> expression -> unit

diff --git a/tools.ml b/tools.ml
index 45c9bab..53b1c15 100755
--- a/tools.ml
+++ b/tools.ml
@@ -143,7 +143,7 @@ module List = struct
   | [] -> raise Not_found
   | hd::tl -> begin match f hd with
               | Some x -> x
-              | None -> find_map f tl
+              | None -> (find_map[@tailrec]) f tl
               end
   end