diff options
Diffstat (limited to 'catalog.ml')
| -rwxr-xr-x | catalog.ml | 40 |
1 files changed, 19 insertions, 21 deletions
@@ -32,13 +32,13 @@ module Make(Data:DATA_SIG) = struct module ComparableSignature = struct
- type 'a t = 'a sig_typ
+ type 'a t = string * 'a sig_typ
(* Type for pure equality *)
type (_, _) eq = Eq : ('a, 'a) eq
(** Compare two signature *)
- let eq: type a b. a sig_typ -> b sig_typ -> (a, b) T.cmp = begin fun a b ->
+ let comp: type a b. string * a sig_typ -> string * b sig_typ -> (a, b) T.cmp = begin fun (namea, a) (nameb, b) ->
let cmp: type c d. c Data.typ -> d Data.typ -> ((c, d) eq -> (a, b) T.cmp) -> (a, b) T.cmp =
begin fun a b f -> match Data.compare_typ a b with
@@ -47,14 +47,22 @@ module Make(Data:DATA_SIG) = struct | T.Gt -> T.Gt
end in
- match a, b with
+ if namea < nameb then
+ T.Lt
+ else if namea > nameb then
+ T.Gt
+ else 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 ->
@@ -63,22 +71,21 @@ module Make(Data:DATA_SIG) = struct )
)
- | 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)
+ module Functions = Splay.Make(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.
*)
- type t = Functions.t Catalog.t
+ type t = Functions.tree
- let empty = Catalog.empty
+ let empty = Functions.empty
(**
Register a function in the catalog. If the function is already defined,
@@ -87,26 +94,17 @@ module Make(Data:DATA_SIG) = struct 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
+ if Functions.member (name', signature) t then
+ raise RegisteredFunction
+ else
+ Functions.add (name', signature) f 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
+ Functions.find ((String.uppercase_ascii name), signature) t
end
end
|