dml and dcl

9 files changed, 530 insertions, 6 deletions

diff --git a/lib/dcl/ast.ml b/lib/dcl/ast.ml
new file mode 100644
index 0000000..95e0271
--- /dev/null
+++ b/lib/dcl/ast.ml
@@ -0,0 +1,23 @@
+open Sexplib.Std
+
+type binding_expr =
+  | Var of string
+  | Const of Drl.Ast.value  (** reuse DRL value for literals *)
+[@@deriving sexp]
+
+type constraint_body =
+  | MemberOf of { target: string; binding: (string * binding_expr) list }
+  | Not of { body: constraint_body; universe: string }
+  | And of constraint_body list
+  | Or of constraint_body list
+  | Exists of { variable: string; quantifier: string; body: constraint_body }
+  | Forall of { variable: string; quantifier: string; body: constraint_body }
+[@@deriving sexp]
+
+type statement =
+  | RegisterConstraint of {
+      constraint_name: string;
+      relation_name: string;
+      body: constraint_body;
+    }
+[@@deriving sexp]
diff --git a/lib/dcl/executor.ml b/lib/dcl/executor.ml
new file mode 100644
index 0000000..810781f
--- /dev/null
+++ b/lib/dcl/executor.ml
@@ -0,0 +1,54 @@
+module Make (Storage : Management.Physical.S) = struct
+  module Ops = Manipulation.Make(Storage)
+
+  type error =
+    | ManipulationError of Manipulation.error
+    | ConversionError of string
+
+  let wrap_manip = Result.map_error (fun e -> ManipulationError e)
+
+  (** Convert a DCL binding_expr to a runtime Constraint.binding_expr *)
+  let convert_binding_expr : Ast.binding_expr -> Constraint.binding_expr = function
+    | Ast.Var name -> Constraint.Var name
+    | Ast.Const value -> Constraint.Const (Drl.Ast.value_to_abstract value)
+
+  (** Convert a list of (target_attr, binding_expr) pairs to a Constraint.binding (BindingMap) *)
+  let convert_binding (pairs : (string * Ast.binding_expr) list) : Constraint.binding =
+    List.fold_left
+      (fun acc (key, expr) ->
+        Constraint.BindingMap.add key (convert_binding_expr expr) acc)
+      Constraint.BindingMap.empty
+      pairs
+
+  (** Convert a DCL constraint_body AST to a runtime Constraint.t *)
+  let rec convert_body : Ast.constraint_body -> Constraint.t = function
+    | Ast.MemberOf { target; binding } ->
+      Constraint.MemberOf { target; binding = convert_binding binding }
+    | Ast.Not { body; universe } ->
+      Constraint.Not { body = convert_body body; universe }
+    | Ast.And bodies ->
+      Constraint.And (List.map convert_body bodies)
+    | Ast.Or bodies ->
+      Constraint.Or (List.map convert_body bodies)
+    | Ast.Exists { variable; quantifier; body } ->
+      Constraint.Exists { variable; quantifier; body = convert_body body }
+    | Ast.Forall { variable; quantifier; body } ->
+      Constraint.Forall { variable; quantifier; body = convert_body body }
+
+  let execute
+      (storage : Storage.t)
+      (db : Management.Database.t)
+      (stmt : Ast.statement)
+    : (Management.Database.t, error) result =
+    match stmt with
+    | Ast.RegisterConstraint { constraint_name; relation_name; body } ->
+      (* TODO: Additional constraint operations (drop constraint, list constraints,
+         validate existing tuples against new constraint) are not supported via DCL.
+         Use the OCaml API for these advanced operations. *)
+      let runtime_body = convert_body body in
+      Ops.register_constraint storage db
+        ~constraint_name ~relation_name ~body:runtime_body
+      |> wrap_manip
+end
+
+module Memory = Make(Management.Physical.Memory)
diff --git a/lib/dcl/parser.ml b/lib/dcl/parser.ml
new file mode 100644
index 0000000..a7981c0
--- /dev/null
+++ b/lib/dcl/parser.ml
@@ -0,0 +1,9 @@
+type error = ParseError of string
+
+let of_string s =
+  match Sexplib.Sexp.of_string s |> Ast.statement_of_sexp with
+  | stmt          -> Ok stmt
+  | exception exn -> Error (ParseError (Printexc.to_string exn))
+
+let to_string stmt =
+  Ast.sexp_of_statement stmt |> Sexplib.Sexp.to_string_hum
diff --git a/lib/dml/ast.ml b/lib/dml/ast.ml
new file mode 100644
index 0000000..4a903e7
--- /dev/null
+++ b/lib/dml/ast.ml
@@ -0,0 +1,22 @@
+open Sexplib.Std
+
+type attr_value = string * Drl.Ast.value
+[@@deriving sexp]
+
+type cardinality_spec =
+  | Finite of int
+  | AlephZero
+  | Continuum
+  | ConstrainedFinite
+[@@deriving sexp]
+
+type statement =
+  | CreateDatabase of string
+  | CreateRelation of { name: string; schema: (string * string) list }
+  | RetractRelation of string
+  | ClearRelation of string
+  | RegisterDomain of { name: string; cardinality: cardinality_spec }
+  | InsertTuple of { relation: string; attributes: attr_value list }
+  | InsertTuples of { relation: string; tuples: attr_value list list }
+  | DeleteTuple of { relation: string; attributes: attr_value list }
+[@@deriving sexp]
diff --git a/lib/dml/executor.ml b/lib/dml/executor.ml
new file mode 100644
index 0000000..3a8b05a
--- /dev/null
+++ b/lib/dml/executor.ml
@@ -0,0 +1,105 @@
+module Make (Storage : Management.Physical.S) = struct
+  module Ops = Manipulation.Make(Storage)
+
+  type error =
+    | ManipulationError of Manipulation.error
+    | RelationNotFound of string
+    | ParseError of string
+
+  let wrap_manip r = Result.map_error (fun e -> ManipulationError e) r
+
+  (** Convert a cardinality_spec AST node to a Conventions.Cardinality.t *)
+  let convert_cardinality : Ast.cardinality_spec -> Conventions.Cardinality.t = function
+    | Ast.Finite n -> Conventions.Cardinality.Finite n
+    | Ast.AlephZero -> Conventions.Cardinality.AlephZero
+    | Ast.Continuum -> Conventions.Cardinality.Continuum
+    | Ast.ConstrainedFinite -> Conventions.Cardinality.ConstrainedFinite
+
+  (** Build a materialized tuple from a list of (attr_name, ast_value) pairs *)
+  let build_tuple ~relation (attributes : Ast.attr_value list) : Tuple.materialized =
+    let attr_map =
+      List.fold_left
+        (fun acc (name, value) ->
+          Tuple.AttributeMap.add name
+            { Attribute.value = Drl.Ast.value_to_abstract value }
+            acc)
+        Tuple.AttributeMap.empty
+        attributes
+    in
+    { Tuple.relation; attributes = attr_map }
+
+  let execute
+      (storage : Storage.t)
+      (db : Management.Database.t)
+      (stmt : Ast.statement)
+    : (Management.Database.t, error) result =
+    match stmt with
+    | Ast.CreateDatabase name ->
+      Ops.create_database storage ~name |> wrap_manip
+
+    | Ast.CreateRelation { name; schema = schema_pairs } ->
+      let schema =
+        List.fold_left
+          (fun s (attr, dom) -> Schema.add attr dom s)
+          Schema.empty
+          schema_pairs
+      in
+      (match Ops.create_relation storage db ~name ~schema |> wrap_manip with
+       | Ok (db, _rel) -> Ok db
+       | Error e -> Error e)
+
+    | Ast.RetractRelation name ->
+      Ops.retract_relation storage db ~name |> wrap_manip
+
+    | Ast.ClearRelation name ->
+      (match Ops.get_relation db ~name with
+       | None -> Error (RelationNotFound name)
+       | Some rel ->
+         match Ops.clear_relation storage db rel |> wrap_manip with
+         | Ok (db, _rel) -> Ok db
+         | Error e -> Error e)
+
+    | Ast.RegisterDomain { name; cardinality } ->
+      (* TODO: Custom generators, membership_criteria, and comparators
+         are not supported via DML. Use the OCaml API for full-featured
+         domain definitions (e.g., custom enumeration, type-specific
+         comparison, or domain-specific validation). *)
+      let domain = Domain.make
+        ~name
+        ~generator:(fun _ -> Generator.Error "not enumerable via DML")
+        ~membership_criteria:(fun _ -> true)
+        ~cardinality:(convert_cardinality cardinality)
+        ~compare:Stdlib.compare
+      in
+      Ops.register_domain storage db domain |> wrap_manip
+
+    | Ast.InsertTuple { relation; attributes } ->
+      (match Ops.get_relation db ~name:relation with
+       | None -> Error (RelationNotFound relation)
+       | Some rel ->
+         let tuple = build_tuple ~relation attributes in
+         match Ops.create_tuple storage db rel tuple |> wrap_manip with
+         | Ok (db, _rel, _hash) -> Ok db
+         | Error e -> Error e)
+
+    | Ast.InsertTuples { relation; tuples } ->
+      (match Ops.get_relation db ~name:relation with
+       | None -> Error (RelationNotFound relation)
+       | Some rel ->
+         let tuple_list = List.map (build_tuple ~relation) tuples in
+         match Ops.create_tuples storage db rel tuple_list |> wrap_manip with
+         | Ok (db, _rel, _hashes) -> Ok db
+         | Error e -> Error e)
+
+    | Ast.DeleteTuple { relation; attributes } ->
+      (match Ops.get_relation db ~name:relation with
+       | None -> Error (RelationNotFound relation)
+       | Some rel ->
+         let tuple = build_tuple ~relation attributes in
+         let tuple_hash = Hashing.hash_tuple tuple in
+         match Ops.retract_tuple storage db rel ~tuple_hash |> wrap_manip with
+         | Ok (db, _rel) -> Ok db
+         | Error e -> Error e)
+end
+
+module Memory = Make(Management.Physical.Memory)
diff --git a/lib/dml/parser.ml b/lib/dml/parser.ml
new file mode 100644
index 0000000..a7981c0
--- /dev/null
+++ b/lib/dml/parser.ml
@@ -0,0 +1,9 @@
+type error = ParseError of string
+
+let of_string s =
+  match Sexplib.Sexp.of_string s |> Ast.statement_of_sexp with
+  | stmt          -> Ok stmt
+  | exception exn -> Error (ParseError (Printexc.to_string exn))
+
+let to_string stmt =
+  Ast.sexp_of_statement stmt |> Sexplib.Sexp.to_string_hum
diff --git a/lib/drl/ast.ml b/lib/drl/ast.ml
index f94965d..2beb010 100644
--- a/lib/drl/ast.ml
+++ b/lib/drl/ast.ml
@@ -8,6 +8,13 @@ type value =
   | Bool  of bool
 [@@deriving sexp]
 
