Forms and Data Entry Validation – Part 1

This is not an article about LiveBinding. I was once hoping it was going to be, but instead it has become an alternative to LiveBinding. If anything, it is about compile-time binding and quality assuring the data input from of your users.

Forms, forms, forms…

How many forms have you created?  Chance is – quite a few – and what do they have in common?   If people type rubbish, your data becomes rubbish.  So – what do you do?  You validate the input to prevent rubbish getting into the system.  You do… don’t you? Sure you do!

When do you validate it?  When someone clicks Submit or OK?  Right – then you have to go through the input, field by field, and first ensure that what the user typed in actually is understandable in the current context – such as no funny characters in an integer – and sometimes you have to check  the values against each other for logical states. If someone said they took three melons, their combined weight should at least be bigger than zero, and blue shirts don’t go well with pink pants, and what else not.

If the user typed in rubbish – you have to inform him or her so that it can be corrected.

Been there, done that

There is a certain amount of logic in this scene that we keep recreating scaffolding for.  Stuffing things into listboxes, formatting and filling in the values, validation of numbers and dates, converting enumerated types into strings (and back again). If you want the dialog to be slick – you might even want to validate as you go, which means eventhandlers for focus changes, keys pressed, UI items clicked, dropped down and selected, also adding to all the scaffolding code.

Some time ago, I had to create yet another dialog.  Lines and lines of housekeeping code that surround the real validation logic.  And naturally I don’t have to be clearvoyant to foresee numerous more such dialogs, as it is a major part of writing applications that deal with configuration, input and control.

So – I thought to myself – can I spend a little time now, and save a lot of time later?  Dangerous, innit, thinking like that…  suddenly you could find yourself writing a framework, and we all know what happens to frameworks, right?  They turn to endless amounts of code written with good intentions of handling the unexpected, covering functionality you won’t ever need, and at some point collapse on themselves to become a black hole of sketchily documented (since noone updated the docs as new features got added) , and hastily changed (since you always are in a hurry for that extra functionality) code.  And when someone else misread your framework intentions and applied it like a hammer to a screw – it just doesn’t end well.

Narrowing down the scope

Hence – Sticking with the KISS principle, I have decided to try to make it independent of other libraries, and limit what I implement to basic functionality while attempting to allow for future expansion.

I am going to create a TInput that wraps a GUI control.  To put it simply – a TInput that points to a specific TEdit, and takes care of stuffing values from the variable and into the GUI control, and vice versa.  The job of that TInput is the present the value correctly, and to ensure that what ever is written into that TEdit, can be converted into an integer.

I will also create a TInputList that is a collection of TInputs, that will have the job of going through the list to fill the controls, to validate the contents, and finally – if all input is syntactically correct – semantically validate the input for logical correctness.

Some of the code that I will present here, is probably centric to the type of data that I work on.  For me, an input form will  typically wrap an object with a set of properties that reflect a row or set of related rows in a database.  Why am I not using data aware controls?  Mostly because the applications we create actually can’t write to the database themselves, except through calling stored procedures that perform more magic before, during, or after the data has been written.  For that reason, the TInputList will be a TInputList, and the TInputList will have a property Current:T that I can populate, and each TInput will know that it is member of a TInputList, so that it can kick of the necessary actions for stuff to get validated.

[kom-pli-kei-tid]

By now you have probably thought to yourself: TEdit?  What about the other controls?

Because there are a number of input types, and a number of controls, and these make a number of combinations. TEdit/Double, TEdit/Integer, TEdit/String, and TEdit/Enum is already a list, and I haven’t even mentioned TComboBox yet,- so it is obvious that TInputList has to be polymorphic.

This brings us to the first part of complicated – creating a set of generic and polymorphic classes.  Generics in Delphi XE still don’t to well with forward declarations, and to create polymorphic parent/children lists, it really helps to be able to forward declare.

After some consideration, I have chosen to use an abstract class without generics as my inner base class.  TAbstractInput will know nothing about the data type we want to work with, nor will it know anything about the control type.  All TAbstractInput will do, is define the virtual abstract methods that will be our type agnostic operators or verbs and queries, if you like.  Hence, our TInputList will use TAbstractInput as its element type.

///  TAbstractInput defines the bare minimum base class for our list of inputs 

TAbstractInput = class abstract
private
protected
function GetEdited: Boolean; virtual; abstract;
procedure SetEdited(const Value: Boolean); virtual; abstract;
function GetEnabled: Boolean; virtual; abstract;
procedure SetEnabled(const Value: Boolean); virtual; abstract;
function ControlValueIsValid:Boolean; virtual; abstract;
function VariableValueIsValid:Boolean; virtual; abstract;
procedure FillControl; virtual; abstract;
procedure FillVariable; virtual; abstract;
procedure SetDisabledState; virtual; abstract;
procedure SetErrorState; virtual; abstract;
procedure SetNormalState; virtual; abstract;
procedure SaveNormalState; virtual; abstract;
procedure Setup; virtual; abstract;
public
procedure Clear; virtual; abstract;
procedure Update; virtual; abstract;
function Validate: Boolean; virtual; abstract;
property Edited: Boolean read GetEdited write SetEdited;
property Enabled: Boolean read GetEnabled write SetEnabled;
end;

