aboutsummaryrefslogtreecommitdiffstats
path: root/prl_api/sakura_prl_api.ml
diff options
context:
space:
mode:
Diffstat (limited to 'prl_api/sakura_prl_api.ml')
-rw-r--r--prl_api/sakura_prl_api.ml32
1 files changed, 32 insertions, 0 deletions
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 ()) }