Re: Smarter Generics

["Francois G. Dorais" <dorais@gauss.dartmouth.edu>]

Frank J. Lhota wrote:
> The recent thread on "A Simple Ada Problem" got me thinking about a
> limitation of Ada generics. Generic are a great way of generalizing an
> implementation strategy for a particular problem, but generics cannot (or
> cannot easily) select one of several implementation strategies based on the
> generic parameters.
> 
> Take the following simple example: Assume that I want to implement stacks of
> limited length, e.g. a stack that I can push or pop elements of a given
> type, but with a limit on how many elements will be on the stack at one
> time:
> 
>     generic
>         type Stack_Element is private;
>         Max_Length : in Positive;
>     package Limited_Stacks is
> 
>         type Stack_Type is limited private;
>         Stack_Overflow, Stack_Underflow : exception;
> 
>         procedure Push ( Item : in Stack_Element; Onto : in out
> Stack_Type );
>         procedure Pop ( Item : out Stack_Element; Onto : in out
> Stack_Type );
> 
>     private
>         ...
>     end Limited_Stacks;
> 
> Two possible implementation strategies:
> 
> 1.    We could implement the stack as an array of Max_Length elements, along
> with a component indicating the current length.
> 2.    We could maintain an adjustable list of pointers to elements allocated
> from the heap.
> 
> Obviously, implementation 1 would be faster and more convenient if
> Max_Length * Stack_Element'Size is relatively small. Implementation 2
> involves additional overhead, but can handle cases where stack elements can
> vary quite a bit in size.
> 
> What would be great is if there were some way to write Limited_Stacks so
> that the implementation strategy could be chosen based on the generic
> parameters, so that we could do something like this:
> 
>     if Max_Length * Stack_Element'Size <= Some_Threshold then
>         -- Static memory allocation should be fine
>         Implement Limited_Stacks using strategy 1;
>     else
>         -- Size could be a problem, better go with pointers.
>         Implement Limited_Stacks using strategy 2;
>     end if;
> 
> AFAIK neither Ada generics nor C++ templates have this level of
> intelligence. Would smarter generics be a worthwhile addition to Ada, and if
> so, what form should it take?

Hmmm... I guess Ada is smarter than C++ after all :)

-- Alternative Methods Example

generic
    type Element_Type is private;
    Stack_Limit : in Positive;
package Limited_Stacks is

    type Limited_Stack_Type is limited private;

    procedure Push (Stack : in out Limited_Stack_Type;
                    Item  : in Element_Type);

    procedure Pop (Stack : in out Limited_Stack_Type;
                   Item  : out Element_Type);

    function Method (Stack : in Limited_Stack_Type) return 
String;
    -- Returns "ARRAY" or "LIST" for testing purposes...

    Stack_Overflow, Stack_Underflow : exception;

private

    type Element_Array is array (1 .. Stack_Limit) of 
Element_Type;

    type Element_Record;

    type Element_Pointer is access Element_Record;

    type Element_Record is record
       Item : Element_Type;
       Pred : Element_Pointer;
    end record;

    Null_Element_Pointer : constant Element_Pointer := null;

    type Limited_Stack_Alternative (Use_Array : Boolean) is 
record
       Stack_Length : Natural := 0;
       case Use_Array is
          when True =>
             Stack_Array : Element_Array;
          when False =>
             Stack_Pointer : Element_Pointer := 
Null_Element_Pointer;
       end case;
    end record;

    type Limited_Stack_Type is new Limited_Stack_Alternative 
(Element_Type'Size * Stack_Limit <= 1024 * 8);

end Limited_Stacks;

with Ada.Unchecked_Deallocation;

package body Limited_Stacks is

    procedure Free is new Ada.Unchecked_Deallocation 
(Element_Record, Element_Pointer);

     procedure Push (Stack : in out Limited_Stack_Type;
                     Item  : in Element_Type) is
     begin
        if Stack.Stack_Length = Stack_Limit then
           raise Stack_Overflow;
        end if;
        Stack.Stack_Length := Stack.Stack_Length + 1;
       case Stack.Use_Array is
          when True =>
             Stack.Stack_Array(Stack.Stack_Length) := Item;
          when False =>
             declare
                New_Pointer : Element_Pointer
                  := new Element_Record'(Item => Item, Pred 
=> Stack.Stack_Pointer);
             begin
                Stack.Stack_Pointer := New_Pointer;
             end;
       end case;
     end Push;

    procedure Pop (Stack : in out Limited_Stack_Type;
                   Item  : out Element_Type) is
    begin
       if Stack.Stack_Length = 0 then
          raise Stack_Underflow;
       end if;
       case Stack.Use_Array is
          when True =>
             Item := Stack.Stack_Array(Stack.Stack_Length);
          when False =>
             declare
                Old_Pointer : Element_Pointer := 
Stack.Stack_Pointer;
             begin
                if Stack.Stack_Pointer = 
Null_Element_Pointer then
                   -- This shouldn't happen but this
                   -- implementation is not meant for
                   -- concurrent access...
                   raise Program_Error;
                end if;
                Stack.Stack_Pointer := Stack.Stack_Pointer.Pred;
                Free(Old_Pointer);
             end;
       end case;
       Stack.Stack_Length := Stack.Stack_Length - 1;
    end Pop;

    function Method (Stack : in Limited_Stack_Type) return 
String is
    begin
       case Stack.Use_Array is
          when True =>
             return "ARRAY";
          when False =>
             return "LIST";
       end case;
    end Method;

end Limited_Stacks;

with Ada.Text_IO;
use Ada.Text_IO;

with Limited_Stacks;

procedure Test_Limited_Stacks is

    type Kilo_String is new String (1 .. 1000);

    type Deca_String is new String (1 .. 10);

    package Kilo_Stacks is new Limited_Stacks (Kilo_String, 16);

    package Deca_Stacks is new Limited_Stacks (Deca_String, 16);

    Kilo_Stack : Kilo_Stacks.Limited_Stack_Type;

    Deca_Stack : Deca_Stacks.Limited_Stack_Type;

begin

    Put_Line("Kilo_Stack uses method " & 
Kilo_Stacks.Method(Kilo_Stack));
    Put_Line("Deca_Stack uses method " & 
Deca_Stacks.Method(Deca_Stack));

end Test_Limited_Stacks;

-- End Example