Multigroup unified reference for hierarchical access

2 files changed, 151 insertions, 68 deletions

diff --git a/lib/prelude/domains.ml b/lib/prelude/domains.ml
index d892696..022cc6b 100644
--- a/lib/prelude/domains.ml
+++ b/lib/prelude/domains.ml
@@ -1,9 +1,9 @@
-(** 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}. *)
+(** Predefined fundamental domains. 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, … *)
+(** 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)
 
@@ -20,7 +20,7 @@ let cantor_unpair n =
 
 (** Integer domain: all integers, enumerated via a bijection from the naturals.
     Schema: [value: integer]. *)
-let integer : Domain.t =
+let integer : Relation.domain =
   let rec generator (position : int option) : Generator.result =
     match position with
     | Some n ->
@@ -38,13 +38,23 @@ let integer : Domain.t =
     | Tuple.Materialized _ -> true
     | Tuple.NonMaterialized _ -> false
   in
-  Domain.make ~name:"integer" ~generator ~membership_criteria
-    ~cardinality:Conventions.Cardinality.AlephZero ~compare:(fun a b ->
-      Stdlib.compare (Obj.magic a : int) (Obj.magic b : int))
+  let schema =
+    Schema.empty
+    |> Schema.add "value" "integer"
+  in
+  new Relation.domain
+    ~name:"integer"
+    ~generator
+    ~membership_criteria
+    ~schema
+    ~constraints:None
+    ~cardinality:Conventions.Cardinality.AlephZero
+    ~lineage:None
+    ~provenance:None
 
 (** Natural number domain: non-negative integers (0, 1, 2, …). Schema:
     [value: natural]. *)
-let natural : Domain.t =
+let natural : Relation.domain =
   let rec generator (position : int option) : Generator.result =
     match position with
     | Some n ->
@@ -64,15 +74,25 @@ let natural : Domain.t =
         | None -> false)
     | Tuple.NonMaterialized _ -> false
   in
-  Domain.make ~name:"natural" ~generator ~membership_criteria
-    ~cardinality:Conventions.Cardinality.AlephZero ~compare:(fun a b ->
-      Stdlib.compare (Obj.magic a : int) (Obj.magic b : int))
+  let schema =
+    Schema.empty
+    |> Schema.add "value" "natural"
+  in
+  new Relation.domain
+    ~name:"natural"
+    ~generator
+    ~membership_criteria
+    ~schema
+    ~constraints:None
+    ~cardinality:Conventions.Cardinality.AlephZero
+    ~lineage:None
+    ~provenance:None
 
 (** 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 rational : Relation.domain =
   let rec generator (position : int option) : Generator.result =
     match position with
     | Some n ->
@@ -97,12 +117,37 @@ let rational : Domain.t =
         | None -> false)
     | Tuple.NonMaterialized _ -> false
   in
-  Domain.make ~name:"rational" ~generator ~membership_criteria
-    ~cardinality:Conventions.Cardinality.AlephZero ~compare:(fun a b ->
-      Stdlib.compare (Obj.magic a : float) (Obj.magic b : float))
+  (* Note: Additionally to the membership criteria, we add the constraint here as this relation
+     can be further dismembered, rendering the denominator into a lone integer, that should
+     propagate the constraint `integer <> 0`. If we declared a domain `integer_without_zero`,
+     then this constraint would not be needed as the domain would not be dissociated from the value. *)
+  let constraints: Relation.RelationConstraint.t option =
+    let denominator_not_zero =
+      let open Constraint in
+      Not
+        { body = Eq {left = Var "denominator"; right = Const (Obj.magic 0)}
+        ; universe = "integer" }
+    in
+    Some (("DENOMINATOR_DIFFERENT_FROM_ZERO", denominator_not_zero)
+          |> List.singleton)
+  in
+  let schema =
+    Schema.empty
+    |> Schema.add "numerator" "integer"
+    |> Schema.add "denominator" "integer"
+  in
+  new Relation.domain
+    ~name:"rational"
+    ~generator
+    ~membership_criteria
+    ~schema
+    ~constraints
+    ~cardinality:Conventions.Cardinality.AlephZero
+    ~lineage:None
+    ~provenance:None
 
 (** String domain: any string value. Not enumerable. Schema: [value: string]. *)
