aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/algebra.ml229
-rw-r--r--lib/drl/ast.ml25
-rw-r--r--lib/drl/executor.ml70
-rw-r--r--lib/drl/parser.ml9
-rw-r--r--test/test_relational_engine.ml308
5 files changed, 641 insertions, 0 deletions
diff --git a/lib/algebra.ml b/lib/algebra.ml
new file mode 100644
index 0000000..8701dcb
--- /dev/null
+++ b/lib/algebra.ml
@@ -0,0 +1,229 @@
+type error =
+ | StorageError of string
+ | GeneratorError of string
+
+module Make(Storage : Management.Physical.S) = struct
+ module Ops = Manipulation.Make(Storage)
+ type storage = Storage.t
+
+ (* Internal generator utilities *)
+
+ let rec list_generator : Tuple.t list -> Generator.t = function
+ | [] -> (fun _pos -> Generator.Done)
+ | t :: rest -> (fun _pos -> Generator.Value (t, list_generator rest))
+
+ let drain gen =
+ let rec go gen pos acc =
+ match gen (Some pos) with
+ | Generator.Done -> Ok (List.rev acc)
+ | Generator.Error e -> Error (GeneratorError e)
+ | Generator.Value (t, next) -> go next (pos + 1) (t :: acc)
+ in go gen 0 []
+
+ let to_generator (storage : storage) (rel : Relation.t) : Generator.t =
+ match rel.Relation.generator with
+ | Some gen -> gen
+ | None ->
+ let hashes = Ops.tuple_hashes rel in
+ (match Ops.load_tuples storage hashes with
+ | Error _ -> (fun _pos -> Generator.Error ("Failed to load: " ^ rel.Relation.name))
+ | Ok ts -> list_generator (List.map (fun t -> Tuple.Materialized t) ts))
+
+ let of_generator ~name ~schema gen =
+ Relation.make
+ ~hash:None ~name ~schema ~tree:None ~constraints:None
+ ~cardinality:Conventions.Cardinality.AlephZero
+ ~generator:(Some gen)
+ ~membership_criteria:(fun _ -> true)
+ ~provenance:Relation.Provenance.Undefined
+ ~lineage:(Relation.Lineage.Base "derived")
+
+ let const_relation (pairs : (string * Conventions.AbstractValue.t) list) : Relation.t =
+ let attrs = List.fold_left (fun acc (k, v) ->
+ Tuple.AttributeMap.add k { Attribute.value = v } acc)
+ Tuple.AttributeMap.empty pairs
+ in
+ let tuple = Tuple.Materialized { Tuple.relation = "const"; attributes = attrs } in
+ let schema = List.map (fun (k, _) -> (k, "abstract")) pairs in
+ of_generator ~name:"const" ~schema (list_generator [tuple])
+
+ (* Operators *)
+
+ let select_fn storage predicate rel =
+ let gen = to_generator storage rel in
+ let lazy_gen =
+ let rec go g pos =
+ match g pos with
+ | Generator.Done -> Generator.Done
+ | Generator.Error e -> Generator.Error e
+ | Generator.Value (t, next) ->
+ if predicate t then Generator.Value (t, go next)
+ else go next (Option.map ((+) 1) pos)
+ in fun pos -> go gen pos
+ in
+ Ok (of_generator ~name:("σ_" ^ rel.Relation.name) ~schema:rel.Relation.schema lazy_gen)
+
+ let project storage (attrs : string list) rel =
+ let gen = to_generator storage rel in
+ let project_tuple = function
+ | Tuple.Materialized t ->
+ let attrs' = List.fold_left (fun acc k ->
+ match Tuple.AttributeMap.find_opt k t.Tuple.attributes with
+ | None -> acc
+ | Some v -> Tuple.AttributeMap.add k v acc)
+ Tuple.AttributeMap.empty attrs in
+ Tuple.Materialized { t with attributes = attrs' }
+ | other -> other
+ in
+ let new_schema = List.filter (fun (n, _) -> List.mem n attrs) rel.Relation.schema in
+ let lazy_gen =
+ let rec go g pos = match g pos with
+ | Generator.Done -> Generator.Done
+ | Generator.Error e -> Generator.Error e
+ | Generator.Value (t, next) -> Generator.Value (project_tuple t, go next)
+ in fun pos -> go gen pos
+ in
+ Ok (of_generator ~name:("π_" ^ rel.Relation.name) ~schema:new_schema lazy_gen)
+
+ let rename storage (renames : (string * string) list) rel =
+ let rename_key k = match List.assoc_opt k renames with Some k' -> k' | None -> k in
+ let rename_tuple = function
+ | Tuple.Materialized t ->
+ let attrs' = Tuple.AttributeMap.fold (fun k v acc ->
+ Tuple.AttributeMap.add (rename_key k) v acc)
+ t.Tuple.attributes Tuple.AttributeMap.empty in
+ Tuple.Materialized { t with attributes = attrs' }
+ | other -> other
+ in
+ let gen = to_generator storage rel in
+ let new_schema = List.map (fun (n, d) -> (rename_key n, d)) rel.Relation.schema in
+ let lazy_gen =
+ let rec go g pos = match g pos with
+ | Generator.Done -> Generator.Done
+ | Generator.Error e -> Generator.Error e
+ | Generator.Value (t, next) -> Generator.Value (rename_tuple t, go next)
+ in fun pos -> go gen pos
+ in
+ Ok (of_generator ~name:("ρ_" ^ rel.Relation.name) ~schema:new_schema lazy_gen)
+
+ let equijoin storage (attrs : string list) left right =
+ let right_gen = to_generator storage right in
+ match drain right_gen with
+ | Error e -> Error e
+ | Ok right_tuples ->
+ let left_gen = to_generator storage left in
+ let get_vals attr_list = function
+ | Tuple.Materialized t ->
+ List.map (fun a -> Tuple.AttributeMap.find_opt a t.Tuple.attributes) attr_list
+ | _ -> List.map (fun _ -> None) attr_list
+ in
+ let merge lt rt = match lt, rt with
+ | Tuple.Materialized l, Tuple.Materialized r ->
+ Tuple.Materialized { l with attributes =
+ Tuple.AttributeMap.union (fun _ a _ -> Some a)
+ l.Tuple.attributes r.Tuple.attributes }
+ | _ -> lt
+ in
+ let merged_schema =
+ left.Relation.schema @
+ List.filter (fun (n, _) ->
+ not (List.mem n attrs) &&
+ not (List.exists (fun (m, _) -> m = n) left.Relation.schema))
+ right.Relation.schema
+ in
+ let join_gen =
+ let rec chain_with_cont g cont pos =
+ match g pos with
+ | Generator.Done -> cont pos
+ | Generator.Value (t, next) -> Generator.Value (t, fun p -> chain_with_cont next cont p)
+ | Generator.Error e -> Generator.Error e
+ in
+ let rec from_left lgen lpos =
+ fun pos ->
+ match lgen (Some lpos) with
+ | Generator.Done -> Generator.Done
+ | Generator.Error e -> Generator.Error e
+ | Generator.Value (lt, next_left) ->
+ let lv = get_vals attrs lt in
+ let matches = List.filter_map (fun rt ->
+ if get_vals attrs rt = lv then Some (merge lt rt) else None) right_tuples in
+ (match matches with
+ | [] -> from_left next_left (lpos + 1) pos
+ | _ ->
+ chain_with_cont (list_generator matches)
+ (from_left next_left (lpos + 1)) pos)
+ in
+ from_left left_gen 0
+ in
+ let name = "⋈_" ^ left.Relation.name ^ "_" ^ right.Relation.name in
+ Ok (of_generator ~name ~schema:merged_schema join_gen)
+
+ let union storage rel1 rel2 =
+ let gen1 = to_generator storage rel1 in
+ let gen2 = to_generator storage rel2 in
+ let chain_gen =
+ let rec go g1 g2 pos =
+ match g1 pos with
+ | Generator.Done -> g2 pos
+ | Generator.Error _ -> g2 pos
+ | Generator.Value (t, next) -> Generator.Value (t, fun p -> go next g2 p)
+ in fun pos -> go gen1 gen2 pos
+ in
+ let name = "∪_" ^ rel1.Relation.name ^ "_" ^ rel2.Relation.name in
+ Ok (of_generator ~name ~schema:rel1.Relation.schema chain_gen)
+
+ let attrs_equal
+ (m1 : Attribute.materialized Tuple.AttributeMap.t)
+ (m2 : Attribute.materialized Tuple.AttributeMap.t) =
+ Tuple.AttributeMap.equal
+ (fun a b -> Stdlib.(=) a.Attribute.value b.Attribute.value) m1 m2
+
+ let diff storage rel1 rel2 =
+ let right_gen = to_generator storage rel2 in
+ match drain right_gen with
+ | Error e -> Error e
+ | Ok right_tuples ->
+ let right_mats = List.filter_map (function
+ | Tuple.Materialized t -> Some t | _ -> None) right_tuples in
+ let left_gen = to_generator storage rel1 in
+ let not_in_right = function
+ | Tuple.Materialized t ->
+ not (List.exists (fun r ->
+ attrs_equal t.Tuple.attributes r.Tuple.attributes) right_mats)
+ | _ -> true
+ in
+ let lazy_gen =
+ let rec go g pos =
+ match g pos with
+ | Generator.Done -> Generator.Done
+ | Generator.Error e -> Generator.Error e
+ | Generator.Value (t, next) ->
+ if not_in_right t then Generator.Value (t, go next)
+ else go next (Option.map ((+) 1) pos)
+ in fun pos -> go left_gen pos
+ in
+ let name = "−_" ^ rel1.Relation.name ^ "_" ^ rel2.Relation.name in
+ Ok (of_generator ~name ~schema:rel1.Relation.schema lazy_gen)
+
+ let take storage n rel =
+ let gen = to_generator storage rel in
+ let lazy_gen =
+ let rec go g count pos =
+ if count = 0 then Generator.Done
+ else match g pos with
+ | Generator.Done -> Generator.Done
+ | Generator.Error e -> Generator.Error e
+ | Generator.Value (t, next) -> Generator.Value (t, go next (count - 1))
+ in fun pos -> go gen n pos
+ in
+ Ok (of_generator ~name:("τ_" ^ rel.Relation.name) ~schema:rel.Relation.schema lazy_gen)
+
+ let materialize storage rel : (Tuple.materialized list, error) Result.t =
+ match drain (to_generator storage rel) with
+ | Error e -> Error e
+ | Ok tuples ->
+ Ok (List.filter_map (function Tuple.Materialized t -> Some t | _ -> None) tuples)
+
+end
+
+module Memory = Make(Management.Physical.Memory)
diff --git a/lib/drl/ast.ml b/lib/drl/ast.ml
new file mode 100644
index 0000000..f94965d
--- /dev/null
+++ b/lib/drl/ast.ml
@@ -0,0 +1,25 @@
+open Sexplib.Std
+
+(** Literal values for Const nodes *)
+type value =
+ | Int of int
+ | Float of float
+ | Str of string
+ | Bool of bool
+[@@deriving sexp]
+
+type direction = Asc | Desc
+[@@deriving sexp]
+
+type query =
+ | Base of string (** base relation by name *)
+ | Const of (string * value) list (** constant single-tuple relation *)
+ | Select of query * query (** σ semijoin: (filter, source) *)
+ | Join of string list * query * query (** ⋈ natural equijoin on named attrs *)
+ | Cartesian of query * query (** × Cartesian product *)
+ | Project of string list * query (** π restrict columns *)
+ | Rename of (string * string) list * query (** ρ rename (old,new) pairs *)
+ | Union of query * query (** ∪ — compatible schemas assumed *)
+ | Diff of query * query (** − *)
+ | Take of int * query (** τ *)
+[@@deriving sexp]
diff --git a/lib/drl/executor.ml b/lib/drl/executor.ml
new file mode 100644
index 0000000..7588b33
--- /dev/null
+++ b/lib/drl/executor.ml
@@ -0,0 +1,70 @@
+module Make(Storage : Management.Physical.S) = struct
+ module Alg = Algebra.Make(Storage)
+ module Ops = Manipulation.Make(Storage)
+
+ type error =
+ | RelationNotFound of string
+ | AlgebraError of Algebra.error
+
+ let wrap = Result.map_error (fun e -> AlgebraError e)
+
+ (* Convert Ast.value → AbstractValue.t (Obj.t) via Obj.repr *)
+ let ast_value_to_abstract : Ast.value -> Conventions.AbstractValue.t = function
+ | Ast.Int n -> Obj.repr n
+ | Ast.Float f -> Obj.repr f
+ | Ast.Str s -> Obj.repr s
+ | Ast.Bool b -> Obj.repr b
+
+ let rec execute
+ (storage : Storage.t)
+ (db : Management.Database.t)
+ (q : Ast.query)
+ : (Relation.t, error) Result.t =
+ let ( >>= ) = Result.bind in
+ match q with
+ | Ast.Base name ->
+ (match Ops.get_relation db ~name with
+ | None -> Error (RelationNotFound name)
+ | Some rel -> Ok rel)
+ | Ast.Const pairs ->
+ Ok (Alg.const_relation
+ (List.map (fun (k, v) -> (k, ast_value_to_abstract v)) pairs))
+ | Ast.Select (filter_q, source_q) ->
+ execute storage db filter_q >>= fun filter ->
+ execute storage db source_q >>= fun source ->
+ (* semijoin = project(source attrs, equijoin on common attrs) *)
+ let common = List.filter_map (fun (n, _) ->
+ if List.exists (fun (m, _) -> m = n) filter.Relation.schema
+ then Some n else None) source.Relation.schema in
+ let source_attrs = List.map fst source.Relation.schema in
+ wrap (Alg.equijoin storage common source filter) >>= fun joined ->
+ wrap (Alg.project storage source_attrs joined)
+ | Ast.Join (attrs, q1, q2) ->
+ execute storage db q1 >>= fun r1 ->
+ execute storage db q2 >>= fun r2 ->
+ wrap (Alg.equijoin storage attrs r1 r2)
+ | Ast.Project (attrs, q) ->
+ execute storage db q >>= fun rel ->
+ wrap (Alg.project storage attrs rel)
+ | Ast.Rename (renames, q) ->
+ execute storage db q >>= fun rel ->
+ wrap (Alg.rename storage renames rel)
+ | Ast.Cartesian (q1, q2) ->
+ execute storage db q1 >>= fun r1 ->
+ execute storage db q2 >>= fun r2 ->
+ (* Cartesian product = join on no attrs *)
+ wrap (Alg.equijoin storage [] r1 r2)
+ | Ast.Union (q1, q2) ->
+ execute storage db q1 >>= fun r1 ->
+ execute storage db q2 >>= fun r2 ->
+ wrap (Alg.union storage r1 r2)
+ | Ast.Diff (q1, q2) ->
+ execute storage db q1 >>= fun r1 ->
+ execute storage db q2 >>= fun r2 ->
+ wrap (Alg.diff storage r1 r2)
+ | Ast.Take (n, q) ->
+ execute storage db q >>= fun rel ->
+ wrap (Alg.take storage n rel)
+end
+
+module Memory = Make(Management.Physical.Memory)
diff --git a/lib/drl/parser.ml b/lib/drl/parser.ml
new file mode 100644
index 0000000..71d694b
--- /dev/null
+++ b/lib/drl/parser.ml
@@ -0,0 +1,9 @@
+type error = ParseError of string
+
+let of_string s =
+ match Sexplib.Sexp.of_string s |> Ast.query_of_sexp with
+ | q -> Ok q
+ | exception exn -> Error (ParseError (Printexc.to_string exn))
+
+let to_string q =
+ Ast.sexp_of_query q |> Sexplib.Sexp.to_string_hum
diff --git a/test/test_relational_engine.ml b/test/test_relational_engine.ml
index 737970b..8ba8226 100644
--- a/test/test_relational_engine.ml
+++ b/test/test_relational_engine.ml
@@ -1042,3 +1042,311 @@ let%test_unit "branching: full reconstruction from hash" =
assert (List.mem "Apple" names);
assert (List.mem "Banana" names);
assert (List.mem "Cherry" names))
+
+(* ============================================================================
+ Algebra Tests
+ ============================================================================ *)
+
+(* Helper: build a materialized tuple with int attributes *)
+let make_int_tuple relation pairs =
+ let attributes =
+ List.fold_left (fun acc (k, v) ->
+ Tuple.AttributeMap.add k { Attribute.value = Obj.repr (v : int) } acc)
+ Tuple.AttributeMap.empty pairs
+ in
+ (Tuple.Materialized { Tuple.relation; attributes } : Tuple.t)
+
+(* Helper: build a stored relation with one integer column and given values *)
+let stored_relation_with_ints storage db ~name ~attr values =
+ let schema = Schema.empty |> Schema.add attr "integer" in
+ let (db, rel) = match Manipulation.Memory.create_relation storage db ~name ~schema with
+ | Error _ -> assert false | Ok x -> x
+ in
+ let tuples = List.map (fun v ->
+ let attributes =
+ Tuple.AttributeMap.singleton attr { Attribute.value = Obj.repr (v : int) }
+ in
+ ({ Tuple.relation = name; attributes } : Tuple.materialized)
+ ) values in
+ let (db, rel, _) = match Manipulation.Memory.create_tuples storage db rel tuples with
+ | Error _ -> assert false | Ok x -> x
+ in
+ (db, rel)
+
+let%test_unit "algebra: const_relation single tuple" =
+ with_storage (fun storage ->
+ let rel = Algebra.Memory.const_relation
+ [ "x", Obj.repr (42 : int);
+ "y", Obj.repr (99 : int) ] in
+ match Algebra.Memory.materialize storage rel with
+ | Error _ -> assert false
+ | Ok [tup] ->
+ let x: int = Obj.obj (Tuple.AttributeMap.find "x" tup.Tuple.attributes).Attribute.value in
+ assert (x = 42)
+ | Ok _ -> assert false)
+
+let%test_unit "algebra: select_fn with predicate" =
+ with_storage (fun storage ->
+ let db = match Manipulation.Memory.create_database storage ~name:"test_db" with
+ | Error _ -> assert false | Ok db -> db
+ in
+ let (_, rel) = stored_relation_with_ints storage db ~name:"nums" ~attr:"n" [1;2;3;4;5] in
+ let predicate = function
+ | Tuple.Materialized t ->
+ let v: int = Obj.obj (Tuple.AttributeMap.find "n" t.Tuple.attributes).Attribute.value in
+ v > 3
+ | _ -> false
+ in
+ match Algebra.Memory.select_fn storage predicate rel with
+ | Error _ -> assert false
+ | Ok result ->
+ match Algebra.Memory.materialize storage result with
+ | Error _ -> assert false
+ | Ok rows ->
+ assert (List.length rows = 2);
+ List.iter (fun t ->
+ let v: int = Obj.obj (Tuple.AttributeMap.find "n" t.Tuple.attributes).Attribute.value in
+ assert (v > 3)) rows)
+
+let%test_unit "algebra: project restricts schema" =
+ with_storage (fun storage ->
+ let db = match Manipulation.Memory.create_database storage ~name:"test_db" with
+ | Error _ -> assert false | Ok db -> db
+ in
+ let schema = Schema.empty |> Schema.add "a" "integer" |> Schema.add "b" "integer" in
+ let (db, rel) = match Manipulation.Memory.create_relation storage db ~name:"ab" ~schema with
+ | Error _ -> assert false | Ok x -> x
+ in
+ let attrs = Tuple.AttributeMap.empty
+ |> Tuple.AttributeMap.add "a" { Attribute.value = Obj.repr (1 : int) }
+ |> Tuple.AttributeMap.add "b" { Attribute.value = Obj.repr (2 : int) } in
+ let (_, rel, _) = match Manipulation.Memory.create_tuple storage db rel
+ { Tuple.relation = "ab"; attributes = attrs } with
+ | Error _ -> assert false | Ok x -> x
+ in
+ match Algebra.Memory.project storage ["a"] rel with
+ | Error _ -> assert false
+ | Ok projected ->
+ match Algebra.Memory.materialize storage projected with
+ | Error _ -> assert false
+ | Ok [t] ->
+ assert (Tuple.AttributeMap.mem "a" t.Tuple.attributes);
+ assert (not (Tuple.AttributeMap.mem "b" t.Tuple.attributes))
+ | Ok _ -> assert false)
+
+let%test_unit "algebra: rename changes attr names" =
+ with_storage (fun storage ->
+ let db = match Manipulation.Memory.create_database storage ~name:"test_db" with
+ | Error _ -> assert false | Ok db -> db
+ in
+ let (_, rel) = stored_relation_with_ints storage db ~name:"r" ~attr:"x" [7] in
+ match Algebra.Memory.rename storage [("x", "y")] rel with
+ | Error _ -> assert false
+ | Ok renamed ->
+ match Algebra.Memory.materialize storage renamed with
+ | Error _ -> assert false
+ | Ok [t] ->
+ assert (not (Tuple.AttributeMap.mem "x" t.Tuple.attributes));
+ assert (Tuple.AttributeMap.mem "y" t.Tuple.attributes);
+ let v: int = Obj.obj (Tuple.AttributeMap.find "y" t.Tuple.attributes).Attribute.value in
+ assert (v = 7)
+ | Ok _ -> assert false)
+
+let%test_unit "algebra: equijoin merges matching tuples" =
+ with_storage (fun storage ->
+ let db = match Manipulation.Memory.create_database storage ~name:"test_db" with
+ | Error _ -> assert false | Ok db -> db
+ in
+ (* left: {id=1, name="Alice"}, {id=2, name="Bob"} *)
+ let schema_l = Schema.empty |> Schema.add "id" "integer" |> Schema.add "name" "string" in
+ let (db, left) = match Manipulation.Memory.create_relation storage db ~name:"L" ~schema:schema_l with
+ | Error _ -> assert false | Ok x -> x
+ in
+ let make_left id name =
+ let attrs = Tuple.AttributeMap.empty
+ |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.repr (id : int) }
+ |> Tuple.AttributeMap.add "name" { Attribute.value = Obj.repr (name : string) } in
+ ({ Tuple.relation = "L"; attributes = attrs } : Tuple.materialized)
+ in
+ let (db, left, _) = match Manipulation.Memory.create_tuples storage db left
+ [make_left 1 "Alice"; make_left 2 "Bob"] with
+ | Error _ -> assert false | Ok x -> x
+ in
+ (* right: {id=1, score=100}, {id=3, score=999} *)
+ let schema_r = Schema.empty |> Schema.add "id" "integer" |> Schema.add "score" "integer" in
+ let (db, right) = match Manipulation.Memory.create_relation storage db ~name:"R" ~schema:schema_r with
+ | Error _ -> assert false | Ok x -> x
+ in
+ let make_right id score =
+ let attrs = Tuple.AttributeMap.empty
+ |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.repr (id : int) }
+ |> Tuple.AttributeMap.add "score" { Attribute.value = Obj.repr (score : int) } in
+ ({ Tuple.relation = "R"; attributes = attrs } : Tuple.materialized)
+ in
+ let (_, right, _) = match Manipulation.Memory.create_tuples storage db right
+ [make_right 1 100; make_right 3 999] with
+ | Error _ -> assert false | Ok x -> x
+ in
+ match Algebra.Memory.equijoin storage ["id"] left right with
+ | Error _ -> assert false
+ | Ok joined ->
+ match Algebra.Memory.materialize storage joined with
+ | Error _ -> assert false
+ | Ok rows ->
+ (* Only id=1 matches *)
+ assert (List.length rows = 1);
+ let t = List.hd rows in
+ let score: int = Obj.obj (Tuple.AttributeMap.find "score" t.Tuple.attributes).Attribute.value in
+ assert (score = 100))
+
+let%test_unit "algebra: equijoin empty match" =
+ with_storage (fun storage ->
+ let db = match Manipulation.Memory.create_database storage ~name:"test_db" with
+ | Error _ -> assert false | Ok db -> db
+ in
+ let (db, left) = stored_relation_with_ints storage db ~name:"L" ~attr:"id" [1;2] in
+ let (_, right) = stored_relation_with_ints storage db ~name:"R" ~attr:"id" [9;8] in
+ match Algebra.Memory.equijoin storage ["id"] left right with
+ | Error _ -> assert false
+ | Ok joined ->
+ match Algebra.Memory.materialize storage joined with
+ | Error _ -> assert false
+ | Ok rows -> assert (List.length rows = 0))
+
+let%test_unit "algebra: union concatenates streams" =
+ with_storage (fun storage ->
+ let db = match Manipulation.Memory.create_database storage ~name:"test_db" with
+ | Error _ -> assert false | Ok db -> db
+ in
+ let (db, r1) = stored_relation_with_ints storage db ~name:"A" ~attr:"n" [1;2] in
+ let (_, r2) = stored_relation_with_ints storage db ~name:"B" ~attr:"n" [3;4] in
+ match Algebra.Memory.union storage r1 r2 with
+ | Error _ -> assert false
+ | Ok unioned ->
+ match Algebra.Memory.materialize storage unioned with
+ | Error _ -> assert false
+ | Ok rows ->
+ assert (List.length rows = 4);
+ let vals = List.map (fun t ->
+ Obj.obj (Tuple.AttributeMap.find "n" t.Tuple.attributes).Attribute.value
+ ) rows in
+ assert (List.mem 1 vals);
+ assert (List.mem 2 vals);
+ assert (List.mem 3 vals);
+ assert (List.mem 4 vals))
+
+let%test_unit "algebra: diff removes right from left" =
+ with_storage (fun storage ->
+ let db = match Manipulation.Memory.create_database storage ~name:"test_db" with
+ | Error _ -> assert false | Ok db -> db
+ in
+ let (db, r1) = stored_relation_with_ints storage db ~name:"A" ~attr:"n" [1;2;3] in
+ let (_, r2) = stored_relation_with_ints storage db ~name:"B" ~attr:"n" [2;3] in
+ match Algebra.Memory.diff storage r1 r2 with
+ | Error _ -> assert false
+ | Ok result ->
+ match Algebra.Memory.materialize storage result with
+ | Error _ -> assert false
+ | Ok rows ->
+ assert (List.length rows = 1);
+ let v: int = Obj.obj (Tuple.AttributeMap.find "n" (List.hd rows).Tuple.attributes).Attribute.value in
+ assert (v = 1))
+
+let%test_unit "algebra: take limits output" =
+ with_storage (fun storage ->
+ let db = match Manipulation.Memory.create_database storage ~name:"test_db" with
+ | Error _ -> assert false | Ok db -> db
+ in
+ let (_, rel) = stored_relation_with_ints storage db ~name:"big" ~attr:"n" [10;20;30;40;50] in
+ match Algebra.Memory.take storage 3 rel with
+ | Error _ -> assert false
+ | Ok result ->
+ match Algebra.Memory.materialize storage result with
+ | Error _ -> assert false
+ | Ok rows -> assert (List.length rows = 3))
+
+(* ============================================================================
+ DRL Parser Tests
+ ============================================================================ *)
+
+let%test_unit "drl: parse Base" =
+ match Drl.Parser.of_string {|(Base "users")|} with
+ | Error _ -> assert false
+ | Ok (Drl.Ast.Base s) -> assert (s = "users")
+ | Ok _ -> assert false
+
+let%test_unit "drl: parse Const" =
+ match Drl.Parser.of_string {|(Const (("age" (Int 18))))|} with
+ | Error _ -> assert false
+ | Ok (Drl.Ast.Const [("age", Drl.Ast.Int 18)]) -> ()
+ | Ok _ -> assert false
+
+let%test_unit "drl: parse Join" =
+ match Drl.Parser.of_string {|(Join (id) (Base "L") (Base "R"))|} with
+ | Error _ -> assert false
+ | Ok (Drl.Ast.Join (["id"], Drl.Ast.Base "L", Drl.Ast.Base "R")) -> ()
+ | Ok _ -> assert false
+
+let%test_unit "drl: parse Select" =
+ let s = {|(Select (Const (("age" (Int 18)))) (Base "users"))|} in
+ match Drl.Parser.of_string s with
+ | Error _ -> assert false
+ | Ok (Drl.Ast.Select (Drl.Ast.Const _, Drl.Ast.Base "users")) -> ()
+ | Ok _ -> assert false
+
+(* ============================================================================
+ DRL Executor end-to-end Tests
+ ============================================================================ *)
+
+let%test_unit "drl: execute Base" =
+ with_storage (fun storage ->
+ let db = match Manipulation.Memory.create_database storage ~name:"test_db" with
+ | Error _ -> assert false | Ok db -> db
+ in
+ let (db, _) = stored_relation_with_ints storage db ~name:"items" ~attr:"v" [10; 20] in
+ match Drl.Parser.of_string {|(Base "items")|} with
+ | Error _ -> assert false
+ | Ok query ->
+ match Drl.Executor.Memory.execute storage db query with
+ | Error _ -> assert false
+ | Ok rel ->
+ match Algebra.Memory.materialize storage rel with
+ | Error _ -> assert false
+ | Ok rows -> assert (List.length rows = 2))
+
+let%test_unit "drl: execute Select+Const" =
+ with_storage (fun storage ->
+ let db = match Manipulation.Memory.create_database storage ~name:"test_db" with
+ | Error _ -> assert false | Ok db -> db
+ in
+ (* users: {age=18, name="Alice"}, {age=25, name="Bob"} *)
+ let schema = Schema.empty |> Schema.add "age" "integer" |> Schema.add "name" "string" in
+ let (db, users) = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with
+ | Error _ -> assert false | Ok x -> x
+ in
+ let make_user age name =
+ let attrs = Tuple.AttributeMap.empty
+ |> Tuple.AttributeMap.add "age" { Attribute.value = Obj.repr (age : int) }
+ |> Tuple.AttributeMap.add "name" { Attribute.value = Obj.repr (name : string) } in
+ ({ Tuple.relation = "users"; attributes = attrs } : Tuple.materialized)
+ in
+ let (db, _, _) = match Manipulation.Memory.create_tuples storage db users
+ [make_user 18 "Alice"; make_user 25 "Bob"] with
+ | Error _ -> assert false | Ok x -> x
+ in
+ (* Query: select users where age = 18 *)
+ let s = {|(Select (Const (("age" (Int 18)))) (Base "users"))|} in
+ match Drl.Parser.of_string s with
+ | Error _ -> assert false
+ | Ok query ->
+ match Drl.Executor.Memory.execute storage db query with
+ | Error _ -> assert false
+ | Ok rel ->
+ match Algebra.Memory.materialize storage rel with
+ | Error _ -> assert false
+ | Ok rows ->
+ assert (List.length rows = 1);
+ let name_v: string =
+ Obj.obj (Tuple.AttributeMap.find "name" (List.hd rows).Tuple.attributes).Attribute.value
+ in
+ assert (name_v = "Alice"))
generated by cgit v1.2.3 (git 2.25.1) at 2026-11-04 10:35:41 +0000