blob: d5e28ecb5e151cdecd363845173d9e0d27a87e8e (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
type t = {
loaded_libraries : (string, unit) Hashtbl.t;
mutex : Mutex.t;
}
let state : t =
{ loaded_libraries = Hashtbl.create 16; mutex = Mutex.create () }
let load_library path : (unit, string) result =
Mutex.protect state.mutex (fun () ->
if Hashtbl.mem state.loaded_libraries path then Ok ()
else
try
Dynlink.loadfile path;
Hashtbl.replace state.loaded_libraries path ();
Ok ()
with Dynlink.Error e -> Error (Dynlink.error_message e))
(* Convert an engine materialized tuple to the plugin's (string * Obj.t) list format. *)
let to_plugin_row (schema : Schema.t) (tuple : Tuple.materialized) :
Sakura_prl_api.tuple option =
let rec go acc = function
| [] -> Some (List.rev acc)
| (attr_name, _) :: rest -> (
match Tuple.AttributeMap.find_opt attr_name tuple.attributes with
| None -> None
| Some attr -> go ((attr_name, attr.Attribute.value) :: acc) rest)
in
go [] schema
(* Convert a plugin row back to an engine materialized tuple. *)
let of_plugin_row relation_name (schema : Schema.t)
(row : Sakura_prl_api.tuple) : Tuple.materialized option =
let rec go acc = function
| [] -> Some { Tuple.relation = relation_name; attributes = acc }
| (attr_name, _) :: rest -> (
match List.assoc_opt attr_name row with
| None -> None
| Some value ->
go (Tuple.AttributeMap.add attr_name { Attribute.value = value } acc)
rest)
in
go Tuple.AttributeMap.empty schema
(* Wrap a list of plugin rows as a generator. Uses an array for O(1) indexing. *)
let rows_to_generator relation_name schema (rows : Sakura_prl_api.tuple list) :
Generator.t =
let arr = Array.of_list rows in
let n = Array.length arr in
let rec gen i _pos =
if i >= n then Generator.Done
else
match of_plugin_row relation_name schema arr.(i) with
| None -> Generator.Error "Plugin row does not conform to predicate schema."
| Some tuple -> Generator.Value (Tuple.Materialized tuple, gen (i + 1))
in
gen 0
let make_generator relation_name schema (impl : Sakura_prl_api.implementation)
(bindings : Sakura_prl_api.tuple) : Generator.t =
match impl.produce with
| None -> fun _ -> Generator.Done
| Some produce ->
let rows_result = lazy (produce bindings) in
fun _pos ->
match Lazy.force rows_result with
| Error e -> Generator.Error e
| Ok rows -> rows_to_generator relation_name schema rows _pos
let make_producer relation_name schema (impl : Sakura_prl_api.implementation) :
Relation.producer =
fun bindings -> make_generator relation_name schema impl bindings
let make_membership_criteria schema (impl : Sakura_prl_api.implementation) :
(string -> Merkle.t option) -> Tuple.t -> bool =
match impl.membership_criteria with
| None -> fun _ _ -> false
| Some check ->
fun _tree_of -> function
| Tuple.NonMaterialized _ -> false
| Tuple.Materialized m -> (
match to_plugin_row schema m with
| None -> false
| Some row -> (match check row with Ok b -> b | Error _ -> false))
|
