From a6b5a6bdd138a5ccc6827bcc73580df1e9218820 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Fri, 24 Nov 2017 09:22:24 +0100 Subject: Moved all the code to src directory --- catalog.ml | 125 ------------------------------------------------------------- 1 file changed, 125 deletions(-) delete mode 100755 catalog.ml (limited to 'catalog.ml') diff --git a/catalog.ml b/catalog.ml deleted file mode 100755 index e4cd34b..0000000 --- a/catalog.ml +++ /dev/null @@ -1,125 +0,0 @@ -module T = Tools -module type DATA_SIG = sig - - type 'a typ - - type 'a returnType - - val compare_typ: 'a typ -> 'b typ -> ('a, 'b) T.cmp - - val repr: Format.formatter -> 'a typ -> unit - -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.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.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 - - - let repr: type a. Format.formatter -> a sig_typ -> unit = 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 - - module ComparableSignature = struct - - type 'a t = string * 'a sig_typ - - (* Type for pure equality *) - type (_, _) eq = Eq : ('a, 'a) eq - - (** Compare two signature *) - 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 - | T.Eq -> f Eq - | T.Lt -> T.Lt - | T.Gt -> T.Gt - end in - - 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 -> - 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 (str, typ) -> - Format.fprintf formatter "%s:%a" - str - repr typ - end - - end - - 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 - - let empty = Functions.empty - - (** - 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 - 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 -> - Functions.find ((String.uppercase_ascii name), signature) t - end - - let repr = Functions.repr - -end -- cgit v1.2.3