blob: 016e3a0540e2a1fdab0722c2f9d155ee79410d7e (
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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
module Error = struct
open Concepts.Condition
let unknown_relation name =
condition "unknown-relation" "A plan named a relation that does not exist under this snapshot"
("name" |=| Concepts.Value.String name)
let cancelled () =
condition "evaluation-cancelled" "An evaluation was stopped before it produced its result" empty
let not_a_plan name =
condition "not-a-fol-program" "The evaluator was given an object that carries no FOL plan"
("object" |=| Concepts.Value.String name)
let not_a_relation name =
condition "not-a-relation" "A plan named an object that does not describe itself as a relation"
("object" |=| Concepts.Value.String name)
let unknown_attribute name =
condition "unknown-attribute" "A plan projected an attribute its relation does not have"
("attribute" |=| Concepts.Value.String name)
let released_relation name =
condition "released-relation" "A plan named a relation that was already released"
("object" |=| Concepts.Value.String name)
end
type plan = Base of Protocols.Handle.t | Project of plan * string BatFingerTree.t
type Protocols.Handle.protocol += Plan of plan
class program plan =
object
inherit Kernel.Lifecycle.null
inherit Kernel.Identity.of_id
method to_string = "fol-program"
method protocols : Protocols.Handle.protocol list = [Plan plan]
end
let program plan = new program plan |> Protocols.Handle.make
let restrict attributes description =
let open Utilities.Result in
BatFingerTree.fold_left
(fun restricted name ->
let* restricted = restricted in
let* attribute =
BatMap.String.find_opt name description
|> Option.to_result ~none:(Error.unknown_attribute name)
in
Ok (BatMap.String.add name attribute restricted) )
(Ok BatMap.String.empty) attributes
let rec describe =
let open Utilities.Result in
function
| Base relation -> (
let* schematics = Protocols.Handle.require Protocols.Schematics.from relation in
let* description = Protocols.Schematics.describe schematics in
match description with
| Protocols.Schematics.Relation description -> Ok description
| _ -> Error (Error.not_a_relation (Protocols.Handle.to_string relation)) )
| Project (plan, attributes) -> describe plan |> fmap (restrict attributes)
let enumerate relation =
let open Utilities.Result in
let* enumerable = Protocols.Enumerable.require relation in
Protocols.Enumerable.enumerate enumerable
let project description relation =
let open Utilities.Result in
let* cursor = enumerate relation in
let produce ~yield =
let* scan = Protocols.Cursor.require cursor in
let rec distinct seen =
let* next = Protocols.Cursor.next scan in
match next with
| None -> Ok ()
| Some tuple ->
let tuple =
{ tuple with
attributes=
BatMap.String.filter
(fun name _ -> BatMap.String.mem name description)
tuple.Concepts.Tuple.attributes }
in
let key = Concepts.Tuple.hash tuple |> Concepts.Hash.to_raw_string in
if BatSet.String.mem key seen then distinct seen
else begin
yield tuple;
distinct (BatSet.String.add key seen)
end
in
distinct BatSet.String.empty
in
Ok (Kernel.Generator.cursor_of ~finally:(fun () -> Protocols.Handle.release cursor) produce)
let derive relation description enumerate =
Kernel.EphemeralRelation.instantiate ~inputs:[relation] description
{Kernel.EphemeralRelation.schematics= `Temporary description}
(fun () -> enumerate relation)
let rec execute plan =
let open Utilities.Result in
let* description = describe plan in
match plan with
| Base relation ->
let* relation =
Protocols.Handle.copy relation
|> Option.to_result ~none:(Error.released_relation (Protocols.Handle.to_string relation))
in
Ok (derive relation description enumerate)
| Project (plan, _) ->
let* relation = execute plan in
Ok (derive relation description (project description))
class evaluator =
object (self)
inherit Kernel.Lifecycle.null
inherit Kernel.Identity.of_id
method to_string = "fol-evaluator"
method invoke program =
Protocols.Handle.into program (function Plan plan -> Some plan | _ -> None)
|> Option.to_result ~none:(Error.not_a_plan (Protocols.Handle.to_string program))
|> Utilities.Result.fmap (fun plan -> Protocols.Handle.invoke plan execute)
method protocols : Protocols.Handle.protocol list = [Protocols.Evaluator.make self]
end
let make () = new evaluator |> Protocols.Handle.make
|
