From 824f2987d47e87d58ee2a4a96d7be417aad6aeab Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Wed, 31 Jan 2018 13:20:20 +0100
Subject: API refactoring : made the GADT abstract, provide contructor for each
 case, and deported the expression with evaluation with module functors

---
 src/expressions/eval_ref.ml | 136 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 136 insertions(+)
 create mode 100755 src/expressions/eval_ref.ml

(limited to 'src/expressions/eval_ref.ml')

diff --git a/src/expressions/eval_ref.ml b/src/expressions/eval_ref.ml
new file mode 100755
index 0000000..d367d2d
--- /dev/null
+++ b/src/expressions/eval_ref.ml
@@ -0,0 +1,136 @@
+type 'a range =
+  | Single of 'a
+  | Array1 of 'a list
+  | Array2 of 'a list list
+
+type content =
+  | Value:  'a ScTypes.DataFormat.t * 'a -> content
+  | List:   'a ScTypes.DataFormat.t * 'a list -> content
+  | Matrix: 'a ScTypes.DataFormat.t * 'a list list -> content
+
+(** Type for the mapper function.
+
+  This function should be able to read the cell from the spreadsheet from
+  it coordinates, and return the associated value.
+
+*)
+type mapper = (int * int -> ScTypes.Result.t option)
+
+type 'a t = mapper -> ScTypes.Result.t option range
+
+type 'a obs = mapper -> content
+
+let cell t mapper = begin
+  Single (mapper (Cell.to_pair t))
+end
+
+let range fst snd mapper = begin
+  let (x1, y1) = Cell.to_pair fst
+  and (x2, y2) = Cell.to_pair snd in
+  let min_x = min x1 x2
+  and max_x = max x1 x2
+  and min_y = min y1 y2
+  and max_y = max y1 y2 in
+  if (min_x = max_x) || (min_y = max_y) then (
+    (* There is only a one dimension array *)
+    let elms = ref [] in
+    for x = min_x to max_x do
+      for y = min_y to max_y do
+        elms := (mapper (x, y))::!elms
+      done
+    done;
+    Array1 (!elms)
+  ) else (
+    (* This a two-dimension array *)
+    let elmx = ref [] in
+    for x = min_x to max_x do
+      let elmy = ref [] in
+      for y = min_y to max_y do
+        elmy := (mapper (x, y))::!elmy
+      done;
+      elmx := !elmy::!elmx
+    done;
+    Array2 (!elmx)
+  )
+end
+
+module TypeContent = struct
+
+  type 'a t = 'a ScTypes.DataFormat.t * 'a
+
+  type value  = Value: ('a ScTypes.DataFormat.t * 'a) -> value [@@unboxed]
+
+  type 'a obs = value
+
+  let str s = (ScTypes.DataFormat.String, s)
+
+  let bool b = (ScTypes.DataFormat.Bool, b)
+
+  let num n : DataType.Num.t t = (ScTypes.DataFormat.Number, n)
+
+  let date d : DataType.Num.t t = (ScTypes.DataFormat.Date, d)
+
+  let observe (f, t) = Value (f, t)
+
+end
+
+module M = ScTypes.Type.Eval(TypeContent)
+
+(** 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 ScTypes.DataFormat.t * a list -> ScTypes.Result.t option -> a ScTypes.DataFormat.t * a list =
+fun (format, elements) result ->
+  begin match result with
+  | None -> format, (ScTypes.DataFormat.default_value_for format)::elements
+  | Some (ScTypes.Result.Error x) -> raise x
+  | Some (ScTypes.Result.Ok r) ->
+
+    let TypeContent.Value (format', element) = M.eval r in
+    let ScTypes.DataFormat.Eq = ScTypes.DataFormat.compare_format format format' in
+    let new_format = if (ScTypes.DataFormat.priority format) > (ScTypes.DataFormat.priority format') then
+        format
+      else
+        format' in
+    new_format, element::elements
+  end
+
+(** extract the content from a range.
+
+      May raise Errors.TypeError if the range cannot be unified.
+  *)
+let get_content = begin function
+  | Single None -> raise Errors.TypeError
+  | Single (Some (ScTypes.Result.Error x)) -> raise x
+  | Single (Some (ScTypes.Result.Ok r)) ->
+    let TypeContent.Value (format, element) = M.eval r in
+    Value (format, element)
+  | Array1 l ->
+    (* Get the first element in the list in order to get the format *)
+    let TypeContent.Value (format, _) =
+      begin match (Tools.List.find_map (fun x -> x) l) with
+      | ScTypes.Result.Error x -> raise x
+      | ScTypes.Result.Ok r -> M.eval r
+      end in
+    (* Then build an unified list (if we can) *)
+    let format, values =  List.fold_left add_elem (format, []) l in
+    List(format, List.rev values)
+  | Array2 l ->
+    (* Get the first element in the list *)
+    let TypeContent.Value (format, _) =
+      begin match (Tools.List.find_map2 (fun x -> x) l) with
+      | ScTypes.Result.Error x -> raise x
+      | ScTypes.Result.Ok r -> M.eval 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
+    Matrix(format, List.rev values)
+  end
+
+
+let observe t mapper = get_content (t mapper)
-- 
cgit v1.2.3