Templates in Object Pascal

By: Rossen Assenov

Abstract: Here's a quick guide to implementing C++-like templates in Object Pascal. By Rossen Assenov.

Does this sound familiar?

You're talking with a C++ programmer about Delphi and how powerful it is. And at some point the C++ jockey says something like "OK, but Delphi uses Pascal -- it doesn't support multiple inheritance and templates. So it is not as good as C++."

Rebutting the multiple inheritance is easy: Delphi has interfaces and they do the job just fine. But you have to agree about templates. Object Pascal doesn't support them.

Well, guess what? You can implement templates in Delphi. As good as C++ templates. And you can start winning the language wars again. Here's how.

GETTING STARTED

Templates let you make generic containers like lists, stacks, queues, and so on. If you want to implement something like this in Delphi you have two choices:

  1. Use a container like TList which holds pointers. In this case you must make explicit typecasts all the time.
  2. Subclass a container like TCollection or TObjectList, and override all the type-dependent methods each time you want to use new data type.

A third alternative is to make a unit with a generic container class, and each time you want to use it for a new data type you can perform search-and-replace in the editor. This will work, but if you change the implementation you have to change all of the units for the different types by hand. It would be nice if the compiler could do the dirty work for you...and this is exactly what we will do!

Take for example the TCollection and TCollectionItem classes. When you declare a new TCollectionItem descendant you also derive a new class from TOwnedCollection and override most of the methods so they will use the new collection item class type and call the inherited method with the proper typecast.

Here is how to implement a generic collection class template in 3 easy steps :

Step one: Create a new text file (not an unit file) called TemplateCollectionInterface.pas:

_COLLECTION_ = class (TOwnedCollection)
protected
 function  GetItem (const aIndex : Integer) : _COLLECTION_ITEM_;
 procedure SetItem (const aIndex : Integer;
                    const aValue : _COLLECTION_ITEM_);
public
 constructor Create (const aOwner : TComponent);

 function Add                                 : _COLLECTION_ITEM_;
 function FindItemID (const aID    : Integer) : _COLLECTION_ITEM_;
 function Insert     (const aIndex : Integer) : _COLLECTION_ITEM_;
 property Items      [const aIndex : Integer] : _COLLECTION_ITEM_ read GetItem write SetItem;
end;

Note that there are no uses or interface clauses, just a generic type declaration in which _COLLECTION_ is the name of the generic collection class and _COLLECTION_ITEM_ is the name of the collection item subclass the collection will hold.

Step two: Create a second text file and save it as TemplateCollectionImplementation.pas:

constructor _COLLECTION_.Create (const aOwner : TComponent);
begin
 inherited Create (aOwner, _COLLECTION_ITEM_);
end;

function _COLLECTION_.Add : _COLLECTION_ITEM_;
begin
 Result := _COLLECTION_ITEM_ (inherited Add);
end;

function _COLLECTION_.FindItemID (const aID : Integer) : _COLLECTION_ITEM_;
begin
 Result := _COLLECTION_ITEM_ (inherited FindItemID (aID));
end;

function _COLLECTION_.GetItem (const aIndex : Integer) : _COLLECTION_ITEM_;
begin
 Result := _COLLECTION_ITEM_ (inherited GetItem (aIndex));
end;

function _COLLECTION_.Insert (const aIndex : Integer) : _COLLECTION_ITEM_;
begin
 Result := _COLLECTION_ITEM_ (inherited Insert (aIndex));
end;

procedure _COLLECTION_.SetItem (const aIndex : Integer;
                                const aValue : _COLLECTION_ITEM_);
begin
 inherited SetItem (aIndex, aValue);
end;

Again, there are no uses or interface clauses here -- just the implementation code of the generic type, which is pretty straightforward.

Step three: Create a new unit file called MyCollectionUnit.pas:

unit MyCollectionUnit;

interface

uses Classes;

