Moved catalog in its own module

6 files changed, 278 insertions, 251 deletions

diff --git a/.merlin b/.merlin
index 3194a14..adf0649 100755
--- a/.merlin
+++ b/.merlin
@@ -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/*
diff --git a/catalog.ml b/catalog.ml
index ee74a5a..e7bdb17 100755
--- a/catalog.ml
+++ b/catalog.ml
@@ -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