Leap Day has me in a whimsical mood. I wanted to write a light-hearted blog post for this special day but couldn’t think of any ideas. First, I thought about how cool it would have been if Delphi had been born on Feb 29, 1996 instead of Feb 14, 1995 (it would still be so young! 🙂 ), but ultimately decided that was not a great blog post. In the nick of time, along comes Marco with this blog post about creating a For loop with a step value greater than 1. His version works perfectly, but my first thought is that if they have a TParallel.For, they should have a TSequential.For… and so a blog post is born.

I quickly whipped up a class after breakfast to provide a sequential For iterator with step size, based on the TParallel model. I added For functions for Integer and Int64, but it can easily be extended to Singles or Doubles, or to add ForDownTo functions. The user would use the class like so:

procedure TForm7.Button1Click(Sender: TObject);
begin
 TSequential.For(0, ListBox1.Items.Count-1, 2, (procedure (const Index: Integer)
 begin
  ListBox1.Items[Index] := 'Leap!'+ListBox1.Items[Index];
 end));
end;

I wanted the user to be able to have Break and Continue like a regular For loop. Continue is obviously easy (just Exit). Break was a little harder. I decided to implement a TSequential.Break method that would silently break the user out of their loop. It raises a ESequentialAbort under the hood which is caught by the TSequential calling routine. The user would break like so:

procedure TForm7.Button1Click(Sender: TObject);
begin
 TSequential.For(0, ListBox1.Items.Count-1, 2, (procedure (const Index: Integer)
 begin
  if ContainsText( ListBox1.Items[Index], 'Day' ) then
   TSequential.Break;
  ListBox1.Items[Index] := 'Leap!'+ListBox1.Items[Index];
 end));
end;

Obviously, this class is not a marvel of efficiency as it uses a function call for each iteration as well as setting up a try…except block once. But it works, is clean, was fun to make, and as a bonus returns the final For loop index. You are welcome to use it as you like. If nothing else, I hope it lightened your day somewhat.

Happy Leap Day and Happy CodeSmithing!

The entire code is below or the file may be downloaded:

unit RSSequential;
//=== File Prolog ============================================================
// This code was developed by RiverSoftAVG (www.RiverSoftAVG.com)
//
//--- Notes ------------------------------------------------------------------
//
//--- Development History ---------------------------------------------------
//
// 02/29/2016 T. Grubb
// Initial version.
//
// File Contents:
//
//--- Warning ----------------------------------------------------------------
// This software is property of RiverSoftAVG. Unauthorized use or
// duplication of this software is strictly prohibited. Authorized users
// are subject to the following restrictions:
// * RiverSoftAVG is not responsible for
// any consequence of the use of this software.
// * The origin of this software must not be misrepresented either by
// explicit claim or by omission.
// * Altered versions of this software must be plainly marked as such.
// * This notice may not be removed or altered.
//
// © 2016, Thomas G. Grubb
//
//=== End File Prolog ========================================================

interface

uses
 System.Types, System.SysUtils, System.Classes, System.Generics.Collections,
 System.Generics.Defaults, System.SysConst;

type
 TFunctionEvent<T> = function (Sender: TObject): T of object;
 TSequential = class sealed
 public
 type
 ESequentialAbort = class(EAbort);
 TProcInt = reference to procedure (const Index: Integer);
 TProcInt64 = reference to procedure (const Index: Int64);
 TIteratorEvent = procedure (Sender: TObject; AIndex: Integer) of object;
 TIteratorEvent64 = procedure (Sender: TObject; AIndex: Int64) of object;
 protected
 class function ForWorker(Sender: TObject; AEvent: TIteratorEvent;
 const AProc: TProcInt; ALowInclusive, AHighExclusive: Integer;
 AStride: Integer = 1): Integer; static;
 class function ForWorker64(Sender: TObject; AEvent: TIteratorEvent64;
 const AProc: TProcInt64; ALowInclusive, AHighExclusive: Int64;
 AStride: Int64 = 1): Int64; static;
 public
 class procedure Break;
 class function &For(ALowInclusive, AHighInclusive: Integer; const AIteratorEvent: TProcInt): Integer; overload; static; inline;
 class function &For(ALowInclusive, AHighInclusive, AStride: Integer; const AIteratorEvent: TProcInt): Integer; overload; static; inline;
 class function &For(ALowInclusive, AHighInclusive: Int64; const AIteratorEvent: TProcInt64): Int64; overload; static; inline;
 class function &For(ALowInclusive, AHighInclusive, AStride: Int64; const AIteratorEvent: TProcInt64): Int64; overload; static; inline;
 end;

implementation

{ TSequential }

class function TSequential.&For(ALowInclusive, AHighInclusive, AStride: Integer;
 const AIteratorEvent: TProcInt): Integer;
begin
 result := ForWorker(nil, nil, AIteratorEvent, ALowInclusive, AHighInclusive, AStride);
end;

class function TSequential.&For(ALowInclusive, AHighInclusive: Integer;
 const AIteratorEvent: TProcInt): Integer;
begin
 result := ForWorker(nil, nil, AIteratorEvent, ALowInclusive, AHighInclusive);
end;

class procedure TSequential.Break;
begin
 raise ESequentialAbort.CreateRes(@SOperationAborted) at ReturnAddress;
end;

class function TSequential.&For(ALowInclusive, AHighInclusive, AStride: Int64;
 const AIteratorEvent: TProcInt64): Int64;
begin
 result := ForWorker64(nil, nil, AIteratorEvent, ALowInclusive, AHighInclusive, AStride);
end;

class function TSequential.ForWorker(Sender: TObject; AEvent: TIteratorEvent;
 const AProc: TProcInt; ALowInclusive, AHighExclusive,
 AStride: Integer): Integer;
begin
 if AHighExclusive <= ALowInclusive then
 begin
 Result := ALowInclusive;
 Exit;
 end;
 result := ALowInclusive;
 if AStride = 0 then AStride := 1;
 try
 while result <= AHighExclusive do
 begin
 AProc(result);
 result := result + AStride;
 end;
 except
 On ESequentialAbort do;
 end;
end;

class function TSequential.ForWorker64(Sender: TObject;
 AEvent: TIteratorEvent64; const AProc: TProcInt64; ALowInclusive,
 AHighExclusive, AStride: Int64): Int64;
begin
 if AHighExclusive <= ALowInclusive then
 begin
 Result := ALowInclusive;
 Exit;
 end;
 result := ALowInclusive;
 if AStride = 0 then AStride := 1;
 try
 while result <= AHighExclusive do
 begin
 AProc(result);
 result := result + AStride;
 end;
 except
 On ESequentialAbort do;
 end;
end;

class function TSequential.&For(ALowInclusive, AHighInclusive: Int64;
 const AIteratorEvent: TProcInt64): Int64;
begin
 result := ForWorker64(nil, nil, AIteratorEvent, ALowInclusive, AHighInclusive);
end;

end.