type TMyCollectionItem = class (TCollectionItem)
     private
      FMyStringData  : String;
      FMyIntegerData : Integer;
     public
      procedure Assign (aSource : TPersistent); override;
     published
      property MyStringData  : String  read FMyStringData  write FMyStringData;
      property MyIntegerData : Integer read FMyIntegerData write FMyIntegerData;
     end;

     // !!! tell the generic collection class what is the actual collection item class type 
     
     _COLLECTION_ITEM_ = TMyCollectionItem; 
     
     // !!! insert the generic collection class interface file - preprocessor directive

     {$INCLUDE TemplateCollectionInterface} 

     // !!! rename the generic collection class

     TMyCollection = _COLLECTION_;          

implementation

uses SysUtils;

// !!! insert the generic collection class implementation file - preprocessor directive

{$INCLUDE TemplateCollectionImplementation} 

procedure TMyCollectionItem.Assign (aSource : TPersistent);
begin
 if aSource is TMyCollectionItem then
 begin
  FMyStringData  := TMyCollectionItem(aSource).FMyStringData;
  FMyIntegerData := TMyCollectionItem(aSource).FMyIntegerData;
 end
 else inherited;
end;

end.

That's it! With just four lines of code the new collection class is ready to use. And the compiler did all the work for you! If you change the interface or implementation of the generic collection class the changes will propagate to all the units which use it.

A SECOND EXAMPLE

 Let's implement a generic class wrapper for dynamic arrays.

Step one: Create a text file and name it TemplateVectorInterface.pas:

_VECTOR_INTERFACE_ = interface
 function  GetLength : Integer;
 procedure SetLength (const aLength : Integer);

 function  GetItems (const aIndex : Integer) : _VECTOR_DATA_TYPE_;
 procedure SetItems (const aIndex : Integer;
                     const aValue : _VECTOR_DATA_TYPE_);

 function  GetFirst : _VECTOR_DATA_TYPE_;
 procedure SetFirst (const aValue : _VECTOR_DATA_TYPE_);

 function  GetLast  : _VECTOR_DATA_TYPE_;
 procedure SetLast  (const aValue : _VECTOR_DATA_TYPE_);

 function  High  : Integer;
 function  Low   : Integer;

 function  Clear                              : _VECTOR_INTERFACE_;
 function  Extend   (const aDelta : Word = 1) : _VECTOR_INTERFACE_;
 function  Contract (const aDelta : Word = 1) : _VECTOR_INTERFACE_; 

 property  Length                         : Integer             read GetLength write SetLength;
 property  Items [const aIndex : Integer] : _VECTOR_DATA_TYPE_  read GetItems  write SetItems; default;
 property  First                          : _VECTOR_DATA_TYPE_  read GetFirst  write SetFirst;
 property  Last                           : _VECTOR_DATA_TYPE_  read GetLast   write SetLast;
end;

_VECTOR_CLASS_ = class (TInterfacedObject, _VECTOR_INTERFACE_)
private
 FArray : array of _VECTOR_DATA_TYPE_;
protected
 function  GetLength : Integer;
 procedure SetLength (const aLength : Integer);

 function  GetItems (const aIndex : Integer) : _VECTOR_DATA_TYPE_;
 procedure SetItems (const aIndex : Integer;
                     const aValue : _VECTOR_DATA_TYPE_);

 function  GetFirst : _VECTOR_DATA_TYPE_;
 procedure SetFirst (const aValue : _VECTOR_DATA_TYPE_);

 function  GetLast  : _VECTOR_DATA_TYPE_;
 procedure SetLast  (const aValue : _VECTOR_DATA_TYPE_);
public
 function  High  : Integer;
 function  Low   : Integer;

 function  Clear                              : _VECTOR_INTERFACE_;
 function  Extend   (const aDelta : Word = 1) : _VECTOR_INTERFACE_;
 function  Contract (const aDelta : Word = 1) : _VECTOR_INTERFACE_; 

 constructor Create (const aLength : Integer);
