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.