[fpc-pascal] Primitive Record Wrappers

[Mazola Winstrol]

Hello,

In the code bellow, the generic type TNullableTyple is implemented (and
incomplete for now).

Is there any possibility of "nullable types" be added to RTL or anyother
fpc provided package?


unit NullableTypes;

{$mode delphi}{$H+}

interface

type

  { TNullable }

  TNullable<T> = record
  strict private
    FValue: T;
    FHasValue: IInterface;
    function GetValue: T;
    function GetHasValue: Boolean;
    procedure SetValue(const AValue: T);
    procedure SetFlatInterface(var Intf: IInterface);
  public
    constructor Create(const AValue: T);
    function GetValueOrDefault: T; overload;
    function GetValueOrDefault(Default: T): T; overload;
    property HasValue: Boolean read GetHasValue;
    property Value: T read GetValue;

    class operator Implicit(AValue: TNullable<T>): T;
    class operator Implicit(const AValue: T): TNullable<T>;
    class operator Explicit(AValue: TNullable<T>): T;
  end;

  TInteger = TNullable<Integer>;


function NopAddref(inst: Pointer): Integer; stdcall;
function NopRelease(inst: Pointer): Integer; stdcall;
function NopQueryInterface(inst: Pointer; const IID: TGUID; out Obj):
HResult;

const
  FlagInterfaceVTable: array[0..2] of Pointer =
  (
    @NopQueryInterface,
    @NopAddref,
    @NopRelease
  );
  FlagInterfaceInstance: Pointer = @FlagInterfaceVTable;

implementation

uses
  SysUtils;



function NopAddref(inst: Pointer): Integer; stdcall;
begin
  Result := -1;
end;

function NopRelease(inst: Pointer): Integer; stdcall;
begin
  Result := -1;
end;

function NopQueryInterface(inst: Pointer; const IID: TGUID; out Obj):
HResult;
stdcall;
begin
  Result := E_NOINTERFACE;
end;

{ TNullable }

procedure TNullable<T>.SetFlatInterface(var Intf: IInterface);
begin
  Intf := IInterface(@FlagInterfaceInstance);
end;

class operator TNullable<T>.Explicit(AValue: TNullable<T>): T;
begin
  Result := AValue.Value;
end;

function TNullable<T>.GetHasValue: Boolean;
begin
  Result := FHasValue <> nil;
end;

function TNullable<T>.GetValue: T;
begin
  if not HasValue then
    raise Exception.Create('Invalid operation, Nullable type has no value');
  Result := FValue;
end;

function TNullable<T>.GetValueOrDefault: T;
begin
  if HasValue then
    Result := FValue
  else
   Result := Default(T);
end;

function TNullable<T>.GetValueOrDefault(Default: T): T;
begin
  if not HasValue then
    Result := Default
  else
    Result := FValue;
end;

class operator TNullable<T>.Implicit(AValue: TNullable<T>): T;
begin
  Result := AValue.Value;
end;

class operator TNullable<T>.Implicit(const AValue: T): TNullable<T>;
begin
  Result := TNullable<T>.Create(AValue);
end;

procedure TNullable<T>.SetValue(const AValue: T);
begin
  FValue := AValue;
  SetFlatInterface(FHasValue);
end;

constructor TNullable<T>.Create(const AValue: T);
begin
  FValue := AValue;
  SetFlatInterface(FHasValue);
end;

end.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20160227/53cebc88/attachment.html>