Update catalog function register

53 files changed, 50 insertions, 63 deletions

diff --git a/opam b/opam
index c8d8408..c8d8408 100755..100644
--- a/opam
+++ b/opam
diff --git a/readme.rst b/readme.rst
index 3a7ed17..3a7ed17 100755..100644
--- a/readme.rst
+++ b/readme.rst
diff --git a/src/UTF8.ml b/src/UTF8.ml
index b09afdc..b09afdc 100755..100644
--- a/src/UTF8.ml
+++ b/src/UTF8.ml
diff --git a/src/UTF8.mli b/src/UTF8.mli
index bd73623..bd73623 100755..100644
--- a/src/UTF8.mli
+++ b/src/UTF8.mli
diff --git a/src/actionParser.mly b/src/actionParser.mly
index 296467a..296467a 100755..100644
--- a/src/actionParser.mly
+++ b/src/actionParser.mly
diff --git a/src/actions.mli b/src/actions.mli
index 9a59aa1..9a59aa1 100755..100644
--- a/src/actions.mli
+++ b/src/actions.mli
diff --git a/src/catalog.ml b/src/catalog.ml
index 71f953f..cd217b3 100755..100644
--- a/src/catalog.ml
+++ b/src/catalog.ml
@@ -62,7 +62,6 @@ module type CATALOG = sig
     ( 'a -> 'b -> 'c -> 'd) ->    (* The function to call*)

     catalog_builder -> catalog_builder

 

-

   (** Compile the catalog *)

   val compile: catalog_builder -> t

 

@@ -78,6 +77,7 @@ module type CATALOG = sig
 

 end

 

+

 (** We cannot update an existing function. Any [registerX] function will raise

  [RegisteredFunction] if a function with the same signature already exists in

 the catalog. *)

@@ -89,65 +89,44 @@ module Make(Data:DATA_SIG) = struct
   type 'a argument = 'a Data.t

   type 'a returnType = 'a Data.returnType

 

-  (** This is the way the function is store in the map.

-       We just the return type, and the function itself. *)

-  type _ t_function =

-    | Fn1: 'b Data.returnType * ('a -> 'b) -> 'a t_function

-    | Fn2: 'c Data.returnType * ('a -> 'b -> 'c) -> ('a * 'b) t_function

-    | Fn3: 'd Data.returnType * ('a -> 'b -> 'c -> 'd) -> ('a * 'b * 'c) t_function

-

-  (** This is the key for storing functions in the map. *)

-  type _ sig_typ =

-    | T1: 'a Data.t -> 'a t_function sig_typ

-    | T2: 'a Data.t * 'b Data.t -> ('a * 'b) t_function sig_typ

-    | T3: 'a Data.t * 'b Data.t * 'c Data.t -> ('a * 'b * 'c) t_function sig_typ

+  type result =

+    | R : 'a returnType * 'a -> result

 

+  type _ lift =

+    | Z : result lift (* No more parameter in the function *)

+    | S : 'c argument * 't1 lift -> ('c -> 't1) lift

 

   module ComparableSignature = struct

 

-    type 'a t = 'a sig_typ

+    type 'a t = 'a lift

 

     (* Type for pure equality *)

     type (_, _) eq = Eq : ('a, 'a) eq

 

     (** Compare two signature *)

-    let comp: type a b. a sig_typ -> b sig_typ -> (a, b) T.cmp = begin fun a b ->

-

-      let cmp: type c d. c Data.t -> d Data.t -> ((c, d) eq -> (a, b) T.cmp) -> (a, b) T.cmp =

-      begin fun a b f -> match Data.compare_typ a b with

-        | T.Eq -> f Eq

+    let rec comp: type a1 a2. a1 lift -> a2 lift -> (a1, a2) T.cmp = fun a b ->

+      begin match (a, b) with

+      | (S _, Z) -> T.Lt

+      | (Z, S _) -> T.Gt

+      | (Z, Z) -> T.Eq

