More convenient bindings generation

See https://discuss.ocaml.org/t/modeling-rust-trait-objects-subtyping-relation-via-ocaml-polymorphic-variants/15644

src/ptr.rs

@@ -177,8 +177,10 @@ impl<T: 'static + Send + ?Sized> Clone for DynBox<T> {
 impl<T: ?Sized + Send + 'static> OCamlDesc for DynBox<T> {
     fn ocaml_desc(env: &::ocaml_gen::Env, _generics: &[&str]) -> String {
         let type_id = <Self as OCamlDesc>::unique_id();
-        env.get_type(type_id, type_name::get_type_name::<T>().as_str())
-            .0
+        let typ = env
+            .get_type(type_id, type_name::get_type_name::<T>().as_str())
+            .0;
+        format!("_ {}'", typ)
     }
 
     fn unique_id() -> u128 {
@@ -221,16 +223,14 @@ impl<T: ?Sized + Send + 'static> OCamlBinding for DynBox<T> {
             .join("|");
 
         if new_type {
+            let name = name.split_whitespace().last().expect("no last element :shrug:").to_owned();
+            let name = name.strip_suffix("'").expect("dynbox type name does not end with `'`!");
             format!(
-                "type nonrec {} = [ {} ] Ocaml_rs_smartptr.Rusty_obj.t",
-                name, variants
+                "type tags = [{}] type 'a {}' = ([> tags ] as 'a) Ocaml_rs_smartptr.Rusty_obj.t type {} = tags {}'",
+                variants, name, name, name
             )
         } else {
-            // add the alias
-            let ty_name = rename.expect("bug in ocaml-gen: rename should be Some");
-            env.add_alias(ty_id, ty_name);
-
-            format!("type nonrec {} = {}", ty_name, name)
+            unimplemented!("aliasing of DynBox bindings is not implemented")
         }
     }
 }

stubs-gen/dune

@@ -16,4 +16,6 @@
  (alias runtest)
  (targets Ocaml_rs_smartptr_test.ml)
  (action
-  (run ./stubs-gen)))
+  (progn
+   (run ./stubs-gen)
+   (run ocamlformat -i %{targets}))))

test/Stubs.ml

@@ -1,28 +1,48 @@
-
-module Animal = struct 
-  type nonrec t = [ `Ocaml_rs_smartptr_test_stubs_animal_proxy|`Core_marker_send ] Ocaml_rs_smartptr.Rusty_obj.t
-  external name : t -> string = "animal_name"
-  external noise : t -> string = "animal_noise"
-  external talk : t -> unit = "animal_talk"
+module Animal = struct
+  type tags =
+    [ `Ocaml_rs_smartptr_test_stubs_animal_proxy
+    | `Core_marker_send
+    ]
+
+  type 'a t' = ([> tags ] as 'a) Ocaml_rs_smartptr.Rusty_obj.t
+  type t = tags t'
+
+  external name : _ t' -> string = "animal_name"
+  external noise : _ t' -> string = "animal_noise"
+  external talk : _ t' -> unit = "animal_talk"
 end
 
+module Sheep = struct
+  type tags =
+    [ `Ocaml_rs_smartptr_test_stubs_sheep
+    | `Core_marker_sync
+    | `Core_marker_send
+    | `Ocaml_rs_smartptr_test_stubs_animal_proxy
+    ]
 
-module Sheep = struct 
-  type nonrec t = [ `Ocaml_rs_smartptr_test_stubs_sheep|`Core_marker_sync|`Core_marker_send|`Ocaml_rs_smartptr_test_stubs_animal_proxy ] Ocaml_rs_smartptr.Rusty_obj.t
-  external create : string -> t = "sheep_create"
-  external is_naked : t -> bool = "sheep_is_naked"
-  external sheer : t -> unit = "sheep_sheer"
-end
-
+  type 'a t' = ([> tags ] as 'a) Ocaml_rs_smartptr.Rusty_obj.t
+  type t = tags t'
 
-module Wolf = struct 
-  type nonrec t = [ `Ocaml_rs_smartptr_test_stubs_wolf|`Core_marker_sync|`Core_marker_send|`Ocaml_rs_smartptr_test_stubs_animal_proxy ] Ocaml_rs_smartptr.Rusty_obj.t
-  external create : string -> t = "wolf_create"
-  external set_hungry : t -> bool -> unit = "wolf_set_hungry"
+  external create : string -> _ t' = "sheep_create"
+  external is_naked : _ t' -> bool = "sheep_is_naked"
+  external sheer : _ t' -> unit = "sheep_sheer"
 end
 
+module Wolf = struct
+  type tags =
+    [ `Ocaml_rs_smartptr_test_stubs_wolf
+    | `Core_marker_sync
+    | `Core_marker_send
+    | `Ocaml_rs_smartptr_test_stubs_animal_proxy
+    ]
 
-module Test_callback = struct 
-  external call_cb : Wolf.t -> ((Wolf.t) -> (Animal.t)) -> Animal.t = "call_cb"
+  type 'a t' = ([> tags ] as 'a) Ocaml_rs_smartptr.Rusty_obj.t
+  type t = tags t'
+
+  external create : string -> _ t' = "wolf_create"
+  external set_hungry : _ t' -> bool -> unit = "wolf_set_hungry"
 end
 
+module Test_callback = struct
+  external call_cb : _ Wolf.t' -> (_ Wolf.t' -> _ Animal.t') -> _ Animal.t' = "call_cb"
+end

test/test.ml

@@ -1,24 +1,46 @@
-open Stubs
+(* Hand-written layer of bindings might look like this: *)
+
+module Animal = struct
+  include Stubs.Animal
+end
+
+module Sheep = struct
+  include Animal
+  include Stubs.Sheep
+end
+
+module Wolf = struct
+  include Animal
+  include Stubs.Wolf
+end
+
+module Test_callback = struct
+  include Stubs.Test_callback
+end
+
+(* Now use hand-written bindings in actual code: *)
 
 let sheep_test () =
   print_endline "\n*** Sheep test";
   let sheep = Sheep.create "dolly" in
-  Animal.talk (sheep :> Animal.t);
+  Animal.talk sheep;
   Sheep.sheer sheep;
-  Animal.talk (sheep :> Animal.t)
+  (* inclusion of Animal into Sheep allows to call Animal methods on Sheep right
+  from Sheep module for convenience *)
+  Sheep.talk sheep
 ;;
 
 let wolf_test () =
   print_endline "\n*** Wolf test";
   let wolf = Wolf.create "big bad wolf" in
-  Animal.talk (wolf :> Animal.t);
+  Animal.talk wolf;
   let animal =
     Test_callback.call_cb wolf (fun wolf ->
       print_endline "(wolf gets modified inside a callback!)";
       Gc.full_major ();
       Wolf.set_hungry wolf true;
       Gc.full_major ();
-      (wolf :> Animal.t))
+      wolf)
   in
   Animal.talk animal
 ;;