From the outside of the list, we need TInput that expose the correct type that we want to access, so that will be our outer base class type – which knows how to set and get the value, and hence the class that we use to reference an input field.

///  TInput defines the input wrapper as we want it to be

/// visible from the outside of our list of controls

TInput = class abstract(TAbstractInput)
private
FOnCanGetValue: TGetValue;
procedure SetOnCanGetValue(const Value: TGetValue);
protected
function GetValue:T; virtual; abstract;
procedure SetValue(const Value:T); virtual; abstract;
function CanGetValue:Boolean; virtual; abstract;
public
property Value:T read GetValue write SetValue;
property OnCanGetValue: TGetValue read FOnCanGetValue write SetOnCanGetValue;
end;

Please note that this is a simplified view of TInput class.

Inside TInputList, I will subclass TInput again, and add knowledge of the controls.  In fact, I will create several subclasses that handle type conversions for each data type and control type, but instead of having the user instantiate all these different class types – I will add factory methods to the TInputList instead.

Here are some excerpts from the declaration of TInputList and the basic control wrapper.

///  TInputList is a wrapper for all our input controls. 

TInputList = class(TList)
...
public
type
/// This is our core input control wrapper on which we base wrappers for specific controls
TInputControl = class(TInput)
private
FController: TInputList;
FControl: TCtrl;
FValue: SVT;
...
end;
end;

Properties and Binding

This is the second part of complicated. Will I be using the XE2 LiveBinding? No. IMO, LiveBinding uses the least desirable method to bind a property for setting and getting. I lamented this in my previous article, Finding yourself in a property bind. In my opinion, LiveBinding is a good idea that is implemented in the wrong way, and in it’s current form will be vulnerable to property and variable name changes during refactoring. In addition, it appears that LiveBinding is not quite mature yet. Then there is the fact that XE and older, doesn’t have LiveBinding.

After some experimentation, I came to the conclusion that even if it appears to be more elegant to use visitors or observers and RTTI binding, I will get more flexibility, readability, and maintainability by using anonymous methods.

Anonymous methods allow me to do manipulation of the value before it is set/get, and allow the setter/getter events to have side effects. It also ensures that all references are validated compile-time. It will not guarantee protection from referencing the wrong properties and variables, but they will at least be of the right type, and actually exist.

Since my primary development platform is Windows, I am a VCL developer – and when I started this little project, I had only VCL in mind. However, as the code matured, I found that I might want to be able to use this for FireMonkey as well. That still remains to be seen as FireMonkey still smell of Baboon.

Still, the core logic is platform agnostic, and the VCL bits are separated into a unit of their own.

Here is an excerpt from the VCL implementation with complete declarations.

TInputListVCL = class(TInputList)

public
type
TInputControlVCL = class(TInputList.TInputControl)
protected
procedure ControlEnable(const aState:Boolean); override;
function ControlEnabled:Boolean; override;
procedure ControlSetFocus(const aFocused:Boolean); override;
end;

/// Basic wrapper for a TEdit
TEditTemplate = class abstract(TInputControlVCL)
private
FNormalColor: TColor;
protected
procedure SetControlValue(const Control:TEdit; const v:String); override;
function GetControlValue(const Control:TEdit): String; override;
function ControlValueAsString:String; override;
procedure SetErrorState; override;
procedure SetNormalState; override;
procedure SaveNormalState; override;
procedure SetDisabledState; override;
public
procedure Clear; override;
procedure Setup; override;
end;

/// TEdit wrapper for editing a string
TEditString = class(TEditTemplate)
protected
function ConvertControlToVariable(const cv: String; var v:String; var ErrMsg:String):Boolean; override;
function ConvertVariableToControl(const v:String; var cv:String):Boolean; override;
end;

/// TEdit wrapper for editing a float
TEditDouble = class(TEditTemplate)
private
FDecimals: Integer;
protected
procedure SetDecimals(const Value: Integer); override;
function GetDecimals:Integer; override;
function ConvertControlToVariable(const cv: String; var v:Double; var ErrMsg:String):Boolean; override;
function ConvertVariableToControl(const v:Double; var cv:String):Boolean; override;
end;

...

end;

Putting it to use

This will be covered in part 2. Until then, don’t forget to try out RAD Studio XE2 and join the RAD Studio World Tour presentations!

A generic cache

Update: Eric Grange suggested a change to TStringList that speeds it up significantly and place it well in front of TCache. I will update the article to reflect this in the end of the week. See the article comments for the details.

In my previous article about a generics based case statement for strings, I commited many sins towards the Church Of Pure Pascal 🙂

One of them was to not check for prior art. Sergey Antonov aka 0xffff did something similar back in April 2010 (Note: two links!).

So, to make penance for my lack of purity (and have a chance to sin some more), I have tried to take the good parts of the concept and create something less ugly, and more comfortable to use.

I rewrote the generic class and named it TCache. I kept the configurable key type, and I made the lookup value configurable as well. Basically, it all ends up as a thin wrapper around a dictionary, but I quite like the simple declaration you can achieve with this approach.

