diff options
Diffstat (limited to 'lib/kernel')
| -rw-r--r-- | lib/kernel/EphemeralRelation.ml | 82 | ||||
| -rw-r--r-- | lib/kernel/Lifecycle.ml | 12 | ||||
| -rw-r--r-- | lib/kernel/Lifecycle.mli | 10 | ||||
| -rw-r--r-- | lib/kernel/SubstantialRelation.ml | 4 |
4 files changed, 31 insertions, 77 deletions
diff --git a/lib/kernel/EphemeralRelation.ml b/lib/kernel/EphemeralRelation.ml index 29b15ed..b403e13 100644 --- a/lib/kernel/EphemeralRelation.ml +++ b/lib/kernel/EphemeralRelation.ml @@ -15,22 +15,6 @@ module type DERIVATION = sig end module Make (D : DERIVATION) = struct - module Error = struct - open Concepts.Condition - - let attributes bound = Concepts.Value.String (String.concat ", " (BatSet.String.elements bound)) - - let ungenerable bound = - condition "ungenerable-binding" - "The derivation declares no mode that generates under the attributes bound." - ("bound" |=| attributes bound) - - let undecidable bound = - condition "undecidable-membership" - "The derivation declares no mode that decides membership under the attributes of the tuple." - ("bound" |=| attributes bound) - end - let pinned_tag = "rnt/pinned/1" let identity ?pinned plan = @@ -42,78 +26,26 @@ module Make (D : DERIVATION) = struct |> Bytes.of_string |> Concepts.Hash.hash_of_bytes - (* A cursor holds a reference to its relation, so the edges it reads - outlive a release of the relation that produced it. *) - class retaining scan release_owner = - object (self) - inherit Lifecycle.counted - inherit Identity.of_id - - method destroy = - Protocols.Handle.release (Protocols.Handle.from scan); - release_owner () - - method fetch limit = Protocols.Cursor.fetch scan limit - method protocols : Protocols.Handle.protocol list = [Protocols.Cursor.make self] - end - class ephemeral (plan : D.plan) address declaration description edges = object (self) inherit Lifecycle.counted - val heading = BatMap.String.keys description |> BatSet.String.of_enum + inherit Protocols.Generative.membership + val heading = Concepts.Mode.attributes_of_map description method destroy = List.iter Protocols.Handle.release edges method predicate = Ok None method local_constraints = Ok None method modes = Ok declaration + (* A cursor holds a reference to its relation, so the edges it reads + outlive a release of the relation that produced it. *) method generate binding = - let open Utilities.Result in - let bound = Protocols.Generative.bound binding in - let* () = - if Option.is_some (Concepts.Mode.generation declaration bound) then Ok () - else Error (Error.ungenerable bound) - in - let* cursor = D.generate plan binding in - match Protocols.Cursor.require cursor with - | Error c -> - Protocols.Handle.release cursor; - Error c - | Ok scan -> - ignore self#reference; - Ok (new retaining scan (fun () -> self#release) |> Protocols.Handle.make) + D.generate plan binding + |> Result.map (fun cursor -> + new Lifecycle.retaining cursor (self :> Lifecycle.lifecycle) |> Protocols.Handle.make ) method enumerate = self#generate Protocols.Generative.nothing method describe () = Ok (Protocols.Schematics.Relation description) - (* Membership of a derived relation is decided by the derivation - and not by a lookup, so it is asked of the generator under the - binding the tuple itself fixes. Only a tuple carrying exactly the - described attributes can be a member, and it must match one whole. *) - method contains (tuple : Concepts.Tuple.t) = - let open Utilities.Result in - let binding = tuple.Concepts.Tuple.attributes in - let bound = Protocols.Generative.bound binding in - if not (BatSet.String.equal heading bound) then Ok false - else - let* () = - if Concepts.Mode.decision declaration bound then Ok () else Error (Error.undecidable bound) - in - let* cursor = D.generate plan binding in - let expected = Concepts.Tuple.hash tuple in - Fun.protect - ~finally:(fun () -> Protocols.Handle.release cursor) - (fun () -> - let* scan = Protocols.Cursor.require cursor in - let rec seek () = - let* found = Protocols.Cursor.next scan in - match found with - | None -> Ok false - | Some member -> - if Concepts.Hash.hash_equals (Concepts.Tuple.hash member) expected then Ok true - else seek () - in - seek () ) - method protocols : Protocols.Handle.protocol list = let carried = [ Protocols.Relation.make self; diff --git a/lib/kernel/Lifecycle.ml b/lib/kernel/Lifecycle.ml index 20282dd..772cb6e 100644 --- a/lib/kernel/Lifecycle.ml +++ b/lib/kernel/Lifecycle.ml @@ -26,3 +26,15 @@ class virtual counted = object (self) if Atomic.fetch_and_add references (-1) = 1 then self#destroy end + +class retaining inner (owner : lifecycle) = object + inherit counted + initializer ignore owner#reference + + method destroy = + Protocols.Handle.release inner; + owner#release + + method hash = Protocols.Handle.hash inner + method protocols = Protocols.Handle.protocols inner +end diff --git a/lib/kernel/Lifecycle.mli b/lib/kernel/Lifecycle.mli index f110768..fa3abee 100644 --- a/lib/kernel/Lifecycle.mli +++ b/lib/kernel/Lifecycle.mli @@ -10,3 +10,13 @@ end class null : lifecycle class virtual counted : controlled_lifecycle + +(** stands for [inner], carrying what it carries, while holding a + reference to [owner], so what [inner] reads outlives a release of + the object that produced it. *) +class retaining : Protocols.Handle.t -> lifecycle -> object + inherit lifecycle + method destroy : unit + method hash : Concepts.Hash.hash + method protocols : Protocols.Handle.protocol list +end diff --git a/lib/kernel/SubstantialRelation.ml b/lib/kernel/SubstantialRelation.ml index 7beb133..b94e2f8 100644 --- a/lib/kernel/SubstantialRelation.ml +++ b/lib/kernel/SubstantialRelation.ml @@ -145,7 +145,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct let modes_of description = Concepts.Mode.of_list [ Concepts.Mode.enumerable Concepts.Cardinality.Finite; - Concepts.Mode.decides_when (BatMap.String.keys description |> BatList.of_enum) ] + {Concepts.Mode.bound= Concepts.Mode.attributes_of_map description; affords= Decides} ] let modes tx relation = schema_of tx relation |> Result.map modes_of @@ -161,7 +161,7 @@ module Make (S : Abstract.Storage.STORAGE) = struct (* The protocol takes a tuple, not bytes: encoding is this object's business, and a caller that had to produce the exact stored bytes would have to know this encoding to do it. *) method contains (tuple : Concepts.Tuple.t) = - SI.with_transaction storage (fun tx -> contains_tuple tx relation tuple) + SI.with_read storage (fun tx -> contains_tuple tx relation tuple) method describe () = Ok (Protocols.Schematics.Relation description) |