Foreign call PRL (#67)

2 files changed, 35 insertions, 0 deletions

diff --git a/prl_api/dune b/prl_api/dune
new file mode 100644
index 0000000..815a625
--- /dev/null
+++ b/prl_api/dune
@@ -0,0 +1,3 @@
+(library
+ (name sakura_prl_api)
+ (public_name sakura.prl_api))
diff --git a/prl_api/sakura_prl_api.ml b/prl_api/sakura_prl_api.ml
new file mode 100644
index 0000000..92fd658
--- /dev/null
+++ b/prl_api/sakura_prl_api.ml
@@ -0,0 +1,32 @@
+type value = Obj.t
+type tuple = (string * value) list
+
+type implementation = {
+  membership_criteria : (tuple -> (bool, string) result) option;
+  produce : (tuple -> (tuple list, string) result) option;
+}
+
+(* TODO: Rethink this instead in terms of a value.
+   We need to store the references as a normal relation
+   on the multigroup relation catalog. *)
+let registry : (string, implementation) Hashtbl.t = Hashtbl.create 32
+let mutex = Mutex.create ()
+
+let register symbol impl =
+  Mutex.protect mutex (fun () -> Hashtbl.replace registry symbol impl)
+
+let find symbol = Mutex.protect mutex (fun () -> Hashtbl.find_opt registry symbol)
+
+let symbols () =
+  Mutex.protect mutex (fun () -> Hashtbl.to_seq_keys registry |> List.of_seq)
+
+let implementation_of_rows ?membership_criteria (rows : tuple list) : implementation =
+  { membership_criteria; produce = Some (fun _bindings -> Ok rows) }
+
+let implementation_of_producer ?membership_criteria
+    (produce : tuple -> (tuple list, string) result) : implementation =
+  { membership_criteria; produce = Some produce }
+
+let implementation_of_unit_producer ?membership_criteria
+    (produce : unit -> (tuple list, string) result) : implementation =
+  { membership_criteria; produce = Some (fun _bindings -> produce ()) }