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