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

[Ben Grasset]

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*.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-devel/attachments/20190627/a58e3aa6/attachment-0001.html>