From 44851daf1601f0f7ac1ff22bc5677c07dfd4ae2e Mon Sep 17 00:00:00 2001
From: Estevan Castilho <tevo@riajuu.net>
Date: Sat, 22 Aug 2026 22:06:47 +0000
Subject: The handle protocol

---
 lib/protocols/Handle.ml  | 41 +++++++++++++++++++++++++++++++++++++++++
 lib/protocols/Handle.mli | 20 ++++++++++++++++++++
 2 files changed, 61 insertions(+)
 create mode 100644 lib/protocols/Handle.ml
 create mode 100644 lib/protocols/Handle.mli

(limited to 'lib')

diff --git a/lib/protocols/Handle.ml b/lib/protocols/Handle.ml
new file mode 100644
index 0000000..1868737
--- /dev/null
+++ b/lib/protocols/Handle.ml
@@ -0,0 +1,41 @@
+type protocol = ..
+
+class type obj = object
+  method reference : bool
+  method release : unit
+  method protocols : protocol list
+end
+
+type t = { valid : bool ref; refers_to : obj }
+
+type 'a interface = { handle : t; interface : 'a }
+
+let object_of { valid; refers_to } =
+  if !valid then
+    refers_to
+  else
+    failwith "Attempt to dereference an invalid handle!"
+
+let interface_of handle interface = { handle; interface }
+
+let make o = { valid = ref true; refers_to = o }
+
+let into handle f =
+  List.find_map f (object_of handle)#protocols
+  |> Option.map (interface_of handle)
+
+let invoke { handle; interface } f =
+  let _ = object_of handle in
+  f interface
+
+let copy handle =
+  let o = object_of handle in
+  if o#reference then
+    Some (make o)
+  else
+    None
+
+let release ({ valid; _ } as handle) =
+  let o = object_of handle in
+  valid := false;
+  o#release
diff --git a/lib/protocols/Handle.mli b/lib/protocols/Handle.mli
new file mode 100644
index 0000000..6fe175b
--- /dev/null
+++ b/lib/protocols/Handle.mli
@@ -0,0 +1,20 @@
+type t
+
+type 'a interface
+
+type protocol = ..
+
+class type obj = object
+  method reference : bool
+  method release : unit
+  method protocols : protocol list
+end
+
+val make : obj -> t
+
+val into : t -> (protocol -> 'a option) -> 'a interface option
+
+val invoke : 'a interface -> ('a -> 'b) -> 'b
+
+val copy : t -> t option
+val release : t -> unit
-- 
cgit v1.2.3