Implemented TLazy + Tests

This commit is contained in:
Michael Schimmel
2025-06-03 17:10:55 +02:00
parent 38c9e2830d
commit 468c6bf849
14 changed files with 247 additions and 149 deletions
+25 -10
View File
@@ -7,15 +7,19 @@ uses
Myc.Signals, Myc.TaskManager, Myc.Futures;
type
// Abstract base class for IMycFuture<T> implementations.
TMycFuture<T> = class abstract( TInterfacedObject, IMycFuture<T> )
protected
function GetResult: T; virtual; abstract;
function GetDone: IMycState; virtual; abstract;
end;
// Concrete future implementation triggered by an initial state, executing a TFunc<T>.
TMycInitStateFuncFuture<T> = class( TMycFuture<T> )
TMycNullFuture<T> = class( TMycFuture<T> )
protected
function GetResult: T; override;
function GetDone: IMycState; override;
end;
TMycGateFuncFuture<T> = class(TMycFuture<T>)
private
FInit: TMycSubscription;
FDone: IMycLatch;
@@ -24,20 +28,31 @@ type
function GetResult: T; override;
function GetDone: IMycState; override;
public
// Creates a future that executes AProc after AGate is set, using ATaskFactory.
constructor Create( const ATaskManager: IMycTaskManager; const AGate: IMycState; AProc: TFunc<T> );
destructor Destroy; override;
end;
implementation
{ TMycInitStateFuncFuture<T> }
{ TMycNullFuture<T> }
constructor TMycInitStateFuncFuture<T>.Create( const ATaskManager: IMycTaskManager; const AGate: IMycState; AProc: TFunc<T> );
function TMycNullFuture<T>.GetDone: IMycState;
begin
Result := TState.Null;
end;
function TMycNullFuture<T>.GetResult: T;
begin
Result := Default(T);
end;
{ TMycGateFuncFuture<T> }
constructor TMycGateFuncFuture<T>.Create(const ATaskManager: IMycTaskManager; const AGate: IMycState; AProc: TFunc<T>);
begin
inherited Create;
FDone := TState.CreateLatch( 1 );
FDone := TLatch.Construct( 1 );
// Subscribe the job execution to AGate.
// The job will run when AGate notifies the subscriber returned by Run.
@@ -58,7 +73,7 @@ begin
end );
end;
destructor TMycInitStateFuncFuture<T>.Destroy;
destructor TMycGateFuncFuture<T>.Destroy;
begin
Assert( FDone.State.IsSet );
@@ -66,12 +81,12 @@ begin
inherited Destroy;
end;
function TMycInitStateFuncFuture<T>.GetDone: IMycState;
function TMycGateFuncFuture<T>.GetDone: IMycState;
begin
Result := FDone.State;
end;
function TMycInitStateFuncFuture<T>.GetResult: T;
function TMycGateFuncFuture<T>.GetResult: T;
begin
Assert( FDone.State.IsSet, 'Result is not yet available.' );
Result := FResult;
+41 -36
View File
@@ -9,18 +9,12 @@ uses
type
TMycState = class abstract( TInterfacedObject, IMycState )
strict private
class var
FNull: IMycState;
class constructor ClassCreate;
protected
function GetIsSet: Boolean; virtual; abstract;
public
function Subscribe(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;
// TMycNullState implements a "null object" pattern for IMycState.
@@ -42,9 +36,6 @@ type
TMycLatch = class(TMycState, IMycLatch)
strict private
FSubscribers: TMycNotifyList<IMycSubscriber>; // List of subscribers waiting for this latch to be set.
class var
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 for the latch.
function GetState: IMycState; // Implementation for IMycLatch.GetState and IMycFlag.GetState.
@@ -56,9 +47,6 @@ type
constructor Create(ACount: Integer);
destructor Destroy; override;
// Factory method: creates a new countdown latch or returns the Null latch if Count <= 0.
class function CreateLatch(Count: Integer): IMycLatch; static;
// IMycSignal implementation
function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; override;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); override;
@@ -67,9 +55,12 @@ type
// Decrements the internal count. If the count reaches zero,
// registered subscribers are notified, and the latch becomes permanently set.
function Notify: Boolean;
end;
// Provides access to the singleton null latch instance (always set).
class property Null: IMycLatch read FNull;
TMycNullLatch = class( TInterfacedObject, IMycLatch )
private
function GetState: IMycState;
function Notify: Boolean;
end;
// TMycDirty implements a resettable "dirty flag".
@@ -91,7 +82,6 @@ type
// Factory method to create a new TMycDirty instance.
class function CreateDirty: IMycDirty; static;
// IMycSignal implementation
function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; override;
procedure Unsubscribe(Tag: TMycNotifyList<IMycSubscriber>.TTag); override;
@@ -103,17 +93,18 @@ type
function Reset: Boolean;
end;
TMycNullDirty = class( TInterfacedObject, IMycDirty )
private
function GetState: IMycState;
function Notify: Boolean;
function Reset: Boolean;
end;
implementation
uses
System.SyncObjs; // For TInterlocked
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;
{ TMycNullState }
constructor TMycNullState.Create;
@@ -142,6 +133,18 @@ begin
// Unsubscribing from a null state has no effect.
end;
{ TMycNullLatch }
function TMycNullLatch.GetState: IMycState;
begin
Result := TState.Null;
end;
function TMycNullLatch.Notify: Boolean;
begin
Result := false;
end;
{ TMycLatch }
constructor TMycLatch.Create(ACount: Integer);
@@ -152,27 +155,12 @@ begin
FSubscribers.Create;
end;
class constructor TMycLatch.ClassCreate;
begin
// 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;
inherited;
end;
class function TMycLatch.CreateLatch(Count: Integer): IMycLatch;
begin
// Factory method: returns a new latch or the shared Null latch if Count <= 0.
if Count > 0 then
Result := TMycLatch.Create(Count) // Instance constructor
else
Result := FNull;
end;
function TMycLatch.Notify: Boolean;
var
currentCountAfterDecrement: Integer;
@@ -259,6 +247,23 @@ begin
end;
end;
{ TMycNullDirty }
function TMycNullDirty.GetState: IMycState;
begin
Result := TState.Null;
end;
function TMycNullDirty.Notify: Boolean;
begin
Result := false;
end;
function TMycNullDirty.Reset: Boolean;
begin
Result := true;
end;
{ TMycDirty }
constructor TMycDirty.Create;
+3 -3
View File
@@ -150,7 +150,7 @@ begin
FWorkThreads[i].Free;
if Assigned(FException) then
FException.Free;
FException.Free;
FWorkGate.Free;
FWorkStack.Clear;
@@ -203,7 +203,7 @@ var
capturedProc: TProc;
begin
// Create a latch that will be signaled when the proc finishes
res := TMycLatch.CreateLatch(1); // Changed to use direct static call on TMycLatch
res := TLatch.Construct(1); // Changed to use direct static call on TMycLatch
capturedProc := Proc; // Capture Proc for the anonymous method
CreateAnonymousThread('Thread',
@@ -303,7 +303,7 @@ begin
raise ETaskException.Create('Task factory terminated');
if not Assigned(Job) then
exit(TMycLatch.Null); // Already correct, uses direct static property on TMycLatch
exit(TLatch.Null); // Already correct, uses direct static property on TMycLatch
// Create a pending job
Result := TMycPendingJob.Create(Self, Job);
+10 -3
View File
@@ -20,16 +20,20 @@ type
end;
TFuture<T> = record
strict private
private
FFuture: IMycFuture<T>;
function GetDone: IMycState; inline;
function GetResult: T; inline;
class var
FNull: IMycFuture<T>;
class constructor CreateClass;
class destructor DestroyClass;
public
constructor Create(const AFuture: IMycFuture<T>);
class operator Implicit(const A: IMycFuture<T>): TFuture<T>; overload;
class operator Implicit(const A: TFuture<T>): IMycFuture<T>; overload;
@@ -52,11 +56,14 @@ uses
constructor TFuture<T>.Create(const AFuture: IMycFuture<T>);
begin
FFuture := AFuture;
if not Assigned(FFuture) then
FFuture := FNull;
end;
class constructor TFuture<T>.CreateClass;
begin
TMycTaskFactory.AquireTaskManager;
FNull := TMycNullFuture<T>.Create;
end;
class destructor TFuture<T>.DestroyClass;
@@ -77,12 +84,12 @@ end;
class function TFuture<T>.Construct(const Proc: TFunc<T>): IMycFuture<T>;
begin
Result := TMycInitStateFuncFuture<T>.Create( TaskManager, nil, Proc );
Result := TMycGateFuncFuture<T>.Create( TaskManager, nil, Proc );
end;
class function TFuture<T>.Construct(const Gate: IMycState; const Proc: TFunc<T>): IMycFuture<T>;
begin
Result := TMycInitStateFuncFuture<T>.Create( TaskManager, Gate, Proc );
Result := TMycGateFuncFuture<T>.Create( TaskManager, Gate, Proc );
end;
function TFuture<T>.GetDone: IMycState;
+87 -24
View File
@@ -24,7 +24,7 @@ type
// Unsubscribes from the associated TState.
procedure Unsubscribe;
class operator Initialize( out Dest: TMycSubscription );
property TState: IMycState read GetState;
property State: IMycState read GetState;
end;
IMycState = interface
@@ -39,6 +39,30 @@ type
property IsSet: Boolean read GetIsSet;
end;
TState = record // helper for IMycState
strict private
class var
FNull: IMycState;
class constructor ClassCreate;
private
FState: IMycState;
function GetIsSet: Boolean; inline;
public
constructor Create(const AState: IMycState);
class operator Implicit(const A: IMycState): TState; overload;
class operator Implicit(const A: TState): IMycState; overload;
class function All( const States: TArray<IMycState> ): IMycState; static;
class function Any( const States: TArray<IMycState> ): IMycState; static;
class property Null: IMycState read FNull;
function Subscribe(Subscriber: IMycSubscriber): TMycSubscription; inline;
procedure Unsubscribe(Tag: Pointer); inline;
property IsSet: Boolean read GetIsSet;
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( IMycSubscriber )
@@ -48,6 +72,16 @@ type
// Inherits IMycSubscriber and State property from IMycFlag. No new members.
end;
TLatch = record
strict private
class var
FNull: IMycLatch;
class constructor ClassCreate;
public
class function Construct(Count: Integer): IMycLatch; static;
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( IMycSubscriber )
@@ -59,19 +93,14 @@ type
property State: IMycState read GetState;
end;
TState = record
private
FState: IMycState;
class function GetNull: IMycState; static;
TDirty = record
strict private
class var
FNull: IMycDirty;
class constructor ClassCreate;
public
constructor Create(const AState: IMycState);
class function CreateLatch( Count: Integer ): IMycLatch; static;
class function CreateDirty: IMycDirty; static;
class function All( const States: TArray<IMycState> ): IMycState; static;
class function Any( const States: TArray<IMycState> ): IMycState; static;
class operator Implicit(const A: IMycState): TState; overload;
class operator Implicit(const A: TState): IMycState; overload;
class property Null: IMycState read GetNull;
class function Construct: IMycDirty; static;
class property Null: IMycDirty read FNull;
end;
implementation
@@ -92,7 +121,7 @@ end;
procedure TMycSubscription.Unsubscribe;
begin
FState.Unsubscribe( FTag );
FState := TMycState.Null;
FState := TState.Null;
FTag := nil;
end;
@@ -103,7 +132,7 @@ end;
class operator TMycSubscription.Initialize( out Dest: TMycSubscription );
begin
Dest.FState := TMycState.Null;
Dest.FState := TState.Null;
Dest.FTag := nil;
end;
@@ -113,19 +142,20 @@ constructor TState.Create(const AState: IMycState);
begin
FState := AState;
if not Assigned(FState) then
FState := TMycState.Null;
FState := FNull;
end;
class function TState.CreateLatch( Count: Integer ): IMycLatch;
class constructor TState.ClassCreate;
begin
Result := TMycLatch.CreateLatch( Count );
// Create a singleton null latch instance that is initially (and always) set.
FNull := TMycNullState.Create(); // Calls the instance constructor
end;
class function TState.All( const States: TArray<IMycState> ): IMycState;
var
Latch: IMycLatch;
begin
Latch := CreateLatch( Length( States ) );
Latch := TLatch.Construct( Length( States ) );
for var i := 0 to High( States ) do
States[i].Subscribe( Latch );
Result := Latch.State;
@@ -141,21 +171,26 @@ begin
end
else
begin
Latch := CreateLatch( 1 );
Latch := TLatch.Construct( 1 );
for var i := 0 to High( States ) do
States[i].Subscribe( Latch );
Result := Latch.State;
end;
end;
class function TState.CreateDirty: IMycDirty;
function TState.GetIsSet: Boolean;
begin
Result := TMycDirty.CreateDirty;
Result := FState.IsSet;
end;
class function TState.GetNull: IMycState;
function TState.Subscribe(Subscriber: IMycSubscriber): TMycSubscription;
begin
Result := TMycState.Null;
Result := FState.Subscribe(Subscriber);
end;
procedure TState.Unsubscribe(Tag: Pointer);
begin
FState.Unsubscribe(Tag);
end;
class operator TState.Implicit(const A: TState): IMycState;
@@ -168,4 +203,32 @@ begin
Result.Create( A );
end;
{ TLatch }
class constructor TLatch.ClassCreate;
begin
// Create a singleton null latch instance that is initially (and always) set.
FNull := TMycNullLatch.Create; // Calls the instance constructor
end;
class function TLatch.Construct(Count: Integer): IMycLatch;
begin
if Count > 0 then
Result := TMycLatch.Create( Count )
else
Result := FNull;
end;
{ TDirty }
class constructor TDirty.ClassCreate;
begin
FNull := TMycNullDirty.Create;
end;
class function TDirty.Construct: IMycDirty;
begin
Result := TMycDirty.Create;
end;
end.