From eea6c106dd959dec19dc70991010bf2008fcf6c6 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Wed, 28 Aug 2019 22:44:18 +0200 Subject: Update catalog function register --- opam | 0 readme.rst | 0 src/UTF8.ml | 0 src/UTF8.mli | 0 src/actionParser.mly | 0 src/actions.mli | 0 src/catalog.ml | 104 +++++++++++++++++---------------------- src/catalog.mli | 3 +- src/cell.ml | 0 src/cell.mli | 0 src/dataType.ml | 0 src/dataType.mli | 0 src/date.mli | 0 src/errors.ml | 0 src/expression.mli | 0 src/expressionLexer.mll | 0 src/expressionParser.mly | 0 src/expressions/eval_ref.ml | 0 src/expressions/evaluate.ml | 1 + src/expressions/show_ref.ml | 0 src/expressions/show_type.ml | 0 src/expressions/sym_ref.ml | 0 src/expressions/sym_type.ml | 0 src/functions.ml | 1 - src/functions.mli | 0 src/main.ml | 0 src/odf/odfLoader.ml | 0 src/odf/odf_ExpressionLexer.mll | 0 src/odf/odf_ExpressionParser.mly | 0 src/odf/odf_ns.ml | 0 src/scTypes.ml | 2 + src/screen.ml | 0 src/screen.mli | 0 src/selection.ml | 0 src/selection.mli | 0 src/sheet.mli | 0 src/symbols.ml | 0 src/symbols.mli | 0 src/tools.ml | 0 src/tree/pageMap.ml | 0 src/tree/splay.mli | 0 stub/Makefile | 0 stub/curses.c | 0 stub/ocaml.c | 0 stub/ocaml.h | 0 tests/dataType_test.ml | 0 tests/expressionParser_test.ml | 0 tests/expression_test.ml | 0 tests/sheet_test.ml | 0 tests/test.ml | 2 + tests/tools_test.ml | 0 tests/tree/splay_test.ml | 0 tests/unicode_test.ml | 0 53 files changed, 50 insertions(+), 63 deletions(-) mode change 100755 => 100644 opam mode change 100755 => 100644 readme.rst mode change 100755 => 100644 src/UTF8.ml mode change 100755 => 100644 src/UTF8.mli mode change 100755 => 100644 src/actionParser.mly mode change 100755 => 100644 src/actions.mli mode change 100755 => 100644 src/catalog.ml mode change 100755 => 100644 src/cell.ml mode change 100755 => 100644 src/cell.mli mode change 100755 => 100644 src/dataType.ml mode change 100755 => 100644 src/dataType.mli mode change 100755 => 100644 src/date.mli mode change 100755 => 100644 src/errors.ml mode change 100755 => 100644 src/expression.mli mode change 100755 => 100644 src/expressionLexer.mll mode change 100755 => 100644 src/expressionParser.mly mode change 100755 => 100644 src/expressions/eval_ref.ml mode change 100755 => 100644 src/expressions/show_ref.ml mode change 100755 => 100644 src/expressions/show_type.ml mode change 100755 => 100644 src/expressions/sym_ref.ml mode change 100755 => 100644 src/expressions/sym_type.ml mode change 100755 => 100644 src/functions.ml mode change 100755 => 100644 src/functions.mli mode change 100755 => 100644 src/main.ml mode change 100755 => 100644 src/odf/odfLoader.ml mode change 100755 => 100644 src/odf/odf_ExpressionLexer.mll mode change 100755 => 100644 src/odf/odf_ExpressionParser.mly mode change 100755 => 100644 src/odf/odf_ns.ml mode change 100755 => 100644 src/screen.ml mode change 100755 => 100644 src/screen.mli mode change 100755 => 100644 src/selection.ml mode change 100755 => 100644 src/selection.mli mode change 100755 => 100644 src/sheet.mli mode change 100755 => 100644 src/symbols.ml mode change 100755 => 100644 src/symbols.mli mode change 100755 => 100644 src/tools.ml mode change 100755 => 100644 src/tree/pageMap.ml mode change 100755 => 100644 src/tree/splay.mli mode change 100755 => 100644 stub/Makefile mode change 100755 => 100644 stub/curses.c mode change 100755 => 100644 stub/ocaml.c mode change 100755 => 100644 stub/ocaml.h mode change 100755 => 100644 tests/dataType_test.ml mode change 100755 => 100644 tests/expressionParser_test.ml mode change 100755 => 100644 tests/expression_test.ml mode change 100755 => 100644 tests/sheet_test.ml mode change 100755 => 100644 tests/tools_test.ml mode change 100755 => 100644 tests/tree/splay_test.ml mode change 100755 => 100644 tests/unicode_test.ml diff --git a/opam b/opam old mode 100755 new mode 100644 diff --git a/readme.rst b/readme.rst old mode 100755 new mode 100644 diff --git a/src/UTF8.ml b/src/UTF8.ml old mode 100755 new mode 100644 diff --git a/src/UTF8.mli b/src/UTF8.mli old mode 100755 new mode 100644 diff --git a/src/actionParser.mly b/src/actionParser.mly old mode 100755 new mode 100644 diff --git a/src/actions.mli b/src/actions.mli old mode 100755 new mode 100644 diff --git a/src/catalog.ml b/src/catalog.ml old mode 100755 new mode 100644 index 71f953f..cd217b3 --- 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 old mode 100755 new mode 100644 diff --git a/src/cell.mli b/src/cell.mli old mode 100755 new mode 100644 diff --git a/src/dataType.ml b/src/dataType.ml old mode 100755 new mode 100644 diff --git a/src/dataType.mli b/src/dataType.mli old mode 100755 new mode 100644 diff --git a/src/date.mli b/src/date.mli old mode 100755 new mode 100644 diff --git a/src/errors.ml b/src/errors.ml old mode 100755 new mode 100644 diff --git a/src/expression.mli b/src/expression.mli old mode 100755 new mode 100644 diff --git a/src/expressionLexer.mll b/src/expressionLexer.mll old mode 100755 new mode 100644 diff --git a/src/expressionParser.mly b/src/expressionParser.mly old mode 100755 new mode 100644 diff --git a/src/expressions/eval_ref.ml b/src/expressions/eval_ref.ml old mode 100755 new mode 100644 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 old mode 100755 new mode 100644 diff --git a/src/expressions/show_type.ml b/src/expressions/show_type.ml old mode 100755 new mode 100644 diff --git a/src/expressions/sym_ref.ml b/src/expressions/sym_ref.ml old mode 100755 new mode 100644 diff --git a/src/expressions/sym_type.ml b/src/expressions/sym_type.ml old mode 100755 new mode 100644 diff --git a/src/functions.ml b/src/functions.ml old mode 100755 new mode 100644 index 0258ce0..491d968 --- 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 old mode 100755 new mode 100644 diff --git a/src/main.ml b/src/main.ml old mode 100755 new mode 100644 diff --git a/src/odf/odfLoader.ml b/src/odf/odfLoader.ml old mode 100755 new mode 100644 diff --git a/src/odf/odf_ExpressionLexer.mll b/src/odf/odf_ExpressionLexer.mll old mode 100755 new mode 100644 diff --git a/src/odf/odf_ExpressionParser.mly b/src/odf/odf_ExpressionParser.mly old mode 100755 new mode 100644 diff --git a/src/odf/odf_ns.ml b/src/odf/odf_ns.ml old mode 100755 new mode 100644 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 old mode 100755 new mode 100644 diff --git a/src/screen.mli b/src/screen.mli old mode 100755 new mode 100644 diff --git a/src/selection.ml b/src/selection.ml old mode 100755 new mode 100644 diff --git a/src/selection.mli b/src/selection.mli old mode 100755 new mode 100644 diff --git a/src/sheet.mli b/src/sheet.mli old mode 100755 new mode 100644 diff --git a/src/symbols.ml b/src/symbols.ml old mode 100755 new mode 100644 diff --git a/src/symbols.mli b/src/symbols.mli old mode 100755 new mode 100644 diff --git a/src/tools.ml b/src/tools.ml old mode 100755 new mode 100644 diff --git a/src/tree/pageMap.ml b/src/tree/pageMap.ml old mode 100755 new mode 100644 diff --git a/src/tree/splay.mli b/src/tree/splay.mli old mode 100755 new mode 100644 diff --git a/stub/Makefile b/stub/Makefile old mode 100755 new mode 100644 diff --git a/stub/curses.c b/stub/curses.c old mode 100755 new mode 100644 diff --git a/stub/ocaml.c b/stub/ocaml.c old mode 100755 new mode 100644 diff --git a/stub/ocaml.h b/stub/ocaml.h old mode 100755 new mode 100644 diff --git a/tests/dataType_test.ml b/tests/dataType_test.ml old mode 100755 new mode 100644 diff --git a/tests/expressionParser_test.ml b/tests/expressionParser_test.ml old mode 100755 new mode 100644 diff --git a/tests/expression_test.ml b/tests/expression_test.ml old mode 100755 new mode 100644 diff --git a/tests/sheet_test.ml b/tests/sheet_test.ml old mode 100755 new mode 100644 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 old mode 100755 new mode 100644 diff --git a/tests/tree/splay_test.ml b/tests/tree/splay_test.ml old mode 100755 new mode 100644 diff --git a/tests/unicode_test.ml b/tests/unicode_test.ml old mode 100755 new mode 100644 -- cgit v1.2.3