From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham
	autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,616091a85ff150f1
X-Google-Attributes: gid103376,public
X-Google-ArrivalTime: 2001-12-05 10:36:39 PST
Path: 
 archiver1.google.com!news1.google.com!newsfeed.stanford.edu!sn-xit-01!sn-post-01!supernews.com!corp.supernews.com!not-for-mail
From: "Matthew Heaney" <mheaney@on2.com>
Newsgroups: comp.lang.ada
Subject: Re: Ada 200X Assertions
Date: Wed, 5 Dec 2001 13:40:30 -0500
Organization: Posted via Supernews, http://www.supernews.com
Message-ID: <u0sq9mg90ecr7b@corp.supernews.com>
References: <3C0C48BE.3B20F04E@adaworks.com>
 <slrna0p3q9.n1.lutz@taranis.iks-jena.de> <u0q6368mkken84@corp.supernews.com>
 <slrna0seip.kq.lutz@taranis.iks-jena.de>
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 5.50.4807.1700
X-MimeOLE: Produced By Microsoft MimeOLE V5.50.4807.1700
X-Complaints-To: newsabuse@supernews.com
Xref: archiver1.google.com comp.lang.ada:17463
Date: 2001-12-05T13:40:30-05:00
List-Id: <comp.lang.ada>


"Lutz Donnerhacke" <lutz@iks-jena.de> wrote in message
news:slrna0seip.kq.lutz@taranis.iks-jena.de...
> Typical example 2: A head node of a linked list contains a next pointer
which
>                    should be handled exactly as the next pointer of the
real
>    list nodes, but no payload at all.

In the code below, I do this by making the List_Type a private derivation of
a Node_Type. Which means a List_Type, containing only the head pointer, can
be used exactly like Node_Type.

    type Node_Type is abstract tagged private;
    type List_Type is Node_Type;
private
   type Node_Type is abstract tagged record
      Next : Node_Class_Access;
   end record;
   type List_Type is new Node_Type with null record;


Of course, you could choose to make the List_Type is public derivation of
Node_Type.

   type Node_Type is abstract tagged private;
   type List_Type is new Node_Type with private;

How is this not adequate?


> >Of course the language already allows you to move from a pointer to
> >component to a pointer to aggregate: just use an access discriminant.
>
> This generates a completely different structure.

What's wrong with that?


--STX
package body Lists is

   procedure Process (Item : access Node_Type) is
   begin
      null;
   end;

   function Head (List : List_Type) return Node_Class_Access is
   begin
      return List.Next;
   end;

   function Cons (Item : Node_Type'Class) return List_Type is
      Node : constant Node_Class_Access := new Node_Type'Class'(Item);
   begin
      return List_Type'(Next => Node);
   end;

   function "&" (Item : Node_Type'Class;
                 List : List_Type) return List_Type is

      Node : constant Node_Class_Access := new Node_Type'Class'(Item);
      New_List : List_Type;
   begin
      Node.Next := List.Next;
      New_List.Next := Node;
      return New_List;
   end;

   procedure Iterate (List : in out List_Type) is
      Item : Node_Class_Access := List.Next;
   begin
      while Item /= null loop
         Process (Item);
         Item := Item.Next;
      end loop;
   end Iterate;

end Lists;
package Lists is

   type List_Type is private;

   type Node_Type is abstract tagged private;
   type Node_Class_Access is access all Node_Type'Class;

   procedure Process (Item : access Node_Type);

   function Head (List : List_Type) return Node_Class_Access;

   function Cons (Item : Node_Type'Class) return List_Type;

   function "&" (Item : Node_Type'Class;
                 List : List_Type) return List_Type;

   procedure Iterate (List : in out List_Type);

private

   type Node_Type is abstract tagged record
      Next : Node_Class_Access;
   end record;

   type List_Type is new Node_Type with null record;

end Lists;
with Ada.Text_IO;  use Ada.Text_IO;

package body P is

   procedure Process (O : access T) is
   begin
      Put_Line ("processing T object");
   end;

end P;with Lists;  use Lists;

package P is

   type T is new Node_Type with null record;

   procedure Process (O : access T);

end P;
with Lists; use Lists;
with P;  use P;
with Ada.Text_IO;  use Ada.Text_IO;

procedure Test_Lists is

   O1 : T;
   O2 : T;

   L : List_Type := Cons (O1);

begin

   Put_Line ("first iterate");
   Iterate (L);

   New_Line;

   L := O2 & L;

   Put_Line ("second iterate");

   Iterate (L);

end Test_Lists;