Commits

Anonymous committed 9698fb2

old tests pass ok

Comments (0)

Files changed (3)

src/cd_Typeinfo.ml

       end
     ;
 
-    .
+
+
+    module No
+     =
+      struct
+        value no meth =
+          raise (No meth (ti_no :> uti))
+        ;
+
+        value eq
+         : 'a -> 'a -> bool
+         = fun _ _ ->
+             no "eq"
+        ;
+
+        value cmp
+         : 'a -> 'a -> cmp_res
+         = fun _ _ ->
+             no "cmp"
+        ;
+
+      end
+    ;
+
+
+    value entype_eq
+     : #ti 'a -> ubox -> ('a -> 'a -> bool)
+     = fun ta uf ->
+         entype_func2 ta ta ti_bool__base uf
+    ;
+
+
+    value get_meth_eq_untyped
+     : #ti 'a -> ubox
+     = fun ta ->
+         get_meth_untyped "eq" ta
+    ;
+
+
+    value get_meth_eq
+     : #ti 'a -> ('a -> 'a -> bool)
+     = fun ta ->
+         try
+           entype_eq ta (get_meth_eq_untyped ta)
+         with
+         [ No_meth -> No.eq
+         | e -> raise e
+         ]
+    ;
+
+
+    value get_meth_cmp_untyped
+     : #ti 'a -> ubox
+     = fun ti ->
+         get_meth_untyped "cmp" ti
+    ;
+
+
+    value entype_cmp
+     : #ti 'a -> ubox -> ('a -> 'a -> cmp_res)
+     = fun ti uf ->
+         entype_func2 ti ti ti_cmp_res__base uf
+    ;
+
+
+    value get_meth_cmp
+     : #ti 'a -> ('a -> 'a -> cmp_res)
+     = fun ta ->
+         try
+           entype_cmp ta (get_meth_cmp_untyped ta)
+         with
+         [ No_meth -> No.cmp
+         | e -> raise e
+         ]
+    ;
+
+
+    value get_meth_eq_same
+     : #ti 'a -> #ti 'a -> ('a -> 'a -> bool)
+     = fun ta1 ta2 ->
+         let uf1 = get_meth_eq_untyped ta1
+         and uf2 = get_meth_eq_untyped ta2 in
+         if uf1 != uf2
+         then
+           failwith "Cdt.get_meth_eq_same: both 'eq' methods should be equal"
+         else
+           entype_eq ta1 uf1
+    ;
+
+
+    (**********)
 
 
     value cmp_of_compare compare =
     value perv_hash = Hashtbl.hash;
 
 
-    value exn_no_eq = No "eq"
-      and exn_no_cmp = No "cmp"
-      and exn_no_hash = No "hash"
-    ;
-
     (*********************)
 
     (* [?eq] is derived from [~cmp] if not specified *)
 
 (********************)
 
-value ti_no = new ti_simple "<unknown>"
-;
 
-module No
- =
-  struct
-    value no meth =
-      raise (No meth (ti_no :> uti))
-    ;
-
-    value eq
-     : 'a -> 'a -> bool
-     = fun _ _ ->
-         no "eq"
-    ;
-
-    value cmp
-     : 'a -> 'a -> cmp_res
-     = fun _ _ ->
-         no "cmp"
-    ;
-
-  end
-;
-
-
-value entype_eq
- : #ti 'a -> ubox -> ('a -> 'a -> bool)
- = fun ta uf ->
-     entype_func2 ta ta ti_bool__base uf
-;
-
-
-value get_meth_eq_untyped
- : #ti 'a -> ubox
- = fun ta ->
-     get_meth_untyped "eq" ta
-;
-
-
-value get_meth_eq
- : #ti 'a -> ('a -> 'a -> bool)
- = fun ta ->
-     try
-       entype_eq ta (get_meth_eq_untyped ta)
-     with
-     [ No_meth -> No.eq
-     | e -> raise e
-     ]
-;
-
-
-value get_meth_cmp_untyped
- : #ti 'a -> ubox
- = fun ti ->
-     get_meth_untyped "cmp" ti
-;
-
-
-value entype_cmp
- : #ti 'a -> ubox -> ('a -> 'a -> cmp_res)
- = fun ti uf ->
-     entype_func2 ti ti ti_cmp_res__base uf
-;
-
-
-value get_meth_cmp
- : #ti 'a -> ('a -> 'a -> cmp_res)
- = fun ta ->
-     try
-       entype_cmp ta (get_meth_cmp_untyped ta)
-     with
-     [ No_meth -> No.cmp
-     | e -> raise e
-     ]
-;
-
-
-value get_meth_eq_same
- : #ti 'a -> #ti 'a -> ('a -> 'a -> bool)
- = fun ta1 ta2 ->
-     let uf1 = get_meth_eq_untyped ta1
-     and uf2 = get_meth_eq_untyped ta2 in
-     if uf1 != uf2
-     then
-       failwith "Cdt.get_meth_eq_same: both 'eq' methods should be equal"
-     else
-       entype_eq ta1 uf1
-;
 
 
 (********************)
 ;
 
 value tint_eq_cmp_raises () =
-  assert_raises (No "cmp")
+  assert_raises (No "cmp" (ti_int_eq :> uti))
     (fun () -> opt_cmp ti_int_eq 123 456 = LT)
 ;