Example declaration

var
Cache : TCache;
i : Integer;
begin
if not Assigned(Cache)
then TCache
.Define(Cache, 0)
['alpha', 11]
['bravo', 22]
['charlie', 33]
['delta', 44]
['echo', 55]
['foxtrot', 66];

i := Cache.Lookup('charlie');

Remember that can be almost any type you like, including code (for the value part, at least).

Here is the class. Note that I also keep track of the index of the order each key/value was added. This could be removed. Also note that I still do dirty deeds, such as a dangerous cast. I guess I just suck at writing clean code ;).

unit GenericsCache;

/// Written by Lars Fosdal , December 5, 2010

interface
uses
SysUtils, Generics.Collections;

type
TCacheEntry = record
Value: T;
Index: Integer;
end;

TCache = class(TObjectDictionary<KeyT, TCacheEntry>)
private
FCache: TCache;
FDefaultValue: ValT;
function AddValue(const Id: KeyT; const Value: ValT): TCache;
protected
function ValidateId(Id: KeyT): KeyT; virtual;
public
class function Define(var Cache; const aDefaultValue:ValT): TCache;
function Lookup(const Id: KeyT):ValT;
function Index(const Id: KeyT):Integer;
property DefaultValue: ValT read FDefaultValue write FDefaultValue;
property Values[const Id: KeyT; const Value: ValT]: TCache read AddValue; default;
end;

TCaseStringCache = class(TCache)
function ValidateId(Id: String): String; override;
end;

implementation

{ TCache }

function TCache.AddValue(const Id: KeyT; const Value: ValT): TCache;
var
Rec : TCacheEntry;
begin
Result := Self;
Rec.Value := Value;
Rec.Index := Count;
Add(ValidateId(Id), Rec);
end;

class function TCache.Define(var Cache; const aDefaultValue: ValT): TCache;
begin
Result := Create;
Result.FCache := Result;
Result.DefaultValue := aDefaultValue;
TCache(Cache) := Result;
end;

function TCache.Index(const Id: KeyT): Integer;
var
Rec : TCacheEntry;
begin
if TryGetValue(ValidateId(Id), Rec)
then Result := Rec.Index
else Result := -1;
end;

function TCache.Lookup(const Id: KeyT): ValT;
var
Rec : TCacheEntry;
begin
if FCache.TryGetValue(ValidateId(Id), Rec)
then Result := Rec.Value
else Result := DefaultValue;
end;

function TCache.ValidateId(Id: KeyT): KeyT;
begin
Result := Id;
end;

{ TCaseStringCache }

function TCaseStringCache.ValidateId(Id: String): String;
begin
Result := LowerCase(Id);
end;

end.

I wrote a simple benchmark, testing different ways to use this, and also comparing it to do String2Index / Case -type lookup mechanisms as well as if/then/else, and the ugly method from my previous article. Several people suggested using a string to index / case approach. I have also used that many times. The painful part of strings to index, is that if you change the order of the strings, you also have to change the indices. TCache makes the index entirely optional, since the string is the index – if you see what I mean.

See below for the test code.

The Good, The Bad, and the Ugly.

The test uses GetTickCount and 5.000.000 iterations, for each method, repeated 10 times, with 12 strings (the numbers are consistant at 6 strings as well – except that string to index will be slightly faster) and the process priority was set to High to avoid other parts of the PC affecting the numbers. I weighted the results towards the results for the if/then/else. So Perf tells you how many times slower than if/then/else each test was.

Method Perf AvgRun Comment
TStringSwitch 52.94 35340.7 The ugly was really ugly performance-wise as well.
AnsiIndexTextFunc 12.40 8277.3 String to Index, then case/anon.method is no speed demon either.
StringIndex 12.05 8041.7 Jolyon’s variant is around the same speed.
AnsiIndexText 12.03 8032.6 If you remove anon.methods, the impact is not huge.
TStringList 6.94 4631.6 Using a pre-created sorted string list is nearly twice the speed of AnsiIndexText.
TCacheProc 3.70 2471.1 Cool, TCache and anon.methods are nearly twice the speed of a string list.
TCacheFunc 3.71 2475.8 No signficant difference between a procedure and function.
TCacheFuncStack 3.72 2480.5 Passing the anon.method by stack doesn’t cost much either.
TCaseStringCache 3.12 2085.6 Case insensitive string to string saves some time over using anon.methods.
TCacheString 2.93 1957.9 So does eliminating the LowerCase function. TCache with string/string is 3 times slower than if/then/else, but it is 4 times faster than AnsiIndexText, and more than twice as fast as a string list.
If/then/else 1 667.6 You can’t beat this. You also can’t enjoy maintaining it.
LastKey 0.39 260.4 No surprise that indexed array lookups are fast. Yes, I know I am not looking up the same strings, but the cost is the same.

If you need to repeatedly do lookup by strings, you can benefit from using something like TCache. Also – for the AnsiIndexText – it does a sequential search for the match, hence if the list is long, or the later entries are more commonly used – it will degrade performancewise. Without having dissected TDictionary in detail, I would believe that it’s hash table will allow TCache to remain relativly constant in performance, even if you add thousands of entries.

