MycLib/Src/Myc.Signals.pas

unit Myc.Signals;

interface

uses
    System.SysUtils;

type
    TSignal = record
        type
            ISubscriber = interface
                function Notify: Boolean;
            end;

            TSubscriptionTag = Pointer;

            ISignal = interface
                function Subscribe(Subscriber: ISubscriber): TSubscriptionTag;
                procedure Unsubscribe(Tag: TSubscriptionTag);
            end;

            TSubscription = record
            private
                FSignal: ISignal;
                FTag: TSubscriptionTag;
                constructor Create(const ASignal: ISignal; ATag: TSubscriptionTag);
            public
                class operator Initialize(out Dest: TSubscription);
                // Unsubscribes from the associated signal
                procedure Unsubscribe;
            end;

    {$REGION 'private'}
    strict private
        class var
            FNull: ISignal;
        class constructor ClassCreate;

    private
        FSignal: ISignal;
    {$ENDREGION}
    public
        constructor Create(const ASignal: ISignal);
        class operator Initialize(out Dest: TSignal);
        class operator Implicit(const A: ISignal): TSignal; overload;
        class operator Implicit(const A: TSignal): ISignal; overload;

        function Subscribe(Subscriber: ISubscriber): TSubscription; inline;

        class property Null: ISignal read FNull;
    end;

    TState = record
        type
            IState = interface(TSignal.ISignal)
                {$REGION 'property access'}
                function GetIsSet: Boolean;
                {$ENDREGION}
                // IsSet is true if the TState has been reached or the condition is met.
                property IsSet: Boolean read GetIsSet;
            end;

    {$REGION 'private'}
    strict private
        class var
            FNull: IState;
        class constructor ClassCreate;

    private
        FState: IState;
        function GetIsSet: Boolean; inline;
        function GetAsSignal: TSignal; inline;
    {$ENDREGION}
    public
        constructor Create(const AState: IState);
        class operator Initialize(out Dest: TState);
        class operator Implicit(const A: IState): TState; overload;
        class operator Implicit(const A: TState): IState; overload;

        class function All(const States: TArray<TState>): TState; static;
        class function Any(const States: TArray<TState>): TState; static;

        class property Null: IState read FNull;

        function Subscribe(Subscriber: TSignal.ISubscriber): TSignal.TSubscription; inline;

        property IsSet: Boolean read GetIsSet;

        // Explicitly cast a state to a signal. This is dangerous, use with care!
        // States only notify, when they change. This behaviour is obscured by treating it like a signal.
        property AsSignal: TSignal read GetAsSignal;
    end;

    // An event is a stateless signal that forwards all notifications to the subscribers.
    TEvent = record
        type
            IEvent = interface(TSignal.ISubscriber)
                {$REGION 'property access'}
                function GetSignal: TSignal;
                {$ENDREGION}
                property Signal: TSignal read GetSignal;
            end;

    {$REGION 'private'}
    strict private
        class var
            FNull: IEvent;
        class constructor ClassCreate;

    private
        FEvent: IEvent;
        function GetSignal: TSignal; inline;
    {$ENDREGION}
    public
        constructor Create(const AEvent: IEvent);
        class operator Initialize(out Dest: TEvent);
        class operator Implicit(const A: IEvent): TEvent; overload;
        class operator Implicit(const A: TEvent): IEvent; overload;

        class function CreateEvent: TEvent; static;
        class function CreateRouter(const Signal: TSignal): TEvent; static;

        class property Null: IEvent read FNull;

        function Notify: Boolean; inline;

        property Signal: TSignal read GetSignal;
    end;

    // A latch is a specific type of event that, once set, remains set (non-resettable).
    // It becomes set when the internal countdown reaches zero.
    TLatch = record
        type
            ILatch = interface(TSignal.ISubscriber)
                {$REGION 'property access'}
                function GetState: TState;
                {$ENDREGION}
                property State: TState read GetState;
            end;

    {$REGION 'private'}
    strict private
        class var
            FNull: ILatch;
            FQueueLock: Integer;
        class constructor ClassCreate;

    private
        FLatch: ILatch;
        function GetState: TState.IState; inline;
    {$ENDREGION}
    public
        constructor Create(const ALatch: ILatch);
        class operator Initialize(out Dest: TLatch);
        class operator Implicit(const A: ILatch): TLatch; overload;
        class operator Implicit(const A: TLatch): ILatch; overload;

        class function CreateLatch(Count: Integer): ILatch; static;

        class function Enqueue1(var Gate: TLatch): TState; overload; static;
        function Enqueue: TState; overload;

        class property Null: ILatch read FNull;

        function Notify: Boolean; inline;

        property State: TState.IState read GetState;
    end;

    // TFlag represents a resettable flag, typically indicating if a State is "dirty" (requiring attention) or "clean".
    TFlag = record
        type
            IFlag = interface(TSignal.ISubscriber)
                {$REGION 'property access'}
                function GetState: TState;
                {$ENDREGION}
                function Reset: Boolean;
                property State: TState read GetState;
            end;

    {$REGION 'private'}
    strict private
        class var
            FNull: IFlag;
        class constructor ClassCreate;

    private
        FFlag: IFlag;
        function GetState: TState; inline;

    {$ENDREGION}
    public
        constructor Create(const AFlag: IFlag);
        class operator Initialize(out Dest: TFlag);
        class operator Implicit(const A: IFlag): TFlag; overload;
        class operator Implicit(const A: TFlag): IFlag; overload;

        class function CreateFlag: TFlag; static;
        class function CreateObserver(const Signal: TSignal): TFlag; static;
        class property Null: IFlag read FNull;

        function Notify: Boolean; inline;
        function Reset: Boolean;

        property State: TState read GetState;
    end;

