Introduce Multigroups (#65)

18 files changed, 606 insertions, 237 deletions

diff --git a/.gitignore b/.gitignore
index 27f25b5..dd2ab30 100644
--- a/.gitignore
+++ b/.gitignore
@@ -8,3 +8,5 @@ result-*
 # OCaml editor/tooling artifacts
 *.merlin
 .ocamlformat-lock
+
+settings.json
\ No newline at end of file
diff --git a/config.sexp b/config.sexp
index 2e56f4d..c1371a8 100644
--- a/config.sexp
+++ b/config.sexp
@@ -2,7 +2,7 @@
 ;; storage: memory
 ;; transport: tcp (address, port)
 (server
- (storage (memory))
+(storage (memory))
  (transport (tcp
              (address "127.0.0.1")
              (port 7777))))
diff --git a/lib/catalog.ml b/lib/catalog.ml
new file mode 100644
index 0000000..be54375
--- /dev/null
+++ b/lib/catalog.ml
@@ -0,0 +1,152 @@
+(** Multi-multigroup catalog.
+
+    Each multigroup gets its own [Atomic.t], so mutations to independent
+    multigroups never contend.  The [sakura] multigroup is auto-bootstrapped,
+    undeletable, and self-referential: it carries a [public:multigroup]
+    relation listing every registered multigroup. *)
+
+type t = {
+  multigroups : Management.Database.t Atomic.t Utilities.StringMap.t Atomic.t;
+  default_multigroup : string;
+  mutex : Mutex.t;
+}
+
+let sakura_name = "sakura"
+
+module Make (S : Management.Physical.S with type error = string) = struct
+  open Utilities.Result
+  module Manip = Manipulation.Make (S)
+
+  type nonrec t = t
+
+  let map_error r = Result.map_error
+    (fun e -> Sexplib.Sexp.to_string (Error.sexp_of_error e)) r
+
+  let get catalog name =
+    Utilities.StringMap.find_opt name (Atomic.get catalog.multigroups)
+
+  let list catalog =
+    Utilities.StringMap.bindings (Atomic.get catalog.multigroups)
+    |> List.map fst
+
+  let publish_multigroups catalog ~expected ~updated =
+    if Atomic.compare_and_set catalog.multigroups expected updated then Ok ()
+    else Error "Concurrent multigroup map update detected"
+
+  (** Swallow errors: a missing prelude relation is non-fatal. *)
+  let register_prelude_relation storage db (rel : Relation.t) =
+    match
+      Manip.create_immutable_relation storage db ~name:rel.name
+        ~schema:rel.schema ~generator:(Option.get rel.generator)
+        ~membership_criteria:rel.membership_criteria
+        ~cardinality:rel.cardinality
+    with
+    | Ok (new_db, _) -> new_db
+    | Error e ->
+        Printf.eprintf "Warning: prelude relation %s: %s\n%!"
+          rel.name (Sexplib.Sexp.to_string (Error.sexp_of_error e));
+        db
+
+  (** Create DB + seed catalog + fold in [prelude_relations]. *)
+  let bootstrap_multigroup storage ~prelude_relations ~name =
+    let* db = Manip.create_database storage ~name |> map_error in
+    Ok (List.fold_left (register_prelude_relation storage) db prelude_relations)
+
+  (** Create additional catalog relations beyond the base six.
+      Used to seed [public:multigroup] into the sakura multigroup only. *)
+  let seed_extra_catalog storage ~definitions db =
+    List.fold_left
+      (fun acc (name, schema) ->
+        let* db = acc in
+        let* new_db, _ =
+          Manip.create_relation storage db ~name ~schema |> map_error
+        in
+        Ok new_db)
+      (Ok db) definitions
+
+  (** Write a tuple into sakura's [public:multigroup] and update the ref.
+      No-op if the relation doesn't exist yet (bootstrap ordering). *)
+  let register_in_sakura storage sakura_ref mg_name =
+    let rec go () =
+      let sakura = Atomic.get sakura_ref in
+      match
+        Management.Database.get_relation sakura Prelude.Catalog.multigroup_rel_name
+      with
+      | None -> Ok ()
+      | Some mg_rel ->
+          let tuple = Prelude.Catalog.build_multigroup_tuple mg_name in
+          let* new_sakura, _, _ =
+            Manip.create_tuple storage sakura mg_rel tuple |> map_error
+          in
+          if Atomic.compare_and_set sakura_ref sakura new_sakura then Ok ()
+          else go ()
+    in
+    go ()
+
+  let create storage ~prelude_relations =
+    let* sakura_db =
+      bootstrap_multigroup storage ~prelude_relations ~name:sakura_name
+    in
+    let* sakura_db =
+      seed_extra_catalog storage
+        ~definitions:Prelude.Catalog.sakura_only_definitions sakura_db
+    in
+    let sakura_ref = Atomic.make sakura_db in
+    let* () = register_in_sakura storage sakura_ref sakura_name in
+    let map = Utilities.StringMap.singleton sakura_name sakura_ref in
+    Ok { multigroups = Atomic.make map; default_multigroup = sakura_name; mutex = Mutex.create () }
+
+  let add catalog storage ~prelude_relations name =
+    Mutex.protect catalog.mutex (fun () ->
+      let map = Atomic.get catalog.multigroups in
+      if Utilities.StringMap.mem name map then
+        Error (Printf.sprintf "Multigroup %s already exists" name)
+      else
+        let* db = bootstrap_multigroup storage ~prelude_relations ~name in
+        let db_ref = Atomic.make db in
+        let* () =
+          match Utilities.StringMap.find_opt sakura_name map with
+          | Some sakura_ref -> register_in_sakura storage sakura_ref name
+          | None -> Ok ()
+        in
+        let new_map = Utilities.StringMap.add name db_ref map in
+        let* () = publish_multigroups catalog ~expected:map ~updated:new_map in
+        Ok db_ref)
+
+  let unregister_from_sakura storage sakura_ref mg_name =
+    let rec go () =
+      let sakura = Atomic.get sakura_ref in
+      match Management.Database.get_relation sakura Prelude.Catalog.multigroup_rel_name with
+      | None -> Ok ()
+      | Some mg_rel ->
+          let tuple_hash =
+            Hashing.hash_tuple (Prelude.Catalog.build_multigroup_tuple mg_name)
+          in
+          let* new_sakura, _ =
+            Manip.retract_tuple storage sakura mg_rel ~tuple_hash |> map_error
+          in
+          if Atomic.compare_and_set sakura_ref sakura new_sakura then Ok ()
+          else go ()
+    in
+    go ()
+
+  let remove catalog storage name =
+    if name = sakura_name then
+      Error "Cannot remove the sakura system catalog"
+    else
+      Mutex.protect catalog.mutex (fun () ->
+        let map = Atomic.get catalog.multigroups in
+        if not (Utilities.StringMap.mem name map) then
+          Error (Printf.sprintf "Multigroup %s does not exist" name)
+        else
+          let* () =
+            match Utilities.StringMap.find_opt sakura_name map with
+            | None -> Ok ()
+            | Some sakura_ref -> unregister_from_sakura storage sakura_ref name
+          in
+          let new_map = Utilities.StringMap.remove name map in
+          let* () =
+            publish_multigroups catalog ~expected:map ~updated:new_map
+          in
+          Ok ())
+end
diff --git a/lib/dcl/ast.ml b/lib/dcl/ast.ml
index 0b6107f..a55ec19 100644
--- a/lib/dcl/ast.ml
+++ b/lib/dcl/ast.ml
@@ -10,4 +10,6 @@ type statement =
   | GetBranchTip of string
   | UpdateBranchTip of { name : string; hash : string }
   | Merge of { left : string; right : string; strategy : merge_strategy }
+  | Use of string
+  | CreateMultigroup of string
 [@@deriving sexp]
diff --git a/lib/dcl/executor.ml b/lib/dcl/executor.ml
index a651067..b83f629 100644
--- a/lib/dcl/executor.ml
+++ b/lib/dcl/executor.ml
@@ -4,24 +4,24 @@ module Make (Storage : Management.Physical.S with type error = string) = struct
   module MergeOps = Management.Merge.Make (Storage) (Ops)
 
   type error =
-    | ParseError       of string
-    | BranchError      of Error.t
-    | BranchNotFound   of string
+    | ParseError of string
+    | BranchError of Error.t
+    | BranchNotFound of string
     | NoDatabaseAtHash of Conventions.Hash.t
-    | StorageError     of string
-    | MergeError       of Error.t
-    | Conflict         of string
+    | StorageError of string
+    | MergeError of Error.t
+    | Conflict of string
 
   let sexp_of_error e =
     let open Sexplib.Sexp in
     match e with
-    | ParseError        s -> List [Atom "parse-error";  Atom s]
-    | BranchError       s -> List [Atom "branch-error"; Error.sexp_of_error s]
-    | BranchNotFound    s -> List [Atom "branch-not-found"; Atom s]
-    | NoDatabaseAtHash  s -> List [Atom "no-database-at-hash"; Atom s]
-    | StorageError      s -> List [Atom "storage-error"; Atom s]
-    | MergeError        s -> List [Atom "merge-error";  Error.sexp_of_error s]
-    | Conflict          s -> List [Atom "conflict"; Atom s]
+    | ParseError s -> List [ Atom "parse-error"; Atom s ]
+    | BranchError s -> List [ Atom "branch-error"; Error.sexp_of_error s ]
+    | BranchNotFound s -> List [ Atom "branch-not-found"; Atom s ]
+    | NoDatabaseAtHash s -> List [ Atom "no-database-at-hash"; Atom s ]
+    | StorageError s -> List [ Atom "storage-error"; Atom s ]
+    | MergeError s -> List [ Atom "merge-error"; Error.sexp_of_error s ]
+    | Conflict s -> List [ Atom "conflict"; Atom s ]
 
   let convert_strategy : Ast.merge_strategy -> Management.Merge.strategy =
     function
@@ -29,71 +29,80 @@ module Make (Storage : Management.Physical.S with type error = string) = struct
     | Ast.PreferRight -> Management.Merge.PreferRight
     | Ast.RevertToAncestor -> Management.Merge.RevertToAncestor
 
+  type exec_result =
+    | DbResult of Management.Database.t * string
+    | Switch of string
+    | NewMultigroup of string
+
   let execute (storage : Storage.t) (db : Management.Database.t)
-      (stmt : Ast.statement) : (Management.Database.t * string, error) result =
+      (stmt : Ast.statement) : (exec_result, error) result =
     match stmt with
-    | Ast.CreateBranch { name; hash } ->
-      let tip = match hash with
-        | Some h -> h
-        | None   -> db.Management.Database.hash
-      in
-      (match Branch.create storage ~name ~tip with
-       | Error e -> Error (StorageError e)
-       | Ok ()   -> Ok (db, "Branch " ^ name ^ " created"))
-
-    | Ast.Checkout branch_name ->
-      (match Branch.get_tip storage branch_name with
-       | Error e       -> Error (StorageError e)
-       | Ok None       -> Error (BranchNotFound branch_name)
-       | Ok (Some tip) ->
-         (match Branch.checkout storage branch_name with
-          | Error e -> Error (StorageError e)
-          | Ok ()   ->
-            (match Ops.load_database storage tip with
-             | Error e -> Error (BranchError e)
-             | Ok None -> Error (NoDatabaseAtHash tip)
-             | Ok (Some loaded_db) ->
-               Ok (loaded_db, "HEAD:" ^ branch_name))))
-
-    | Ast.GetHead ->
-      (match Branch.get_head storage with
-       | Error e        -> Error (StorageError e)
-       | Ok None        -> Ok (db, "HEAD is unset")
-       | Ok (Some name) -> Ok (db, "HEAD:" ^ name))
-
-    | Ast.GetBranchTip name ->
-      (match Branch.get_tip storage name with
-       | Error e        -> Error (StorageError e)
-       | Ok None        -> Error (BranchNotFound name)
-       | Ok (Some hash) -> Ok (db, "branch:" ^ name ^ "=" ^ hash))
-
-    | Ast.UpdateBranchTip { name; hash } ->
-      (match Branch.update_tip storage ~name ~tip:hash with
-       | Error e -> Error (StorageError e)
-       | Ok ()   -> Ok (db, "Branch " ^ name ^ " updated"))
-
-    | Ast.Merge { left; right; strategy } ->
-      (match Branch.get_tip storage left, Branch.get_tip storage right with
-       | Error e, _ | _, Error e -> Error (StorageError e)
-       | Ok None, _  -> Error (BranchNotFound left)
-       | _, Ok None  -> Error (BranchNotFound right)
-       | Ok (Some left_tip), Ok (Some right_tip) ->
-         let strat = convert_strategy strategy in
-         (match MergeOps.merge ~storage ~strategy:strat ~left_tip ~right_tip with
-          | Error e -> Error (MergeError e)
-          | Ok (Management.Merge.Failed conflicts) ->
-            let msgs = List.map (function
-              | Management.Merge.TupleConflict    { relation; hash } ->
-                "tuple conflict in " ^ relation ^ " (" ^ hash ^ ")"
-              | Management.Merge.SchemaConflict   r -> "schema conflict in " ^ r
-              | Management.Merge.ConstraintConflict r -> "constraint conflict in " ^ r
-            ) conflicts in
-            Error (Conflict ("Merge failed: " ^ String.concat "; " msgs))
-          | Ok (Management.Merge.Clean merged_db) ->
-            let _ = Branch.update_tip storage ~name:left
-                      ~tip:merged_db.Management.Database.hash in
-            Ok (merged_db,
-                "Merged:" ^ right ^ "→" ^ left)))
+    | Ast.CreateBranch { name; hash } -> (
+        let tip =
+          match hash with Some h -> h | None -> db.Management.Database.hash
+        in
+        match Branch.create storage ~name ~tip with
+        | Error e -> Error (StorageError e)
+        | Ok () -> Ok (DbResult (db, "Branch " ^ name ^ " created")))
+    | Ast.Checkout branch_name -> (
+        match Branch.get_tip storage branch_name with
+        | Error e -> Error (StorageError e)
+        | Ok None -> Error (BranchNotFound branch_name)
+        | Ok (Some tip) -> (
+            match Branch.checkout storage branch_name with
+            | Error e -> Error (StorageError e)
+            | Ok () -> (
+                match Ops.load_database storage tip with
+                | Error e -> Error (BranchError e)
+                | Ok None -> Error (NoDatabaseAtHash tip)
+                | Ok (Some loaded_db) ->
+                    Ok (DbResult (loaded_db, "HEAD:" ^ branch_name)))))
+    | Ast.GetHead -> (
+        match Branch.get_head storage with
+        | Error e -> Error (StorageError e)
+        | Ok None -> Ok (DbResult (db, "HEAD is unset"))
+        | Ok (Some name) -> Ok (DbResult (db, "HEAD:" ^ name)))
+    | Ast.GetBranchTip name -> (
+        match Branch.get_tip storage name with
+        | Error e -> Error (StorageError e)
+        | Ok None -> Error (BranchNotFound name)
+        | Ok (Some hash) -> Ok (DbResult (db, "branch:" ^ name ^ "=" ^ hash)))
+    | Ast.UpdateBranchTip { name; hash } -> (
+        match Branch.update_tip storage ~name ~tip:hash with
+        | Error e -> Error (StorageError e)
+        | Ok () -> Ok (DbResult (db, "Branch " ^ name ^ " updated")))
+    | Ast.Merge { left; right; strategy } -> (
+        match (Branch.get_tip storage left, Branch.get_tip storage right) with
+        | Error e, _ | _, Error e -> Error (StorageError e)
+        | Ok None, _ -> Error (BranchNotFound left)
+        | _, Ok None -> Error (BranchNotFound right)
+        | Ok (Some left_tip), Ok (Some right_tip) -> (
+            let strat = convert_strategy strategy in
+            match
+              MergeOps.merge ~storage ~strategy:strat ~left_tip ~right_tip
+            with
+            | Error e -> Error (MergeError e)
+            | Ok (Management.Merge.Failed conflicts) ->
+                let msgs =
+                  List.map
+                    (function
+                      | Management.Merge.TupleConflict { relation; hash } ->
+                          "tuple conflict in " ^ relation ^ " (" ^ hash ^ ")"
+                      | Management.Merge.SchemaConflict r ->
+                          "schema conflict in " ^ r
+                      | Management.Merge.ConstraintConflict r ->
+                          "constraint conflict in " ^ r)
+                    conflicts
+                in
+                Error (Conflict ("Merge failed: " ^ String.concat "; " msgs))
+            | Ok (Management.Merge.Clean merged_db) ->
+                let _ =
+                  Branch.update_tip storage ~name:left
+                    ~tip:merged_db.Management.Database.hash
+                in
+                Ok (DbResult (merged_db, "Merged:" ^ right ^ "→" ^ left))))
+    | Ast.Use multigroup -> Ok (Switch multigroup)
+    | Ast.CreateMultigroup name -> Ok (NewMultigroup name)
 end
 
 module Memory = Make (Management.Physical.Memory)
diff --git a/lib/dcl/sublanguage.ml b/lib/dcl/sublanguage.ml
index eab5ecb..7af0703 100644
--- a/lib/dcl/sublanguage.ml
+++ b/lib/dcl/sublanguage.ml
@@ -16,7 +16,9 @@ module Make (Storage : Management.Physical.S with type error = string) = struct
 
   let execute storage db ast =
     match Exec.execute storage db ast with
-    | Ok (db, msg) -> Ok (Sublanguage_types.Transition (db, msg))
+    | Ok (Exec.DbResult (db, msg)) -> Ok (Sublanguage_types.Transition (db, msg))
+    | Ok (Exec.Switch multigroup) -> Ok (Sublanguage_types.SessionSwitch multigroup)
+    | Ok (Exec.NewMultigroup name) -> Ok (Sublanguage_types.CreateMultigroup name)
     | Error e -> Error e
 
   let sexp_of_error = Exec.sexp_of_error
diff --git a/lib/dml/executor.ml b/lib/dml/executor.ml
index 85f9791..e92b0f5 100644
--- a/lib/dml/executor.ml
+++ b/lib/dml/executor.ml
@@ -58,19 +58,21 @@ module Make (Storage : Management.Physical.S) = struct
     match stmt with
     | Ast.InsertTuple { relation; attributes } ->
         let* rel = get_rel db relation in
-        let tuple = build_tuple ~relation attributes in
+        let tuple = build_tuple ~relation:rel.Relation.name attributes in
         let* db, _, _ = Ops.create_tuple storage db rel tuple |> wrap_manip in
         Ok db
     | Ast.InsertTuples { relation; tuples } ->
         let* rel = get_rel db relation in
-        let tuple_list = List.map (build_tuple ~relation) tuples in
+        let tuple_list =
+          List.map (build_tuple ~relation:rel.Relation.name) tuples
+        in
         let* db, _, _ =
           Ops.create_tuples storage db rel tuple_list |> wrap_manip
         in
         Ok db
     | Ast.DeleteTuple { relation; attributes } ->
         let* rel = get_rel db relation in
-        let tuple = build_tuple ~relation attributes in
+        let tuple = build_tuple ~relation:rel.Relation.name attributes in
         let tuple_hash = Hashing.hash_tuple tuple in
         let* db, _ =
           Ops.retract_tuple storage db rel ~tuple_hash |> wrap_manip
@@ -82,7 +84,8 @@ module Make (Storage : Management.Physical.S) = struct
         let* tuples = materialize_tuples storage result_rel in
         let* db, rel = Ops.clear_relation storage db rel |> wrap_manip in
         let* db, _, _ =
-          Ops.create_tuples storage db rel (List.map (retarget target) tuples)
+          Ops.create_tuples storage db rel
+            (List.map (retarget rel.Relation.name) tuples)
           |> wrap_manip
         in
         Ok db
@@ -91,7 +94,8 @@ module Make (Storage : Management.Physical.S) = struct
         let* result_rel = eval_query storage db source in
         let* tuples = materialize_tuples storage result_rel in
         let* db, _, _ =
-          Ops.create_tuples storage db rel (List.map (retarget target) tuples)
+          Ops.create_tuples storage db rel
+            (List.map (retarget rel.Relation.name) tuples)
           |> wrap_manip
         in
         Ok db
@@ -118,7 +122,7 @@ module Make (Storage : Management.Physical.S) = struct
           (fun acc t ->
             let* db = acc in
             let* rel = get_rel db target in
-            let tuple_hash = Hashing.hash_tuple (retarget target t) in
+            let tuple_hash = Hashing.hash_tuple (retarget rel.Relation.name t) in
             let* db, _ =
               Ops.retract_tuple storage db rel ~tuple_hash |> wrap_manip
             in
diff --git a/lib/error.ml b/lib/error.ml
index edaa85b..09b2e53 100644
--- a/lib/error.ml
+++ b/lib/error.ml
@@ -13,6 +13,7 @@ type t =
   | SublanguageError of Sexplib.Sexp.t
   | Conflict of { old_db : Management.Database.t; new_db : Management.Database.t}
   | SyntaxError of string
+  | MultigroupNotFound of string
 
 let sexp_of_error e =
   let open Sexplib.Sexp in
@@ -30,5 +31,6 @@ let sexp_of_error e =
   | MalformedExpression s       -> error "malformed-expression"     ["expression" <+> s]
   | SublanguageError s          -> error "sublanguage-error"        ["error"      <+> s]
   | SyntaxError s               -> error "syntax-error"             ["message"    <+> (Atom s)]
+  | MultigroupNotFound s        -> error "multigroup-not-found"     ["name"       <+> (Atom s)]
   | Conflict { old_db; new_db } -> error "conflict"                 ["old-hash"   <+> (Atom old_db.hash);
                                                                      "new-hash"   <+> (Atom new_db.hash)]
diff --git a/lib/listener.ml b/lib/listener.ml
index d7951aa..c706180 100644
--- a/lib/listener.ml
+++ b/lib/listener.ml
@@ -1,29 +1,40 @@
-module type LISTENER = functor (T : Transport.TRANSPORT)(S : Management.Physical.S with type error = string) -> sig
-  val run : T.t -> Management.Database.t -> S.t -> unit
+module type LISTENER = functor
+  (T : Transport.TRANSPORT)
+  (S : Management.Physical.S with type error = string)
+  -> sig
+  val run : T.t -> Catalog.t -> S.t -> unit
 end
 
+type connection_context = { mutable current_multigroup : string }
+
 module Make : LISTENER =
-  functor (T : Transport.TRANSPORT)(S : Management.Physical.S with type error = string) -> struct
+functor
+  (T : Transport.TRANSPORT)
+  (S : Management.Physical.S with type error = string)
+  ->
+  struct
     module type SubS = Sublanguage.S with type storage = S.t
+
     module BranchOps = Management.Branch.Make (S)
     module AlgebraOps = Algebra.Make (S)
+    module CatalogOps = Catalog.Make (S)
 
     let read_command input =
-      try
-        Ok (Sexplib.Sexp.input_sexp input)
-      with Sexplib.Sexp.Parse_error { err_msg ; _} ->
+      try Ok (Sexplib.Sexp.input_sexp input)
+      with Sexplib.Sexp.Parse_error { err_msg; _ } ->
         Error (Error.SyntaxError err_msg)
 
-    let sublanguages =          (* should this go here? *)
+    let sublanguages =
       List.fold_right
-        (fun (module Language : SubS) -> Utilities.StringMap.add Language.name (module Language : SubS))
+        (fun (module Language : SubS) ->
+          Utilities.StringMap.add Language.name (module Language : SubS))
         [
-          (module Drl.Sublanguage.Make(S) : SubS);
-          (module Ddl.Sublanguage.Make(S) : SubS);
-          (module Dml.Sublanguage.Make(S) : SubS);
-          (module Icl.Sublanguage.Make(S) : SubS);
-          (module Dcl.Sublanguage.Make(S) : SubS);
-          (module Scl.Sublanguage.Make(S) : SubS);
+          (module Drl.Sublanguage.Make (S) : SubS);
+          (module Ddl.Sublanguage.Make (S) : SubS);
+          (module Dml.Sublanguage.Make (S) : SubS);
+          (module Icl.Sublanguage.Make (S) : SubS);
+          (module Dcl.Sublanguage.Make (S) : SubS);
+          (module Scl.Sublanguage.Make (S) : SubS);
         ]
         Utilities.StringMap.empty
 
@@ -36,32 +47,46 @@ module Make : LISTENER =
     let execute storage db expr (module Language : SubS) =
       Language.parse_sexp expr
       |> fmap (Language.execute storage db)
-      |> Result.map_error (fun e -> Error.SublanguageError (Language.sexp_of_error e))
+      |> Result.map_error (fun e ->
+          Error.SublanguageError (Language.sexp_of_error e))
 
     let execute_command storage db = function
-      | Sexplib.Sexp.(List [Atom tag; expr]) ->
-         find_language tag
-         |> fmap (execute storage db expr)
+      | Sexplib.Sexp.(List [ Atom tag; expr ]) ->
+          find_language tag |> fmap (execute storage db expr)
       | s -> Error (Error.MalformedExpression s)
 
     let advance_head_branch storage new_hash =
       match BranchOps.get_head storage with
       | Ok (Some branch_name) ->
-         ignore (BranchOps.update_tip storage ~name:branch_name ~tip:new_hash)
+          ignore (BranchOps.update_tip storage ~name:branch_name ~tip:new_hash)
       | _ -> ()
 
-    let perform storage db_head old_db result =
+    let perform storage catalog ctx db_head old_db result =
       match result with
       | Sublanguage.Transition (new_db, _) ->
-         if Atomic.compare_and_set db_head old_db new_db
-         then (advance_head_branch storage new_db.hash; Ok result)
-         else Error (Error.Conflict { old_db; new_db })
+          if Atomic.compare_and_set db_head old_db new_db then (
+            advance_head_branch storage new_db.hash;
+            Ok result)
+          else Error (Error.Conflict { old_db; new_db })
+      | Sublanguage.SessionSwitch multigroup -> (
+          match CatalogOps.get catalog multigroup with
+          | None -> Error (Error.MultigroupNotFound multigroup)
+          | Some _ ->
+              ctx.current_multigroup <- multigroup;
+              Ok result)
+      | Sublanguage.CreateMultigroup name -> (
+          match
+            CatalogOps.add catalog storage
+              ~prelude_relations:Prelude.Standard.prelude_relations name
+          with
+          | Error e -> Error (Error.SyntaxError e)
+          | Ok _ -> Ok result)
       | _ -> Ok result
 
     let get_branch storage =
       match BranchOps.get_head storage with Ok (Some name) -> name | _ -> "--"
 
-    let current_limit = 16      (* TODO: make the limit per-connection? *)
+    let current_limit = 16 (* TODO: make the limit per-connection? *)
 
     let materialize_generator gen limit =
       let rec go gen pos acc count =
@@ -71,14 +96,14 @@ module Make : LISTENER =
           | Generator.Done -> (List.rev acc, false)
           | Generator.Error _ -> (List.rev acc, false)
           | Generator.Value (t, next) -> (
-            let mat =
-              match t with
-              | Tuple.Materialized m -> Some m
-              | Tuple.NonMaterialized _ -> None
-            in
-            match mat with
-            | None -> go next (pos + 1) acc count
-            | Some m -> go next (pos + 1) (m :: acc) (count + 1))
+              let mat =
+                match t with
+                | Tuple.Materialized m -> Some m
+                | Tuple.NonMaterialized _ -> None
+              in
+              match mat with
+              | None -> go next (pos + 1) acc count
+              | Some m -> go next (pos + 1) (m :: acc) (count + 1))
       in
       go gen 0 [] 0
 
@@ -88,48 +113,86 @@ module Make : LISTENER =
 
     let tuple_to_sexp (t : Tuple.materialized) =
       let open Sexplib.Sexp in
-      List (Tuple.AttributeMap.bindings t.Tuple.attributes
-            |> List.map (fun (k, attr) -> List [ Atom k; Conventions.AbstractValue.sexp_of_t attr.Attribute.value ]))
+      List
+        (Tuple.AttributeMap.bindings t.Tuple.attributes
+        |> List.map (fun (k, attr) ->
+            List
+              [
+                Atom k; Conventions.AbstractValue.sexp_of_t attr.Attribute.value;
+              ]))
 
     (* TODO: does our network protocol make sense? *)
     let serialize storage (db : Management.Database.t) =
       let open Sexplib.Sexp in
       function
-      | Error e -> List [ Atom "error"; (Error.sexp_of_error e) ]
+      | Error e -> List [ Atom "error"; Error.sexp_of_error e ]
       (* TODO: forsake the global cursor register in favour of per-connection bookkeeping *)
       | Ok (Sublanguage.Cursor { cursor_id; rows; has_more }) ->
-         let row_sexps = List.map tuple_to_sexp rows in
-         let rows_sexp = List row_sexps in
-         List [ Atom "cursor";
-                List [ Atom "id"; Atom cursor_id ];
-                List [ Atom "rows"; rows_sexp ];
-                List [ Atom "row_count"; Atom (string_of_int (List.length row_sexps)) ];
-                List [ Atom "has_more"; Atom (string_of_bool has_more) ];
-                List [ Atom "db_hash"; Atom db.hash ];
-                List [ Atom "db_name"; Atom db.name ];
-                List [ Atom "branch"; Atom (get_branch storage) ] ]
+          let row_sexps = List.map tuple_to_sexp rows in
+          let rows_sexp = List row_sexps in
+          List
+            [
+              Atom "cursor";
+              List [ Atom "id"; Atom cursor_id ];
+              List [ Atom "rows"; rows_sexp ];
+              List
+                [
+                  Atom "row_count"; Atom (string_of_int (List.length row_sexps));
+                ];
+              List [ Atom "has_more"; Atom (string_of_bool has_more) ];
+              List [ Atom "db_hash"; Atom db.hash ];
+              List [ Atom "db_name"; Atom db.name ];
+              List [ Atom "branch"; Atom (get_branch storage) ];
+            ]
       | Ok (Sublanguage.Query rel) ->
-         let tuples, truncated = materialize_relation storage rel current_limit in
-         let schema_sexp = List (List.map (fun (a, d) -> List [ Atom a; Atom d ]) rel.Relation.schema) in
-         let rows_sexp = List (List.map tuple_to_sexp tuples) in
-         List [ Atom "relation";
-                List [ Atom "name"; Atom rel.Relation.name ];
-                List [ Atom "schema"; schema_sexp ];
-                List [ Atom "rows"; rows_sexp ];
-                List [ Atom "row_count"; Atom (string_of_int (List.length tuples)) ];
-                List [ Atom "truncated"; Atom (string_of_bool truncated) ];
-                List [ Atom "db_hash"; Atom db.hash ];
-                List [ Atom "db_name"; Atom db.name ];
-                List [ Atom "branch"; Atom (get_branch storage) ] ]
+          let tuples, truncated =
+            materialize_relation storage rel current_limit
+          in
+          let schema_sexp =
+            List
+              (List.map
+                 (fun (a, d) -> List [ Atom a; Atom d ])
+                 rel.Relation.schema)
+          in
+          let rows_sexp = List (List.map tuple_to_sexp tuples) in
+          List
+            [
+              Atom "relation";
+              List [ Atom "name"; Atom rel.Relation.name ];
+              List [ Atom "schema"; schema_sexp ];
+              List [ Atom "rows"; rows_sexp ];
+              List
+                [ Atom "row_count"; Atom (string_of_int (List.length tuples)) ];
+              List [ Atom "truncated"; Atom (string_of_bool truncated) ];
+              List [ Atom "db_hash"; Atom db.hash ];
+              List [ Atom "db_name"; Atom db.name ];
+              List [ Atom "branch"; Atom (get_branch storage) ];
+            ]
       | Ok (Sublanguage.Transition (new_db, message)) ->
-         List [ Atom "ok";
-                List [ Atom "message"; Atom message ];
-                List [ Atom "db_hash"; Atom new_db.hash ];
-                List [ Atom "db_name"; Atom new_db.name ];
-                (* TODO: `serialize' shouldn't need access to the storage layer *)
-                List [ Atom "branch"; Atom (get_branch storage) ] ]
-
-    let print_with_time str =   (* TODO: a proper logger *)
+          List
+            [
+              Atom "ok";
+              List [ Atom "message"; Atom message ];
+              List [ Atom "db_hash"; Atom new_db.hash ];
+              List [ Atom "db_name"; Atom new_db.name ];
+              (* TODO: `serialize' shouldn't need access to the storage layer *)
+              List [ Atom "branch"; Atom (get_branch storage) ];
+            ]
+      | Ok (Sublanguage.SessionSwitch multigroup) ->
+          List
+            [
+              Atom "ok";
+              List [ Atom "message"; Atom ("Switched to multigroup " ^ multigroup) ];
+            ]
+      | Ok (Sublanguage.CreateMultigroup name) ->
+          List
+            [
+              Atom "ok";
+              List [ Atom "message"; Atom ("Multigroup " ^ name ^ " created") ];
+            ]
+
+    let print_with_time str =
+      (* TODO: a proper logger *)
       let now = Unix.gettimeofday () in
       let tm = Unix.localtime now in
       let orange = "\027[38;5;208m" in
@@ -139,50 +202,58 @@ module Make : LISTENER =
           (tm.Unix.tm_mon + 1) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min
           tm.Unix.tm_sec
       in
-      print_endline @@ Printf.sprintf "%s[%s]%s %s" orange formatted_time reset str
+      print_endline
+      @@ Printf.sprintf "%s[%s]%s %s" orange formatted_time reset str
 
-    let output_response output sexp =
+    let output_response out_ch sexp =
       let response = Sexplib.Sexp.to_string sexp in
-      output_string output response;
-      (* Some programs, like our current iteration of
-       * relational-explorer, expect server responses to always end
-       * with a newline. Although that is technically incorrect,
-       * acommodating for it doesn't bring us much harm; thus:
-       *)
-      output_string output "\n";
-      flush output;
+      output_string out_ch response;
+      output_string out_ch "\n";
+      flush out_ch;
       print_with_time response
 
-    let handle_client connection db_head (storage : S.t) =
+    let resolve_db_ref catalog ctx =
+      match CatalogOps.get catalog ctx.current_multigroup with
+      | Some db_ref -> Ok db_ref
+      | None -> Error (Error.MultigroupNotFound ctx.current_multigroup)
+
+    let fallback_db ctx = Management.Database.empty ~name:ctx.current_multigroup
+
+    let send_serialized storage out_ch db result =
+      serialize storage db result |> output_response out_ch
+
+    let handle_sublanguage storage catalog ctx out_ch sexp =
+      match resolve_db_ref catalog ctx with
+      | Error e -> send_serialized storage out_ch (fallback_db ctx) (Error e)
+      | Ok db_ref ->
+          let db = Atomic.get db_ref in
+          Ok sexp
+          |> fmap (execute_command storage db)
+          |> fmap (perform storage catalog ctx db_ref db)
+          |> send_serialized storage out_ch db
+
+    let handle_client connection catalog (storage : S.t) =
       let input = T.input connection in
       let output = T.output connection in
+      let ctx = { current_multigroup = catalog.Catalog.default_multigroup } in
       try
         while true do
-          let db = Atomic.get db_head in
-          read_command input
-          |> fmap (execute_command storage db)
-          |> fmap (perform storage db_head db)
-          |> serialize storage db
-          |> output_response output
-          |> ignore
+          match read_command input with
+          | Error e ->
+              send_serialized storage output (fallback_db ctx) (Error e)
+          | Ok sexp -> handle_sublanguage storage catalog ctx output sexp
         done
       with
-        End_of_file -> ()
-      (* TODO: use the logger instead *)
-      | e -> Printf.eprintf "Error handling connection: %s" (Printexc.to_string e)
-
-    let spawn_handler db_head storage connection =
-      Stdlib.Domain.spawn (fun () -> handle_client connection db_head storage)
-
-    let run transport db storage =
-      (* TODO: consider how to handle multiple databases within a
-       * single server (a catalog perhaps?)
-       *)
-      let db_head = Atomic.make db in
+      | End_of_file -> ()
+      | e ->
+          Printf.eprintf "Error handling connection: %s" (Printexc.to_string e)
+
+    let spawn_handler catalog storage connection =
+      Stdlib.Domain.spawn (fun () -> handle_client connection catalog storage)
+
+    let run transport catalog storage =
       T.listen transport;
       while true do
-        T.accept transport
-        |> spawn_handler db_head storage
-        |> ignore
+        T.accept transport |> spawn_handler catalog storage |> ignore
       done
   end
diff --git a/lib/management/branch.ml b/lib/management/branch.ml
index 1d218b1..81dcdff 100644
--- a/lib/management/branch.ml
+++ b/lib/management/branch.ml
@@ -78,7 +78,7 @@ module Make (Storage : Physical.S with type error = string) = struct
     let mk v = { Attribute.value = Obj.repr v } in
     let rec generator position =
       match position with
-      | None -> Generator.Error "random access not supported for sakura:branch"
+      | None -> Generator.Error "random access not supported for public:branch"
       | Some pos -> (
           match list storage with
           | Error _ -> Generator.Done
@@ -109,7 +109,7 @@ module Make (Storage : Physical.S with type error = string) = struct
     let mk v = { Attribute.value = Obj.repr v } in
     let generator position =
       match position with
-      | None -> Generator.Error "random access not supported for sakura:head"
+      | None -> Generator.Error "random access not supported for public:head"
       | Some 0 -> (
           match get_head storage with
           | Ok None | Error _ -> Generator.Done
diff --git a/lib/management/database.ml b/lib/management/database.ml
index f4d18e8..b8a9829 100644
--- a/lib/management/database.ml
+++ b/lib/management/database.ml
@@ -6,6 +6,9 @@
    reconstruct a past state from a hash alone without a separate snapshot
    store. Either cap the history or make it actually useful. *)
 
+(* TODO: refactor RelationMap keying from composite "schema:relation" strings
+   to nested maps (schema -> relation -> Relation.t) for cleaner semantics.
+   Currently, callers are responsible for passing composite keys. *)
 module RelationMap = Map.Make (String)
 
 type deferred_entry = {
diff --git a/lib/manipulation.ml b/lib/manipulation.ml
index 91cd35d..acf6068 100644
--- a/lib/manipulation.ml
+++ b/lib/manipulation.ml
@@ -14,9 +14,9 @@
 
 module RelationMap = Management.Database.RelationMap
 
-(** Build membership criteria from schema (validates type membership).
-    Returns a function that takes a tree-lookup function and a tuple, checking
-    schema conformance and tree membership at call time. *)
+(** Build membership criteria from schema (validates type membership). Returns a
+    function that takes a tree-lookup function and a tuple, checking schema
+    conformance and tree membership at call time. *)
 let build_membership_criteria ~name schema :
     (string -> Merkle.t option) -> Tuple.t -> bool =
   let value_conforms_to_domain domain_name (value : Conventions.AbstractValue.t)
@@ -55,7 +55,8 @@ let build_membership_criteria ~name schema :
              schema
 
 let tree_of_db (db : Management.Database.t) name =
-  Option.bind (Management.Database.get_relation db name) (fun r -> r.Relation.tree)
+  Option.bind (Management.Database.get_relation db name) (fun r ->
+      r.Relation.tree)
 
 module Constraint = struct
   include Constraint
@@ -79,6 +80,35 @@ module Make (Storage : Management.Physical.S) = struct
   let of_string_error s = Error.StorageError s
   let ( let* ) = Result.bind
 
+  let normalize_name n = Qualified_name.(parse n |> to_key)
+
+  let rec normalize_constraint_body c =
+    match c with
+    | Constraint.MemberOf { target; binding } ->
+        Constraint.MemberOf { target = normalize_name target; binding }
+    | Constraint.Not { body; universe } ->
+        Constraint.Not
+          {
+            body = normalize_constraint_body body;
+            universe = normalize_name universe;
+          }
+    | Constraint.And cs -> Constraint.And (List.map normalize_constraint_body cs)
+    | Constraint.Or cs -> Constraint.Or (List.map normalize_constraint_body cs)
+    | Constraint.Exists { variable; quantifier; body } ->
+        Constraint.Exists
+          {
+            variable;
+            quantifier = normalize_name quantifier;
+            body = normalize_constraint_body body;
+          }
+    | Constraint.Forall { variable; quantifier; body } ->
+        Constraint.Forall
+          {
+            variable;
+            quantifier = normalize_name quantifier;
+            body = normalize_constraint_body body;
+          }
+
   let fold_result (f : 'a -> 'b -> ('a, error) Result.t) (init : 'a)
       (xs : 'b list) : ('a, error) Result.t =
     List.fold_left
@@ -108,7 +138,8 @@ module Make (Storage : Management.Physical.S) = struct
       match Storage.load_raw storage hash with
       | Error _ | Ok None -> None
       | Ok (Some bytes) ->
-          load_attrs [] (Storable.Tuple.of_bytes bytes).Storable.Tuple.attributes
+          load_attrs []
+            (Storable.Tuple.of_bytes bytes).Storable.Tuple.attributes
     in
     let rec load_all acc = function
       | [] -> Some (List.rev acc)
@@ -218,7 +249,8 @@ module Make (Storage : Management.Physical.S) = struct
           Relation.make ~hash:(Some rel_hash) ~name:stored.name
             ~schema:stored.schema ~tree:(Some tree) ~constraints:None
             ~cardinality:stored.cardinality ~generator:None
-            ~membership_criteria:(build_membership_criteria ~name:stored.name stored.schema)
+            ~membership_criteria:
+              (build_membership_criteria ~name:stored.name stored.schema)
             ~provenance:(Relation.Provenance.Base stored.name)
             ~lineage:(Relation.Lineage.Base stored.name)
         in
@@ -527,7 +559,10 @@ module Make (Storage : Management.Physical.S) = struct
       =
     let name = relation.name in
     let* () = ensure_relation_exists db name in
-    if not (relation.membership_criteria (tree_of_db db) (Tuple.Materialized tuple)) then
+    if
+      not
+        (relation.membership_criteria (tree_of_db db) (Tuple.Materialized tuple))
+    then
       Error
         (Error.ConstraintViolation "Tuple does not satisfy membership criteria")
     else
@@ -623,7 +658,7 @@ module Make (Storage : Management.Physical.S) = struct
       (relation : Relation.t) : (Management.Database.t, error) Result.t =
     if Prelude.Catalog.is_catalog_relation relation.name then Ok db
     else
-      (* Insert into sakura:relation *)
+      (* Insert into public:relation *)
       match
         Management.Database.get_relation db Prelude.Catalog.relation_rel_name
       with
@@ -631,7 +666,7 @@ module Make (Storage : Management.Physical.S) = struct
       | Some rel_cat -> (
           let rel_tuple = Prelude.Catalog.build_relation_tuple relation.name in
           let* db, _, _ = create_tuple storage db rel_cat rel_tuple in
-          (* Insert into sakura:attribute for each schema entry *)
+          (* Insert into public:attribute for each schema entry *)
           match
             Management.Database.get_relation db
               Prelude.Catalog.attribute_rel_name
@@ -671,7 +706,7 @@ module Make (Storage : Management.Physical.S) = struct
               Ok new_db
             else Ok db
       in
-      (* Remove attribute tuples for this relation from sakura:attribute *)
+      (* Remove attribute tuples for this relation from public:attribute *)
       let attr_tuples =
         Prelude.Catalog.build_attribute_tuples ~relation_name:relation.name
           relation.schema
@@ -745,6 +780,11 @@ module Make (Storage : Management.Physical.S) = struct
         (List.map Prelude.Catalog.build_domain_tuple
            [ "integer"; "natural"; "rational"; "string" ])
     in
+    let* schema_rel = get_required db Prelude.Catalog.schema_rel_name in
+    let* db, _, _ =
+      create_tuples storage db schema_rel
+        [ Prelude.Catalog.build_schema_tuple Qualified_name.default_schema ]
+    in
     Ok db
 
   (*
@@ -753,7 +793,7 @@ module Make (Storage : Management.Physical.S) = struct
 
   (** Register a domain in the database. Can be called after [create_database]
       to add user-defined domains (e.g. [money], [email], [uuid]). Also inserts
-      a tuple into [sakura:domain] if the catalog is live. *)
+      a tuple into [public:domain] if the catalog is live. *)
   let register_domain (storage : storage) (db : Management.Database.t)
       (domain : Domain.t) : (Management.Database.t, error) Result.t =
     let db = Management.Database.add_domain db domain in
@@ -788,10 +828,11 @@ module Make (Storage : Management.Physical.S) = struct
       *)
 
   (** Create a new empty relation with the given schema. Also updates
-      [sakura:relation] and [sakura:attribute] in the system catalog. *)
+      [public:relation] and [public:attribute] in the system catalog. *)
   let create_relation (storage : storage) (db : Management.Database.t)
       ~(name : string) ~(schema : Schema.t) :
       (Management.Database.t * Relation.t, error) Result.t =
+    let name = normalize_name name in
     if Management.Database.has_relation db name then
       Error (Error.RelationAlreadyExists name)
     else
@@ -817,6 +858,7 @@ module Make (Storage : Management.Physical.S) = struct
       ~(membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool)
       ~(cardinality : Conventions.Cardinality.t) :
       (Management.Database.t * Relation.t, error) Result.t =
+    let name = normalize_name name in
     if Management.Database.has_relation db name then
       Error (Error.RelationAlreadyExists name)
     else
@@ -837,9 +879,10 @@ module Make (Storage : Management.Physical.S) = struct
       Ok (final_db, relation)
 
   (** Remove a relation from the database. Also removes its entries from
-      [sakura:relation] and [sakura:attribute]. *)
+      [public:relation] and [public:attribute]. *)
   let retract_relation (storage : storage) (db : Management.Database.t)
       ~(name : string) : (Management.Database.t, error) Result.t =
+    let name = normalize_name name in
     match Management.Database.get_relation db name with
     | None -> Error (Error.RelationNotFound name)
     | Some relation ->
@@ -884,6 +927,7 @@ module Make (Storage : Management.Physical.S) = struct
       (db : Management.Database.t) ~(relation_name : string)
       ~(constraints : Relation.RelationConstraint.t) :
       (Management.Database.t * Relation.t, error) Result.t =
+    let relation_name = normalize_name relation_name in
     match Management.Database.get_relation db relation_name with
     | None -> Error (Error.RelationNotFound relation_name)
     | Some relation ->
@@ -917,10 +961,12 @@ module Make (Storage : Management.Physical.S) = struct
         Ok (new_db, new_relation)
 
   (** Register a named constraint on a relation. Attaches the constraint body to
-      the relation AND records it in [sakura:constraint]. *)
+      the relation AND records it in [public:constraint]. *)
   let register_constraint (storage : storage) (db : Management.Database.t)
       ~(constraint_name : string) ~(relation_name : string)
       ~(body : Constraint.t) : (Management.Database.t, error) Result.t =
+    let relation_name = normalize_name relation_name in
+    let body = normalize_constraint_body body in
     let* db, _ =
       update_relation_constraints storage db ~relation_name
         ~constraints:[ (constraint_name, body) ]
@@ -945,7 +991,7 @@ module Make (Storage : Management.Physical.S) = struct
   (** Get relation by name from database *)
   let get_relation (db : Management.Database.t) ~(name : string) :
       Relation.t option =
-    Management.Database.get_relation db name
+    Management.Database.get_relation db (normalize_name name)
 
   (** Count tuples in a relation *)
   let tuple_count (relation : Relation.t) : int =
@@ -966,6 +1012,8 @@ module Make (Storage : Management.Physical.S) = struct
       ~(constraint_name : string) ~(relation_name : string)
       ~(body : Constraint.t) ~(timing : Constraint.timing) :
       (Management.Database.t, error) Result.t =
+    let relation_name = normalize_name relation_name in
+    let body = normalize_constraint_body body in
     let* db, _ =
       update_relation_constraints storage db ~relation_name
         ~constraints:[ (constraint_name, body) ]
diff --git a/lib/prelude/catalog.ml b/lib/prelude/catalog.ml
index ce36f1e..743d397 100644
--- a/lib/prelude/catalog.ml
+++ b/lib/prelude/catalog.ml
@@ -1,13 +1,13 @@
 (** 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.
-*)
+    manipulation dependency. Consumed by {!Manipulation.Make} and
+    {!Catalog.Make} to bootstrap the catalog relations that make each multigroup
+    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 catalog_prefix = "public:"
 let relation_rel_name = catalog_prefix ^ "relation"
 let domain_rel_name = catalog_prefix ^ "domain"
 let attribute_rel_name = catalog_prefix ^ "attribute"
@@ -16,7 +16,10 @@ 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 multigroup_rel_name = catalog_prefix ^ "multigroup"
+let schema_rel_name = catalog_prefix ^ "schema"
 
+(** Relations present in every multigroup's catalog. *)
 let catalog_relation_names =
   [
     relation_rel_name;
@@ -25,9 +28,16 @@ let catalog_relation_names =
     constraint_rel_name;
     on_rel_name;
     timing_rel_name;
+    schema_rel_name;
   ]
 
-let is_catalog_relation name = List.mem name catalog_relation_names
+(** 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 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"
 
@@ -43,7 +53,10 @@ let constraint_schema : Schema.t =
 
 let on_schema : Schema.t = Schema.empty |> Schema.add "event" "string"
 let timing_schema : Schema.t = Schema.empty |> Schema.add "timing" "string"
+let multigroup_schema : Schema.t = Schema.empty |> Schema.add "name" "string"
+let schema_schema : Schema.t = Schema.empty |> Schema.add "name" "string"
 
+(** Definitions seeded into every multigroup. *)
 let catalog_definitions =
   [
     (relation_rel_name, relation_schema);
@@ -52,8 +65,12 @@ let catalog_definitions =
     (constraint_rel_name, constraint_schema);
     (on_rel_name, on_schema);
     (timing_rel_name, timing_schema);
+    (schema_rel_name, schema_schema);
   ]
 
+(** Extra definitions seeded only into the sakura meta-multigroup. *)
+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. *)
@@ -115,3 +132,20 @@ let build_timing_tuple timing : Tuple.materialized =
       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 };
+  }
+
+let build_schema_tuple schema_name : Tuple.materialized =
+  {
+    Tuple.relation = schema_rel_name;
+    attributes =
+      Tuple.AttributeMap.singleton "name"
+        { Attribute.value = Obj.magic schema_name };
+  }
+
diff --git a/lib/prelude/standard.ml b/lib/prelude/standard.ml
index 6822f19..2a507e5 100644
--- a/lib/prelude/standard.ml
+++ b/lib/prelude/standard.ml
@@ -328,3 +328,15 @@ let divide_natural : Relation.t =
     ~generator:(Some generator) ~membership_criteria
     ~provenance:(Relation.Provenance.Base "divide")
     ~lineage:(Relation.Lineage.Base "divide")
+
+let prelude_relations =
+  [ less_than_natural
+  ; less_than_or_equal_natural
+  ; greater_than_natural
+  ; greater_than_or_equal_natural
+  ; equal_natural
+  ; not_equal_natural
+  ; plus_natural
+  ; times_natural
+  ; minus_natural
+  ; divide_natural ]
diff --git a/lib/qualified_name.ml b/lib/qualified_name.ml
new file mode 100644
index 0000000..b6d01bb
--- /dev/null
+++ b/lib/qualified_name.ml
@@ -0,0 +1,31 @@
+(** Fully qualified relation name: [multigroup:schema:relation].
+
+    Splits on [:], fills defaults for missing parts.
+    - ["relation"]             -> { multigroup=""; schema="public"; relation }
+    - ["schema:relation"]      -> { multigroup=""; schema; relation }
+    - ["mg:schema:relation"]   -> { multigroup=mg; schema; relation }
+*)
+
+type t = {
+  multigroup : string;
+  schema : string;
+  relation : string;
+}
+
+let default_schema = "public"
+
+let parse s =
+  match String.split_on_char ':' s with
+  | [ rel ] -> { multigroup = ""; schema = default_schema; relation = rel }
+  | [ schema; rel ] -> { multigroup = ""; schema; relation = rel }
+  | [ mg; schema; rel ] -> { multigroup = mg; schema; relation = rel }
+  | _ -> { multigroup = ""; schema = default_schema; relation = s }
+
+let make ?(multigroup = "") ?(schema = default_schema) relation =
+  { multigroup; schema; relation }
+
+let to_string { multigroup; schema; relation } =
+  if multigroup = "" then schema ^ ":" ^ relation
+  else multigroup ^ ":" ^ schema ^ ":" ^ relation
+
+let to_key { schema; relation; _ } = schema ^ ":" ^ relation
diff --git a/lib/qualified_name.mli b/lib/qualified_name.mli
new file mode 100644
index 0000000..9bee0c9
--- /dev/null
+++ b/lib/qualified_name.mli
@@ -0,0 +1,24 @@
+(** Fully qualified relation name: [multigroup:schema:relation].
+
+    Unqualified names fill in defaults: empty multigroup, ["public"] schema. *)
+
+type t = {
+  multigroup : string;
+  schema : string;
+  relation : string;
+}
+
+val default_schema : string
+
+(** Split on [:] with default filling.
+    - ["rel"]           -> multigroup="", schema="public", relation="rel"
+    - ["s:rel"]         -> multigroup="", schema="s",      relation="rel"
+    - ["mg:s:rel"]      -> multigroup="mg", schema="s",    relation="rel" *)
+val parse : string -> t
+
+val make : ?multigroup:string -> ?schema:string -> string -> t
+val to_string : t -> string
+
+(** Composite key for [RelationMap] lookup within a single database:
+    ["schema:relation"]. *)
+val to_key : t -> string
diff --git a/lib/sublanguage_types.ml b/lib/sublanguage_types.ml
index b4b6b29..d82d6aa 100644
--- a/lib/sublanguage_types.ml
+++ b/lib/sublanguage_types.ml
@@ -8,3 +8,5 @@ type result =
   | Query of Relation.t
   | Transition of Management.Database.t * string
   | Cursor of cursor_result
+  | SessionSwitch of string
+  | CreateMultigroup of string
\ No newline at end of file
diff --git a/lib/system.ml b/lib/system.ml
index 4280dda..14ef089 100644
--- a/lib/system.ml
+++ b/lib/system.ml
@@ -38,33 +38,6 @@ let registry : registry =
              let transport = Transport.TCP.create config in
              Ok (TransportParcel ((module Transport.TCP), transport))) }
 
