Multiton Design Pattern in Delphi

The multiton is somewhat an extension of the singleton pattern. It is referred to as registry of singletons by the GOF. I don’t know for sure who appointed the name multiton: it’s an analogy derived from the term singleton. So, singleton = single + ton; while multiton = multi + ton. The singleton pattern guarantees that a class has only one instance; while the multiton allows keeping multiple instances by maintaining a map of related keys and unique objects. Note that there can be only one instance per key when implementing the multiton pattern. Also, note that the key does not have to be a string value; it can be an object for example. Nonetheless, in our code snippet, we will consider the key to be a string. I am going to tweak my singleton class implementation so that I can make it a multiton instead:

unit Multiton;

interface

uses
  Generics.Collections;

type
  TMultiton = class
  private
    //Private fields and methods here...

     class var _registry: TDictionary<string, TMultiton>;
  protected

  public
    class function Create(aName: string): TMultiton;
    class destructor Destroy;
    class function Lookup(aName: string): TMultiton;
   
    destructor Destroy; override;

    //Other public methods and properties here...   
  end;

implementation

{ TMultiton }

class function TMultiton.Create(aName: string): TMultiton;
begin
  if not Assigned(_registry) then
    _registry:= TDictionary<string, TMultiton>.Create;

  if not _registry.TryGetValue(aName, Result) then
  begin
    Result:= inherited Create as Self;
    _registry.Add(aName, Result);
  end;
end;

class destructor TMultiton.Destroy;
begin
   if Assigned(_registry) then
   begin
     _registry.Values.ToArray[0].Free;      
   end;
end;

class function TMultiton.Lookup(aName: string): TMultiton;
begin
  if Assigned(_registry) then
    _registry.TryGetValue(aName, Result);
end;

destructor TMultiton.Destroy;
var
  _instance: TMultiton;
  ValuesArray: TArray<TMultiton>;          
begin
  if Assigned(_registry) then
  begin
    ValuesArray:= _registry.Values.ToArray;

    _registry.Clear;
    _registry.Free;
    _registry:= nil;

    for _instance in  ValuesArray do
      if _instance <> Self then
        _instance.Free;
  end;

  inherited;
end;

end.

A few things I want you to note:

• Instead of a single instance, we are holding a registry of instances. We do so by introducing the class variable _registry of type TDictionary<string, TMultiton>.
• We register (create) the different instances by calling the class function Create. This function gets the key name as a parameter. A new instance is only created if no matches to the key name are found in the dictionary. If a match is found, then the corresponding value is returned from the dictionary data structure.
• The Lookup class function allows retrieving a particular instance by giving its key name. Note that the Create function can also be used for this purpose, but it feels more natural to call Lookup for the searches, and Create for the registration (creation) of instances.
• We have provided a regular destructor that once invoked releases all the memory: not only the current multiton instance, but the whole registry.
• We have also provided a class destructor in case that we forget to manually release the memory.

This code was compiled with Delphi XE2, but it should also work for all versions above Delphi 2009. Comments, corrections and suggestions are most welcome.

Consider reading these books about design patterns if you haven’t yet:

• Design Patterns: Elements of Reusable Object-Oriented Software 1st Edition
• Head First Design Patterns: A Brain-Friendly Guide 1st Edition
• Object Models: Strategies, Patterns, and Applications (2nd Edition) 2nd Edition

CodeProject