1 files changed, 41 insertions, 0 deletions
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