[fpc-devel] Initial implementation of a "functional" array helper unit, as suggested by Sven Barth on the Lazarus forums.

[Ben Grasset]

On Thu, Jun 27, 2019 at 9:09 PM Ben Grasset <operator97 at gmail.com> wrote:

> -snip-
>
> Yikes, I didn't realize the "preformatted" code from the Lazarus HTML
exporter would show up with a bunch of asterisks outside of a real email
client.

Here's normal text versions of both the unit, and the example program:

unit Functional;

{$mode Delphi}{$H+}

interface

type
  TArrayHelper<T> = record
  public type
    TMapModifier = function(constref Current: T): T;
    TFilterTest = function(constref Current: T): boolean;
    TReduceModifier = procedure(var Accumulator: T; constref Current: T);
    ArrayType = array of T;
    THelperImpl = record helper for ArrayType
      function Map(const Modifier: TMapModifier): ArrayType; overload;
      function Filter(const Test: TFilterTest): ArrayType; overload;
      function Reduce(const Modifier: TReduceModifier): T; overload;
      class function Map(constref Values: array of T; const Modifier:
TMapModifier): ArrayType; static; overload;
      class function Filter(constref Values: array of T; const Test:
TFilterTest): ArrayType; static; overload;
      class function Reduce(constref Values: array of T; const Modifier:
TReduceModifier): T; static; overload;
    end;
  end;

  (* These are defined without the usual T prefix to avoid any conflict
     with possible existing type aliases. *)
  UInt8Array = TArrayHelper<Byte>.ArrayType;
  ShortIntArray = TArrayHelper<ShortInt>.ArrayType;
  SmallIntArray = TArrayHelper<SmallInt>.ArrayType;
  UInt16Array = TArrayHelper<Word>.ArrayType;
  UInt32Array = TArrayHelper<Cardinal>.ArrayType;
  Int32Array = TArrayHelper<LongInt>.ArrayType;
  Int64Array = TArrayHelper<Int64>.ArrayType;
  UInt64Array = TArrayHelper<QWord>.ArrayType;
  Float32Array = TArrayHelper<Single>.ArrayType;
  Float64Array = TArrayHelper<Double>.ArrayType;
  ShortStringArray = TArrayHelper<ShortString>.ArrayType;
  AnsiStringArray = TArrayHelper<AnsiString>.ArrayType;
  UnicodeStringArray = TArrayHelper<UnicodeString>.ArrayType;

implementation

function TArrayHelper<T>.THelperImpl.Map(const Modifier: TMapModifier):
ArrayType;
var I: PtrUInt;
begin
  SetLength(Result, Length(Self));
  for I := 0 to High(Self) do
    Result[I] := Modifier(Self[I]);
end;

function TArrayHelper<T>.THelperImpl.Filter(const Test: TFilterTest):
ArrayType;
var I, J: PtrUInt;
begin
  J := 0;
  SetLength(Result, Length(Self));
  for I := 0 to High(Self) do
    if Test(Self[I]) then begin
      Result[J] := Self[I];
      Inc(J);
    end;
  SetLength(Result, J);
end;

function TArrayHelper<T>.THelperImpl.Reduce(const Modifier:
TReduceModifier): T;
var I: PtrUInt;
begin
  Result := Self[0];
  for I := 1 to High(Self) do
    Modifier(Result, Self[I]);
end;

class function TArrayHelper<T>.THelperImpl.Map(constref Values: array of T;
const Modifier: TMapModifier): ArrayType;
var I: PtrUInt;
begin
  SetLength(Result, Length(Values));
  for I := 0 to High(Values) do
    Result[I] := Modifier(Values[I]);
end;

class function TArrayHelper<T>.THelperImpl.Filter(constref Values: array of
T; const Test: TFilterTest): ArrayType;
var I, J: PtrUInt;
begin
  J := 0;
  SetLength(Result, Length(Values));
  for I := 0 to High(Values) do
    if Test(Values[I]) then begin
      Result[J] := Values[I];
      Inc(J);
    end;
  SetLength(Result, J);
end;

class function TArrayHelper<T>.THelperImpl.Reduce(constref Values: array of
T; const Modifier: TReduceModifier): T;
var I: PtrUInt;
begin
  Result := Values[0];
  for I := 1 to High(Values) do
    Modifier(Result, Values[I]);
end;

end.

///////////////

program TestFunctional;

{$mode ObjFPC}{$H+}

uses Functional;

function NumMap(constref Current: LongInt): LongInt;
begin
  Result := Current + Current;
end;

function NumFilter(constref Current: LongInt): Boolean;
begin
  Result := Current > 5;
end;

procedure NumReduce(var Accumulator: LongInt; constref Current: LongInt);
begin
  Accumulator += Current;
end;

function StringMap(constref Current: AnsiString): AnsiString;
begin
  Result := Current + Current;
end;

function StringFilter(constref Current: AnsiString): boolean;
begin
  Result := Current > 'e';
end;

procedure StringReduce(var Accumulator: AnsiString; constref Current:
AnsiString);
begin
  Accumulator += Current;
end;

var
  I: LongInt;
  S: AnsiString;

begin
  WriteLn('Instanced Integer Map!');
  for I in Int32Array.Create(1, 2, 3, 4, 5, 6, 7, 8, 9, 10).Map(@NumMap) do
WriteLn(I);

  WriteLn('Instanced Integer Filter!');
  for I in Int32Array.Create(1, 2, 3, 4, 5, 6, 7, 8, 9,
10).Filter(@NumFilter) do WriteLn(I);

  WriteLn('Instanced Integer Reduce!');
  WriteLn(Int32Array.Create(1, 2, 3, 4, 5, 6, 7, 8, 9,
10).Reduce(@NumReduce));

  WriteLn('Static Integer Map!');
  for I in Int32Array.Map([1, 2, 3, 4, 5, 6, 7, 8, 9, 10], @NumMap) do
WriteLn(I);

  WriteLn('Static Integer Filter!');
  for I in Int32Array.Filter([1, 2, 3, 4, 5, 6, 7, 8, 9, 10], @NumFilter)
do WriteLn(I);

  WriteLn('Static Integer Reduce!');
  WriteLn(Int32Array.Reduce([1, 2, 3, 4, 5, 6, 7, 8, 9, 10], @NumReduce));

  WriteLn('Instanced String Map!');
  for S in AnsiStringArray.Create('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h',
'i').Map(@StringMap) do WriteLn(S);

  WriteLn('Instanced String Filter!');
  for S in AnsiStringArray.Create('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h',
'i').Filter(@StringFilter) do WriteLn(S);

  WriteLn('Instanced String Reduce!');
  WriteLn(AnsiStringArray.Create('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h',
'i').Reduce(@StringReduce));

  WriteLn('Static String Map!');
  for S in AnsiStringArray.Map(['a', 'b', 'c', 'd', 'e', 'f', 'g', 'h',
'i'], @StringMap) do WriteLn(S);

  WriteLn('Static String Filter!');
  for S in AnsiStringArray.Filter(['a', 'b', 'c', 'd', 'e', 'f', 'g', 'h',
'i'], @StringFilter) do WriteLn(S);

  WriteLn('Static String Reduce!');
  WriteLn(AnsiStringArray.Reduce(['a', 'b', 'c', 'd', 'e', 'f', 'g', 'h',
'i'], @StringReduce));
end.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-devel/attachments/20190628/b5f8c8c6/attachment.html>