aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--[-rwxr-xr-x]src/UTF8.ml0
-rw-r--r--[-rwxr-xr-x]src/UTF8.mli0
-rw-r--r--[-rwxr-xr-x]src/actionParser.mly0
-rw-r--r--[-rwxr-xr-x]src/actions.mli0
-rw-r--r--[-rwxr-xr-x]src/catalog.ml104
-rw-r--r--src/catalog.mli3
-rw-r--r--[-rwxr-xr-x]src/cell.ml0
-rw-r--r--[-rwxr-xr-x]src/cell.mli0
-rw-r--r--[-rwxr-xr-x]src/dataType.ml0
-rw-r--r--[-rwxr-xr-x]src/dataType.mli0
-rw-r--r--[-rwxr-xr-x]src/date.mli0
-rw-r--r--[-rwxr-xr-x]src/errors.ml0
-rw-r--r--[-rwxr-xr-x]src/expression.mli0
-rw-r--r--[-rwxr-xr-x]src/expressionLexer.mll0
-rw-r--r--[-rwxr-xr-x]src/expressionParser.mly0
-rw-r--r--[-rwxr-xr-x]src/expressions/eval_ref.ml0
-rw-r--r--src/expressions/evaluate.ml1
-rw-r--r--[-rwxr-xr-x]src/expressions/show_ref.ml0
-rw-r--r--[-rwxr-xr-x]src/expressions/show_type.ml0
-rw-r--r--[-rwxr-xr-x]src/expressions/sym_ref.ml0
-rw-r--r--[-rwxr-xr-x]src/expressions/sym_type.ml0
-rw-r--r--[-rwxr-xr-x]src/functions.ml1
-rw-r--r--[-rwxr-xr-x]src/functions.mli0
-rw-r--r--[-rwxr-xr-x]src/main.ml0
-rw-r--r--[-rwxr-xr-x]src/odf/odfLoader.ml0
-rw-r--r--[-rwxr-xr-x]src/odf/odf_ExpressionLexer.mll0
-rw-r--r--[-rwxr-xr-x]src/odf/odf_ExpressionParser.mly0
-rw-r--r--[-rwxr-xr-x]src/odf/odf_ns.ml0
-rw-r--r--src/scTypes.ml2
-rw-r--r--[-rwxr-xr-x]src/screen.ml0
-rw-r--r--[-rwxr-xr-x]src/screen.mli0
-rw-r--r--[-rwxr-xr-x]src/selection.ml0
-rw-r--r--[-rwxr-xr-x]src/selection.mli0
-rw-r--r--[-rwxr-xr-x]src/sheet.mli0
-rw-r--r--[-rwxr-xr-x]src/symbols.ml0
-rw-r--r--[-rwxr-xr-x]src/symbols.mli0
-rw-r--r--[-rwxr-xr-x]src/tools.ml0
-rw-r--r--[-rwxr-xr-x]src/tree/pageMap.ml0
-rw-r--r--[-rwxr-xr-x]src/tree/splay.mli0
39 files changed, 48 insertions, 63 deletions
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 18:12:17 +0000