Re: Inheritance and Polymorphism in Ada !!

[Brian Rogoff <bpr@shell5.ba.best.com>]

On Mon, 18 Oct 1999, Robert A Duff wrote:
> "Matthew Heaney" <matthew_heaney@acm.org> writes:
> > Yes, it's true that dynamic memory allocation isn't allowed, but Ada was
> > designed to that you don't need dynamic memory allocation.
> > 
> > There was no reason for you to put the object on the heap.  You could
> > have said just as easily:
> > 
> >   Object : Type_A'Class := Type_B'(1, 2);
> > 
> > No heap required.
> 
> True in this case, but I think it's fair to say that if you're doing
> OOP, you will *usually* need to put some objects in the heap.  The above
> trick only works when you know the tag you want a the right time, and
> you don't want to change the tag (which you can simulate by deallocating
> and reallocating in the heap), and when you don't have heterogeneous
> data structures (eg you're not allowed to make an array of a class-wide
> type).

I agree with all of this, but I recall a few years ago that someone :-)
posted a heap using version of Ackerman's function, directly translating 
a program Norman Cohen wrote using (full upward) closures. In this
particular program, a few tweaks and a bit of naughtiness allows us to 
write a "heapless" version, assuming that the variable sized arrays aren't 
heap allocated. I'll append this program, and refer reader's back to 
the original discussion entitled "Q: access to subprogram" from Jul '96. 
Note that even though naughty, this is Ada-95 with no GNAT extensions.

No you can't do this in general for OOP programs, but I confess that I
admire Matt's dedication to stackliness. 

-- Brian 

package body Ackermann_Computation is

    package Container is
        -- We need to put Ackermann_Row_Type in a package, so
        -- Invoke will be primitive.

        type Ackermann_Row_Type is abstract tagged limited null record;
        -- Six reserved words in a row!

        function Invoke(R: Ackermann_Row_Type; N: Natural)
                        return Natural is abstract;
        -- Invokes the closure represented by R, with parameter N.

        type Ackermann_Row_Ptr is access all Ackermann_Row_Type'Class;
   end Container;

   use Container;

   type Row_Zero_Type is new Ackermann_Row_Type with null record;

   function Invoke(R: Row_Zero_Type; N: Natural)
                   return Natural;

   function Invoke(R: Row_Zero_Type; N: Natural)
                   return Natural is
   begin
      return N + 1;
   end Invoke;

   type Successor_Row_Type is new Ackermann_Row_Type with
      record
          Pred : Ackermann_Row_Ptr;
      end record;

   -- Pred points to the predecessor row of this row.  This is analogous
   -- to the parameter F in Norman's Successor_Row function.

   function Invoke(R: Successor_Row_Type; N: Natural)
                   return Natural;

   function Invoke(R: Successor_Row_Type; N: Natural)
                   return Natural is
      Counter : Natural := N + 1;
      Result  : Natural := 1;
   begin
      while Counter /= 0 loop
         Result := Invoke(R.Pred.all, Result);
         Counter := Counter - 1;
      end loop;
      return Result;
   end Invoke;

   function Ackermann (M, N: Natural) return Natural is
      Row_Zero : aliased Row_Zero_Type;  -- R[0]
      Row      : array (1 .. M) of aliased Successor_Row_Type;
      Row_Ptr  : Ackermann_Row_Ptr := Row_Zero'Unchecked_Access;
   begin
       if M = 0 then
           return N+1;
       end if;

       for I in 1 .. M loop
           Row(I).Pred := Row_Ptr;
           Row_Ptr     := Row(I)'Unchecked_Access;
           -- Compute R[1] from R[0], R[2] from R[1], ...
       end loop;
       return Invoke(Row(M), N);  -- i.e., R[m](n)
   end Ackermann;

end Ackermann_Computation;