Gem #8: Factory Functions

by Matthew Heaney —On2 Technologies

Let's get started…

Suppose we have a generic package that declares a stack class. The root of the hierarchy would be as follows:

  generic
    type Element_Type is private;
  package Stacks is
    type Stack is abstract tagged null record;

    procedure Push
     (Container : in out Stack;
      Item      : in     Element_Type) is abstract;
   …
  end Stacks;

Assume there are various concrete types in the class, say an unbounded stack (that automatically grows as necessary) and a bounded stack (implemented as a fixed-size array).

Now suppose we want to assign one stack to another, irrespective of the specific stack type, something like this:

  procedure Op (T : in out Stack'Class; S : Stack'Class) is
  begin
     T := S;  -- raises exception if tags don't match
     …
  end;

This compiles, but isn't very robust, since if the tag of the target stack doesn't match the tag of the source stack, then an exception will occur. Our goal here is to figure out how to assign stack objects (whose type is class-wide) in a manner such that the assignment is guaranteed to work without raising a tag-mismatch exception.

One way to do this is to make an assignment-style operation that is primitive for the type, so that it will dispatch according to the type of the target stack. If the type of the source stack is class-wide, then there can't be a tag mismatch (and hence no exception) since there's only one controlling parameter.

(Note that you could do it the other way too, by dispatching on the tag of the source stack. You could even make the operation class-wide, so that it doesn't need to dispatch at all. The idea is to avoid passing more than a single controlled operand.)

The assign operation would be declared like this:

   procedure Assign
     (Target : in out Stack;
      Source : Stack'Class) is abstract;

which would allow us to rewrite the above assignment statement as:

  procedure Op (T : in out Stack'Class; S : Stack'Class) is
  begin
     T.Assign (S);  -- dispatches according T's tag
     …
  end;

Each type in the class will have to override Assign. As an example, let's follow the steps the necessary to implement the operation for the bounded stack type. Its spec would look like this:

   generic
   package Stacks.Bounded_G is
     type Stack (Capacity : Natural) is 
       new Stacks.Stack with private;

     procedure Assign
       (Target : in out Stack;
        Source : Stacks.Stack'Class);
     …
   private
     type Stack (Capacity : Natural) is
       new Stacks.Stack with 
     record
        Elements  : Element_Array (1 .. Capacity);
        Top_Index : Natural := 0;
     end record;
   end Stacks.Bounded_G;

This is just a canonical implementation of a bounded container form, that uses a discriminent to control how much storage for the object is allocated. The interesting part is implementing the Assign operation, since we need some way to iterate over items in the source stack. Here's a skeleton of the implementation:

   procedure Assign
     (Target : in out Stack;  -- bounded form
      Source : Stacks.Stack'Class)
   is
     …
   begin
      …
     for I in reverse 1 .. Source.Length loop
         Target.Elements (I) := <get curr elem of source>
         <move to next elem of source>
      end loop;
      ...      
   end Assign;

Note carefully that, assuming we visit items of the source stack in top-to-bottom order, it's not a simple matter of pushing items onto the target stack, since if we did that the items would end up in reverse order. That's the reason why we populate the target stack array in reverse, starting from largest index (the top of the stack) and working backwards (towards the bottom of the stack).

The question is, how do you iterate over the source stack? Assume that each specific type in the stack class has its own iterator type, matched to that stacks's particular representation (similar to how the containers in the standard library are implemented). The issue is that the type of the source stack formal parameter is class-wide. How do we get an iterator for the source stack actual parameter, if its specific type is not known (not known statically, that is)?

The answer is, just ask the stack for one! A tagged type has dispatching operations, some of which can be functions, so here we just need a dispatching function to return an iterator object. The idiom of dispatching on an object whose type is in one class, to return an object whose type is in another class, is called a “factory function” or “dispatching constructor.”

An operation can only be primitive for one tagged type, so if the operation dispatches on the stack parameter then the function return type must be class-wide. We now introduce type Cursor, the root of the stack iterator hierarchy, and amend the stack class with a factory function for cursors:

   type Cursor is abstract tagged null record;  -- the iterator

   function Top_Cursor  -- the factory function
     (Container : not null access constant Stack)
     return Cursor'Class is abstract;

   … -- primitive ops for the Cursor class

Each type in the stack class will override Top_Cursor, to return a cursor that can be used to visit the items in that stack object. We can now complete our implementation of the Assign operation for bounded stacks as follows:

   procedure Assign
     (Target : in out Stack;
      Source : Stacks.Stack'Class)
   is
      C : Stacks.Cursor'Class := Source.Top_Cursor;  -- dispatches
      
   begin
      Target.Clear;
      
      for I in reverse 1 .. Source.Length loop
         Target.Elements (I) := C.Element;  -- dispatches
         C.Next;  -- dispatches
      end loop;
      
      Target.Top_Index := Source.Length;
   end Assign;

The Source parameter has a class-wide type, which means the call to Top_Cursor dispatches (since Top_Cursor is primitive for the type). This is exactly what we want, since different stack types will have different representations, and will therefore require different kinds of cursors. The cursor object (here, C) returned by the factory function is itself class-wide, which means that cursor operations also dispatch. The function call C.Element returns the element of Source at the current position of the cursor, and C.Next advances the cursor to the next position (towards the bottom of the stack).

Related Source Code

Ada Gems example files are distributed by AdaCore and may be used or modified for any purpose without restrictions.