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

Ben Grasset6-28-2019 01:09 UTC

The relevant forum post can be found here.
<https://forum.lazarus.freepascal.org/index.php/topic,45818.msg324506.html#msg324506>

Currently, this just implements "Map", "Filter" and "Reduce", but I thought I'd get some feedback / opinions on what the best area of the FPC codebase for the unit to go would be / e.t.c. on the whole thing before I went any further.

Two things to note:

A) My implementation takes advantage of the (undocumented) fact that you can indeed have generic type helpers if you define them inside the scope of another generic type. This allows for a significantly nicer API than would be otherwise possible (I.E. an end user doesn't even have to directly use generic themselves if they don't want to), and also for easy declaration of type aliases that then just automatically have the routines associated with them.

B) Oddly, this kind of use of type helpers only works in {$mode Delphi}, and in fact crashes the compiler in {$mode ObjFPC}. This is obviously a bug that I'll probably make a report for on the tracker at some point. That said, the unit I've written can of course be *used* from other units that use any other compiler mode at all without issues, which makes the bug not really directly a problem in this case.

*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*.

I also wrote a small example / test program to give an idea of how the unit can be used:

*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*.

Reply by email

Ben Grasset6-28-2019 16:39 UTC

to Ben Grasset

PM Ben Grasset 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.

Reply by email

Unknown author6-28-2019 18:03 UTC

to Ben Grasset

Ben Grasset wrote
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.

FWIW: it did that because it *BOLD*ed those lines or at least attempted to...

yeah, it is another reason to use plain-text for mailing list and newsgroup posts ;)

NOTE: No off-list assistance is given without prior approval. *Please keep mailing list traffic on the list unless* *a signed and pre-paid contract is in effect with us.*

Reply by email

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

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