domains

3 files changed, 153 insertions, 5 deletions

diff --git a/lib/management/database.ml b/lib/management/database.ml
index 1e68402..e4705e5 100644
--- a/lib/management/database.ml
+++ b/lib/management/database.ml
@@ -15,6 +15,7 @@ type t = {
   name : Conventions.Name.t;
   tree : Merkle.t;
   relations : Relation.t RelationMap.t;  (* Stores actual relations, not just hashes *)
+  domains : Domain.t RelationMap.t;      (* Domain registry: prelude + user-defined *)
   history : Conventions.Hash.t list;
   timestamp : float;
 }
@@ -24,6 +25,7 @@ let empty ~name = {
   name;
   tree = Merkle.empty;
   relations = RelationMap.empty;
+  domains = RelationMap.empty;
   history = [];
   timestamp = Unix.gettimeofday ();
 }
@@ -47,6 +49,7 @@ let update_state db ~relations ~tree =
     name = db.name;
     tree;
     relations;
+    domains = db.domains;
     history;
     timestamp = Unix.gettimeofday ();
   }
@@ -95,3 +98,28 @@ let update_relation db ~(relation : Relation.t) =
     let tree = db.tree |> Merkle.delete old_hash |> Merkle.insert new_hash in
     let relations = RelationMap.add name relation db.relations in
     update_state db ~relations ~tree
+
+(* ============================================================================
+   Domain Registry - prelude and user-defined domains
+   ============================================================================ *)
+
+(** Register a domain in the database.  Overwrites any existing domain with
+    the same name, allowing user-defined domains to shadow prelude ones. *)
+let add_domain db (domain : Domain.t) =
+  { db with domains = RelationMap.add domain.name domain db.domains }
+
+(** Look up a domain by name *)
+let get_domain db name =
+  RelationMap.find_opt name db.domains
+
+(** List all registered domain names *)
+let get_domain_names db =
+  RelationMap.fold (fun name _ acc -> name :: acc) db.domains []
+
+(** Check whether a domain is registered *)
+let has_domain db name =
+  RelationMap.mem name db.domains
+
+(** Remove a domain from the registry *)
+let remove_domain db name =
+  { db with domains = RelationMap.remove name db.domains }
diff --git a/lib/manipulation.ml b/lib/manipulation.ml
index 50722a8..283641a 100644
--- a/lib/manipulation.ml
+++ b/lib/manipulation.ml
@@ -150,6 +150,7 @@ module Make (Storage : Management.Physical.S) = struct
           name = stored.name;
           tree;
           relations;
+          domains = Management.Database.RelationMap.empty;
           history = stored.history;
           timestamp = stored.timestamp;
         })
@@ -158,12 +159,19 @@ module Make (Storage : Management.Physical.S) = struct
      Database Operations
      ============================================================================ *)
 
-  (** Create a new database with standard domain relations *)
+  (** Register a domain in the database.  Can be called after [create_database]
+      to add user-defined domains (e.g. [money], [email], [uuid]). *)
+  let register_domain (db : Management.Database.t) (domain : Domain.t)
+    : Management.Database.t =
+    Management.Database.add_domain db domain
+
+  (** Create a new database pre-seeded with the standard prelude domains. *)
   let create_database ~name : Management.Database.t =
-    let db = Management.Database.empty ~name in
-    (* Add standard domain relations: integer, natural, string, etc. *)
-    (* For now, just return empty database. Prelude can be added later. *)
-    db
+    let seed domains db =
+      List.fold_left Management.Database.add_domain db domains
+    in
+    Management.Database.empty ~name
+    |> seed Prelude.Domains.[integer; natural; rational; string]
 
   (** Get database history *)
   let database_history (db : Management.Database.t) : Conventions.Hash.t list =