implementation

uses
    Myc.Core.Notifier,
    Myc.Core.Signals;

{ TSignal.TSubscription }

constructor TSignal.TSubscription.Create(const ASignal: ISignal; ATag: TSubscriptionTag);
begin
    FSignal := ASignal;
    FTag := ATag;
    Assert(Assigned(FSignal));
end;

procedure TSignal.TSubscription.Unsubscribe;
begin
    FSignal.Unsubscribe(FTag);
    FSignal := TSignal.Null;
    FTag := nil;
end;

class operator TSignal.TSubscription.Initialize(out Dest: TSubscription);
begin
    Dest.FSignal := TSignal.Null;
    Dest.FTag := nil;
end;

{ TState }

constructor TState.Create(const AState: IState);
begin
    FState := AState;
    if not Assigned(FState) then
        FState := FNull;
end;

class constructor TState.ClassCreate;
begin
    // 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<TState>): TState;
var
    Latch: TLatch.ILatch;
begin
    Latch := TLatch.CreateLatch(Length(States));
    for var i := 0 to High(States) do
        States[i].Subscribe(Latch);
    Result := Latch.State;
end;

class function TState.Any(const States: TArray<TState>): TState;
var
    Latch: TLatch.ILatch;
begin
    if Length(States) = 0 then
    begin
        Result := TState.Null;
    end
    else
    begin
        Latch := TLatch.CreateLatch(1);
        for var i := 0 to High(States) do
            States[i].Subscribe(Latch);
        Result := Latch.State;
    end;
end;

function TState.GetAsSignal: TSignal;
begin
    Result := FState;
end;

function TState.GetIsSet: Boolean;
begin
    Result := FState.IsSet;
end;

function TState.Subscribe(Subscriber: TSignal.ISubscriber): TSignal.TSubscription;
begin
    Result := TSignal.TSubscription.Create(FState, FState.Subscribe(Subscriber));
end;

class operator TState.Implicit(const A: TState): IState;
begin
    Result := A.FState;
end;

class operator TState.Implicit(const A: IState): TState;
begin
    Result.Create(A);
end;

class operator TState.Initialize(out Dest: TState);
begin
    Dest.FState := FNull;
end;

{ TEvent }

constructor TEvent.Create(const AEvent: IEvent);
begin
    FEvent := AEvent;
    if not Assigned(FEvent) then
        FEvent := FNull;
end;

class constructor TEvent.ClassCreate;
begin
    FNull := TMycNullEvent.Create();
end;

class function TEvent.CreateEvent: TEvent;
begin
    Result := TMycEvent.Create;
end;

class function TEvent.CreateRouter(const Signal: TSignal): TEvent;
begin
    Result := TMycRouterEvent.Create(Signal);
end;

function TEvent.GetSignal: TSignal;
begin
    Result := FEvent.Signal;
end;

function TEvent.Notify: Boolean;
begin
    Result := FEvent.Notify;
end;

