aboutsummaryrefslogtreecommitdiffstats
path: root/lib/prelude/catalog.ml
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-06-23 23:53:26 -0300
committerGitHub <noreply@github.com>2026-06-23 23:53:26 -0300
commitc284fcd570342c31bc21169960579a20a763e32e (patch)
treece7485055116d794c55090ad0978e0b3f5ff4c2a /lib/prelude/catalog.ml
parentb81586ee4a0543a5f9866586c78dccdd6328934a (diff)
downloadSakura-c284fcd570342c31bc21169960579a20a763e32e.tar.gz
Sakura-c284fcd570342c31bc21169960579a20a763e32e.zip
Format
Diffstat (limited to 'lib/prelude/catalog.ml')
-rw-r--r--lib/prelude/catalog.ml154
1 files changed, 52 insertions, 102 deletions
diff --git a/lib/prelude/catalog.ml b/lib/prelude/catalog.ml
index 01721b2..26fe30c 100644
--- a/lib/prelude/catalog.ml
+++ b/lib/prelude/catalog.ml
@@ -7,7 +7,7 @@
written to by any executor. They appear to be stubs for trigger/timing
metadata that was never implemented. *)
-(** Dedicated multigroup hosting the system catalog. The catalog's relation
+(** Dedicated multigroup hosting the system catalog. The catalog's relation
names keep the [public:] prefix — that prefix is part of the relation name
inside this mg, not a separate namespace. *)
let prelude_mg = "sakura"
@@ -28,8 +28,7 @@ let loaded_library_rel_name = catalog_prefix ^ "loaded_library"
(** Relations present in every multigroup's catalog. *)
let catalog_relation_names =
- [
- relation_rel_name;
+ [ relation_rel_name;
domain_rel_name;
attribute_rel_name;
constraint_rel_name;
@@ -37,15 +36,12 @@ let catalog_relation_names =
timing_rel_name;
schema_rel_name;
function_predicate_rel_name;
- loaded_library_rel_name;
- ]
+ loaded_library_rel_name ]
(** Relations exclusive to the sakura meta-multigroup. *)
-let sakura_only_relation_names = [ multigroup_rel_name ]
-
-let all_catalog_relation_names =
- catalog_relation_names @ sakura_only_relation_names
+let sakura_only_relation_names = [multigroup_rel_name]
+let all_catalog_relation_names = catalog_relation_names @ sakura_only_relation_names
let is_catalog_relation name = List.mem name all_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"
@@ -57,8 +53,7 @@ let attribute_schema : Schema.t =
|> Schema.add "domain_name" "string"
let constraint_schema : Schema.t =
- Schema.empty |> Schema.add "name" "string"
- |> Schema.add "relation_name" "string"
+ 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"
@@ -66,108 +61,74 @@ let multigroup_schema : Schema.t = Schema.empty |> Schema.add "name" "string"
let schema_schema : Schema.t = Schema.empty |> Schema.add "name" "string"
let function_predicate_schema : Schema.t =
- Schema.empty |> Schema.add "name" "string"
+ Schema.empty
+ |> Schema.add "name" "string"
|> Schema.add "symbol" "string"
|> Schema.add "cardinality" "string"
|> Schema.add "purity" "string"
-let loaded_library_schema : Schema.t =
- Schema.empty |> Schema.add "path" "string"
+let loaded_library_schema : Schema.t = Schema.empty |> Schema.add "path" "string"
(** Definitions seeded into every multigroup. *)
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);
- (schema_rel_name, schema_schema);
- (function_predicate_rel_name, function_predicate_schema);
- (loaded_library_rel_name, loaded_library_schema);
- ]
+ [ 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;
+ schema_rel_name, schema_schema;
+ function_predicate_rel_name, function_predicate_schema;
+ loaded_library_rel_name, loaded_library_schema ]
(** Extra definitions seeded only into the sakura meta-multigroup. *)
-let sakura_only_definitions = [ (multigroup_rel_name, multigroup_schema) ]
+let sakura_only_definitions = [multigroup_rel_name, multigroup_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 };
- }
+ { 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 =
+ { 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.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 });
- ];
- })
+ [ "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.relation= constraint_rel_name;
+ attributes=
Tuple.AttributeMap.of_list
- [
- ("name", { Attribute.value = Obj.magic cname });
- ("relation_name", { Attribute.value = Obj.magic rel_name });
- ];
- }
+ [ "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 };
- }
+ { 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 };
- }
+ { Tuple.relation= timing_rel_name;
+ attributes= Tuple.AttributeMap.singleton "timing" {Attribute.value= Obj.magic timing} }
let build_multigroup_tuple mg_name : Tuple.materialized =
- {
- Tuple.relation = multigroup_rel_name;
- attributes =
- Tuple.AttributeMap.singleton "name"
- { Attribute.value = Obj.magic mg_name };
- }
+ { Tuple.relation= multigroup_rel_name;
+ attributes= Tuple.AttributeMap.singleton "name" {Attribute.value= Obj.magic mg_name} }
let build_schema_tuple schema_name : Tuple.materialized =
- {
- Tuple.relation = schema_rel_name;
- attributes =
- Tuple.AttributeMap.singleton "name"
- { Attribute.value = Obj.magic schema_name };
- }
+ { Tuple.relation= schema_rel_name;
+ attributes= Tuple.AttributeMap.singleton "name" {Attribute.value= Obj.magic schema_name} }
let purity_to_string p = Sexplib.Sexp.to_string (Conventions.Purity.sexp_of_t p)
@@ -176,33 +137,22 @@ let purity_of_string s =
| p -> Some p
| exception _ -> None
-let cardinality_to_string c =
- Sexplib.Sexp.to_string (Conventions.Cardinality.sexp_of_t c)
+let cardinality_to_string c = Sexplib.Sexp.to_string (Conventions.Cardinality.sexp_of_t c)
let cardinality_of_string s =
match Conventions.Cardinality.t_of_sexp (Sexplib.Sexp.of_string s) with
| c -> Some c
| exception _ -> None
-let build_function_predicate_tuple ~name ~symbol ~cardinality ~purity :
- Tuple.materialized =
- {
- Tuple.relation = function_predicate_rel_name;
- attributes =
+let build_function_predicate_tuple ~name ~symbol ~cardinality ~purity : Tuple.materialized =
+ { Tuple.relation= function_predicate_rel_name;
+ attributes=
Tuple.AttributeMap.of_list
- [
- ("name", { Attribute.value = Obj.magic name });
- ("symbol", { Attribute.value = Obj.magic symbol });
- ( "cardinality",
- { Attribute.value = Obj.magic (cardinality_to_string cardinality) }
- );
- ("purity", { Attribute.value = Obj.magic (purity_to_string purity) });
- ];
- }
+ [ "name", {Attribute.value= Obj.magic name};
+ "symbol", {Attribute.value= Obj.magic symbol};
+ "cardinality", {Attribute.value= Obj.magic (cardinality_to_string cardinality)};
+ "purity", {Attribute.value= Obj.magic (purity_to_string purity)} ] }
let build_loaded_library_tuple path : Tuple.materialized =
- {
- Tuple.relation = loaded_library_rel_name;
- attributes =
- Tuple.AttributeMap.singleton "path" { Attribute.value = Obj.magic path };
- }
+ { Tuple.relation= loaded_library_rel_name;
+ attributes= Tuple.AttributeMap.singleton "path" {Attribute.value= Obj.magic path} }