+(** Convert an AST value to an AbstractValue.t (Obj.t) via Obj.repr *)
+let value_to_abstract : value -> Conventions.AbstractValue.t = function
+  | Int n   -> Obj.repr n
+  | Float f -> Obj.repr f
+  | Str s   -> Obj.repr s
+  | Bool b  -> Obj.repr b
+
 type direction = Asc | Desc
 [@@deriving sexp]
 
diff --git a/lib/drl/executor.ml b/lib/drl/executor.ml
index 7588b33..27f52c2 100644
--- a/lib/drl/executor.ml
+++ b/lib/drl/executor.ml
@@ -8,12 +8,7 @@ module Make(Storage : Management.Physical.S) = struct
 
   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 ast_value_to_abstract = Ast.value_to_abstract
 
   let rec execute
       (storage : Storage.t)
diff --git a/test/test_relational_engine.ml b/test/test_relational_engine.ml
index f7421f1..6bb1eed 100644
--- a/test/test_relational_engine.ml
+++ b/test/test_relational_engine.ml
@@ -2384,3 +2384,303 @@ let%test_unit "constraint propagation: project filters constraints" =
     match Algebra.Memory.project storage [ "y" ] rel with
     | Error _ -> assert false
     | Ok result -> assert (result.Relation.constraints = None))