You could also shave off some more by eliminating the ValidateId methods.

Here is the test program (which also use the unit from my previous article).

program TestGenericsSwitch;
{$apptype Console}
uses
ExceptionLog,
Windows,
Classes,
SysUtils,
StrUtils,
GenericsCache in 'GenericsCache.pas',
GenericsSwitch in 'GenericsSwitch.pas';

{$define Twelve} // remove this to run with 6 strings

const
{$ifndef Twelve}
Elements = 6;
{$else}
Elements = 12;
{$endif}
TestCount = 5000000;
Keys : Array[0..Elements] of String
= ('alpha','bravo', 'charlie', 'delta', 'echo', 'foxtrot',
{$ifdef Twelve}
'golf', 'hotel', 'india', 'juliet', 'kilo', 'lima',
{$endif}
'what');

type
TFunc = reference to function:String;
TProc = reference to procedure;

function RandomKey:String;
begin
Result := Keys[Random(Elements + 1)];
end;

function AssignTest:String;
var
ix : Integer;
s: String;
begin
for ix := 0 to TestCount - 1
do TStringSwitch.CaseOf(RandomKey)
['alpha', procedure begin
s := 'Definitively any case';
end]
['bravo', procedure begin
s := 'B all you can B';
end]
['charlie', procedure begin
s := 'Checkpoint C';
end]
['delta', procedure begin
s := 'Checkpoint D';
end]
['echo', procedure begin
s := 'Checkpoint E';
end]
['foxtrot', procedure begin
s := 'Checkpoint F';
end]
{$ifdef Twelve}
['golf', procedure begin
s:= 'golf';
end]
['hotel',procedure begin
s:= 'hotel';
end]
['india',procedure begin
s:= 'india';
end]
['juliet', procedure begin
s:= 'juliet';
end]
['kilo', procedure begin
s:= 'kilo';
end]
['lima', procedure begin
s:= 'lima';
end]
{$endif}
.ElseCase(procedure begin
s := 'Else what?';
end)
.EndCase;
Result := s;
end;

function AssignTestIf:String;
var
ix : Integer;
s, t: String;
begin
for ix := 0 to TestCount - 1 do
begin
t := LowerCase(RandomKey);
if t = 'alpha' then
s := 'Definitively any case'
else if t = 'bravo' then
s := 'B all you can B'
else if t = 'charlie' then
s := 'Checkpoint C'
else if t = 'delta' then
s := 'Checkpoint D'
else if t = 'echo' then
s := 'Checkpoint E'
else if t = 'foxtrot' then
s := 'Checkpoint F'
{$ifdef Twelve}
else if t = 'golf' then
s := 'golf'
else if t = 'hotel' then
s := 'hotel'
else if t = 'india' then
s := 'india'
else if t = 'juliet' then
s := 'juliet'
else if t = 'kilo' then
s := 'kilo'
else if t = 'lima' then
s := 'lima'
{$endif}
else
s := 'Else what?';
end;
Result := s;
end;

function AssignTestS2I:String;
var
ix : Integer;
s: String;
begin
for ix := 0 to TestCount - 1
do case AnsiIndexText(RandomKey, ['alpha', 'bravo', 'charlie', 'delta', 'echo', 'foxtrot'
{$ifdef Twelve}
, 'golf', 'hotel', 'india', 'juliet', 'kilo', 'lima'
{$endif}
]) of
0 : s := 'Definitively any case';
1 : s := 'B all you can B';
2 : s := 'Checkpoint C';
3 : s := 'Checkpoint D';
4 : s := 'Checkpoint E';
5 : s := 'Checkpoint F';
{$ifdef Twelve}
6 : s := 'golf';
7 : s := 'hotel';
8 : s := 'india';
9 : s := 'juliet';
10 : s := 'kilo';
11 : s := 'lima';
{$endif}
else s := 'Else what?';
end;
Result := s;
end;

function StringIndex(const aString: string; const aCases: array of string;
const aCaseSensitive: Boolean): Integer;
begin
if aCaseSensitive then
begin
for Result := 0 to Pred(Length(aCases)) do
if ANSISameText(aString, aCases[Result]) then
EXIT;
end
else
begin
for Result := 0 to Pred(Length(aCases)) do
if ANSISameStr(aString, aCases[Result]) then
EXIT;
end;

Result := -1;
end;

