[fpc-devel] "Blank slate" next version of FPC
Ben Grasset
operator97 at gmail.com
Fri Feb 22 16:51:02 CET 2019
On Fri, Feb 22, 2019 at 1:07 AM Paul van Helden <paul at planetgis.co.za>
wrote:
> How do you make a (for in) enumerator with a record? I don't use them for
> exactly this reason, and they did seem to be another useful language
> feature that turned out to be poorly implemented by Embarcadero. (Haven't
> checked with FPC).
>
Here's an example (for FPC) that demonstrates it by implementing the
"take-while" pattern:
program TakeWhileExample;
{$mode Delphi}{$H+}{$J-}
{$modeswitch NestedProcVars}
{$ImplicitExceptions Off}
{$PointerMath On}
type
TSlice<T> = record
public type
PT = ^T;
ArrayType = array of T;
private
FFirst, FLast, FCurrent: PT;
function GetCurrent: T; inline;
public
function GetEnumerator: TSlice<T>; inline;
function MoveNext: Boolean; inline;
class function TakeWhile(const A: ArrayType; function F(const Val: T):
Boolean): TSlice<T>; static; inline;
property Current: T read GetCurrent;
end;
TTestFunc<T> = function(const Val: T): Boolean;
function TSlice<T>.GetCurrent: T;
begin
Result := FCurrent^;
end;
function TSlice<T>.GetEnumerator: TSlice<T>;
begin
Result := Self;
with Result do FCurrent := FFirst - 1;
end;
function TSlice<T>.MoveNext: Boolean;
begin
Inc(FCurrent);
Exit((FCurrent <= FLast) and (FFirst <> FLast));
end;
function Test(const Val: SizeUInt): Boolean; inline;
begin
Exit((Val < 50000000));
end;
class function TSlice<T>.TakeWhile(const A: ArrayType; function F(const
Val: T): Boolean): TSlice<T>;
var
I: SizeUInt;
X: TTestFunc<T> absolute F;
//FPC generates slightly better code for the "absolute" way, not sure
why...
begin
with Result do begin
FFirst := @A[0];
FLast := @A[0];
for I := 0 to High(A) do
case X(A[I]) of
True: Inc(FLast);
False: Exit();
end;
end;
end;
var
I, J: SizeUInt;
Arr: TSlice<SizeUInt>.ArrayType;
begin
SetLength(Arr, 100000000);
for I := 0 to 99999999 do Arr[I] := I;
I := 0;
J := 0;
for I in TSlice<SizeUInt>.TakeWhile(Arr, Test) do J := I;
WriteLn(J);
end.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-devel/attachments/20190222/fbb946ba/attachment.html>
More information about the fpc-devel
mailing list