+
+(* ============================================================================
+   DML Sublanguage Tests
+   ============================================================================ *)
+
+(* Parse tests use canonical flat sexp format: (Constructor (field val) ...) *)
+
+let%test_unit "dml: parse CreateDatabase" =
+  match Dml.Parser.of_string {|(CreateDatabase "shop")|} with
+  | Error _ -> assert false
+  | Ok stmt -> assert (stmt = Dml.Ast.CreateDatabase "shop")
+
+let%test_unit "dml: parse RetractRelation" =
+  match Dml.Parser.of_string {|(RetractRelation "users")|} with
+  | Error _ -> assert false
+  | Ok stmt -> assert (stmt = Dml.Ast.RetractRelation "users")
+
+let%test_unit "dml: parse ClearRelation" =
+  match Dml.Parser.of_string {|(ClearRelation "users")|} with
+  | Error _ -> assert false
+  | Ok stmt -> assert (stmt = Dml.Ast.ClearRelation "users")
+
+let%test_unit "dml: round-trip InsertTuple" =
+  let src = Dml.Ast.InsertTuple {
+    relation = "users";
+    attributes = [("name", Drl.Ast.Str "Alice"); ("age", Drl.Ast.Int 30)]
+  } in
+  match Dml.Parser.of_string (Dml.Parser.to_string src) with
+  | Error _ -> assert false
+  | Ok parsed -> assert (parsed = src)
+
+let%test_unit "dml: round-trip CreateRelation" =
+  let src = Dml.Ast.CreateRelation {
+    name = "users";
+    schema = [("name", "string"); ("age", "natural")]
+  } in
+  match Dml.Parser.of_string (Dml.Parser.to_string src) with
+  | Error _ -> assert false
+  | Ok parsed -> assert (parsed = src)
+
+let%test_unit "dml: round-trip InsertTuples" =
+  let src = Dml.Ast.InsertTuples {
+    relation = "users";
+    tuples = [
+      [("name", Drl.Ast.Str "Alice"); ("age", Drl.Ast.Int 30)];
+      [("name", Drl.Ast.Str "Bob");   ("age", Drl.Ast.Int 25)];
+    ]
+  } in
+  match Dml.Parser.of_string (Dml.Parser.to_string src) with
+  | Error _ -> assert false
+  | Ok parsed -> assert (parsed = src)
+
+let%test_unit "dml: round-trip RegisterDomain" =
+  let src = Dml.Ast.RegisterDomain { name = "money"; cardinality = Dml.Ast.AlephZero } in
+  match Dml.Parser.of_string (Dml.Parser.to_string src) with
+  | Error _ -> assert false
+  | Ok parsed -> assert (parsed = src)
+
+(* Executor tests construct AST directly — no dependency on sexp format *)
+
+let%test_unit "dml: execute CreateDatabase" =
+  with_storage (fun storage ->
+    let db = Management.Database.empty ~name:"" in
+    let stmt = Dml.Ast.CreateDatabase "shop" in
+    match Dml.Executor.Memory.execute storage db stmt with
+    | Error _ -> assert false
+    | Ok db -> assert (db.name = "shop"))
+
+let%test_unit "dml: execute CreateRelation" =
+  with_storage (fun storage ->
+    let db = match Manipulation.Memory.create_database storage ~name:"shop" with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let stmt = Dml.Ast.CreateRelation { name = "users"; schema = [("name", "string"); ("age", "natural")] } in
+    match Dml.Executor.Memory.execute storage db stmt with
+    | Error _ -> assert false
+    | Ok db -> assert (Management.Database.has_relation db "users"))
+
+let%test_unit "dml: execute InsertTuple" =
+  with_storage (fun storage ->
+    let db = match Manipulation.Memory.create_database storage ~name:"shop" with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let schema = Schema.empty |> Schema.add "name" "string" in
+    let db = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with
+      | Error _ -> assert false | Ok (db, _) -> db
+    in
+    let stmt = Dml.Ast.InsertTuple { relation = "users"; attributes = [("name", Drl.Ast.Str "Alice")] } in
+    match Dml.Executor.Memory.execute storage db stmt with
+    | Error _ -> assert false
+    | Ok db ->
+      let rel = match Management.Database.get_relation db "users" with
+        | None -> assert false | Some r -> r
+      in
+      assert (Manipulation.Memory.tuple_count rel = 1))
+
+let%test_unit "dml: execute InsertTuples" =
+  with_storage (fun storage ->
+    let db = match Manipulation.Memory.create_database storage ~name:"shop" with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let schema = Schema.empty |> Schema.add "name" "string" in
+    let db = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with
+      | Error _ -> assert false | Ok (db, _) -> db
+    in
+    let stmt = Dml.Ast.InsertTuples {
+      relation = "users";
+      tuples = [[("name", Drl.Ast.Str "Alice")]; [("name", Drl.Ast.Str "Bob")]]
+    } in
+    match Dml.Executor.Memory.execute storage db stmt with
+    | Error _ -> assert false
+    | Ok db ->
+      let rel = match Management.Database.get_relation db "users" with
+        | None -> assert false | Some r -> r
+      in
+      assert (Manipulation.Memory.tuple_count rel = 2))
+
+let%test_unit "dml: execute DeleteTuple" =
+  with_storage (fun storage ->
+    let db = match Manipulation.Memory.create_database storage ~name:"shop" with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let schema = Schema.empty |> Schema.add "name" "string" in
+    let db = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with
+      | Error _ -> assert false | Ok (db, _) -> db
+    in
+    let db = match Dml.Executor.Memory.execute storage db
+      (Dml.Ast.InsertTuple { relation = "users"; attributes = [("name", Drl.Ast.Str "Alice")] }) with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let stmt = Dml.Ast.DeleteTuple { relation = "users"; attributes = [("name", Drl.Ast.Str "Alice")] } in
+    match Dml.Executor.Memory.execute storage db stmt with
+    | Error _ -> assert false
+    | Ok db ->
+      let rel = match Management.Database.get_relation db "users" with
+        | None -> assert false | Some r -> r
+      in
+      assert (Manipulation.Memory.tuple_count rel = 0))
+
+let%test_unit "dml: execute RetractRelation" =
+  with_storage (fun storage ->
+    let db = match Manipulation.Memory.create_database storage ~name:"shop" with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let schema = Schema.empty in
+    let db = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with
+      | Error _ -> assert false | Ok (db, _) -> db
+    in
+    match Dml.Executor.Memory.execute storage db (Dml.Ast.RetractRelation "users") with
+    | Error _ -> assert false
+    | Ok db -> assert (not (Management.Database.has_relation db "users")))
+
+let%test_unit "dml: execute ClearRelation" =
+  with_storage (fun storage ->
+    let db = match Manipulation.Memory.create_database storage ~name:"shop" with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let schema = Schema.empty |> Schema.add "name" "string" in
+    let db = match Manipulation.Memory.create_relation storage db ~name:"users" ~schema with
+      | Error _ -> assert false | Ok (db, _) -> db
+    in
+    let db = match Dml.Executor.Memory.execute storage db
+      (Dml.Ast.InsertTuples { relation = "users";
+        tuples = [[("name", Drl.Ast.Str "Alice")]; [("name", Drl.Ast.Str "Bob")]] }) with
+      | Error _ -> assert false | Ok db -> db
+    in
+    match Dml.Executor.Memory.execute storage db (Dml.Ast.ClearRelation "users") with
+    | Error _ -> assert false
+    | Ok db ->
+      let rel = match Management.Database.get_relation db "users" with
+        | None -> assert false | Some r -> r
+      in
+      assert (Manipulation.Memory.tuple_count rel = 0))
+
+let%test_unit "dml: execute RegisterDomain" =
+  with_storage (fun storage ->
+    let db = match Manipulation.Memory.create_database storage ~name:"shop" with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let stmt = Dml.Ast.RegisterDomain { name = "money"; cardinality = Dml.Ast.AlephZero } in
+    match Dml.Executor.Memory.execute storage db stmt with
+    | Error _ -> assert false
+    | Ok db -> assert (Management.Database.has_domain db "money"))
+
+let%test_unit "dml: insert into nonexistent relation returns error" =
+  with_storage (fun storage ->
+    let db = match Manipulation.Memory.create_database storage ~name:"shop" with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let stmt = Dml.Ast.InsertTuple { relation = "ghost"; attributes = [("x", Drl.Ast.Int 1)] } in
+    match Dml.Executor.Memory.execute storage db stmt with
+    | Error (Dml.Executor.Memory.RelationNotFound "ghost") -> ()
+    | _ -> assert false)
+
+(* ============================================================================
+   DCL Sublanguage Tests
+   ============================================================================ *)
+
+let%test_unit "dcl: round-trip RegisterConstraint MemberOf" =
+  let src = Dcl.Ast.RegisterConstraint {
+    constraint_name = "fk_order";
+    relation_name = "order_items";
+    body = Dcl.Ast.MemberOf { target = "orders"; binding = [("order_id", Dcl.Ast.Var "order_id")] }
+  } in
+  match Dcl.Parser.of_string (Dcl.Parser.to_string src) with
+  | Error _ -> assert false
+  | Ok parsed -> assert (parsed = src)
+
+let%test_unit "dcl: round-trip And constraint" =
+  let src = Dcl.Ast.RegisterConstraint {
+    constraint_name = "valid_range";
+    relation_name = "scores";
+    body = Dcl.Ast.And [
+      Dcl.Ast.MemberOf { target = "ge_zero";
+        binding = [("left", Dcl.Ast.Var "score"); ("right", Dcl.Ast.Const (Drl.Ast.Int 0))] };
+      Dcl.Ast.MemberOf { target = "le_hundred";
+        binding = [("left", Dcl.Ast.Var "score"); ("right", Dcl.Ast.Const (Drl.Ast.Int 100))] };
+    ]
+  } in
+  match Dcl.Parser.of_string (Dcl.Parser.to_string src) with
+  | Error _ -> assert false
+  | Ok parsed -> assert (parsed = src)
+
+let%test_unit "dcl: round-trip Not constraint" =
+  let src = Dcl.Ast.RegisterConstraint {
+    constraint_name = "not_closed";
+    relation_name = "open_ticket";
+    body = Dcl.Ast.Not {
+      body = Dcl.Ast.MemberOf { target = "closed_ticket";
+        binding = [("ticket_id", Dcl.Ast.Var "ticket_id")] };
+      universe = "open_ticket"
+    }
+  } in
+  match Dcl.Parser.of_string (Dcl.Parser.to_string src) with
+  | Error _ -> assert false
+  | Ok parsed -> assert (parsed = src)
+
+let%test_unit "dcl: execute RegisterConstraint attaches constraint" =
+  with_storage (fun storage ->
+    let db = match Manipulation.Memory.create_database storage ~name:"shop" with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let schema = Schema.empty |> Schema.add "order_id" "natural" in
+    let db = match Manipulation.Memory.create_relation storage db ~name:"order_items" ~schema with
+      | Error _ -> assert false | Ok (db, _) -> db
+    in
+    let stmt = Dcl.Ast.RegisterConstraint {
+      constraint_name = "fk_order";
+      relation_name = "order_items";
+      body = Dcl.Ast.MemberOf { target = "orders"; binding = [("order_id", Dcl.Ast.Var "order_id")] }
+    } in
+    match Dcl.Executor.Memory.execute storage db stmt with
+    | Error _ -> assert false
+    | Ok db ->
+      let rel = match Management.Database.get_relation db "order_items" with
+        | None -> assert false | Some r -> r
+      in
+      assert (rel.Relation.constraints <> None))
+
+let%test_unit "dcl: FK constraint enforced on insert" =
+  with_storage (fun storage ->
+    let db = match Manipulation.Memory.create_database storage ~name:"shop" with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let db = match Manipulation.Memory.create_relation storage db ~name:"orders"
+        ~schema:(Schema.empty |> Schema.add "id" "natural") with
+      | Error _ -> assert false | Ok (db, _) -> db
+    in
+    (* Insert a valid order *)
+    let db = match Dml.Executor.Memory.execute storage db
+      (Dml.Ast.InsertTuple { relation = "orders"; attributes = [("id", Drl.Ast.Int 1)] }) with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let db = match Manipulation.Memory.create_relation storage db ~name:"order_items"
+        ~schema:(Schema.empty |> Schema.add "order_id" "natural") with
+      | Error _ -> assert false | Ok (db, _) -> db
+    in
+    (* Register FK: order_id in order_items must match id in orders *)
+    let db = match Dcl.Executor.Memory.execute storage db
+      (Dcl.Ast.RegisterConstraint {
+        constraint_name = "fk_order";
+        relation_name = "order_items";
+        body = Dcl.Ast.MemberOf { target = "orders"; binding = [("id", Dcl.Ast.Var "order_id")] }
+      }) with
+      | Error _ -> assert false | Ok db -> db
+    in
+    (* Valid insert: order_id=1 exists in orders *)
+    let db = match Dml.Executor.Memory.execute storage db
+      (Dml.Ast.InsertTuple { relation = "order_items"; attributes = [("order_id", Drl.Ast.Int 1)] }) with
+      | Error _ -> assert false | Ok db -> db
+    in
+    let rel = match Management.Database.get_relation db "order_items" with
+      | None -> assert false | Some r -> r
+    in
+    assert (Manipulation.Memory.tuple_count rel = 1);
+    (* Invalid insert: order_id=99 does not exist in orders *)
+    match Dml.Executor.Memory.execute storage db
+      (Dml.Ast.InsertTuple { relation = "order_items"; attributes = [("order_id", Drl.Ast.Int 99)] }) with
+    | Error (Dml.Executor.Memory.ManipulationError (Manipulation.ConstraintViolation _)) -> ()
+    | _ -> assert false)