-let initialize_multigroup create_immutable_relation storage multigroup =
-  let open Prelude.Standard in
-  List.fold_left
-    (fun multigroup (rel : Relation.t) ->
-      match
-        create_immutable_relation storage multigroup ~name:rel.name
-          ~schema:rel.schema ~generator:(Option.get rel.generator)
-          ~membership_criteria:rel.membership_criteria
-          ~cardinality:rel.cardinality
-      with
-      | Ok (new_multigroup, _) -> new_multigroup
-      | Error e ->
-          Printf.eprintf
-            "Warning: failed to register prelude relation %s: %s\n%!" rel.name
-            (Sexplib.Sexp.to_string (Error.sexp_of_error e));
-          multigroup)
-    multigroup
-    [ less_than_natural;
-      less_than_or_equal_natural;
-      greater_than_natural;
-      greater_than_or_equal_natural;
-      equal_natural;
-      not_equal_natural;
-      plus_natural;
-      times_natural;
-      minus_natural;
-      divide_natural ]
 
 let assemble (config : Configuration.t) : (unit -> unit, string) result =
   let open Utilities.Result in
@@ -93,15 +66,13 @@ let assemble (config : Configuration.t) : (unit -> unit, string) result =
   let* packed_transport = transport_provider transport_body in
   let (StorageParcel ((module S), storage)) = packed_storage in
   let (TransportParcel ((module T), transport)) = packed_transport in
-  let module Manip = Manipulation.Make (S) in
-  let* multigroup =
-    Manip.create_database storage ~name:"sakura"
-    |> Result.map (initialize_multigroup Manip.create_immutable_relation storage)
-    |> Result.map_error (fun _ -> "Failed to create initial database")
+  let module C = Catalog.Make (S) in
+  let* catalog =
+    C.create storage ~prelude_relations:Prelude.Standard.prelude_relations
   in
   let module L = Listener.Make (T) (S) in
   Ok (fun () -> Scl.Executor.set_sessions (Session.create ());
-                L.run transport multigroup storage)
+                L.run transport catalog storage)
 
 let run_from_config (path : string) : (unit -> unit, string) result =
   let ( let* ) = Result.bind in