Ada95 Letter
by Glen Shipley
package Linked_List_Defs is
   type My_List_Data is abstract tagged null record;
   -- declare class-wide pointer to access any object in class hierarchy
   type My_List_Data_Class_Ptr is access all My_List_Data;
   procedure Print (This : in     My_List_Data);

   type My_List is new My_List_Data with private;
   type My_List_Ptr is access all My_List;
   procedure Print (This : in     My_List);  -- overrides base definition
   procedure Add_To_List (List : in out My_List;
                          Data : access My_List_Data'Class);
   type My_Number is new My_List_Data with private;
   type My_Number_Ptr is access all My_Number;
   procedure Print (This : in     My_Number);  -- overrides base definition
   function New_My_Number (Number : in     Integer) return My_Number_Ptr;

   type My_Point is new My_List_Data with private;
   type My_Point_Ptr is access all My_Point;
   procedure Print (This : in     My_Point);  -- overrides base definition
   function New_My_Point (X : in     Integer;
                          Y : in     Integer) return My_Point_Ptr;
   type My_List_Element is private;
   type My_List_Element_Ptr is access all My_List_Element;
private
   type My_List is new My_List_Data with
      record
         Head : My_List_Element_Ptr := null;
         Tail : My_List_Element_Ptr := null;
      end record;
   type My_Number is new My_List_Data with
      record
         Value : Integer;
      end record;
   type My_Point is new My_List_Data with
      record
         X : Integer;
         Y : Integer;
      end record;
   type My_List_Element is
      record
         Data : My_List_Data_Class_Ptr;
         Next : My_List_Element_Ptr := null;
      end record;
end Linked_List_Defs;

with Ada.Tags;
with Ada.Text_IO; use Ada.Text_IO;
package body Linked_List_Defs is
   procedure Print (This : in     My_List_Data) is
   begin
      Put_Line("No print method for " & Ada.Tags.Expanded_Name(This'Tag);
   end Print;
   procedure Print (This : in     My_List) is
      Element : My_List_Element_Ptr := This.Head;
   begin
      while Element /= null loop
         Print(Element.Data.all);
         Element := Element.Next;
      end loop;
   end Print;
   procedure Add_To_List (List : in out My_List;
                          Data : access My_List_Data'Class) is
      New_Element : My_List_Element_Ptr := new My_List_Element'(Data, null);
   begin
      if List.Head = null then
         List.Tail := New_Element;
         List.Head := List.Tail;
      else
         List.Tail.Next := New_Element;
         List.Tail := New_Element;
      end if;
   end Add_To_List;
   procedure Print (This : in     My_Number) is
   begin
      Put_Line("Number: " & Integer'Image(This.Value));
   end Print;
   function New_My_Number (Number : in     Integer) return My_Number_Ptr is
      New_Number : My_Number_Ptr := new My_Number'(Value => Number);
   begin
      return New_Number;
   end New_My_Number;
   procedure Print (This : in     My_Point) is
   begin
     Put_Line("Point: " & Integer'Image(This.X) & "," & Integer'Image(This.Y));
   end Print;
   function New_My_Point (X : in     Integer;
                          Y : in     Integer) return My_Point_Ptr is
      New_Point : My_Point_Ptr := new My_Point'(X, Y);
   begin
      return New_Point;
   end New_My_Point;
end Linked_List_Defs;

with Ada.Text_IO; use Ada.Text_IO;
with Linked_List_Defs; use Linked_List_Defs;
procedure Main is
   List1 : aliased My_List;
   List2 : aliased My_List;
   N1    : My_Number_Ptr := New_My_Number(10);
   N2    : My_Number_Ptr := New_My_Number(20);
   P1    : My_Point_Ptr  := New_My_Point(2,3);
   P2    : My_Point_Ptr  := New_My_Point(4,5);
begin
   Add_To_List(List1, N1);
   Add_To_List(List1, N2);
   Add_To_List(List1, P1);
   Add_To_List(List2, N2);
   Add_To_List(List2, P1);
   Add_To_List(List2, P2);
   Add_To_List(List2, List1'Access);
   Put_Line("List1: ");
   Print(List1);
   Put_Line("List2: ");
   Print(List2);
end Main;

List1:
Number:  10
Number:  20
Point:  2, 3
List2:
Number:  20
Point:  2, 3
Point:  4, 5
Number:  10
Number:  20
Point:  2, 3