-let string : Domain.t =
+let string : Relation.domain =
   let generator (_ : int option) : Generator.result =
     Generator.Error "Strings are not enumerable."
   in
@@ -110,6 +155,17 @@ let string : Domain.t =
     | Tuple.Materialized _ -> true
     | Tuple.NonMaterialized _ -> false
   in
-  Domain.make ~name:"string" ~generator ~membership_criteria
-    ~cardinality:Conventions.Cardinality.AlephZero ~compare:(fun a b ->
-      String.compare (Obj.magic a : string) (Obj.magic b : string))
+  let schema =
+    Schema.empty
+    |> Schema.add "value" "string"
+  in
+  new Relation.domain
+    ~name:"string"
+    ~generator
+    ~membership_criteria
+    ~schema
+    ~constraints:None
+    (* TODO: Implement some form of enumeration for strings with a bijection on naturals. *)
+    ~cardinality:Conventions.Cardinality.Continuum
+    ~lineage:None
+    ~provenance:None
diff --git a/lib/prelude/standard.ml b/lib/prelude/standard.ml
index 8b0db9f..f38ee40 100644
--- a/lib/prelude/standard.ml
+++ b/lib/prelude/standard.ml
@@ -15,8 +15,9 @@ let make_comparison ~name ~domain_name ~pred ~cardinality ~generator =
     |> Schema.add "left" domain_name
     |> Schema.add "right" domain_name
   in