function AssignStringIndexFunc:String;
var
ix : Integer;
func : TFunc;
begin
for ix := 0 to TestCount - 1
do case StringIndex(RandomKey, ['alpha', 'bravo', 'charlie', 'delta', 'echo', 'foxtrot'
{$ifdef Twelve}
, 'golf', 'hotel', 'india', 'juliet', 'kilo', 'lima'
{$endif}], false) of
0 : func := function:String begin
Result := 'Definitively any case';
end;
1 : func := function:String begin
Result := 'B all you can B';
end;
2 : func := function:String begin
Result := 'Checkpoint C';
end;
3 : func := function:String begin
Result := 'Checkpoint D';
end;
4 : func := function:String begin
Result := 'Checkpoint E';
end;
5 : func := function:String begin
Result := 'Checkpoint F';
end;
{$ifdef Twelve}
6 : func := function:String begin
Result:= 'golf';
end;
7 : func := function:String begin
Result:= 'hotel';
end;
8 : func := function:String begin
Result:= 'india';
end;
9 : func := function:String begin
Result:= 'juliet';
end;
10: func := function:String begin
Result:= 'kilo';
end;
11: func := function:String begin
Result:= 'lima';
end;
{$endif}
else func := function:String begin
Result := 'Else what?';
end;
end;
Result := Func;
end;

function AssignTestS2IFunc:String;
var
ix : Integer;
func : TFunc;
begin
for ix := 0 to TestCount - 1
do case AnsiIndexText(RandomKey, ['alpha', 'bravo', 'charlie', 'delta', 'echo', 'foxtrot'
{$ifdef Twelve}
, 'golf', 'hotel', 'india', 'juliet', 'kilo', 'lima'
{$endif}]) of
0 : func := function:String begin
Result := 'Definitively any case';
end;
1 : func := function:String begin
Result := 'B all you can B';
end;
2 : func := function:String begin
Result := 'Checkpoint C';
end;
3 : func := function:String begin
Result := 'Checkpoint D';
end;
4 : func := function:String begin
Result := 'Checkpoint E';
end;
5 : func := function:String begin
Result := 'Checkpoint F';
end;
{$ifdef Twelve}
6 : func := function:String begin
Result:= 'golf';
end;
7 : func := function:String begin
Result:= 'hotel';
end;
8 : func := function:String begin
Result:= 'india';
end;
9 : func := function:String begin
Result:= 'juliet';
end;
10: func := function:String begin
Result:= 'kilo';
end;
11: func := function:String begin
Result:= 'lima';
end;
{$endif}
else func := function:String begin
Result := 'Else what?';
end;
end;
Result := Func;
end;

function AssignCaseStringCache:String;
var
ix : Integer;
s: String;
Cache : TCaseStringCache;
begin
TCaseStringCache.Define(Cache,
'Else what?')
['alpha', 'Definitively any case']
['bravo', 'B all you can B']
['charlie', 'Checkpoint C']
['delta', 'Checkpoint D']
['echo', 'Checkpoint E']
['foxtrot', 'Checkpoint F']
{$ifdef Twelve}
['golf', 'golf']
['hotel', 'hotel']
['india', 'india']
['juliet', 'juliet']
['kilo', 'kilo']
['lima', 'lima']
{$endif};
for ix := 0 to TestCount - 1
do s := Cache.Lookup(RandomKey);
Result := s;
end;

function AssignCacheString:String;
var
ix : Integer;
s: String;
Cache : TCache;
begin
TCache
.Define(Cache, 'Else what?')
['alpha', 'Definitively any case']
['bravo', 'B all you can B']
['charlie', 'Checkpoint C']
['delta', 'Checkpoint D']
['echo', 'Checkpoint E']
['foxtrot', 'Checkpoint F']
{$ifdef Twelve}
['golf', 'golf']
['hotel', 'hotel']
['india', 'india']
['juliet', 'juliet']
['kilo', 'kilo']
['lima', 'lima']
{$endif};
for ix := 0 to TestCount - 1
do s := Cache.Lookup(RandomKey);
Result := s;
end;

function AssignCacheProc:String;
var
ix : Integer;
s: String;
Cache : TCache;
begin
TCache.Define(Cache,
procedure begin
s := 'Else what?';
end)
['alpha', procedure begin
s := 'Definitively any case';
end]
['bravo', procedure begin
s := 'B all you can B';
end]
['charlie', procedure begin
s := 'Checkpoint C';
end]
['delta', procedure begin
s := 'Checkpoint D';
end]
['echo', procedure begin
s := 'Checkpoint E';
end]
['foxtrot', procedure begin
s := 'Checkpoint F';
end]
{$ifdef Twelve}
['golf', procedure begin
s:= 'golf';
end]
['hotel', procedure begin
s:= 'hotel';
end]
['india', procedure begin
s:= 'india';
end]
['juliet', procedure begin
s:= 'juliet';
end]
['kilo', procedure begin
s:= 'kilo';
end]
['lima', procedure begin
s:= 'lima';
end]
{$endif};

for ix := 0 to TestCount - 1
do Cache.Lookup(RandomKey)();
Result := s;
end;

function AssignCacheFuncStack:String;
var
ix : Integer;
s: String;
Cache : TCache;
begin
TCache.Define(Cache,
function:String begin
Result := 'Else what?';
end)
['alpha', function:String begin
Result := 'Definitively any case';
end]
['bravo', function:String begin
Result := 'B all you can B';
end]
['charlie', function:String begin
Result := 'Checkpoint C';
end]
['delta', function:String begin
Result := 'Checkpoint D';
end]
['echo', function:String begin
Result := 'Checkpoint E';
end]
['foxtrot', function:String begin
Result := 'Checkpoint F';
end]
{$ifdef Twelve}
['golf', function:String begin
Result := 'golf';
end]
['hotel',function:String begin
Result := 'hotel';
end]
['india',function:String begin
Result := 'india';
end]
['juliet', function:String begin
Result := 'juliet';
end]
['kilo', function:String begin
Result := 'kilo';
end]
['lima', function:String begin
Result := 'lima';
end]
{$endif};

