Snippets

Created by Алексей Корепанов
unit uIntfRecord;

interface

uses
  System.SysUtils;

type
  TRecord<T: record> = record
  private type
    PT = ^T;
  public type
    IRecord = interface(TFunc<T>)
      procedure Invoke(out ARef: PT); overload;
    end;

  private type
    PVTTable = ^TVTTable;
    TVTTable = array[0..4] of Pointer;

    PSimpleInstance = ^TSimpleInstance;
    TSimpleInstance = record
      Vtable: PVTTable;
      RefCount: Integer;
      Value: T;
    end;
  private

    class function MakeInstance(const VTable: PVTTable; const AValue: T): Pointer; static; inline;

    class function QueryInterface(inst: Pointer; const IID: TGUID; out Obj): HResult; stdcall; static;
    class function _AddRef(const inst: PSimpleInstance): Integer; stdcall; static;
    class function _Release(const inst: PSimpleInstance): Integer; stdcall; static;
    class function InvokeValue(const inst: PSimpleInstance): T; overload; static;
    class procedure InvokeRef(const inst: PSimpleInstance; out ARef: PT); overload; static;
  public
    class function Create(const AValue: T): IRecord; static; inline;
  end;

  TRecord = record
  public
    class function Create<T: record>(const AValue: T): TRecord<T>.IRecord; static; inline;
  end;

implementation

{ TRecord<T> }

class function TRecord<T>.QueryInterface(inst: Pointer; const IID: TGUID; out Obj): HResult;
begin
  Result := E_NOINTERFACE;
end;

class function TRecord<T>._AddRef(const inst: PSimpleInstance): Integer;
begin
  Result := AtomicIncrement(inst^.RefCount);
end;

class function TRecord<T>.Create(const AValue: T): IRecord;
const
  LVTable: TVTTable = (
    @QueryInterface,
    @_AddRef,
    @_Release,
    @InvokeValue,
    @InvokeRef);
begin
  Result := IRecord(MakeInstance(@LVTable, AValue));
end;

class function TRecord<T>.InvokeValue(const inst: PSimpleInstance): T;
begin
  Result := Inst^.Value;
end;

class procedure TRecord<T>.InvokeRef(const inst: PSimpleInstance; out ARef: PT);
begin
  ARef := @Inst^.Value;
end;

class function TRecord<T>.MakeInstance(const VTable: PVTTable; const AValue: T): Pointer;
var
  LInstance: PSimpleInstance;
begin
  GetMem(LInstance, SizeOf(LInstance^));
  LInstance^.Vtable := VTable;
  LInstance^.RefCount := 0;
  LInstance^.Value := AValue;
  Result := LInstance;
end;

class function TRecord<T>._Release(const inst: PSimpleInstance): Integer;
begin
  Result := AtomicDecrement(inst^.RefCount);
  if Result = 0 then
    FreeMem(inst);
end;

{ TRecord }

class function TRecord.Create<T>(const AValue: T): TRecord<T>.IRecord;
begin
  Result := TRecord<T>.Create(AValue);
end;

end.

Comments (0)

HTTPS SSH

You can clone a snippet to your computer for local editing. Learn more.