Brummel/MycLib
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects 1 Releases Wiki Activity

added Futures

Browse Source
This commit is contained in:
Michael Schimmel
2025-06-02 00:45:30 +02:00
parent ca101a3452
commit 63484cd495
15 changed files with 1625 additions and 4126 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Src/Myc.Signals.pas
+283 -126
View File
@@ -3,153 +3,220 @@ unit Myc.Signals;
interface
uses
System.SysUtils, Myc.Core.Notifier; // Assuming Myc.Core.Notifier is available
System.SysUtils, Myc.Core.Notifier;
type
IMycLatch = interface; // Forward declaration for the latch interface
TMycSignal = class; // Base or related signal type
IMycState = interface;
IMycSubscriber = interface
// Interface for an entity that can be notified by a signal or latch.
// Returns true if further notifications are expected, false otherwise.
// Returns true if this subscriber expects further notifications from the source, false otherwise.
function Notify: Boolean;
end;
TMycState = class;
TMycSubscription = record
private
FSignal: TMycSignal; // Could also be a more general IMycSignalProvider if TMycLatch isn't a TMycSignal
FTag: TMycNotifyList<IMycSubscriber>.TTag;
FState: IMycState;
FTag: TMycNotifyList<IMycSubscriber>.TTag; // Tag identifying this subscription within the notifier list.
function GetState: IMycState;
constructor Create(const AState: IMycState; ATag: TMycNotifyList<IMycSubscriber>.TTag);
public
class operator Initialize(out Dest: TMycSubscription);
class operator Finalize(var Dest: TMycSubscription);
class operator Assign(var Dest: TMycSubscription; const [ref] Src: TMycSubscription);
// Setup associates the subscription with a signal and a specific tag from TMycNotifyList.
procedure Setup(ASignal: TMycSignal; ATag: TMycNotifyList<IMycSubscriber>.TTag); inline;
// Unsubscribe removes this subscription from the signal it's associated with.
// Unsubscribes from the associated signal.
procedure Unsubscribe;
property State: IMycState read GetState;
end;
IMycSignal = interface
// Allows a subscriber to register for notifications.
// Returns a subscription record that manages the lifetime of the subscription.
function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription;
end;
TMycSignal = class abstract(TInterfacedObject, IMycSignal)
public
// Abstract method for subscribing to this signal.
function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; virtual; abstract;
// Abstract method for unsubscribing using a tag.
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); virtual; abstract;
end;
IMycState = interface(IMycSignal)
// Represents a state that can be queried (IsSet) and subscribed to for changes.
IMycState = interface
// Represents a subscribable state that can be queried.
{$region 'property access'}
function GetIsSet: Boolean;
{$endregion}
// IsSet is true if the state has been reached or the condition met.
// Subscribes a given subscriber to this signal.
function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
// IsSet is true if the state has been reached or the condition is met.
property IsSet: Boolean read GetIsSet;
end;
// IMycLatch represents a synchronization primitive that acts like a gate.
// Once its internal condition is met (e.g., a count reaches zero), it becomes "set"
// (its IMycState.IsSet becomes true) and remains set.
// It can be notified (as an IMycSubscriber) to progress towards its "set" state.
IMycLatch = interface(IMycSubscriber)
TMycState = class abstract( TInterfacedObject, IMycState )
strict private
class var
FNull: IMycState;
class constructor ClassCreate;
protected
function GetIsSet: Boolean; virtual; abstract;
public
function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; virtual; abstract;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); virtual; abstract;
property IsSet: Boolean read GetIsSet;
// Provides access to the singleton null latch instance (always set).
class property Null: IMycState read FNull;
end;
// IMycFlag represents a base for signal-like objects that have a binary state (set/not set),
// can be notified (as an IMycSubscriber) to potentially change state,
// and whose state (IMycState) can be queried and subscribed to.
IMycFlag = interface(IMycSubscriber)
{$region 'property access'}
// Provides access to the IMycState interface of the latch,
// which indicates if the latch is set and allows subscriptions to this state change.
// Provides access to the IMycState interface of the flag.
function GetState: IMycState;
{$endregion}
property State: IMycState read GetState;
end;
// IMycLatch is a specific type of flag that, once set, remains set (non-resettable).
// It typically becomes set when an internal countdown reaches zero.
IMycLatch = interface(IMycFlag)
// Inherits IMycSubscriber and State property from IMycFlag. No new members.
end;
// TMycLatch implements a countdown latch.
// It is initialized with a count. Calls to its Notify method (as an IMycSubscriber)
// decrement this count. When the count reaches zero, the latch transitions to the "set"
// state (IsSet becomes true), notifies its current subscribers once, and then remains set.
TMycLatch = class(TMycSignal, IMycLatch, IMycState)
TMycLatch = class(TMycState, IMycLatch, IMycFlag)
strict private
FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers waiting for this latch to be set.
class var
FNull: IMycLatch;
class constructor ClassCreate;
FNull: IMycLatch; // Singleton instance of a latch that is always set.
class constructor ClassCreate; // Class constructor to initialize FNull.
private
[volatile] FCount: Integer; // The internal countdown value.
function GetState: IMycState;
function GetIsSet: Boolean;
[volatile] FCount: Integer; // The internal countdown value for the latch.
function GetState: IMycState; // Implementation for IMycLatch.GetState and IMycFlag.GetState.
protected
function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet.
public
// Creates the latch with an initial count.
// If ACount is 0 or less, the latch is initially set.
// If ACount is 0 or less, the latch is effectively pre-set (delegates to FNull via CreateLatch factory).
constructor Create(ACount: Integer);
destructor Destroy; override;
// Creates a new countdown latch initialized with the given count.
// Factory method: creates a new countdown latch or returns the Null latch if Count <= 0.
class function CreateLatch(Count: Integer): IMycLatch; static;
// IMycSignal implementation (from TMycSignal)
// IMycSignal implementation
function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; override;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); override;
// IMycSubscriber implementation for TMycLatch itself.
// Decrements the internal count. If the count reaches zero,
// registered subscribers are notified and the latch becomes permanently set.
// registered subscribers are notified, and the latch becomes permanently set.
function Notify: Boolean;
// Provides access to the singleton null latch instance (always set).
class property Null: IMycLatch read FNull;
end;
// IMycDirty represents a resettable flag, typically indicating if a state is "dirty" (requiring attention) or "clean".
// It inherits from IMycFlag, meaning it has a state, can be notified, and subscribed to.
IMycDirty = interface(IMycFlag)
// Resets the flag to its "clean" (not set / not dirty) state.
// Returns true if the flag was actually dirty before this reset, false otherwise.
function Reset: Boolean;
end;
// TMycDirty implements a resettable "dirty flag".
// It can be explicitly set to dirty (via Notify) or reset to clean (via Reset).
// Subscribers are notified of relevant state changes.
TMycDirty = class(TMycState, IMycFlag, IMycDirty)
strict private
FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers interested in state changes of this dirty flag.
private
[volatile] FFlag: Boolean; // Internal state: true if dirty/set, false if clean/reset.
function GetState: IMycState; // Implementation for IMycFlag.GetState.
protected
function GetIsSet: Boolean; override; final; // Implementation for IMycState.GetIsSet (true if dirty).
public
// Creates a new dirty flag, initially set to dirty (true).
constructor Create;
destructor Destroy; override;
// Factory method to create a new TMycDirty instance.
class function CreateDirty: IMycDirty; static;
// IMycSignal implementation
function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription; override;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); override;
// IMycSubscriber implementation for TMycDirty.
// Sets this flag to dirty (true). Notifies subscribers if it transitioned from clean to dirty.
function Notify: Boolean;
// IMycDirty implementation. Resets the flag to clean (false).
function Reset: Boolean;
end;
implementation
uses
System.SyncObjs; // For TInterlocked if used, though it wasn't in the original TMycSemaphore.Notify directly visible
System.SyncObjs; // For TInterlocked
type
// TMycNullState implements a "null object" pattern for IMycState.
// This state is always considered "set".
TMycNullState = class(TInterfacedObject, IMycState)
protected
// IMycState
function GetIsSet: Boolean;
function Subscribe(const Subscriber: IMycSubscriber): TMycSubscription;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
public
constructor Create;
end;
{ TMycNullState }
constructor TMycNullState.Create;
begin
inherited Create;
end;
function TMycNullState.GetIsSet: Boolean;
begin
Result := true; // Null state is always set.
end;
function TMycNullState.Subscribe(const Subscriber: IMycSubscriber): TMycSubscription;
begin
// Since the state is always set, notify the subscriber immediately.
if Assigned(Subscriber) then
begin
Subscriber.Notify;
end;
// No ongoing subscription is necessary or meaningful for a null state.
Result.Create(Self, nil); // Return an empty subscription.
end;
procedure TMycNullState.Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
begin
// Unsubscribing from a null state has no effect.
end;
{ TMycSubscription }
procedure TMycSubscription.Setup(ASignal: TMycSignal; ATag: TMycNotifyList<IMycSubscriber>.TTag);
constructor TMycSubscription.Create(const AState: IMycState; ATag:
TMycNotifyList<IMycSubscriber>.TTag);
begin
Unsubscribe; // Ensure any previous subscription is cleared.
FSignal := ASignal;
Assert( Assigned(AState) );
FState := AState;
FTag := ATag;
end;
procedure TMycSubscription.Unsubscribe;
begin
if FTag <> nil then // Check if currently subscribed
if Assigned(FState) then
begin
Assert(Assigned(FSignal), 'FSignal is not assigned during Unsubscribe');
FSignal.Unsubscribe(FTag);
FTag := nil; // Mark as unsubscribed
FState.Unsubscribe(FTag);
FTag := nil;
FState := nil;
end;
end;
class operator TMycSubscription.Assign(var Dest: TMycSubscription; const [ref] Src: TMycSubscription);
function TMycSubscription.GetState: IMycState;
begin
// This default assignment might not be what's intended if Src is a temporary.
// Proper management would involve Dest taking ownership or Src being managed.
// However, if it's just copying the record fields:
Dest.Setup(Src.FSignal, Src.FTag);
// To prevent Src from unsubscribing if it's a temporary and Dest now "owns" the subscription,
// one might consider nil'ing out Src.FTag, but that depends on usage patterns.
// Given the `const [ref] Src`, this assignment implies Dest should reflect Src.
// If Src is finalized later, it will call Unsubscribe. This might be problematic if Dest also expects to manage it.
// A robust solution for record assignment with resource management often requires more careful design
// or using interfaces/objects for the subscription itself.
// For now, keeping it simple as per original structure.
end;
class operator TMycSubscription.Initialize(out Dest: TMycSubscription);
begin
Dest.FSignal := nil; // Ensure FSignal is initialized
Dest.FTag := nil; // Initialize tag to nil, indicating no active subscription.
end;
class operator TMycSubscription.Finalize(var Dest: TMycSubscription);
begin
Dest.Unsubscribe; // Automatically unsubscribe when the record goes out of scope.
Result := FState;
end;
{ TMycLatch }
@@ -157,29 +224,28 @@ end;
constructor TMycLatch.Create(ACount: Integer);
begin
inherited Create;
FCount := ACount; // Set the initial countdown value.
FSubscribers.Create; // Initialize the list of subscribers.
Assert( ACount >= 0 );
FCount := ACount;
FSubscribers.Create;
end;
{ TMycLatch }
class constructor TMycLatch.ClassCreate;
begin
// Create1 a null latch instance that is initially (and always) set.
FNull := TMycLatch.Create(0);
// Create a singleton null latch instance that is initially (and always) set.
FNull := TMycLatch.Create(0); // Calls the instance constructor
end;
destructor TMycLatch.Destroy;
begin
FSubscribers.Destroy; // Clean up the subscriber list.
FSubscribers.Destroy;
inherited;
end;
class function TMycLatch.CreateLatch(Count: Integer): IMycLatch;
begin
// Factory method to create a new TMycLatch instance.
// Factory method: returns a new latch or the shared Null latch if Count <= 0.
if Count > 0 then
Result := TMycLatch.Create(Count)
Result := TMycLatch.Create(Count) // Instance constructor
else
Result := FNull;
end;
@@ -189,37 +255,29 @@ var
currentCountAfterDecrement: Integer;
shouldNotifySubscribers: Boolean;
begin
FSubscribers.Lock; // Lock to protect FCount and FSubscribers modifications/iterations
FSubscribers.Lock;
try
currentCountAfterDecrement := TInterlocked.Decrement(FCount);
// Defend against extreme underflow if Notify could be called excessively.
// This helps maintain a semblance of sanity for FCount, though ideally
// it shouldn't be needed if used as a typical countdown latch.
if currentCountAfterDecrement < -MaxInt div 2 then
TInterlocked.Increment(FCount); // Try to pull it back from extreme negative.
TInterlocked.Increment(FCount); // Defend against extreme underflow.
// Notify subscribers only when the count transitions to zero.
shouldNotifySubscribers := (currentCountAfterDecrement = 0);
shouldNotifySubscribers := (currentCountAfterDecrement = 0); // Notify only on transition to zero.
if shouldNotifySubscribers then
begin
FSubscribers.Notify(
function(Subscriber: IMycSubscriber): Boolean
begin
// Notify each subscriber. The result of Subscriber.Notify indicates
// if that subscriber expects further notifications (which, for a latch, is typically false after the first one).
Result := Subscriber.Notify;
end);
end;
// A latch, once set (count <= 0), remains set.
// This Notify method itself returns true if the count is still > 0,
// indicating the latch has not yet been "set" by this Notify call.
// Returns true if the latch has not yet been set by this Notify call (count > 0).
Result := currentCountAfterDecrement > 0;
// If the latch has become set (or was already set and Notify is called again making count more negative),
// unadvise all subscribers. This makes it a one-shot notification for this set of subscribers.
// If the latch is now set (or was already set), unadvise all subscribers.
// This ensures one-shot notification for the current set of subscribers.
if currentCountAfterDecrement <= 0 then
FSubscribers.UnadviseAll;
finally
@@ -229,7 +287,7 @@ end;
function TMycLatch.GetIsSet: Boolean;
begin
// The latch is considered "set" if its count has reached zero or less.
// The latch is set if its count has reached zero or less.
Result := FCount <= 0;
end;
@@ -243,58 +301,157 @@ function TMycLatch.Subscribe(const Subscriber: IMycSubscriber): TMycSubscription
var
alreadySet: Boolean;
begin
Result.Create(TMycState.Null, nil); // Default to an empty subscription.
if not Assigned(Subscriber) then
begin
Result.Setup(nil, nil); // Return an empty/invalid subscription
exit;
end;
// It's good practice to manage ref counts for interfaces passed around,
// especially if their lifetime is tied to the subscription.
// TMycNotifyList should handle AddRef/Release for stored subscribers if it holds interfaces.
// If direct Advise/Unadvise handles it, this explicit AddRef/Release pair might be for safety
// during the decision-making part of this method.
Subscriber._AddRef; // Manually increment ref count for safety during this method's logic
Subscriber._AddRef; // Manage ref count during this method's logic.
try
FSubscribers.Lock;
try
// Check if the latch is already set.
// This uses FCount directly rather than GetIsSet to avoid re-entrancy issues if GetIsSet had complex logic.
alreadySet := (FCount <= 0);
alreadySet := (FCount <= 0); // Check if latch is already set.
if alreadySet then
begin
// If already set, notify the new subscriber immediately and do not add to list.
// The subscription will be effectively null/empty as it's a one-shot notification.
Result.Setup(nil, nil); // No persistent subscription needed.
Subscriber.Notify; // Notify immediately.
// If already set, notify immediately; no persistent subscription needed.
Subscriber.Notify;
end
else
begin
// If not yet set, advise the subscriber to the list.
// The TMycSubscription record will hold the tag for later unsubscription.
Result.Setup(Self, FSubscribers.Advise(Subscriber));
// If not yet set, advise the subscriber.
Result.Create(Self, FSubscribers.Advise(Subscriber));
end;
finally
FSubscribers.Release;
end;
finally
Subscriber._Release; // Release the ref count taken at the beginning of the method.
Subscriber._Release;
end;
end;
procedure TMycLatch.Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
begin
if Tag = nil then // No valid tag to unadvise.
if Tag = nil then
exit;
FSubscribers.Lock;
try
FSubscribers.Unadvise(Tag); // Remove the subscriber associated with this tag.
FSubscribers.Unadvise(Tag);
finally
FSubscribers.Release;
end;
end;
{ TMycDirty }
constructor TMycDirty.Create;
begin
inherited Create;
FFlag := true; // A new dirty flag is initially considered dirty.
FSubscribers.Create;
end;
class function TMycDirty.CreateDirty: IMycDirty;
begin
// Factory method to create a new TMycDirty instance.
Result := TMycDirty.Create;
end;
destructor TMycDirty.Destroy;
begin
FSubscribers.Destroy; // Clean up the subscriber list.
inherited;
end;
function TMycDirty.Reset: Boolean;
begin
// Sets the flag to false (clean) and returns true if it was previously true (dirty).
Result := TInterlocked.Exchange(FFlag, false);
end;
function TMycDirty.GetIsSet: Boolean;
begin
// IsSet is true if the flag is dirty (FFlag = true).
Result := FFlag;
end;
function TMycDirty.GetState: IMycState;
begin
// TMycDirty itself implements IMycState.
exit(Self);
end;
function TMycDirty.Notify: Boolean;
var
wasPreviouslyClean: Boolean;
begin
FSubscribers.Lock;
try
// Set the flag to true (dirty) and check if it was previously false (clean).
wasPreviouslyClean := not TInterlocked.Exchange(FFlag, true);
if wasPreviouslyClean then // Only notify subscribers if state changed from clean to dirty.
begin
FSubscribers.Notify(
function(Subscriber: IMycSubscriber): Boolean
begin
Result := Subscriber.Notify;
end);
end;
// The return value of this Notify (as an IMycSubscriber) indicates if this
// TMycDirty instance itself would want more notifications if it were subscribed to something.
// Here, it reflects whether a state change to dirty occurred due to this call.
Result := wasPreviouslyClean;
finally
FSubscribers.Release;
end;
end;
function TMycDirty.Subscribe(const Subscriber: IMycSubscriber): TMycSubscription;
begin
Result.Create(TMycState.Null, nil); // Default to an empty subscription
if not Assigned(Subscriber) then
exit;
// For TMycDirty, we always add the subscriber and then check if we need to notify immediately.
// Ref counting for the subscriber interface is assumed to be handled by TMycNotifyList.Advise/Unadvise.
// Or, if explicit management is needed like in TMycLatch, it should be added.
// For consistency with TMycLatch, let's add AddRef/Release here too.
Subscriber._AddRef;
try
FSubscribers.Lock;
try
// Add subscriber regardless of current state.
Result.Create(Self, FSubscribers.Advise(Subscriber));
if FFlag then // If currently dirty, notify the new subscriber immediately.
begin
Subscriber.Notify;
end;
finally
FSubscribers.Release;
end;
finally
Subscriber._Release;
end;
end;
procedure TMycDirty.Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag);
begin
if Tag = nil then
exit;
FSubscribers.Lock;
try
FSubscribers.Unadvise(Tag);
finally
FSubscribers.Release;
end;
end;
class constructor TMycState.ClassCreate;
begin
// Create a singleton null latch instance that is initially (and always) set.
FNull := TMycNullState.Create(); // Calls the instance constructor
end;
end.