1 files changed, 130 insertions, 257 deletions

diff --git a/src/scTypes.ml b/src/scTypes.ml
index fc6dd1f..ef39af3 100755
--- a/src/scTypes.ml
+++ b/src/scTypes.ml
@@ -4,87 +4,29 @@ let u = UTF8.from_utf8string
 
 exception Error
 
-type cell = Cell.t
-
-type ident = UTF8.t
-
-type _ dataFormat =
-  | Date:   DataType.Num.t dataFormat   (* Date *)
-  | Number: DataType.Num.t dataFormat   (* Number *)
-  | String: DataType.String.t dataFormat(* String  *)
-  | Bool:   DataType.Bool.t dataFormat  (* Boolean *)
-
-type numericType =
-  | Date
-  | Number
-
-let get_numeric_type: DataType.Num.t dataFormat -> numericType = function
-  | Date -> Date
-  | Number -> Number
-
-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 *)
-  | Bool : DataType.Bool.t -> DataType.Bool.t types             (** A boolean *)
-
-let number n = Num (Number, n)
-let string s = Str s
-let date d = Num (Date, d)
-let boolean b = Bool b
-
-
-type 'a returnType =
-  | Num  : DataType.Num.t dataFormat option -> DataType.Num.t returnType    (** A number *)
-  | Str  : DataType.String.t returnType                         (** A string *)
-  | Bool : DataType.Bool.t returnType                           (** A boolean *)
-
-
-let f_num: DataType.Num.t returnType  = Num None
-let f_date: DataType.Num.t returnType = Num (Some Date)
-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 refs =
-  | Cell of cell                                      (** A cell *)
-  | Range of cell * cell                              (** An area of cells *)
-
-type expression =
-  | Value : 'a types -> expression                    (** A direct value *)
-  | Ref : refs -> expression                          (** A reference to another cell *)
-  | Call : ident * expression list -> expression      (** A call to a function *)
-  | Expression : expression -> expression             (** An expression *)
-
-(** Result from a computation *)
-type result =
-  | Result : 'a types -> result
-  | Error : exn -> result
-
 module DataFormat = struct
 
-  type formats = F : 'a dataFormat -> formats [@@unboxed]
+  type _ t =
+    | Date:   DataType.Num.t t   (* Date *)
+    | Number: DataType.Num.t t   (* Number *)
+    | String: DataType.String.t t(* String  *)
+    | Bool:   DataType.Bool.t t  (* Boolean *)
+
+  type formats = F : 'a t -> formats [@@unboxed]
 
-  let priority: type a. a dataFormat -> int = function
+  let priority: type a. a t -> int = function
     | Date   -> 1
     | Number -> 0
     | String -> 0
     | Bool   -> 0
 
-  let collect_format: DataType.Num.t dataFormat -> formats -> DataType.Num.t dataFormat = begin
+  let collect_format: DataType.Num.t t -> formats -> DataType.Num.t t = 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
+  let default_value_for: type a. a t -> a = function
     | Date -> DataType.Num.zero
     | Number -> DataType.Num.zero
     | Bool -> false
@@ -92,7 +34,7 @@ module DataFormat = struct
 
   type ('a, 'b) equality = Eq : ('a, 'a) equality
 
-  let compare_format: type a b. a dataFormat -> b dataFormat -> (a, b) equality =
+  let compare_format: type a b. a t -> b t -> (a, b) equality =
     fun a b -> begin match a, b with
     | Date, Date -> Eq
     | String, String -> Eq
@@ -107,117 +49,44 @@ end
 
 module Type = struct
 