+      | (S (arg1, s1), S (arg2, s2)) -> begin match Data.compare_typ arg1 arg2 with

         | T.Lt -> T.Lt

         | T.Gt -> T.Gt

-      end in

-

-      match a, b with

-      | T1(a), T1(b) -> cmp a b (fun Eq -> T.Eq)

-      | T1(_), _ -> T.Lt

-      | _, T1(_) -> T.Gt

-

-      | T2(a, b), T2(c, d) ->

-        cmp a c (fun Eq ->

-          cmp b d (fun Eq -> T.Eq)

-        )

-      | T2(_), _ -> T.Lt

-      | _, T2(_) -> T.Gt

-

-      | T3(a, b, c), T3(d, e, f) ->

-        cmp a d (fun Eq ->

-          cmp b e (fun Eq ->

-            cmp c f (fun Eq -> T.Eq)

-          )

-        )

-      end

-

-      let repr : type a. Format.formatter -> a t -> unit = begin fun formatter -> function

-        | T1 t -> Format.fprintf formatter "(%a)" Data.repr t

-        | T2 (t1, t2) -> Format.fprintf formatter "(%a,%a)" Data.repr t1 Data.repr t2

-        | T3 (t1, t2, t3) -> Format.fprintf formatter "(%a,%a,%a)" Data.repr t1 Data.repr t2 Data.repr t3

+        | T.Eq -> begin match comp s1 s2 with

+          | T.Eq -> T.Eq

+          | T.Lt -> T.Lt

+          | T.Gt -> T.Gt

+          end

       end

+    end

 

+    let rec repr : type a b. Format.formatter -> a t -> unit = begin fun formatter t -> match t with

+      | Z -> Format.fprintf formatter "->"

+      | S (t1, f) -> Format.fprintf formatter "(%a,%a)" Data.repr t1 repr f

+    end

   end

 

+

   module Catalog = Map.Make(String)

   module Functions = Splay.Make(ComparableSignature)

 

@@ -160,9 +139,11 @@ module Make(Data:DATA_SIG) = struct
 

   let empty = Catalog.empty

 