end;

Step two: Create another text file and save it as TemplateVectorImplementation.pas:

constructor _VECTOR_CLASS_.Create (const aLength : Integer);
begin
 inherited Create;

 SetLength (aLength);
end;

function _VECTOR_CLASS_.GetLength : Integer;
begin
 Result := System.Length (FArray);
end;

procedure _VECTOR_CLASS_.SetLength (const aLength : Integer);
begin
 System.SetLength (FArray, aLength);
end;

function _VECTOR_CLASS_.GetItems (const aIndex : Integer) : _VECTOR_DATA_TYPE_;
begin
 Result := FArray [aIndex];
end;

procedure _VECTOR_CLASS_.SetItems (const aIndex : Integer;
                                   const aValue : _VECTOR_DATA_TYPE_);
begin
 FArray [aIndex] := aValue;
end;

function _VECTOR_CLASS_.High : Integer;
begin
 Result := System.High (FArray);
end;

function _VECTOR_CLASS_.Low : Integer;
begin
 Result := System.Low (FArray);
end;

function _VECTOR_CLASS_.GetFirst : _VECTOR_DATA_TYPE_;
begin
 Result := FArray [System.Low (FArray)];
end;

procedure _VECTOR_CLASS_.SetFirst (const aValue : _VECTOR_DATA_TYPE_);
begin
 FArray [System.Low (FArray)] := aValue;
end;

function _VECTOR_CLASS_.GetLast : _VECTOR_DATA_TYPE_;
begin
 Result := FArray [System.High (FArray)];
end;

procedure _VECTOR_CLASS_.SetLast (const aValue : _VECTOR_DATA_TYPE_);
begin
 FArray [System.High (FArray)] := aValue;
end;

function _VECTOR_CLASS_.Clear : _VECTOR_INTERFACE_;
begin
 FArray := Nil;

 Result := Self;
end;

function _VECTOR_CLASS_.Extend (const aDelta : Word) : _VECTOR_INTERFACE_;
begin
 System.SetLength (FArray, System.Length (FArray) + aDelta);

 Result := Self;
end;

function _VECTOR_CLASS_.Contract (const aDelta : Word) : _VECTOR_INTERFACE_;
begin
 System.SetLength (FArray, System.Length (FArray) - aDelta);

 Result := Self;
end;

Step three: Create a Delphi unit file named FloatVectorUnit.pas:

unit FloatVectorUnit;

interface

uses Classes;                           // !!! "Classes" unit contains TInterfacedObject class declaration

type _VECTOR_DATA_TYPE_ = Double;       // !!! the data type for the array class is Double

     {$INCLUDE TemplateVectorInterface}

     IFloatVector = _VECTOR_INTERFACE_; // !!! give the interface a meanigful name
     TFloatVector = _VECTOR_CLASS_;     // !!! give the class a meanigful name

function CreateFloatVector (const aLength : Integer = 0) : IFloatVector; // !!! this is an optional factory function 

implementation

{$INCLUDE TemplateVectorImplementation}

function CreateFloatVector (const aLength : Integer = 0) : IFloatVector;     
begin
 Result := TFloatVector.Create (aLength);
end;

end.

Of course you can easily extend your new generic vector class with iterators and additional functions. Let your imagination run wild!

USING THE TEMPLATES

Here is how you can use the new vector interface:

procedure TestFloatVector;
 var aFloatVector : IFloatVector;
     aIndex       : Integer;
begin
 aFloatVector := CreateFloatVector;

 aFloatVector.Extend.Last := 1;
 aFloatVector.Extend.Last := 2;

 for aIndex := aFloatVector.Low to aFloatVector.High do
 begin
  WriteLn (FloatToStr (aFloatVector [aIndex]));
 end;
end.

The only requirements when implementing templates this way is that each new type should be declared in a separate unit and you should have the sources for the generic classes.

Suggestions and comments are welcomed -- just write me!


Server Response from: ETNASC02