for ix := 0 to TestCount - 1
do s := Cache.Lookup(RandomKey)();
Result := s;
end;

function AssignCacheFunc:String;
var
ix : Integer;
s: String;
func: TFunc;
Cache : TCache;
begin
TCache.Define(Cache,
function:String begin
Result := 'Else what?';
end)
['alpha', function:String begin
Result := 'Definitively any case';
end]
['bravo', function:String begin
Result := 'B all you can B';
end]
['charlie', function:String begin
Result := 'Checkpoint C';
end]
['delta', function:String begin
Result := 'Checkpoint D';
end]
['echo', function:String begin
Result := 'Checkpoint E';
end]
['foxtrot', function:String begin
Result := 'Checkpoint F';
end]
{$ifdef Twelve}
['golf', function:String begin
Result := 'golf';
end]
['hotel',function:String begin
Result := 'hotel';
end]
['india',function:String begin
Result := 'india';
end]
['juliet', function:String begin
Result := 'juliet';
end]
['kilo', function:String begin
Result := 'kilo';
end]
['lima', function:String begin
Result := 'lima';
end]
{$endif};

for ix := 0 to TestCount - 1
do begin
func := Cache.Lookup(RandomKey);
s := func;
end;
Result := s;
end;

function AssignStringList:String;
var
ix, fx : Integer;
s: String;
func : TFunc;
obj : TObject absolute func;
StrList : TStringList;
begin
StrList := TStringList.Create;

StrList.AddObject('alpha', TObject(function:String begin
Result := 'Definitively any case';
end));
StrList.AddObject('bravo', TObject(function:String begin
Result := 'B all you can B';
end));
StrList.AddObject('charlie', TObject(function:String begin
Result := 'Checkpoint C';
end));
StrList.AddObject('delta', TObject(function:String begin
Result := 'Checkpoint D';
end));
StrList.AddObject('echo', TObject(function:String begin
Result := 'Checkpoint E';
end));
StrList.AddObject('foxtrot', TObject(function:String begin
Result := 'Checkpoint F';
end));
//{$ifdef Twelve}
StrList.AddObject('golf', TObject(function:String begin
Result := 'golf';
end));
StrList.AddObject('hotel',TObject(function:String begin
Result := 'hotel';
end));
StrList.AddObject('india',TObject(function:String begin
Result := 'india';
end));
StrList.AddObject('juliet', TObject(function:String begin
Result := 'juliet';
end));
StrList.AddObject('kilo', TObject(function:String begin
Result := 'kilo';
end));
StrList.AddObject('lima', TObject(function:String begin
Result := 'lima';
end));
//{$endif}

StrList.Sorted := True;

for ix := 0 to TestCount - 1
do begin
fx := StrList.IndexOf(RandomKey);
if fx >= 0
then begin
obj := StrList.Objects[fx];
s := func;
end
else s := 'ElseWhat';
end;
Result := s;
end;

function TimeIt(proc: TFunc; name:String):Integer;
var
start : Cardinal;
LastLookup : String;
oldSeed : Integer;
begin
OldSeed := RandSeed;
start := GetTickCount;
LastLookup := Proc;
Result := GetTickCount - start;
Writeln(Format('%-18s %6d - %s', [name, Result, LastLookup]));
RandSeed := OldSeed;
end;

function LastKey:String;
var
ix : Integer;
s : String;
OldSeed : Integer;
begin
OldSeed := RandSeed;
for ix := 0 to TestCount - 1
do s := RandomKey;
RandSeed := OldSeed;
Result := s;
end;

procedure Test;
const
Repeats = 10;
var
ix : Integer;
begin
for ix := 0 to Repeats - 1
do begin
Randomize;
// RandSeed := 2003112605;
Writeln;
Writeln(Format('strings=%d, repeats=%d, seed=%d', [Elements, TestCount, RandSeed]));
TimeIt(AssignTest,'TStringSwitch');
TimeIt(AssignTestS2IFunc, 'AnsiIndexText Func');
TimeIt(AssignStringIndexFunc, 'StringIndex');
TimeIt(AssignTestS2I, 'AnsiIndexText');
TimeIt(AssignStringList,'TStringList');
TimeIt(AssignCacheProc, 'TCache Proc');
TimeIt(AssignCacheFunc, 'TCache Func');
TimeIt(AssignCacheFuncStack, 'TCache Func Stack');
TimeIt(AssignCaseStringCache, 'TCaseStringCache');
TimeIt(AssignCacheString, 'TCache String');
TimeIt(AssignTestIf, 'If/then/else');
TimeIt(LastKey, 'LastKey');
end;
end;

begin
try
Write('Press Enter to start: ');
Readln;

Test;

finally
Writeln;
Write('Press Enter: ');
Readln;
end;
end.

