From 041426ccc1b8c46578de38cd5a816a38158a51db Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Wed, 1 Nov 2017 20:06:02 +0100
Subject: Moved range extraction function in ScTypes.ml

---
 evaluator.ml | 72 ++++++++++++------------------------------------------------
 1 file changed, 14 insertions(+), 58 deletions(-)

(limited to 'evaluator.ml')

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