diff --git a/lib/prelude/domains.ml b/lib/prelude/domains.ml
new file mode 100644
index 0000000..bc1716a
--- /dev/null
+++ b/lib/prelude/domains.ml
@@ -0,0 +1,112 @@
+(** Predefined fundamental domains, ported from the Erlang implementation.
+    Each domain carries a generator (for enumeration) and membership criteria
+    (for validation). Values are stored as {!Conventions.AbstractValue.t} via
+    [Obj.magic], following the same convention as {!Standard}. *)
+
+(** Bijection from natural number to integer: 0→0, 1→1, 2→-1, 3→2, 4→-2, … *)
+let nat_to_int n =
+  if n = 0 then 0
+  else if n mod 2 = 1 then (n + 1) / 2
+  else -(n / 2)
+
+(** Cantor pairing inverse: given position [n], returns a pair [(a, b)] of
+    natural numbers such that [a + b] lies on the [n]-th diagonal. *)
+let cantor_unpair n =
+  let w =
+    int_of_float (floor ((sqrt (float_of_int (8 * n + 1)) -. 1.) /. 2.))
+  in
+  let t = (w * (w + 1)) / 2 in
+  let b = n - t in
+  let a = w - b in
+  (a, b)
+
+(** Integer domain: all integers, enumerated via a bijection from the naturals.
+    Schema: [value: integer]. *)
+let integer : Domain.t =
+  let rec generator (position : int option) : Generator.result =
+    match position with
+    | Some n ->
+      let v = nat_to_int n in
+      let attributes = Tuple.AttributeMap.of_list [ ("value", Obj.magic v) ] in
+      Generator.Value
+        (Tuple.make_materialized ~relation:"integer" ~attributes, generator)
+    | None ->
+      Generator.Error
+        "Cannot produce a randomly enumerated value for the integer domain."
+  in
+  let membership_criteria : Tuple.t -> bool = function
+    | Tuple.Materialized _ -> true
+    | Tuple.NonMaterialized _ -> false
+  in
+  Domain.make ~name:"integer" ~generator ~membership_criteria
+    ~cardinality:Conventions.Cardinality.AlephZero
+
+(** Natural number domain: non-negative integers (0, 1, 2, …).
+    Schema: [value: natural]. *)
+let natural : Domain.t =
+  let rec generator (position : int option) : Generator.result =
+    match position with
+    | Some n ->
+      let attributes = Tuple.AttributeMap.of_list [ ("value", Obj.magic n) ] in
+      Generator.Value
+        (Tuple.make_materialized ~relation:"natural" ~attributes, generator)
+    | None ->
+      Generator.Error
+        "Cannot produce a randomly enumerated value for the natural domain."
+  in
+  let membership_criteria : Tuple.t -> bool = function
+    | Tuple.Materialized m -> (
+      match Tuple.AttributeMap.find_opt "value" m.attributes with
+      | Some attr -> (Obj.magic attr : int) >= 0
+      | None -> false)
+    | Tuple.NonMaterialized _ -> false
+  in
+  Domain.make ~name:"natural" ~generator ~membership_criteria
+    ~cardinality:Conventions.Cardinality.AlephZero
+
+(** Rational number domain: pairs [(numerator, denominator)] where the
+    denominator is never zero.  The generator enumerates all such pairs via
+    Cantor pairing on the integers.
+    Schema: [numerator: integer, denominator: integer]. *)
+let rational : Domain.t =
+  let rec generator (position : int option) : Generator.result =
+    match position with
+    | Some n ->
+      let a, b = cantor_unpair n in
+      let num = nat_to_int a in
+      (* Map b → non-zero integer: 0→1, 1→-1, 2→2, 3→-2, … *)
+      let den =
+        if b mod 2 = 0 then b / 2 + 1 else -((b + 1) / 2)
+      in
+      let attributes =
+        Tuple.AttributeMap.of_list
+          [ ("numerator", Obj.magic num); ("denominator", Obj.magic den) ]
+      in
+      Generator.Value
+        (Tuple.make_materialized ~relation:"rational" ~attributes, generator)
+    | None ->
+      Generator.Error
+        "Cannot produce a randomly enumerated value for the rational domain."
+  in
+  let membership_criteria : Tuple.t -> bool = function
+    | Tuple.Materialized m -> (
+      match Tuple.AttributeMap.find_opt "denominator" m.attributes with
+      | Some attr -> (Obj.magic attr : int) <> 0
+      | None -> false)
+    | Tuple.NonMaterialized _ -> false
+  in
+  Domain.make ~name:"rational" ~generator ~membership_criteria
+    ~cardinality:Conventions.Cardinality.AlephZero
+
+(** String domain: any string value.  Not enumerable.
+    Schema: [value: string]. *)
+let string : Domain.t =
+  let generator (_ : int option) : Generator.result =
+    Generator.Error "Strings are not enumerable."
+  in
+  let membership_criteria : Tuple.t -> bool = function
+    | Tuple.Materialized _ -> true
+    | Tuple.NonMaterialized _ -> false
+  in
+  Domain.make ~name:"string" ~generator ~membership_criteria
+    ~cardinality:Conventions.Cardinality.AlephZero