blob: 0b62517ab5a88a013388ba5387671f0b037b1198 (
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
|
module type DERIVATION = sig
type plan
val identity : plan -> Concepts.Hash.hash
val describe :
plan -> (Protocols.Schematics.relation_description, Concepts.Condition.condition) result
val modes : plan -> (Concepts.Mode.t, Concepts.Condition.condition) result
val generate :
plan ->
Protocols.Generative.binding ->
(Protocols.Handle.t, Concepts.Condition.condition) result
end
module Make (D : DERIVATION) = struct
let pinned_tag = "rnt/pinned/1"
let identity ?pinned plan =
let derivation = D.identity plan in
match pinned with
| None -> derivation
| Some branch ->
pinned_tag ^ Concepts.Hash.to_raw_string derivation ^ Concepts.Hash.to_raw_string branch
|> Bytes.of_string
|> Concepts.Hash.hash_of_bytes
let exhaustible declaration =
match Concepts.Mode.generation declaration BatSet.String.empty with
| Some cardinality -> Concepts.Cardinality.exhaustible cardinality
| None -> false
class ephemeral plan address declaration total edges =
object (self)
inherit Lifecycle.counted
val plan : D.plan = plan
method destroy = List.iter Protocols.Handle.release edges
method predicate = Ok None
method local_constraints = Ok None
method modes = Ok declaration
method generate binding = D.generate plan binding
method enumerate = D.generate plan Protocols.Generative.nothing
method describe () =
D.describe plan |> Result.map (fun description -> Protocols.Schematics.Relation description)
(* Membership of a derived relation is decided by the derivation
and not by a lookup, so it is asked of the generator under the
binding the tuple itself fixes. *)
method contains (tuple : Concepts.Tuple.t) =
let open Utilities.Result in
let* cursor = D.generate plan tuple.Concepts.Tuple.attributes in
Fun.protect
~finally:(fun () -> Protocols.Handle.release cursor)
(fun () ->
let* scan = Protocols.Cursor.require cursor in
let* first = Protocols.Cursor.next scan in
Ok (Option.is_some first) )
method protocols : Protocols.Handle.protocol list =
let carried =
[ Protocols.Relation.make self;
Protocols.Schematics.make self;
Protocols.Generative.make self ]
in
if total then Protocols.Enumerable.make self :: carried else carried
method hash : Concepts.Hash.hash = address
end
let derive ?pinned ?(edges = []) plan =
let open Utilities.Result in
let* declaration = D.modes plan in
Ok
( new ephemeral plan (identity ?pinned plan) declaration (exhaustible declaration) edges
|> Protocols.Handle.make )
end
|
