blob: 6846e43c9406559d37e7215783aef279afe6088a (
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
|
module Error = struct
open Concepts.Condition
let not_generative () =
condition "not-generative"
"A relation was used where the expression must produce members under a binding, but it \
declares no modes. A relation that cannot be asked this way can still be reached through \
another access path."
empty
let attributes bound = Concepts.Value.String (String.concat ", " (BatSet.String.elements bound))
let ungenerable bound =
condition "ungenerable-binding"
"The relation declares no mode that generates under the attributes bound."
("bound" |=| attributes bound)
let undecidable bound =
condition "undecidable-membership"
"The relation declares no mode that decides membership under the attributes of the tuple."
("bound" |=| attributes bound)
end
type binding = Concepts.Value.value BatMap.String.t
class type implementation = object
method modes : (Concepts.Mode.t, Concepts.Condition.condition) result
method generate : binding -> (Handle.t, Concepts.Condition.condition) result
end
type Handle.protocol += Generative of implementation
type t = implementation
let make impl = Generative (impl :> implementation)
let from handle = Handle.into handle (function Generative impl -> Some impl | _ -> None)
let require handle = from handle |> Option.to_result ~none:(Error.not_generative ())
let nothing = BatMap.String.empty
let bound = Concepts.Mode.attributes_of_map
let modes i = Handle.invoke i (fun o -> o#modes)
let generate i binding =
Handle.invoke i (fun o ->
let open Utilities.Result in
let bound = bound binding in
let* declaration = o#modes in
if Option.is_some (Concepts.Mode.generation declaration bound) then o#generate binding
else Error (Error.ungenerable bound) )
let satisfies binding tuple =
BatMap.String.for_all
(fun attribute value ->
match BatMap.String.find_opt attribute tuple.Concepts.Tuple.attributes with
| Some found -> Concepts.Value.equal found value
| None -> false )
binding
class virtual membership =
object (self)
val virtual heading : Concepts.Mode.attributes
method virtual modes : (Concepts.Mode.t, Concepts.Condition.condition) result
method virtual generate : binding -> (Handle.t, Concepts.Condition.condition) result
method contains (tuple : Concepts.Tuple.t) =
let open Utilities.Result in
let binding = tuple.Concepts.Tuple.attributes in
let bound = bound binding in
if not (BatSet.String.equal heading bound) then Ok false
else
let* declaration = self#modes in
let* () =
if Concepts.Mode.decision declaration bound then Ok ()
else Error (Error.undecidable bound)
in
let* cursor = self#generate binding in
let expected = Concepts.Tuple.hash tuple in
Fun.protect
~finally:(fun () -> Handle.release cursor)
(fun () ->
let* scan = Cursor.require cursor in
Cursor.exists scan (fun member ->
Concepts.Hash.hash_equals (Concepts.Tuple.hash member) expected ) )
end
|
