diff options
| -rwxr-xr-x | .merlin | 2 | ||||
| -rwxr-xr-x | catalog.ml | 132 | ||||
| -rw-r--r--[-rwxr-xr-x] | catalog.mli | 38 | ||||
| -rwxr-xr-x | evaluator.ml | 352 | ||||
| -rwxr-xr-x | evaluator.mli | 4 | ||||
| -rwxr-xr-x | expression.ml | 1 |
6 files changed, 278 insertions, 251 deletions
@@ -1,4 +1,4 @@ -PKG num curses camlzip ezxmlm uutf text oUnit menhirLib +PKG num curses camlzip ezxmlm text oUnit menhirLib S . S odf/* S tests/* @@ -1,21 +1,125 @@ -(** Catalog for all function *)
-module C = Map.Make(
- struct
- type t = UTF8.t
- let compare a b = Pervasives.compare
- (String.uppercase_ascii @@ UTF8.to_utf8string a)
- (String.uppercase_ascii @@ UTF8.to_utf8string b)
+module D = DataType
+module T = Tools
+module type DATA_SIG = sig
+
+ type 'a typ
+
+ type 'a result
+
+ val compare_typ: 'a typ -> 'b typ -> ('a, 'b) T.cmp
+
+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. *)
+exception RegisteredFunction
+
+(** Catalog for all functions *)
+module Make(Data:DATA_SIG) = struct
+
+ (** 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.result * ('a -> 'b) -> 'a t_function
+ | Fn2: 'c Data.result * ('a -> 'b -> 'c) -> ('a * 'b) t_function
+ | Fn3: 'd Data.result * ('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.typ -> 'a t_function sig_typ
+ | T2: 'a Data.typ * 'b Data.typ -> ('a * 'b) t_function sig_typ
+ | T3: 'a Data.typ * 'b Data.typ * 'c Data.typ -> ('a * 'b * 'c) t_function sig_typ
+
+ module ComparableSignature = struct
+
+ type 'a t = 'a sig_typ
+
+
+ (** Compare two signature *)
+ let eq: type a b. a sig_typ -> b sig_typ -> (a, b) T.cmp = begin fun a b ->
+ match a, b with
+
+ | T1(a), T1(b) ->
+ begin match Data.compare_typ a b with
+ | T.Lt -> T.Lt
+ | T.Gt -> T.Gt
+ | T.Eq -> T.Eq
+ end
+
+ | T2(a, b), T2(c, d) ->
+ begin match (Data.compare_typ a c) with
+ | T.Lt -> T.Lt
+ | T.Gt -> T.Gt
+ | T.Eq ->
+ begin match (Data.compare_typ b d) with
+ | T.Lt -> T.Lt
+ | T.Gt -> T.Gt
+ | T.Eq -> T.Eq
+ end
+ end
+
+ | T3(a, b, c), T3(d, e, f) ->
+ begin match (Data.compare_typ a d) with
+ | T.Lt -> T.Lt
+ | T.Gt -> T.Gt
+ | T.Eq ->
+ begin match (Data.compare_typ b e) with
+ | T.Lt -> T.Lt
+ | T.Gt -> T.Gt
+ | T.Eq ->
+ begin match (Data.compare_typ c f) with
+ | T.Lt -> T.Lt
+ | T.Gt -> T.Gt
+ | T.Eq -> T.Eq
+ end
+ end
+ end
+ | x, y -> if (T.Ex x) > (T.Ex y) then T.Gt else T.Lt
+ end
+
end
-)
-let catalog = ref C.empty
+ module Catalog = Map.Make(String)
+ module Functions = Tools.Map(ComparableSignature)
+
-let register name f =
- catalog := C.add name f !catalog
+ (* This is the map which contains all the registered functions.
+ Each name is binded with another map with contains the function for each
+ signature.
+ *)
+ type t = Functions.t Catalog.t
-let eval name params =
+ let empty = Catalog.empty
- let func = C.find name !catalog in
- func params
+ (**
+ Register a function in the catalog. If the function is already defined,
+ raise an exception.
+ *)
+ let register t name signature f = begin
+ let name' = String.uppercase_ascii name in
+ let map = begin match Catalog.find name' t with
+ | exception Not_found ->
+ Functions.singleton signature f
+ | x ->
+ (* We prevent any update to already registered function *)
+ if (Functions.mem signature x) then
+ raise RegisteredFunction
+ else
+ Functions.add signature f x
+ end in
+
+ Catalog.add name' map t
+ end
+
+
+ (** 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 =
+ begin fun t name signature ->
+ Catalog.find (String.uppercase_ascii name) t
+ |> Functions.find signature
+ end
+end
diff --git a/catalog.mli b/catalog.mli index 583db14..d2bb707 100755..100644 --- a/catalog.mli +++ b/catalog.mli @@ -1,4 +1,34 @@ -
-val register: UTF8.t -> (ScTypes.types list -> ScTypes.types) -> unit
-
-val eval: UTF8.t -> ScTypes.types list -> ScTypes.types
+module type DATA_SIG = sig + + type 'a typ + + type 'a result + + val compare_typ: 'a typ -> 'b typ -> ('a, 'b) Tools.cmp + +end + +module Make(D:DATA_SIG): sig + + type t + + type 'a t_function = + | Fn1: 'b D.result * ('a -> 'b) -> 'a t_function + | Fn2: 'c D.result * ('a -> 'b -> 'c) -> ('a * 'b) t_function + | Fn3: 'd D.result * ('a -> 'b -> 'c -> 'd) -> ('a * 'b * 'c) t_function + + type 'a sig_typ = + | T1: 'a D.typ -> 'a t_function sig_typ + | T2: 'a D.typ * 'b D.typ -> ('a * 'b) t_function sig_typ + | T3: 'a D.typ * 'b D.typ * 'c D.typ -> ('a * 'b * 'c) t_function sig_typ + + (** Empty catalog *) + val empty: t + + (** Register a new function in the catalog *) + val register : t -> string -> 'a sig_typ -> 'a -> t + + (** Find a function with the given name and signature *) + val find_function: t -> string -> 'a t_function sig_typ -> 'a t_function + +end diff --git a/evaluator.ml b/evaluator.ml index 26541c7..4bbf780 100755 --- a/evaluator.ml +++ b/evaluator.ml @@ -1,7 +1,7 @@ module D = DataType
module T = Tools
-exception RegisteredFunction
+module Data = struct
(** Data format *)
@@ -27,11 +27,6 @@ type _ typ = | String: UTF8.t typ
| List: 'a typ -> 'a list typ
-let t_bool= Bool
-let t_int = Num
-let t_string = String
-let t_list t = List t
-
let typ_of_format:
type a. a dataFormat -> a typ =
function
@@ -86,12 +81,6 @@ type _ result = | String: UTF8.t result (* String result, there is only one representation *)
| Bool: D.Bool.t result (* Boolean result *)
-let f_num = Numeric
-let f_date = Date
-let f_number = Number
-let f_string = String
-let f_bool = Bool
-
let specialize_result: type a. a result -> a dataFormat -> a result =
begin fun a b -> match a, b with
| Date, _ -> Date
@@ -158,233 +147,126 @@ let format_of_value: type a. a value -> a dataFormat = function | List (t, l) -> raise Errors.TypeError
| List2 (t, l) -> raise Errors.TypeError
-type existencialResult =
- | Result : 'a value -> existencialResult
-
-(** Catalog for all functions *)
-module C = struct
-
- (** This is the way the function is store in the map.
- We just the return type, and the function itself.
-
- For Fn1 and T1 constructors, we need to add extra information in the
- GADT signature in order to help the compiler: 'a could be any ('a * 'b),
- ('a * 'b * 'c) and so on…
-
- Instead of returning a signature with type 'a t_function, we have to
- force it as 'a typ t_function.
- *)
- type _ t_function =
- | Fn1: 'b result * ('a -> 'b) -> 'a typ t_function
- | Fn2: 'c result * ('a -> 'b -> 'c) -> ('a * 'b) t_function
- | Fn3: 'd result * ('a -> 'b -> 'c -> 'd) -> ('a * 'b * 'c) t_function
-
- (** This is the key for storing functions in the map.
- *)
- type _ sig_typ =
- | T1: 'a typ -> 'a typ t_function sig_typ
- | T2: 'a typ * 'b typ -> ('a * 'b) t_function sig_typ
- | T3: 'a typ * 'b typ * 'c typ -> ('a * 'b * 'c) t_function sig_typ
-
- let print_sig_typ: type a. Format.formatter -> a sig_typ -> unit = begin fun printer typ ->
- match typ with
- | T1 a -> Format.fprintf printer "(%a)"
- print_typ a
- | T2 (a, b) -> Format.fprintf printer "(%a, %a)"
- print_typ a
- print_typ b
- | T3 (a, b, c) -> Format.fprintf printer "(%a, %a, %a)"
- print_typ a
- print_typ b
- print_typ c
- end
-
- module ComparableSignature = struct
-
- type 'a t = 'a sig_typ
-
- (** Compare two signature *)
- let eq: type a b. a sig_typ -> b sig_typ -> (a, b) T.cmp = begin fun a b ->
- match a, b with
- | T1(a), T1(b) ->
- begin match compare_typ a b with
- | T.Lt -> T.Lt
- | T.Gt -> T.Gt
- | T.Eq -> T.Eq
- end
- | T2(a, b), T2(c, d) ->
- begin match (compare_typ a c) with
- | T.Lt -> T.Lt
- | T.Gt -> T.Gt
- | T.Eq ->
- begin match (compare_typ b d) with
- | T.Lt -> T.Lt
- | T.Gt -> T.Gt
- | T.Eq -> T.Eq
- end
- end
- | T3(a, b, c), T3(d, e, f) ->
- begin match (compare_typ a d) with
- | T.Lt -> T.Lt
- | T.Gt -> T.Gt
- | T.Eq ->
- begin match (compare_typ b e) with
- | T.Lt -> T.Lt
- | T.Gt -> T.Gt
- | T.Eq ->
- begin match (compare_typ c f) with
- | T.Lt -> T.Lt
- | T.Gt -> T.Gt
- | T.Eq -> T.Eq
- end
- end
- end
- | x, y -> if (T.Ex x) > (T.Ex y) then T.Gt else T.Lt
- end
-
- end
-
- module Catalog = Map.Make(String)
- module Functions = Tools.Map(ComparableSignature)
-
-
- (* This is the map which contains all the registered functions.
- Each name is binded with another map with contains the function for each
- signature.
- *)
- let (catalog:Functions.t Catalog.t ref) = ref Catalog.empty
-
- (**
- Register a function in the catalog. If the function is already defined,
- raise an exception.
- *)
- let register name signature f = begin
-
- let name' = String.uppercase_ascii name in
- let map = begin match Catalog.find name' !catalog with
- | exception Not_found ->
- Functions.singleton signature f
- | x ->
- (* We prevent any update to already registered function *)
- if (Functions.mem signature x) then
- raise RegisteredFunction
- else
- Functions.add signature f x
- end in
-
- catalog := Catalog.add name' map !catalog
- end
-
- let inject:
- type a. a result -> (unit -> a dataFormat) -> a -> existencialResult =
- fun resultFormat f res ->
- let (x:a value) = begin match resultFormat, res with
+ let inject':
+ type a. a result -> (unit -> a dataFormat) -> a -> a value =
+ fun resultFormat f res -> begin match resultFormat, res with
| Bool, x -> Bool x
| Numeric, x -> Num (f (), x)
| Date, x -> Num(Date, x)
| Number, x -> Num(Number, x)
| String, s -> String s
- end in
- Result x
-
- (** Look in the catalog for a function with the given name and signature *)
- let find_function:
- type a. string -> a t_function sig_typ -> a t_function =
- begin fun name signature ->
- Catalog.find (String.uppercase_ascii name) !catalog
- |> Functions.find signature
- end
+ end
+
+let compare_format: type a b. a typ -> a result -> b value -> a result = begin
+fun init_typ currentResult value ->
+
+(* If the argument as the same type as the result format, just the most specialized *)
+match compare_typ init_typ (type_of_value value) with
+ | T.Eq -> begin match value with
+ | Bool b -> Bool
+ | String s -> String
+ | Num (f, v) -> specialize_result currentResult f
+ (* There is no possibility to get init_typ as List typ*)
+ | List (f, v) -> raise Errors.TypeError
+ | List2 (f, v) -> raise Errors.TypeError
+ end
+ (* The types differ, handle the special cases for Lists *)
+ | _ ->
+ begin match value with
+ | List (f, v) ->
+ begin match compare_typ init_typ (typ_of_format f) with
+ | T.Eq -> specialize_result currentResult f
+ | _ -> currentResult
+ end
+ | List2 (f, v) ->
+ begin match compare_typ init_typ (typ_of_format f) with
+ | T.Eq -> specialize_result currentResult f
+ | _ -> currentResult
+ end
+ | _ -> currentResult
+ end
+end
end
+module C = Catalog.Make(Data)
+
+let (catalog:C.t ref) = ref C.empty
+
+
+type existencialResult =
+ | Result : 'a Data.value -> existencialResult
+
(** Guess the format to use for the result function from the arguments given.
The most specialized format take over the others.
*)
let guess_format_result:
-type a. a result -> existencialResult list -> unit -> a dataFormat =
+type a. a Data.result -> existencialResult list -> unit -> a Data.dataFormat =
begin fun init_value values () ->
- let init_typ = typ_of_result init_value in
+ let init_typ:a Data.typ = Data.typ_of_result init_value in
(* fold over the arguments, and check if they have the same format *)
- let compare_format (currentResult: a result) (Result value): a result =
-
- (* If the argument as the same type as the result format, just the most specialized *)
- match compare_typ init_typ (type_of_value value) with
- | T.Eq -> begin match value with
- | Bool b -> Bool
- | String s -> String
- | Num (f, v) -> specialize_result currentResult f
- (* There is no possibility to get init_typ as List typ*)
- | List (f, v) -> raise Errors.TypeError
- | List2 (f, v) -> raise Errors.TypeError
- end
- (* The types differ, handle the special cases for Lists *)
- | _ ->
- begin match value with
- | List (f, v) ->
- begin match compare_typ init_typ (typ_of_format f) with
- | T.Eq -> specialize_result currentResult f
- | _ -> currentResult
- end
- | List2 (f, v) ->
- begin match compare_typ init_typ (typ_of_format f) with
- | T.Eq -> specialize_result currentResult f
- | _ -> currentResult
- end
- | _ -> currentResult
- end in
+ let compare_format: a Data.result -> existencialResult -> a Data.result =
+ fun currentResult (Result value) ->
+ Data.compare_format init_typ currentResult value in
begin match List.fold_left compare_format init_value values with
- | String -> String
- | Bool -> Bool
- | Number -> Number
- | Date -> Date
- | Numeric -> Number
+ | Data.String -> Data.String
+ | Data.Bool -> Data.Bool
+ | Data.Number -> Data.Number
+ | Data.Date -> Data.Date
+ | Data.Numeric -> Data.Number
end
end
+let inject:
+type a. a Data.result -> (unit -> a Data.dataFormat) -> a -> existencialResult =
+fun resultFormat f res ->
+ let (x:a Data.value) = Data.inject' resultFormat f res in
+ Result x
+
let register0 name returnType f =
- C.register name (C.T1(Unit)) (C.Fn1 (returnType, f))
+ catalog := C.register !catalog name (C.T1(Data.Unit)) (C.Fn1 (returnType, f))
let register1 name typ1 returnType f =
- C.register name (C.T1(typ1)) (C.Fn1 (returnType, f))
+ catalog := C.register !catalog name (C.T1(typ1)) (C.Fn1 (returnType, f))
let register2 name (typ1, typ2) result f =
- C.register name (C.T2(typ1, typ2)) (C.Fn2 (result, f))
+ catalog := C.register !catalog name (C.T2(typ1, typ2)) (C.Fn2 (result, f))
let register3 name (typ1, typ2, typ3) result f =
- C.register name (C.T3(typ1, typ2, typ3)) (C.Fn3 (result, f))
+ catalog := C.register !catalog name (C.T3(typ1, typ2, typ3)) (C.Fn3 (result, f))
let call name args = begin
let name' = UTF8.to_utf8string name in
begin try match args with
| [] ->
- let C.Fn1(ret, f) = C.find_function name' (C.T1 Unit) in
- C.inject ret (fun () -> raise Errors.TypeError) (f ())
+ let C.Fn1(ret, f) = C.find_function !catalog name' (C.T1 Data.Unit) in
+ inject ret (fun () -> raise Errors.TypeError) (f ())
| (Result p1)::[] ->
let C.Fn1(ret, f) =
- C.find_function name' (C.T1 (type_of_value p1)) in
- C.inject ret (guess_format_result ret args) (f (get_value_content p1))
+ C.find_function !catalog name' (C.T1 (Data.type_of_value p1)) in
+ inject ret (guess_format_result ret args) (f (Data.get_value_content p1))
| (Result p1)::(Result p2)::[] ->
let C.Fn2(ret, f) =
- C.find_function name' (C.T2 (type_of_value p1, type_of_value p2)) in
- C.inject ret (guess_format_result ret args) (f (get_value_content p1) (get_value_content p2))
+ C.find_function !catalog name' (C.T2 (Data.type_of_value p1, Data.type_of_value p2)) in
+ inject ret (guess_format_result ret args) (f (Data.get_value_content p1) (Data.get_value_content p2))
| (Result p1)::(Result p2)::(Result p3)::[] ->
let C.Fn3(ret, f) =
- C.find_function name' (C.T3 (type_of_value p1, type_of_value p2, type_of_value p3)) in
- C.inject ret (guess_format_result ret args) (f (get_value_content p1) (get_value_content p2) (get_value_content p3))
+ C.find_function !catalog name' (C.T3 (Data.type_of_value p1, Data.type_of_value p2, Data.type_of_value p3)) in
+ inject ret (guess_format_result ret args) (f (Data.get_value_content p1) (Data.get_value_content p2) (Data.get_value_content p3))
| _ -> raise Not_found
with Not_found ->
let signature = List.map (fun (Result x) ->
let formatter = Format.str_formatter in
- print_typ formatter (type_of_value x);
+ Data.print_typ formatter (Data.type_of_value x);
Format.flush_str_formatter ()) args in
raise (Errors.Undefined (name, signature))
@@ -397,49 +279,49 @@ let repr mapper value = begin If the value is Undefined, raise an exception.
*)
let extract_value = begin function
- | ScTypes.Num (n,s) -> Result (Num (Number, (D.Num.of_num n)))
- | ScTypes.Bool b -> Result (Bool b)
- | ScTypes.Date d -> Result (Num (Date, (D.Num.of_num d)))
- | ScTypes.Str s -> Result (String s)
+ | ScTypes.Num (n,s) -> Result (Data.Num (Data.Number, (D.Num.of_num n)))
+ | ScTypes.Bool b -> Result (Data.Bool b)
+ | ScTypes.Date d -> Result (Data.Num (Data.Date, (D.Num.of_num d)))
+ | ScTypes.Str s -> Result (Data.String s)
end in
- let add_elem: type a. a typ -> a list * a dataFormat -> ScTypes.types option -> a list * a dataFormat =
+ let add_elem: type a. a Data.typ -> a list * a Data.dataFormat -> ScTypes.types option -> a list * a Data.dataFormat =
begin fun type_of (result, format_of) next ->
let Result r = match next with
| Some x -> extract_value x
| None -> begin match type_of with
- | Num -> Result (Num (Number, (D.Num.nan)))
- | Bool -> Result (Bool false)
- | String -> Result (String (UTF8.empty))
- | List x -> Result (List ((default_format_for_type x), []))
- | Unit -> raise Errors.TypeError
+ | Data.Num -> Result (Data.Num (Data.Number, (D.Num.nan)))
+ | Data.Bool -> Result (Data.Bool false)
+ | Data.String -> Result (Data.String (UTF8.empty))
+ | Data.List x -> Result (Data.List ((Data.default_format_for_type x), []))
+ | Data.Unit -> raise Errors.TypeError
end in
- begin match compare_typ type_of (type_of_value r) with
+ begin match Data.compare_typ type_of (Data.type_of_value r) with
| T.Eq ->
- let l' = (get_value_content r)::result in
- l' , (most_generic_format (format_of_value r) format_of)
+ let l' = (Data.get_value_content r)::result in
+ l' , (Data.most_generic_format (Data.format_of_value r) format_of)
| _ -> raise Errors.TypeError
end
end in
(* Return the result for any expression as an ScTypes.types result *)
- let rec get_repr: type a. a value -> ScTypes.types = begin function
- | Bool b -> ScTypes.Bool b
- | Num (format, n) -> begin match format with
- | Number -> ScTypes.Num (D.Num.to_num n, None)
- | Date -> ScTypes.Date (D.Num.to_num n)
+ let rec get_repr: type a. a Data.value -> ScTypes.types = begin function
+ | Data.Bool b -> ScTypes.Bool b
+ | Data.Num (format, n) -> begin match format with
+ | Data.Number -> ScTypes.Num (D.Num.to_num n, None)
+ | Data.Date -> ScTypes.Date (D.Num.to_num n)
| _ -> raise Errors.TypeError (* This pattern could be refuted *)
end
- | String s -> ScTypes.Str s
- | List (t, l) ->
- List.hd l (* Extract the first element *)
- |> build_value t (* Convert it in boxed value *)
- |> get_repr (* Return it's representation *)
- | List2 (t, l) ->
- List.hd l (* Extract the first element *)
+ | Data.String s -> ScTypes.Str s
+ | Data.List (t, l) ->
+ List.hd l (* Extract the first element *)
+ |> Data.build_value t (* Convert it in boxed value *)
+ |> get_repr (* Return it's representation *)
+ | Data.List2 (t, l) ->
+ List.hd l (* Extract the first element *)
|> List.hd
- |> build_value t (* Convert it in boxed value *)
- |> get_repr (* Return it's representation *)
+ |> Data.build_value t (* Convert it in boxed value *)
+ |> get_repr (* Return it's representation *)
end in
(** Extract the value from an expression.
@@ -459,23 +341,23 @@ let repr mapper value = begin | ScTypes.Refs.Array1 l ->
(* Guess the list type from it's first defined element *)
let Result r = extract_value (Tools.List.find_map (fun x -> x) l) in
- let format_of = format_of_value r in
- let type_of = type_of_value r in
+ let format_of = Data.format_of_value r in
+ let type_of = Data.type_of_value r in
(* Build the list with all the elements *)
let elems, format = List.fold_left (add_elem type_of) ([], format_of) l in
- Result (List (format, elems))
+ Result (Data.List (format, elems))
| ScTypes.Refs.Array2 l ->
(* Guess the list type from it's first defined element *)
let Result r = extract_value (Tools.List.find_map2 (fun x -> x) l) in
- let format_of = format_of_value r in
- let type_of = type_of_value r in
+ let format_of = Data.format_of_value r in
+ let type_of = Data.type_of_value r in
(* Build the list with all the elements *)
let elems, format = List.fold_left (fun (result, format_of) elems ->
let elems, format = List.fold_left (add_elem type_of) ([], format_of) elems in
- elems::result, (most_generic_format format_of format)
+ elems::result, (Data.most_generic_format format_of format)
) ([], format_of) l in
- Result (List2 (format, elems))
+ Result (Data.List2 (format, elems))
end
(* Evaluate the expression *)
@@ -491,12 +373,20 @@ let repr mapper value = begin end
let wrap f =
- let old_catalog = !C.catalog in
+ let old_catalog = !catalog in
Tools.try_finally
- (fun () -> C.catalog := C.Catalog.empty; f ())
- (fun () -> C.catalog := old_catalog)
+ (fun () -> catalog := C.empty; f ())
+ (fun () -> catalog := old_catalog)
+
(* Register the standard functions *)
+type 'a result = 'a Data.result
+
+let f_num: DataType.Num.t Data.result = Data.Numeric
+let f_date: DataType.Num.t Data.result = Data.Date
+let f_number: DataType.Num.t Data.result = Data.Number
+let f_string: DataType.String.t Data.result = Data.String
+let f_bool: DataType.Bool.t Data.result = Data.Bool
module MAKE(C: D.COMPARABLE) = struct
@@ -511,6 +401,12 @@ module MAKE(C: D.COMPARABLE) = struct end
+type 'a typ = 'a Data.typ
+let t_bool: DataType.Bool.t typ = Data.Bool
+let t_int: DataType.Num.t typ = Data.Num
+let t_string: UTF8.t typ = Data.String
+let t_list (t: 'a typ): 'a list typ = Data.List t
+
(* Helper for list functions : reduce over a list of elements *)
let reduce name typ res f = begin
register1 name (t_list typ) res (fun x ->
@@ -531,6 +427,7 @@ end let () = begin
let module CompareNum = MAKE(D.Num) in
+ Data.(
CompareNum.register t_int;
register0 "rand" f_number D.Num.rnd;
@@ -571,5 +468,6 @@ let () = begin (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num day)
|> D.Num.of_num
)
+ )
end
diff --git a/evaluator.mli b/evaluator.mli index d69bba6..d695b68 100755 --- a/evaluator.mli +++ b/evaluator.mli @@ -29,10 +29,6 @@ val f_string: DataType.String.t result (** Catalog *)
-(** We cannot update an existing function. Any [registerX] function will raise
- [RegisteredFunction] if a function with the same signature already exists in the catalog. *)
-exception RegisteredFunction
-
val register0:
string -> (* The function name *)
'a result -> (* The return type *)
diff --git a/expression.ml b/expression.ml index 155e1b9..0bc8f43 100755 --- a/expression.ml +++ b/expression.ml @@ -1,4 +1,3 @@ -module C = Catalog
module Tuple2 = Tools.Tuple2
let u = UTF8.from_utf8string
|