Commits

Anonymous committed 685a06b

..mid..

Comments (0)

Files changed (2)

src/cd_Typeinfo.ml

 
 
     *)
-    
+
+
+
+(*
+    вроде бы достаточно только подставить правильный type_desc
+    для работы этого:
+
+    value ti_option2 (ti_a : #ti _) =
+      ti_sum_type ~name:"option" ~params:[ti_a] & fun
+      [ None -> ti_variant "None" [| |]
+      | Some v_a -> ti_variant "Some" [| ubox ti_a v_a |]
+      ]
+    ;
+*)
+
 
 
 (* старье:
     ;
 
 
-    value ti_option2 (ti_a : #ti _) =
-      ti_sum_type ~name:"option" ~params:[ti_a] & fun
-      [ None -> ti_variant "None" [| |]
-      | Some v_a -> ti_variant "Some" [| ubox ti_a v_a |]
-      ]
-    ;
-
     value ti_option2_hiding (ti_a : #ti _) =
       ti_sum_type ~name:"option" ~params:[ti_a] & fun
       [ None -> ti_variant "None" [| |]
       | Some v_a -> ti_methods & fun
-          [ `Show -> ti_variant "Some" [| |]
+          [ "show" -> ti_variant "Some" [| ubox ti_string "<hidden>" |]
           | _ -> ti_variant "Some" [| ubox ti_a v_a |]
           ]
       ]
+(*
+todo: убрать многое в Typeinfo, так как Cdt будет открываться всегда,
+а мусорить именами не ок.
+*)
+
+
 type cmp_res = [ LT | EQ | GT ]
 ;
 
 ;
 
 
+(*****************************************************)
 
-class virtual ticmp_ ['a] ~cmp () =
+
+
+class virtual ticmp_register ['a] =
   object (self : #tti 'a)
-    method cmp = cmp;
+
+    method virtual cmp : 'a -> 'a -> cmp_res;
 
     initializer
       uti_add_meth self "cmp"
         (let ti__t_cmp_res = ti_abs (self :> tti _) ti_cmp_res__base in
          let ti__t_t_cmp_res = ti_abs (self :> tti _) ti__t_cmp_res in
-         ubox ti__t_t_cmp_res cmp
+         ubox ti__t_t_cmp_res self#cmp
         )
     ;
+
+  end
+
+and virtual ticmp_ ['a] ~cmp () =
+  object (_self : #tti 'a)
+    method cmp : 'a -> 'a -> cmp_res = cmp;
+    inherit ticmp_register ['a];
+  end
+;
+
+
+value cmp_struc ux uy : cmp_res =
+  (ignore ux; ignore uy; raise Exit)
+;
+
+
+class virtual ticmp_struc_ ['a] =
+  object (self : #tti 'a)
+    method cmp x y = cmp_struc (ubox self x) (ubox self y)
+    ;
   end
 ;