class operator TEvent.Implicit(const A: TEvent): IEvent;
begin
    Result := A.FEvent;
end;

class operator TEvent.Implicit(const A: IEvent): TEvent;
begin
    Result.Create(A);
end;

class operator TEvent.Initialize(out Dest: TEvent);
begin
    Dest.FEvent := FNull;
end;

{ TFlag }

class constructor TFlag.ClassCreate;
begin
    FNull := TMycNullFlag.Create;
end;

constructor TFlag.Create(const AFlag: IFlag);
begin
    FFlag := AFlag;
    if not Assigned(FFlag) then
        FFlag := FNull;
end;

class function TFlag.CreateFlag: TFlag;
begin
    Result := TMycFlag.Create;
end;

class function TFlag.CreateObserver(const Signal: TSignal): TFlag;
begin
    Result.Create(TMycObserverFlag.Create(Signal));
end;

function TFlag.GetState: TState;
begin
    Result := FFlag.State;
end;

function TFlag.Notify: Boolean;
begin
    Result := FFlag.Notify;
end;

function TFlag.Reset: Boolean;
begin
    Result := FFlag.Reset;
end;

class operator TFlag.Implicit(const A: IFlag): TFlag;
begin
    Result.Create(A);
end;

class operator TFlag.Implicit(const A: TFlag): IFlag;
begin
    Result := A.FFlag;
end;

class operator TFlag.Initialize(out Dest: TFlag);
begin
    Dest.FFlag := FNull;
end;

{ TLatch }

class constructor TLatch.ClassCreate;
begin
    // Create a singleton null latch instance that is initially (and always) set.
    FNull := TMycNullLatch.Create;
    FQueueLock := 0;
end;

constructor TLatch.Create(const ALatch: TLatch.ILatch);
begin
    FLatch := ALatch;
    if not Assigned(FLatch) then
        FLatch := FNull;
end;

class function TLatch.CreateLatch(Count: Integer): ILatch;
begin
    if Count > 0 then
        Result := TMycLatch.Create(Count)
    else
        Result := FNull;
end;

class function TLatch.Enqueue1(var Gate: TLatch): TState;
begin
    var Latch: TLatch.ILatch := TMycLatch.Create(1);

    repeat
        if FQueueLock > 0 then
        begin
            YieldProcessor;
            continue;
        end;
    until AtomicCmpExchange(FQueueLock, 1, 0) = 0;

    try
        Gate.State.Subscribe(Latch);
        Gate := Latch;
        Result := Latch.State;
    finally
        AtomicDecrement(FQueueLock);
    end;
end;

function TLatch.Enqueue: TState;
begin
    var Latch: ILatch := TMycLatch.Create(1);

    repeat
        if FQueueLock > 0 then
        begin
            YieldProcessor;
            continue;
        end;
    until AtomicCmpExchange(FQueueLock, 1, 0) = 0;

    try
        FLatch.State.Subscribe(Latch);
        FLatch := Latch;
        Result := FLatch.State;
    finally
        AtomicDecrement(FQueueLock);
    end;
end;

function TLatch.GetState: TState.IState;
begin
    Result := FLatch.State;
end;

function TLatch.Notify: Boolean;
begin
    Result := FLatch.Notify;
end;

class operator TLatch.Implicit(const A: TLatch.ILatch): TLatch;
begin
    Result.Create(A);
end;

class operator TLatch.Implicit(const A: TLatch): TLatch.ILatch;
begin
    Result := A.FLatch;
end;

class operator TLatch.Initialize(out Dest: TLatch);
begin
    Dest.FLatch := FNull;
end;

class constructor TSignal.ClassCreate;
begin
    FNull := TMycNullSignal.Create();
end;

{ TSignal }

constructor TSignal.Create(const ASignal: ISignal);
begin
    FSignal := ASignal;
    if not Assigned(FSignal) then
        FSignal := FNull;
end;

function TSignal.Subscribe(Subscriber: ISubscriber): TSubscription;
begin
    Result := TSubscription.Create(FSignal, FSignal.Subscribe(Subscriber));
end;

class operator TSignal.Implicit(const A: TSignal): ISignal;
begin
    Result := A.FSignal;
end;

class operator TSignal.Implicit(const A: ISignal): TSignal;
begin
    Result.Create(A);
end;

class operator TSignal.Initialize(out Dest: TSignal);
begin
    Dest.FSignal := FNull;
end;

end.