-  let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
-   fun _tree_of -> function
+  let membership_criteria : (*(string -> Merkle.t option) ->*) Tuple.t -> bool =
+   (* fun _tree_of -> function *)
+   function
      | Tuple.Materialized m -> (
          match
            ( Tuple.AttributeMap.find_opt "left" m.attributes,
@@ -27,10 +28,15 @@ let make_comparison ~name ~domain_name ~pred ~cardinality ~generator =
          | _ -> false)
      | Tuple.NonMaterialized _ -> false
   in
-  Relation.make ~hash:None ~name ~schema ~tree:None ~constraints:None
-    ~cardinality ~generator:(Some generator) ~membership_criteria
-    ~provenance:(Relation.Provenance.Base name)
-    ~lineage:(Relation.Lineage.Base name) ()
+  new Relation.ephemeral
+    ~name
+    ~schema
+    ~constraints:None
+    ~cardinality
+    ~generator
+    ~membership_criteria
+    ~provenance:None
+    ~lineage:None
 
 (** Enumerate pairs (a, b) where a < b using triangular indexing. *)
 let pair_of_nat_lt n =
@@ -50,7 +56,7 @@ let cantor_pair_of_nat n =
   let a = w - b in
   (a, b)
 
-let less_than_natural : Relation.t =
+let less_than_natural : Relation.ephemeral =
   let rec generator (position : int option) : Generator.result =
     match position with
     | Some position ->
@@ -69,7 +75,7 @@ let less_than_natural : Relation.t =
     ~pred:(fun c -> c < 0)
     ~cardinality:Conventions.Cardinality.AlephZero ~generator
 
-let less_than_or_equal_natural : Relation.t =
+let less_than_or_equal_natural : Relation.ephemeral =
   let rec generator (position : int option) : Generator.result =
     match position with
     | Some n ->
@@ -90,7 +96,7 @@ let less_than_or_equal_natural : Relation.t =
     ~pred:(fun c -> c <= 0)
     ~cardinality:Conventions.Cardinality.AlephZero ~generator
 
-let greater_than_natural : Relation.t =
+let greater_than_natural : Relation.ephemeral =
   let rec generator (position : int option) : Generator.result =
     match position with
     | Some n ->
@@ -108,7 +114,7 @@ let greater_than_natural : Relation.t =
     ~pred:(fun c -> c > 0)
     ~cardinality:Conventions.Cardinality.AlephZero ~generator
 
-let greater_than_or_equal_natural : Relation.t =
+let greater_than_or_equal_natural : Relation.ephemeral =
   let rec generator (position : int option) : Generator.result =
     match position with
     | Some n ->
@@ -128,7 +134,7 @@ let greater_than_or_equal_natural : Relation.t =
     ~pred:(fun c -> c >= 0)
     ~cardinality:Conventions.Cardinality.AlephZero ~generator
 
-let equal_natural : Relation.t =
+let equal_natural : Relation.ephemeral =
   let rec generator (position : int option) : Generator.result =
     match position with
     | Some n ->
@@ -143,7 +149,7 @@ let equal_natural : Relation.t =
     ~pred:(fun c -> c = 0)
     ~cardinality:Conventions.Cardinality.AlephZero ~generator
 
-let not_equal_natural : Relation.t =
+let not_equal_natural : Relation.ephemeral =
   let rec generator (position : int option) : Generator.result =
     match position with
     | Some n ->
@@ -160,7 +166,7 @@ let not_equal_natural : Relation.t =
     ~pred:(fun c -> c <> 0)
     ~cardinality:Conventions.Cardinality.AlephZero ~generator
 
-let plus_natural : Relation.t =
+let plus_natural : Relation.ephemeral =
   let schema =
     Schema.empty |> Schema.add "a" "natural" |> Schema.add "b" "natural"
     |> Schema.add "sum" "natural"
@@ -177,8 +183,9 @@ let plus_natural : Relation.t =
           (Tuple.make_materialized ~relation:"plus" ~attributes, generator)
     | None -> Error "Cannot enumerate plus randomly."
   in
-  let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
-   fun _tree_of -> function
+  let membership_criteria : Tuple.t -> bool =
+   (* fun _tree_of ->  *)
+    function
      | Tuple.Materialized m -> (
          match
            ( Tuple.AttributeMap.find_opt "a" m.attributes,
@@ -192,13 +199,17 @@ let plus_natural : Relation.t =
          | _ -> false)
      | Tuple.NonMaterialized _ -> false
   in
-  Relation.make ~hash:None ~name:"natural_plus" ~schema ~tree:None
-    ~constraints:None ~cardinality:Conventions.Cardinality.AlephZero
-    ~generator:(Some generator) ~membership_criteria
-    ~provenance:(Relation.Provenance.Base "plus")
-    ~lineage:(Relation.Lineage.Base "plus") ()
+  new Relation.ephemeral
+    ~name:"natural_plus"
+    ~schema
+    ~constraints:None
+    ~cardinality:Conventions.Cardinality.AlephZero
+    ~generator
+    ~membership_criteria
+    ~provenance:None
+    ~lineage:None
 
-let times_natural : Relation.t =
+let times_natural : Relation.ephemeral =
   let schema =
     Schema.empty |> Schema.add "a" "natural" |> Schema.add "b" "natural"
     |> Schema.add "product" "natural"
@@ -216,8 +227,9 @@ let times_natural : Relation.t =
           (Tuple.make_materialized ~relation:"times" ~attributes, generator)
     | None -> Error "Cannot enumerate times randomly."
   in
-  let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
-   fun _tree_of -> function
+  let membership_criteria : Tuple.t -> bool =
+   (* fun _tree_of -> *) 
+    function
      | Tuple.Materialized m -> (
          match
            ( Tuple.AttributeMap.find_opt "a" m.attributes,
@@ -231,13 +243,17 @@ let times_natural : Relation.t =
          | _ -> false)
      | Tuple.NonMaterialized _ -> false
   in
-  Relation.make ~hash:None ~name:"natural_times" ~schema ~tree:None
-    ~constraints:None ~cardinality:Conventions.Cardinality.AlephZero
-    ~generator:(Some generator) ~membership_criteria
-    ~provenance:(Relation.Provenance.Base "times")
-    ~lineage:(Relation.Lineage.Base "times") ()
+  new Relation.ephemeral
+    ~name:"natural_times"
+    ~schema
+    ~constraints:None
+    ~cardinality:Conventions.Cardinality.AlephZero
+    ~generator
+    ~membership_criteria
+    ~provenance:None
+    ~lineage:None
 
-let minus_natural : Relation.t =
+let minus_natural : Relation.ephemeral =
   let schema =
     Schema.empty |> Schema.add "a" "natural" |> Schema.add "b" "natural"
     |> Schema.add "difference" "natural"
@@ -256,10 +272,11 @@ let minus_natural : Relation.t =
           (Tuple.make_materialized ~relation:"minus" ~attributes, generator)
     | None -> Error "Cannot enumerate minus randomly."
   in
-  let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
-   fun _tree_of -> function
-     | Tuple.Materialized m -> (
-         match
+  let membership_criteria : Tuple.t -> bool =
+   (* fun _tree_of ->  *)
+    function
+     | Tuple.Materialized m ->
+         begin match
            ( Tuple.AttributeMap.find_opt "a" m.attributes,
              Tuple.AttributeMap.find_opt "b" m.attributes,
              Tuple.AttributeMap.find_opt "difference" m.attributes )
@@ -269,16 +286,21 @@ let minus_natural : Relation.t =
              let bv = (Obj.magic b.Attribute.value : int) in
              let dv = (Obj.magic d.Attribute.value : int) in
              av - bv = dv && dv >= 0
-         | _ -> false)
+         | _ -> false
+         end
      | Tuple.NonMaterialized _ -> false
   in
-  Relation.make ~hash:None ~name:"natural_minus" ~schema ~tree:None
-    ~constraints:None ~cardinality:Conventions.Cardinality.AlephZero
-    ~generator:(Some generator) ~membership_criteria
-    ~provenance:(Relation.Provenance.Base "minus")
-    ~lineage:(Relation.Lineage.Base "minus") ()
+  new Relation.ephemeral
+    ~name:"natural_minus"
+    ~schema
+    ~constraints:None
+    ~cardinality:Conventions.Cardinality.AlephZero
+    ~generator
+    ~membership_criteria
+    ~provenance:None
+    ~lineage:None
 
-let divide_natural : Relation.t =
+let divide_natural : Relation.ephemeral =
   let schema =
     Schema.empty |> Schema.add "a" "natural" |> Schema.add "b" "natural"
     |> Schema.add "quotient" "natural"
@@ -305,8 +327,9 @@ let divide_natural : Relation.t =
           (Tuple.make_materialized ~relation:"divide" ~attributes, generator)
     | None -> Error "Cannot enumerate divide randomly."
   in
-  let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
-   fun _tree_of -> function
+  let membership_criteria : Tuple.t -> bool =
+   (* fun _tree_of ->  *)
+    function
      | Tuple.Materialized m -> (
          match
            ( Tuple.AttributeMap.find_opt "a" m.attributes,
@@ -323,11 +346,15 @@ let divide_natural : Relation.t =
          | _ -> false)
      | Tuple.NonMaterialized _ -> false
   in
-  Relation.make ~hash:None ~name:"natural_divide" ~schema ~tree:None
-    ~constraints:None ~cardinality:Conventions.Cardinality.AlephZero
-    ~generator:(Some generator) ~membership_criteria
-    ~provenance:(Relation.Provenance.Base "divide")
-    ~lineage:(Relation.Lineage.Base "divide") ()
+  new Relation.ephemeral
+    ~name:"natural_divide"
+    ~schema
+    ~constraints:None
+    ~cardinality:Conventions.Cardinality.AlephZero
+    ~generator
+    ~membership_criteria
+    ~provenance:None
+    ~lineage:None
 
 let prelude_relations =
   [