-  (**

+  (** Generic register function in the catalog.

+

      Register a function in the catalog. If the function is already defined,

      raise an exception.

+

    *)

   let register t name signature f = begin

 

@@ -179,18 +160,21 @@ module Make(Data:DATA_SIG) = struct
     Catalog.add name' map t

   end

 

-  let register1 name typ1 returnType f catalog =

-    register catalog name (T1(typ1)) (Fn1 (returnType, f))

+  let register1 name typ1 result f catalog =

+    let f' arg1 = R(result, f arg1) in

+    register catalog name (S (typ1, Z)) f'

 

   let register2 name (typ1, typ2) result f catalog =

-    register catalog name (T2(typ1, typ2)) (Fn2 (result, f))

+    let f' arg1 arg2 = R(result, f arg1 arg2) in

+    register catalog name (S (typ1, S (typ2, Z))) f'

 

   let register3 name (typ1, typ2, typ3) result f catalog =

-    register catalog name (T3(typ1, typ2, typ3)) (Fn3 (result, f))

+    let f' arg1 arg2 arg3 = R(result, f arg1 arg2 arg3) in

+    register catalog name (S (typ1, S (typ2, S (typ3, Z)))) f'

 

   (** Look in the catalog for a function with the given name and signature *)

   let find_function:

-  type a. t -> string -> a t_function sig_typ -> a t_function =

+  type a b. t -> string -> a ComparableSignature.t  -> a =

   begin fun t name signature ->

        String_dict.find_exn t (String.uppercase_ascii name)

     |> Functions.find signature

@@ -203,21 +187,21 @@ module Make(Data:DATA_SIG) = struct
     String_dict.of_alist_exn (Catalog.bindings t)

 

 

-  type result =

-    | R : 'a returnType * 'a -> result

-

   let eval1 catalog name (t1, arg1) = begin

-    let Fn1(ret, f) = find_function catalog name (T1 t1) in

-    R (ret, f arg1)

+    let f = find_function catalog name (S (t1, Z)) in

+    f arg1

   end

 

   let eval2 catalog name (t1, arg1) (t2, arg2) = begin

-    let Fn2(ret, f) = find_function catalog name (T2 (t1, t2)) in

-    R (ret, f arg1 arg2)

+    let f = find_function catalog name (S (t1, S (t2, Z))) in

+    f arg1 arg2

   end

 

   let eval3 catalog name (t1, arg1) (t2, arg2) (t3, arg3) = begin

-    let Fn3(ret, f) = find_function catalog name (T3 (t1, t2, t3)) in

-    R (ret, f arg1 arg2 arg3)

+    let f = find_function catalog name (S (t1, S (t2, S (t3, Z)))) in

+    f arg1 arg2 arg3

   end

+

+

+

 end

diff --git a/src/catalog.mli b/src/catalog.mli
index 01288ef..49de242 100644
--- a/src/catalog.mli
+++ b/src/catalog.mli
@@ -46,7 +46,7 @@ module type CATALOG = sig
     'b returnType ->              (* The return type *)
     ('a -> 'b) ->                 (* The function to call *)
     catalog_builder -> catalog_builder
-  
+
   val register2:
     string ->                     (* The function name *)
     ('a argument * 'b argument) ->(* The signature *)
@@ -61,7 +61,6 @@ module type CATALOG = sig
     ( 'a -> 'b -> 'c -> 'd) ->    (* The function to call*)
     catalog_builder -> catalog_builder
 
-
   (** Compile the catalog *)
   val compile: catalog_builder -> t
 
diff --git a/src/cell.ml b/src/cell.ml
index dc5dcdc..dc5dcdc 100755..100644
--- a/src/cell.ml
+++ b/src/cell.ml
diff --git a/src/cell.mli b/src/cell.mli
index 3a482da..3a482da 100755..100644
--- a/src/cell.mli
+++ b/src/cell.mli
diff --git a/src/dataType.ml b/src/dataType.ml
index abac572..abac572 100755..100644
--- a/src/dataType.ml
+++ b/src/dataType.ml
diff --git a/src/dataType.mli b/src/dataType.mli
index 4b87c32..4b87c32 100755..100644
--- a/src/dataType.mli
+++ b/src/dataType.mli
diff --git a/src/date.mli b/src/date.mli
index 253013b..253013b 100755..100644
--- a/src/date.mli
+++ b/src/date.mli
diff --git a/src/errors.ml b/src/errors.ml
index f4b3425..f4b3425 100755..100644
--- a/src/errors.ml
+++ b/src/errors.ml
diff --git a/src/expression.mli b/src/expression.mli
index 2c6b3e7..2c6b3e7 100755..100644
--- a/src/expression.mli
+++ b/src/expression.mli
diff --git a/src/expressionLexer.mll b/src/expressionLexer.mll
index 7df1c72..7df1c72 100755..100644
--- a/src/expressionLexer.mll
+++ b/src/expressionLexer.mll
diff --git a/src/expressionParser.mly b/src/expressionParser.mly
index a2218a6..a2218a6 100755..100644
--- a/src/expressionParser.mly
+++ b/src/expressionParser.mly
diff --git a/src/expressions/eval_ref.ml b/src/expressions/eval_ref.ml
index 99b35af..99b35af 100755..100644
--- a/src/expressions/eval_ref.ml
+++ b/src/expressions/eval_ref.ml
diff --git a/src/expressions/evaluate.ml b/src/expressions/evaluate.ml
index fbf2a18..4cf98da 100644
--- a/src/expressions/evaluate.ml
+++ b/src/expressions/evaluate.ml
@@ -106,6 +106,7 @@ let observe repr catalog = begin
       (* We can only match numeric formats here *)

       | ScTypes.DataFormat.Date -> ScTypes.Result.Ok (ScTypes.Type.date n)

       | ScTypes.DataFormat.Number -> ScTypes.Result.Ok (ScTypes.Type.number n)

+      | _ -> raise Errors.TypeError

     end

   | _ -> raise Errors.TypeError

 end

diff --git a/src/expressions/show_ref.ml b/src/expressions/show_ref.ml
index 97d8022..97d8022 100755..100644
--- a/src/expressions/show_ref.ml
+++ b/src/expressions/show_ref.ml
diff --git a/src/expressions/show_type.ml b/src/expressions/show_type.ml
index 3451cde..3451cde 100755..100644
--- a/src/expressions/show_type.ml
+++ b/src/expressions/show_type.ml
diff --git a/src/expressions/sym_ref.ml b/src/expressions/sym_ref.ml
index ef9168e..ef9168e 100755..100644
--- a/src/expressions/sym_ref.ml
+++ b/src/expressions/sym_ref.ml
diff --git a/src/expressions/sym_type.ml b/src/expressions/sym_type.ml
index 8670f4d..8670f4d 100755..100644
--- a/src/expressions/sym_type.ml
+++ b/src/expressions/sym_type.ml
diff --git a/src/functions.ml b/src/functions.ml
index 0258ce0..491d968 100755..100644
--- a/src/functions.ml
+++ b/src/functions.ml
@@ -72,7 +72,6 @@ module C = Catalog.Make(struct
 

   type 'a returnType = 'a ScTypes.ReturnType.t

 

-

 end)

 

 let f_num = ScTypes.ReturnType.f_num

diff --git a/src/functions.mli b/src/functions.mli
index 2c7db0d..2c7db0d 100755..100644
--- a/src/functions.mli
+++ b/src/functions.mli
diff --git a/src/main.ml b/src/main.ml
index 5da7b90..5da7b90 100755..100644
--- a/src/main.ml
+++ b/src/main.ml
diff --git a/src/odf/odfLoader.ml b/src/odf/odfLoader.ml
index 4abe49f..4abe49f 100755..100644
--- a/src/odf/odfLoader.ml
+++ b/src/odf/odfLoader.ml
diff --git a/src/odf/odf_ExpressionLexer.mll b/src/odf/odf_ExpressionLexer.mll
index 00d1ce6..00d1ce6 100755..100644
--- a/src/odf/odf_ExpressionLexer.mll
+++ b/src/odf/odf_ExpressionLexer.mll
diff --git a/src/odf/odf_ExpressionParser.mly b/src/odf/odf_ExpressionParser.mly
index 1b9e8e2..1b9e8e2 100755..100644
--- a/src/odf/odf_ExpressionParser.mly
+++ b/src/odf/odf_ExpressionParser.mly
diff --git a/src/odf/odf_ns.ml b/src/odf/odf_ns.ml
index 43e9329..43e9329 100755..100644
--- a/src/odf/odf_ns.ml
+++ b/src/odf/odf_ns.ml
diff --git a/src/scTypes.ml b/src/scTypes.ml
index f0a42d4..46886a9 100644
--- a/src/scTypes.ml
+++ b/src/scTypes.ml
@@ -92,6 +92,8 @@ module Type = struct
       match f with
       | DataFormat.Number -> T.num n
       | DataFormat.Date -> T.date n
+      | _ -> raise Errors.TypeError
+
 
     let eval t = T.observe (eval_type t)
 
diff --git a/src/screen.ml b/src/screen.ml
index e11180b..e11180b 100755..100644
--- a/src/screen.ml
+++ b/src/screen.ml
diff --git a/src/screen.mli b/src/screen.mli
index 0c3ce40..0c3ce40 100755..100644
--- a/src/screen.mli
+++ b/src/screen.mli
diff --git a/src/selection.ml b/src/selection.ml
index 94db4e7..94db4e7 100755..100644
--- a/src/selection.ml
+++ b/src/selection.ml
diff --git a/src/selection.mli b/src/selection.mli
index ed93dbd..ed93dbd 100755..100644
--- a/src/selection.mli
+++ b/src/selection.mli
diff --git a/src/sheet.mli b/src/sheet.mli
index 5f85e92..5f85e92 100755..100644
--- a/src/sheet.mli
+++ b/src/sheet.mli
diff --git a/src/symbols.ml b/src/symbols.ml
index d87e019..d87e019 100755..100644
--- a/src/symbols.ml
+++ b/src/symbols.ml
diff --git a/src/symbols.mli b/src/symbols.mli
index 9e168b2..9e168b2 100755..100644
--- a/src/symbols.mli
+++ b/src/symbols.mli
diff --git a/src/tools.ml b/src/tools.ml
index c9d78a7..c9d78a7 100755..100644
--- a/src/tools.ml
+++ b/src/tools.ml
diff --git a/src/tree/pageMap.ml b/src/tree/pageMap.ml
index e18ba6f..e18ba6f 100755..100644
--- a/src/tree/pageMap.ml
+++ b/src/tree/pageMap.ml
diff --git a/src/tree/splay.mli b/src/tree/splay.mli
index 60d067b..60d067b 100755..100644
--- a/src/tree/splay.mli
+++ b/src/tree/splay.mli
diff --git a/stub/Makefile b/stub/Makefile
index ea4ddde..ea4ddde 100755..100644
--- a/stub/Makefile
+++ b/stub/Makefile
diff --git a/stub/curses.c b/stub/curses.c
index 79cad8d..79cad8d 100755..100644
--- a/stub/curses.c
+++ b/stub/curses.c
diff --git a/stub/ocaml.c b/stub/ocaml.c
index 8994c21..8994c21 100755..100644
--- a/stub/ocaml.c
+++ b/stub/ocaml.c
diff --git a/stub/ocaml.h b/stub/ocaml.h
index fc7c065..fc7c065 100755..100644
--- a/stub/ocaml.h
+++ b/stub/ocaml.h
diff --git a/tests/dataType_test.ml b/tests/dataType_test.ml
index 18f243f..18f243f 100755..100644
--- a/tests/dataType_test.ml
+++ b/tests/dataType_test.ml
diff --git a/tests/expressionParser_test.ml b/tests/expressionParser_test.ml
index 6bfe0f2..6bfe0f2 100755..100644
--- a/tests/expressionParser_test.ml
+++ b/tests/expressionParser_test.ml
diff --git a/tests/expression_test.ml b/tests/expression_test.ml
index 5b5d991..5b5d991 100755..100644
--- a/tests/expression_test.ml
+++ b/tests/expression_test.ml
diff --git a/tests/sheet_test.ml b/tests/sheet_test.ml
index 7c5da64..7c5da64 100755..100644
--- a/tests/sheet_test.ml
+++ b/tests/sheet_test.ml
diff --git a/tests/test.ml b/tests/test.ml
index e0b006d..15eff89 100644
--- a/tests/test.ml
+++ b/tests/test.ml
@@ -28,6 +28,8 @@ let () =
     Odf_ExpressionParser_test.tests;
     Selection_test.tests;
     Splay_test.tests;
+    Evaluate_test.tests;
+    Show_expr_test.tests;
   ]
   in OUnit2.run_test_tt_main tests
 
diff --git a/tests/tools_test.ml b/tests/tools_test.ml
index 4f48382..4f48382 100755..100644
--- a/tests/tools_test.ml
+++ b/tests/tools_test.ml
diff --git a/tests/tree/splay_test.ml b/tests/tree/splay_test.ml
index 6f01368..6f01368 100755..100644
--- a/tests/tree/splay_test.ml
+++ b/tests/tree/splay_test.ml
diff --git a/tests/unicode_test.ml b/tests/unicode_test.ml
index 6f8ffa9..6f8ffa9 100755..100644
--- a/tests/unicode_test.ml
+++ b/tests/unicode_test.ml