-  let (=) : type a b. a types -> b types -> bool = fun t1 t2 ->
+  type 'a t =
+    | Num  : DataType.Num.t DataFormat.t * DataType.Num.t -> DataType.Num.t t    (** A number *)
+    | Str  : DataType.String.t -> DataType.String.t t         (** A string *)
+    | Bool : DataType.Bool.t -> DataType.Bool.t t             (** A boolean *)
+
+  let number n = Num (Number, n)
+  let string s = Str s
+  let date d = Num (Date, d)
+  let boolean b = Bool b
+
+  let (=) : type a b. a t -> b t -> bool = fun t1 t2 ->
     match t1, t2 with
     | Num (_, n1), Num (_, n2) -> DataType.Num.eq n1 n2
     | Bool b1, Bool b2 -> b1 = b2
     | Str s1, Str s2 -> s1 = s2
     | _, _ -> false
 
-  (** Show a list of elements
-   *)
-  let rec show_list printer buffer = begin function
-    | [] -> ()
-    | hd::[] ->
-        UTF8.Printf.bprintf buffer "%a"
-        printer hd
-    | hd::tl ->
-        UTF8.Printf.bprintf buffer "%a, "
-        printer hd;
-        show_list printer buffer tl
-  end
-
-  let show: type a. UTF8.Buffer.buffer -> a types -> unit = fun buffer -> begin function
-    | Str x     -> UTF8.Buffer.add_string buffer x
-    | Bool b    -> UTF8.Printf.bprintf buffer "%B" b
-    | Num (Number, n)     ->
-      if DataType.Num.is_integer n then
-        DataType.Num.to_int n
-          |> string_of_int
-          |> UTF8.from_utf8string
-          |> UTF8.Buffer.add_string buffer
-      else
-        let f = DataType.Num.to_float n
-        and to_b = UTF8.Format.formatter_of_buffer buffer in
-        ignore @@ UTF8.Format.fprintf to_b "%.2f" f;
-        Format.pp_print_flush to_b ()
-    | Num (Date, n)    ->
-        let y, m, d = DataType.Date.date_from_julian_day n in
-        UTF8.Printf.bprintf buffer "%d/%d/%d" y m d
-  end
+  module Eval(T:Sym_type.SYM_TYPE) = struct
 
-  let show_full: type a. UTF8.Buffer.buffer -> a types -> unit = fun buffer -> begin function
-    | Str x     -> UTF8.Buffer.add_string buffer x
-    | Bool b    -> UTF8.Printf.bprintf buffer "%B" b
-    | Num (Number, n)     ->
-      if DataType.Num.is_integer n then
-        DataType.Num.to_int n
-          |> string_of_int
-          |> UTF8.from_utf8string
-          |> UTF8.Buffer.add_string buffer
-      else
-        let f = DataType.Num.to_float n
-        and to_b = UTF8.Format.formatter_of_buffer buffer in
-        ignore @@ UTF8.Format.fprintf to_b "%f" f;
-        Format.pp_print_flush to_b ()
-    | Num (Date, n)    ->
-        let y, m, d = DataType.Date.date_from_julian_day n in
-        UTF8.Printf.bprintf buffer "%d/%d/%d" y m d
-  end
+    let eval_type : type a. a t -> a T.t = function
+    | Str s -> T.str s
+    | Bool b -> T.bool b
+    | Num (f, n) ->
+      match f with
+      | DataFormat.Number -> T.num n
+      | DataFormat.Date -> T.date n
 
