Merge pull request #2589 from chenglou/functor

Expose Id.MakeComparable/ComparableU/Hashable/HashableU

Author: bobzhang

jscomp/others/belt_Id.ml

@@ -43,7 +43,7 @@ type ('key, 'id) comparable =
   (module Comparable with type t = 'key and type identity = 'id)
 
 
-module MakeComparable (M : sig
+module MakeComparableU (M : sig
    type t
    val cmp: t -> t -> int [@bs]
   end) =
@@ -53,20 +53,38 @@ struct
   let cmp = M.cmp
 end
 
+module MakeComparable (M : sig
+   type t
+   val cmp: t -> t -> int
+  end) =
+struct
+  type identity
+  type t = M.t
+  (* see https://github.com/BuckleScript/bucklescript/pull/2589/files/5ef875b7665ee08cfdc59af368fc52bac1fe9130#r173330825 *)
+  let cmp = 
+    let cmp = M.cmp in fun[@bs] a b -> cmp a b
+end
+
 let comparableU
   (type key) 
   cmp   
   =
-  let module N = MakeComparable(struct
+  let module N = MakeComparableU(struct
       type t = key
       let cmp = cmp
     end) in 
   (module N : Comparable with type t = key)
 
+let comparable
+  (type key) 
+  cmp   
+  =
+  let module N = MakeComparable(struct
+      type t = key
+      let cmp = cmp
+    end) in 
+  (module N : Comparable with type t = key)
 
-let comparable cmp =
-  comparableU (fun[@bs] a b -> cmp a b)
-    
 module type Hashable = sig 
   type identity 
   type t 
@@ -76,9 +94,9 @@ end
 
 type ('key, 'id) hashable = (module Hashable with type t = 'key and type identity = 'id)
 
-module MakeHashable (M : sig
+module MakeHashableU (M : sig
    type t
-   val hash : t -> int  [@bs]
+   val hash : t -> int [@bs]
    val eq : t -> t -> bool [@bs]
   end) =
 struct
@@ -87,16 +105,33 @@ struct
   let hash = M.hash
   let eq = M.eq
 end
-  
+
+module MakeHashable (M : sig
+   type t
+   val hash : t -> int
+   val eq : t -> t -> bool
+  end) =
+struct
+  type identity
+  type t = M.t
+  let hash = 
+    let hash = M.hash in fun[@bs] a -> hash a
+  let eq = 
+    let eq = M.eq in fun[@bs] a b -> eq a b
+end
+
 let hashableU (type key) ~hash ~eq = 
-  let module N = MakeHashable(struct 
+  let module N = MakeHashableU(struct 
     type t = key 
     let hash = hash 
     let eq = eq 
   end) in 
   (module N : Hashable with type t = key) 
 
-let hashable ~hash ~eq =
-  hashableU
-    ~hash:(fun [@bs] a -> hash a)
-    ~eq:(fun [@bs] a b -> eq a b)
+let hashable (type key) ~hash ~eq = 
+  let module N = MakeHashable(struct 
+    type t = key 
+    let hash = hash 
+    let eq = eq 
+  end) in 
+  (module N : Hashable with type t = key) 

jscomp/others/belt_Id.mli

@@ -42,7 +42,7 @@ type ('a, 'id) hash
     type parameter, so that different hash functions type mismatch
 *) 
 
-type ('a, 'id) eq 
+type ('a, 'id) eq
 (** [('a, 'id) eq]
  
     Its runtime represenation is an [eq] function, but signed with a 
@@ -55,7 +55,6 @@ type ('a, 'id) cmp
     Its runtime representation is a [cmp] function, but signed with a 
     type parameter, so that different hash functions type mismatch
 *)
-    
 module type Comparable = sig
   type identity
   type t
@@ -75,20 +74,36 @@ type ('key, 'id) comparable =
     mismatch if they use different comparison function
 *)
 
+module MakeComparableU : 
+  functor (M : sig 
+    type t 
+    val cmp : t -> t -> int [@bs] 
+  end) -> 
+  Comparable with type t = M.t
+
+module MakeComparable : 
+  functor (M : sig 
+    type t 
+    val cmp : t -> t -> int 
+  end) ->
+  Comparable with type t = M.t
+
 val comparableU:
   ('a -> 'a -> int [@bs]) ->
   (module Comparable with type t = 'a)
+[@@ocaml.deprecated "Use the MakeComparableU functor API instead"]
 
 val comparable:
   ('a -> 'a -> int) -> 
   (module Comparable with type t = 'a)
+[@@ocaml.deprecated "Use the MakeComparable functor API instead"]
 
 module type Hashable = sig 
-  type identity 
-  type t 
-  val hash: (t,identity) hash
-  val eq:  (t,identity) eq
-end 
+  type identity
+  type t
+  val hash : (t, identity) hash
+  val eq : (t, identity) eq
+end
 
 type ('key, 'id) hashable =
   (module Hashable with type t = 'key and type identity = 'id)
@@ -103,17 +118,33 @@ type ('key, 'id) hashable =
     mismatch if they use different comparison function
 *)
 
-                            
-
-val hashableU:
+module MakeHashableU : 
+  functor (M : sig 
+    type t 
+     val hash : t -> int [@bs]
+     val eq : t -> t -> bool [@bs]
+  end) ->
+  Hashable with type t = M.t
+
+module MakeHashable : 
+  functor (M : sig 
+    type t 
+     val hash : t -> int
+     val eq : t -> t -> bool
+  end) ->
+  Hashable with type t = M.t
+
+val hashableU :
   hash:('a -> int [@bs]) ->
   eq:('a -> 'a -> bool [@bs]) ->
   (module Hashable with type t = 'a)
-  
-val hashable:
-  hash:('a -> int ) ->
+[@@ocaml.deprecated "Use the MakeHashableU functor API instead"]
+
+val hashable :
+  hash:('a -> int) ->
   eq:('a -> 'a -> bool ) ->
   (module Hashable with type t = 'a)
+[@@ocaml.deprecated "Use the MakeHashable functor API instead"]
 
 
 

lib/js/belt_Id.js

@@ -2,12 +2,44 @@
 
 var Curry = require("./curry.js");
 
+function MakeComparableU(M) {
+  var cmp = M[/* cmp */0];
+  return /* module */[/* cmp */cmp];
+}
+
+function MakeComparable(M) {
+  var cmp = M[/* cmp */0];
+  var cmp$1 = Curry.__2(cmp);
+  return /* module */[/* cmp */cmp$1];
+}
+
 function comparableU(cmp) {
   return /* module */[/* cmp */cmp];
 }
 
 function comparable(cmp) {
-  return comparableU(Curry.__2(cmp));
+  var cmp$1 = Curry.__2(cmp);
+  return /* module */[/* cmp */cmp$1];
+}
+
+function MakeHashableU(M) {
+  var hash = M[/* hash */0];
+  var eq = M[/* eq */1];
+  return /* module */[
+          /* hash */hash,
+          /* eq */eq
+        ];
+}
+
+function MakeHashable(M) {
+  var hash = M[/* hash */0];
+  var hash$1 = Curry.__1(hash);
+  var eq = M[/* eq */1];
+  var eq$1 = Curry.__2(eq);
+  return /* module */[
+          /* hash */hash$1,
+          /* eq */eq$1
+        ];
 }
 
 function hashableU(hash, eq) {
@@ -18,11 +50,20 @@ function hashableU(hash, eq) {
 }
 
 function hashable(hash, eq) {
-  return hashableU(Curry.__1(hash), Curry.__2(eq));
+  var hash$1 = Curry.__1(hash);
+  var eq$1 = Curry.__2(eq);
+  return /* module */[
+          /* hash */hash$1,
+          /* eq */eq$1
+        ];
 }
 
+exports.MakeComparableU = MakeComparableU;
+exports.MakeComparable = MakeComparable;
 exports.comparableU = comparableU;
 exports.comparable = comparable;
+exports.MakeHashableU = MakeHashableU;
+exports.MakeHashable = MakeHashable;
 exports.hashableU = hashableU;
 exports.hashable = hashable;
 /* No side effect */