A generic case for strings

Do you remember the discussion about a case statement for strings?

I got this flash idea after reading Jolyon Smith’s “The case for case[]”, and remembering a comment from Francisco Ruiz on Nick Hodges’ article on THTMLWriter which suggested using a default array property in a creative fashion.

Honestly, it is not really a true case statement, and it might not be as fast as an if then else, but here is how it looks when used. A bit ugly. but good fun 🙂

program TestGenericsSwitch;
{$apptype Console}
uses
  GenericsSwitch;
begin
TStringSwitch.CaseOf('chARLie')
['Any', procedure begin
Writeln('Definitively any case');
end]
['B', procedure begin
Writeln('B all you can B');
end]
['Charlie', procedure begin
Writeln('Checkpoint C');
end]
.ElseCase(procedure begin
Writeln('Else what?');
end)
.EndCase;
end.

And here is how it is implemented.

unit GenericsSwitch;

/// Written by Lars Fosdal , December 1, 2010

interface
uses
SysUtils, Generics.Collections;

type
TSwitchProc = reference to procedure;
TGenericSwitch = class(TObjectDictionary)
private
FTheElseCase: TSwitchProc;
FTheTargetKey: KeyType;
function AddSwitchCase(const name: KeyType;
const value: TSwitchProc): TGenericSwitch;
procedure SetTheElseCase(const Value: TSwitchProc);
procedure SetTheTargetKey(const Value: KeyType);
protected
function ValidateKey(Key:KeyType):KeyType; virtual;
property TheTargetKey:KeyType read FTheTargetKey write SetTheTargetKey;
property TheElseCase:TSwitchProc read FTheElseCase write SetTheElseCase;
public
class function CaseOf(const Key: KeyType):TGenericSwitch;
function ElseCase(const Action: TSwitchProc): TGenericSwitch;
procedure EndCase;
property Cases[const name:KeyType; const value:TSwitchProc]: TGenericSwitch
read AddSwitchCase; default;
end;

TStringSwitch = class(TGenericSwitch)
function ValidateKey(key:String):String; override;
end;

implementation

{ TGenericSwitch }

function TGenericSwitch.AddSwitchCase(const name: KeyType; const value: TSwitchProc): TGenericSwitch;
begin
Result := Self;
Add(ValidateKey(Name), Value);
end;

class function TGenericSwitch.CaseOf(const Key: KeyType): TGenericSwitch;
begin
Result := Create;
Result.TheTargetKey := Key;
end;

function TGenericSwitch.ElseCase(const Action: TSwitchProc): TGenericSwitch;
begin
Result := Self;
TheElseCase := Action;
end;

procedure TGenericSwitch.EndCase;
var
DoIt : TSwitchProc;
begin
if TryGetValue(TheTargetKey, DoIt)
then DoIt
else
if Assigned(TheElseCase)
then TheElseCase;
Destroy;
end;

procedure TGenericSwitch.SetTheElseCase(const Value: TSwitchProc);
begin
FTheElseCase := Value;
end;

procedure TGenericSwitch.SetTheTargetKey(const Value: KeyType);
begin
FTheTargetKey := ValidateKey(Value);
end;

function TGenericSwitch.ValidateKey(Key: KeyType):KeyType;
begin
Result := Key;
end;

{ TStringSwitch }

function TStringSwitch.ValidateKey(key: String): String;
begin
Result := LowerCase(Key);
end;


end.

Anonymous Methods – When to use them?

As many others, I am still trying to wrap my head around this. All the hubbub about anon.methods, but lack of direct descriptions of actual use, lead us to take a “Emperor’s New Clothes” kind of view on them.

I believe there are some areas where anon.methods will have a significant impact. Not dramatic or revolutionary – but significant.

That said, we do really need something solid which demonstrate the advantages of anon.methods beyond the trivial one-liner demo methods (which easily can be done in the “old ways”). Until we see some, here is some speculation and conjecture from my side…

1. Lambda expressions and Generics
I assume that for generic classes, the compiler generates something to the effect of anon.methods behind the scene. I also assume that anon.methods are one of the building blocks in type inference.

2. Isolation Glue
When you write classes that interact in the traditional OOP way, you often have to derive new classes from the base classes and implement a set of features (read: method override) where you apply your knowledge of the two new classes to create new interaction rules. Very often, such override methods are just a handful of lines. Yet you have to add yet another two classes to achieve it. In concept, this is a similar problem domain to generics – but here we could be talking about trying to make two specific classes (such as a visual and a non-visual) work together without having to reimplement all the plumbing in great explicitness.

Anon.methods can simplify this by allowing one of the classes to implement all the glue using anon.methods instead of having to implement overridden virtual methods in both classes.

3. Threads
Threads today are a fairly elaborate construction project. Anon.methods may enable us to create something similar to fibers. Where the old style single kernel fibers had to deal with manual scheduling on one CPU, today’s multi-core aware fiber management code can delegate the “packaged” anon.methods and data (or fibers if you like) to multiple kernels for actual concurrency.