-  type t =
-    | Value: 'a dataFormat * 'a -> t
+    let eval t = T.observe (eval_type 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
 
 end
 
 module Refs = struct
 
-  type 'a range =
-    | Single of 'a
-    | Array1 of 'a list
-    | Array2 of 'a list list
-
-  let collect = function
-    | Cell x -> Single (Pervasives.fst x)
-    | Range (fst, snd) ->
-        let (x1, y1) = Pervasives.fst fst
-        and (x2, y2) = Pervasives.fst 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 := (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 := (x, y)::!elmy
-            done;
-            elmx := !elmy::!elmx
-          done;
-          Array2 (!elmx)
-        )
-
-  let map f = function
-    | Single coord ->  Single (f coord)
-    | Array1 values -> Array1 (List.map f values)
-    | Array2 values -> Array2 (List.map (List.map f) values)
+  type t =
+    | Cell of Cell.t                                      (** A cell *)
+    | Range of Cell.t * Cell.t                            (** An area of cells *)
 
   let shift (vector_x, vector_y) ref =
     let _shift ((x, y), (fixed_x, fixed_y)) =
@@ -228,74 +97,90 @@ module Refs = struct
     | Cell x -> Cell (_shift x)
     | Range (fst, snd) -> Range (_shift fst, _shift snd)
 
-  let show buffer = begin function
-    | Cell r      -> UTF8.Buffer.add_string buffer @@ Cell.to_string r
-    | Range (f,t) ->
-        Tools.Tuple2.printb ~first:"" ~last:"" ~sep:":" Cell.to_buffer Cell.to_buffer buffer (f,t)
+  let cell c = Cell c
+  let range c1 c2 = Range (c1, c2)
+
+  module Eval(R:Sym_ref.SYM_REF) = struct
+
+    let eval_ref = function
+    | Cell c -> R.cell c
+    | Range(c1, c2) -> R.range c1 c2
+
+    let eval t = R.observe (eval_ref t)
+
   end
 
-  type content =
-    | Value: 'a dataFormat * 'a -> content
-    | List: 'a dataFormat * 'a list -> content
-    | Matrix: 'a dataFormat * 'a list list -> content
-
-  (** 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, (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 DataFormat.Eq = DataFormat.compare_format format format' in
-      let new_format = if (DataFormat.priority format) > (DataFormat.priority format') then
-          format
-        else
-          format' in
-      new_format, element::elements
+end
+
+module Expr = struct
+
+  type ident = UTF8.t
+
+  type t =
+    | Value : 'a Type.t -> t          (** A direct value *)
+    | Ref : Refs.t -> t               (** A reference to another cell *)
+    | Call0 : ident -> t              (** A call to a 0 arg function *)
+    | Call1 : ident * t -> t          (** A call to a 1 arg function *)
+    | Call2 : ident * t * t -> t      (** A call to a 2 arg function *)
+    | Call3 : ident * t * t * t -> t  (** A call to a 3 arg function *)
+    | CallN : ident * t list -> t     (** A call to a function *)
+    | Expression : t -> t             (** An expression *)
+
+  let value v = Value v
+  let ref r = Ref r
+  let call0 ident = Call0 ident
+  let call1 ident expr = Call1 (ident, expr)
+  let call2 ident expr1 expr2 = Call2(ident, expr1, expr2)
+  let call3 ident expr1 expr2 expr3 = Call3(ident, expr1, expr2, expr3)
+  let callN ident params = CallN(ident, params)
+  let expression e = Expression e
+
+  let rec shift_exp vector = function
+    | Value v -> Value v
+    | Call0 ident -> Call0 ident
+    | Call1 (ident, p1) -> Call1 (ident, shift_exp vector p1)
+    | Call2 (ident, p1, p2) -> Call2 (ident, shift_exp vector p1, shift_exp vector p2)
+    | Call3 (ident, p1, p2, p3) -> Call3 (ident, shift_exp vector p1, shift_exp vector p2, shift_exp vector p3)
+    | CallN (ident, params) -> CallN (ident, List.map (shift_exp vector) params)
+    | Ref r -> Ref (Refs.shift vector r)
+    | Expression expr -> Expression (shift_exp vector expr)
+
+  module Eval(E:Sym_expr.SYM_EXPR) = struct
+
+    module T = Type.Eval(E.T)
+    module R = Refs.Eval(E.R)
+
+    let eval e t  = begin
+
+      let rec eval_expr : t -> E.repr = function
+      | Ref r -> E.ref (R.eval_ref r) t
+      | Value v -> E.value (T.eval_type v) t
+      | Call0 ident -> E.call0 ident t
+      | Call1 (ident, p1) -> E.call1 ident (eval_expr p1) t
+      | Call2 (ident, p1, p2) -> E.call2 ident (eval_expr p1) (eval_expr p2) t
+      | Call3 (ident, p1, p2, p3) -> E.call3 ident (eval_expr p1) (eval_expr p2) (eval_expr p3) t
+      | CallN (ident, exprs) -> E.callN ident (List.map (fun x -> eval_expr x) exprs) t
+      | Expression e -> E.expression (eval_expr e) t
+      in
+      E.observe (eval_expr e)
     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
-    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
-    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
-    Matrix(format, List.rev values)
   end
 
 end
 
+module TypeRepr = Type.Eval(Show_type)
+
 module Result = struct
+
+  (** Result from a computation *)
+  type t =
+    | Ok : 'a Type.t -> t
+    | Error : exn -> t
+
   let (=) t1 t2 =
     match t1, t2 with
-    | Result v1, Result v2 -> Type.(=) v1 v2
+    | Ok v1, Ok v2 -> Type.(=) v1 v2
     | _, _ -> t1 = t2
 
   let show = begin function
@@ -308,45 +193,33 @@ module Result = struct
         u(Buffer.contents buffer)
         *)
         u"#Error"
-    | Result v ->
+    | Ok v ->
           let buffer = UTF8.Buffer.create 16 in
-          Type.show buffer v;
+          TypeRepr.eval v buffer;
           UTF8.Buffer.contents buffer
   end
 
 end
 
-(** Represent an expression.
- *)
-let rec show_expr buffer : expression -> unit = begin function
-  | Value (Str x) ->
-      (** Print the value with quotes *)
-      UTF8.Printf.bprintf buffer "\"%s\"" (UTF8.to_utf8string x)
-  | Value v -> Type.show buffer v
-  | Ref r -> Refs.show buffer r
-  | Call (ident, params) ->
-    let utf8ident = UTF8.to_utf8string ident in
-    begin match utf8ident with
-    | "+" | "*" | "-" | "/" | "^" | "="
-    | "<>" | "<=" | ">=" | "<" | ">" -> begin match params with
-      | v1::[] ->
-        UTF8.Printf.bprintf buffer "%s%a"
-        utf8ident
-        show_expr v1
-      | v1::v2::[] ->
-        UTF8.Printf.bprintf buffer "%a%s%a"
-        show_expr v1
-          utf8ident
-        show_expr v2
-      | _ ->
-        UTF8.Buffer.add_string buffer ident;
-        Tools.List.printb ~sep:(u";") show_expr buffer params
-    end
-    | _ ->
-      UTF8.Buffer.add_string buffer ident;
-      Tools.List.printb ~sep:(u";") show_expr buffer params
-    end
-  | Expression expr ->
-      UTF8.Printf.bprintf buffer "(%a)" show_expr expr
-end
+module ReturnType = struct
+
+  type 'a t =
+    | Num  : DataType.Num.t DataFormat.t option -> DataType.Num.t t    (** A number *)
+    | Str  : DataType.String.t t                         (** A string *)
+    | Bool : DataType.Bool.t t                           (** A boolean *)
 
+  let f_num: DataType.Num.t t  = Num None
+  let f_date: DataType.Num.t t = Num (Some Date)
+  let f_number: DataType.Num.t t = Num (Some Number)
+  let f_string: DataType.String.t t = Str
+  let f_bool: DataType.Bool.t t = Bool
+
+  let guess_format_result: type a. a t -> (unit -> DataFormat.formats list) -> a DataFormat.t =
+    fun return params -> begin match return with
+    | Str -> DataFormat.String
+    | Bool -> DataFormat.Bool
+    | Num (Some x) -> x
+    | Num None -> List.fold_left DataFormat.collect_format DataFormat.Number (params ())
+  end
+
+end