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
|
(** System catalog helpers. Pure definitions — no storage access, no
manipulation dependency. Consumed by {!Manipulation.Make} to bootstrap and
maintain the six catalog relations that make the database self-describing.
*)
(* TODO: on_rel_name and timing_rel_name are defined and seeded but never
written to by any executor. They appear to be stubs for trigger/timing
metadata that was never implemented. *)
let catalog_prefix = "sakura:"
let relation_rel_name = catalog_prefix ^ "relation"
let domain_rel_name = catalog_prefix ^ "domain"
let attribute_rel_name = catalog_prefix ^ "attribute"
let constraint_rel_name = catalog_prefix ^ "constraint"
let on_rel_name = catalog_prefix ^ "on"
let timing_rel_name = catalog_prefix ^ "timing"
let branch_rel_name = catalog_prefix ^ "branch"
let head_rel_name = catalog_prefix ^ "head"
let catalog_relation_names =
[
relation_rel_name;
domain_rel_name;
attribute_rel_name;
constraint_rel_name;
on_rel_name;
timing_rel_name;
]
let is_catalog_relation name = List.mem name catalog_relation_names
let relation_schema : Schema.t = Schema.empty |> Schema.add "name" "string"
let domain_schema : Schema.t = Schema.empty |> Schema.add "name" "string"
let attribute_schema : Schema.t =
Schema.empty
|> Schema.add "relation_name" "string"
|> Schema.add "attr_name" "string"
|> Schema.add "domain_name" "string"
let constraint_schema : Schema.t =
Schema.empty |> Schema.add "name" "string"
|> Schema.add "relation_name" "string"
let on_schema : Schema.t = Schema.empty |> Schema.add "event" "string"
let timing_schema : Schema.t = Schema.empty |> Schema.add "timing" "string"
let catalog_definitions =
[
(relation_rel_name, relation_schema);
(domain_rel_name, domain_schema);
(attribute_rel_name, attribute_schema);
(constraint_rel_name, constraint_schema);
(on_rel_name, on_schema);
(timing_rel_name, timing_schema);
]
(* TODO: all tuple builders use Obj.magic to coerce string values into
Attribute.value (Obj.t). This is the same UB pattern fixed in standard.ml;
should use Obj.repr instead. *)
let build_relation_tuple rel_name : Tuple.materialized =
{
Tuple.relation = relation_rel_name;
attributes =
Tuple.AttributeMap.singleton "name"
{ Attribute.value = Obj.magic rel_name };
}
let build_domain_tuple dom_name : Tuple.materialized =
{
Tuple.relation = domain_rel_name;
attributes =
Tuple.AttributeMap.singleton "name"
{ Attribute.value = Obj.magic dom_name };
}
let build_attribute_tuples ~relation_name (schema : Schema.t) :
Tuple.materialized list =
List.map
(fun (attr_n, dom_n) ->
{
Tuple.relation = attribute_rel_name;
attributes =
Tuple.AttributeMap.of_list
[
("relation_name", { Attribute.value = Obj.magic relation_name });
("attr_name", { Attribute.value = Obj.magic attr_n });
("domain_name", { Attribute.value = Obj.magic dom_n });
];
})
schema
let build_constraint_tuple cname rel_name : Tuple.materialized =
{
Tuple.relation = constraint_rel_name;
attributes =
Tuple.AttributeMap.of_list
[
("name", { Attribute.value = Obj.magic cname });
("relation_name", { Attribute.value = Obj.magic rel_name });
];
}
let build_on_tuple event : Tuple.materialized =
{
Tuple.relation = on_rel_name;
attributes =
Tuple.AttributeMap.singleton "event" { Attribute.value = Obj.magic event };
}
let build_timing_tuple timing : Tuple.materialized =
{
Tuple.relation = timing_rel_name;
attributes =
Tuple.AttributeMap.singleton "timing"
{ Attribute.value = Obj.magic timing };
}
|