In what way will this differ from threads? Threads are elaborate to design, requiring yet another class descendant to implement the Execute method. You have to manually feed them their data/scope, and manually retrieve any generated content, and manually implement a “tie it all together” sync.point (ie where you are waiting for all threads to complete so that you can continue). They are expensive to set up, kick off and there is a lot of housekeeping involved.

From the top of my head, here are some forms of processing can be compartmentalized using anon.methods without the overhead of multiple thread class implementations: Sorting (key generation/comparison), matrix math / SSD type processing like compression/decompression, and other types of algoritmic code. In theory, any sequential processing that don’t have backwards or forwards dependencies in the dataset, would be trivial to parallelize.

The result should be less obstacles to writing code that actually can utilize all your hardware.

• Is it possible to do this with the existing TThread? Yes it is.
• Can anon.methods reduce the complexity of doing it? Most likely, yes.

• Is it is still possible to do horrific mistakes? Yes, but they are the same old mistakes as for regular threads (race, starve, deadlock, data you can’t/shouldn’t touch, etc), and since you are now defining your thread/fiber in the scope of it’s deployer – it may be that the compiler can make more intelligent judgement about the validity of your thread/fiber.

Will anon.methods lead to spaghetti?
I don’t think so. Generally speaking, they may make some things clearer as more of the logic can be packed into one class, instead of being spread over multiple related classes. All “generic” code (pardon the pun) can be kept simple and ..ehm.. generic, and you don’t have to build a huge inheritance tree where methods are virtualized up the wazzoo.

I think a possible factor in explaining why it is hard to come up with examples that are short, detailed and easily understood, is that we will benefit the most from anonymous methods in code that is anything but trivial.

P.S. In Bart Roozendaal’s blog about anon.methods, Thomas Mueller mentions that the good old Turbo Pascal TCollection ForEach and FirstThat will be possible again. That’s not a bad example either. I actually missed those a lot when I couldn’t use them anymore.

Edit: Make sure to read Jarle Stabell’s article on Lambda functions!

Edit 2:
• An older post from Barry Kelly on how how closures presents a challenge in Delphi for Win32. I guess we know by now that they landed on refcounting.
• The “Pascal gets Closures before Java” Reddit thread.

Edit 3:
Wayne Niddery on Understanding Anonymous Methods
Jolyon Smith on Anonymous Methods – When should they be used?
Andreano Lanusse – Tiburon – Anonymous Methods

Edit 4: • Joel Spolsky – Can your programming language do this?

Anonymous methods – Variable Scope?

I am reading about all the Tiburón goodies with great pleasure, but I find myself uncertain of how some aspects of anonymous methods actually will work.

What variables that are in scope at the point of definition will be allowed used within the anonymous method, and which references should be avoided?

Can the method be defined without being assigned to a local variable, ie directly as a parameter to a call?

With reference to the articles on the TGridViewController, would it be possible to convert this (class method pointer)…


procedure TViewDirectory.DefineAttributes;
begin
CreateTextColumn('Name', GetFileName, 300);
CreateTimeColumn('Date', GetFileDate, 100, taCenter);
CreateIntegerColumn('Size', GetFileSize, 100, taRightJustify);
end;

// Note that Dir is a protected class property of TViewDirectory

function TViewDirectory.GetFileDate(const Row:Integer):TDateTime;
begin
Result := FileDateToDateTime(Dir.Entry[Row].Time);
end;

function TViewDirectory.GetFileName(const Row:Integer):String;
begin
Result := Dir.Entry[Row].Name;
end;

function TViewDirectory.GetFileSize(const Row:Integer):Integer;
begin
Result := Dir.Entry[Row].Size;
end;

to this? I.e. in-line declared anonymous methods


procedure TViewDirectory.DefineAttributes;
begin
CreateTextColumn(function (const row:integer):String;
begin
Result := Dir.Entry[row].Name;
end, 'Name', 300);

CreateTimeColumn(function (const row:integer):TDateTime;
begin
Result := FileDateToDateTime(Dir.Entry[row].Time);
end, 'Time', 100, taCenter);

CreateIntegerColumn(function (const row:integer):Integer
begin
Result := Dir.Entry[row].Size;
end, 'Size', 100, taRightJustify);
end;

Apart from in-parameter definition (and any related syntactical mistakes I might have made), the problem here would be the reference to Dir. Since Dir is a class property (or private variable), it seems possible that this would be quite safe.

What about local variables?
Is this legal?

procedure DefineAttributes;
var
Reg : TRegistry;
Key, Value : TStringList;
begin
Reg := TRegistry.Create;
key := TStringList.Create;
Value := TStringList.Create;
try
Reg.OpenKeyReadOnly('\Software\Somewhere');
Reg.GetKeyNames(Key);
Reg.GetValueNames(Value);

// we have ensured that GetRowCount returns the correct count

CreateTextColumn( function (const row:integer):string;
begin
Result := Key[row];
end, 'Key');

CreateTextColumn( function (const row:integer):string;
begin
Result := Value[Row];
end, 'Value');

finally
FreeAndNil(Value);
FreeAndNil(Key);
FreeAndNil(Reg);
end;
end;

I am really looking forward to learn more on this!