Commits

Dmitry Grebeniuk  committed cf59056

.

  • Participants
  • Parent commits ede2af0

Comments (0)

Files changed (4)

File src/cadastr.ml

 
     (*****************************************************)
 
-    module Tree (Key : TMOD 'a)
+    module Tree (Key : TCMP 'a)
      :
       sig
 
      =
       struct
 
-        value tkey = t_of_tmod (module Key : TMOD with type t = Key.t)
+        value tkey = t_of_tmod (module Key : T with type t = Key.t)
         ;
 
         module Kcompare =
 
 
     module Tree
-      (T : TMOD)
+      (Key : TCMP)
      :
       sig
         class map_rws_tree ['v] : [?tval: t 'v] -> [unit]
-          -> Timp.map_rws [T.t, 'v]
+          -> Timp.map_rws [Key.t, 'v]
         ;
       end
      =
       struct
 
-        module F = Sfun.Tree(T);
+        module F = Sfun.Tree(Key);
 
         class map_rws_tree ['v] ?tval ()
         =
-          map_rws_of_Sfun [T.t, 'v] (new F.map_rws_tree ?tval ())
+          map_rws_of_Sfun [Key.t, 'v] (new F.map_rws_tree ?tval ())
         ;
 
       end

File src/cd_Typeinfo.ml

       let module Tmod =
         struct
           type t = tt;
-          value eq = eq;
-          value cmp = cmp;
-          value hash = hash;
-          value show = show;
+          value opt_eq = eq;
+          value opt_cmp = cmp;
+          value opt_hash = hash;
+          value opt_show = show;
         end
       in
 
-      let tmod = (module Tmod : TMOD with type t = tt)
+      let tmod = (module Tmod : T with type t = tt)
       and topt =
       (
         object
           (module
             (struct
                type t = tt;
-               value eq = No.eq;
-               value show = No.show;
-               value hash = No.hash;
-               value cmp = No.cmp;
+               value opt_eq = No.eq;
+               value opt_show = No.show;
+               value opt_hash = No.hash;
+               value opt_cmp = No.cmp;
              end
             )
-          : TMOD with type t = tt
+          : T with type t = tt
           )
         ;
       end
     ;
 
 
-    value topt_of_tmod (type a) (tmod : (module TMOD with type t = a)) : tall a
+    value topt_of_tmod (type a) (tmod : (module T with type t = a)) : tall a
      =
-      let module T = (value tmod : TMOD with type t = a) in
-      let cmp = T.cmp
-      and eq = T.eq
-      and hash = T.hash
-      and show = T.show
+      let module T = (value tmod : T with type t = a) in
+      let cmp = T.opt_cmp
+      and eq = T.opt_eq
+      and hash = T.opt_hash
+      and show = T.opt_show
       in
       object
         method cmp = cmp;
       end
     ;
 
-    value t_of_tmod (type a) (tmod : (module TMOD with type t = a)) : t a =
+    value t_of_tmod (type a) (tmod : (module T with type t = a)) : t a =
       let topt = topt_of_tmod tmod in
       ((
       object
       (module
         (struct
            type t = a;
-           value eq = eq;
+
+           value opt_eq = eq;
+           value opt_cmp = cmp;
+           value opt_hash = hash;
+           value opt_show = show;
+
            value cmp = cmp;
-           value hash = hash;
-           value show = show;
          end
         )
-      : TMOD_CMP with type t = a
+      : TCMP with type t = a
       )
     ;
 
 
 (***************************************************************)
 
-module type TMOD
+module type T
  =
   sig
     type t;
-    value eq : t -> t -> bool;
-    value cmp : t -> t -> cmp_res;
-    value hash : t -> int;
-    value show : t -> string;
+
+    value opt_eq : t -> t -> bool;
+    value opt_cmp : t -> t -> cmp_res;
+    value opt_hash : t -> int;
+    value opt_show : t -> string;
   end
 ;
 
-type tmod 'a = (module TMOD with type t = 'a)
+module type TCMP
+ =
+  sig
+    type t;
+
+    value opt_eq : t -> t -> bool;
+    value opt_cmp : t -> t -> cmp_res;
+    value opt_hash : t -> int;
+    value opt_show : t -> string;
+
+    value cmp : t -> t -> cmp_res;
+  end
 ;
 
-module type TMOD_CMP = TMOD
+type tmod 'a = (module T with type t = 'a)
 ;
 
-type tmod_cmp 'a = (module TMOD_CMP with type t = 'a)
+type tmod_cmp 'a = (module TCMP with type t = 'a)
 ;
 
 (***************************************************************)

File test/test.ml

   ()
 ;
 
-(* doesn't compile since tint_eq has no [cmp] method
+
+(*
+   doesn't compile since tint_eq has no [cmp] method:
+
 module TreeWithoutCmp =
-  Sfun.Tree(value (tmod_cmp_of_tcmp tint_eq) : TMOD_CMP with type t = int)
+  Sfun.Tree(value (tmod_cmp_of_tcmp tint_eq) : TCMP with type t = int)
+;
+
+   doesn't compile since tint_cmp#tmod has type T, but TCMP
+   required by module unpacking:
+
+module TreeWithout_T_CMP_UNP =
+  Sfun.Tree(value tint_cmp#tmod : TCMP with type t = int)
+;
+
+   doesn't compile since tint_cmp#tmod has type T, but TCMP
+   required by function that :
+
+module TreeWithout_TCMP_APP =
+  Sfun.Tree(value tint#tmod : T with type t = int)
 ;
 
   but this example does compile:
 *)
 module TreeWithCmp =
-  Sfun.Tree(value (tmod_cmp_of_tcmp tint_cmp) : TMOD_CMP with type t = int)
+  Sfun.Tree(value (tmod_cmp_of_tcmp tint_cmp) : TCMP with type t = int)
 ;
 
 
 
 
 
-module IntTree = Cd.Sfun.Tree((value tint#tmod : TMOD with type t = int))
+module IntTree = Cd.Sfun.Tree((value (tmod_cmp_of_tcmp tint) : TCMP with type t = int))
 ;