diff options
Diffstat (limited to 'catalog.ml')
| -rwxr-xr-x | catalog.ml | 132 |
1 files changed, 118 insertions, 14 deletions
@@ -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
|