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=unavailable autolearn_force=no version=3.4.4 Path: eternal-september.org!reader01.eternal-september.org!reader02.eternal-september.org!news.eternal-september.org!mx02.eternal-september.org!feeder.eternal-september.org!newsfeed.kamp.net!newsfeed.kamp.net!fu-berlin.de!uni-berlin.de!individual.net!not-for-mail From: Niklas Holsti Newsgroups: comp.lang.ada Subject: Re: Generic Embedded List Nodes Date: Wed, 22 Jun 2016 00:38:34 +0300 Organization: Tidorum Ltd Message-ID: References: <66c14298-c62d-4f4b-b0c0-e969454f9334@googlegroups.com> <2e39857a-7121-476b-807a-d2bff1e598f4@googlegroups.com> <431af616-7df3-4e4d-9262-26ed68cb74c7@googlegroups.com> <037df2b8-b9c4-4447-87ee-cc89d7072b30@googlegroups.com> <15914c54-191c-4f37-b754-282855d1aeaf@googlegroups.com> <3e25c9a0-469c-4487-b78e-6f87434f87fa@googlegroups.com> <2e69ca6f-484c-4d58-b0fe-d17a744b1418@googlegroups.com> <9ada1cdc-2fbd-4009-99f1-aba71ac1b9d2@googlegroups.com> Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit X-Trace: individual.net 5etUojG2LfGSVQP//uGemgDKP9rCF2gmyws1nRzwjvk8+MMGCt Cancel-Lock: sha1:T+JvEDBCokpHbbaG6SDnESbLJwI= User-Agent: Mozilla/5.0 (Macintosh; Intel Mac OS X 10.8; rv:45.0) Gecko/20100101 Thunderbird/45.1.1 In-Reply-To: <9ada1cdc-2fbd-4009-99f1-aba71ac1b9d2@googlegroups.com> Xref: news.eternal-september.org comp.lang.ada:30868 Date: 2016-06-22T00:38:34+03:00 List-Id: On 16-06-21 13:31 , Warren wrote: > On Tuesday, 21 June 2016 01:52:51 UTC-4, Niklas Holsti wrote: >> On 16-06-21 05:20 , Warren wrote: >>> On Monday, 20 June 2016 15:33:16 UTC-4, Niklas Holsti wrote: >>>> On 16-06-20 15:26 , Warren wrote: >>>> >>>>> Anyway folks- thanks for your help but I now have a working solution. I'm signing off this thread. >>>> >>>> Before signing off, do please describe your solution. >>> >>> I thought I had the problem licked using the following generic >>> Object_Of function, but when I whipped up an example, the compile >>> problem returned (or there was pilot error): >>> >>> function Object_Of( >>> Node: access Emb_Node; >>> Member: Natural >>> ) return Object_Type is >>> use System.Storage_Elements; >>> >>> A: constant System.Address := Node.all'Address; >>> B: constant System.Address := A - Storage_Offset(Member); >>> R: Object_Type; >>> for R'Address use B; >>> pragma Import(Convention => Ada, Entity => R); >>> begin >>> return R; >>> end Object_Of; >>> >>> The compiler is complaining with: >>> >>> warning: controlled object "R" must not be overlaid. >> >> The component My_Recd.Name, of the controlled type Unbounded_String, is >> making Object_Type also controlled. I well understand that the compiler >> does not want controlled objects to be overlaid with address clauses. >> >> Instead of a function returning Object_Type, you could try returning an >> access to Object_Type, as produced by an instance of >> System.Address_To_Access_Conversions. In fact, if I understand your >> goals, you do not want Object_Of to return a _copy_ of the object >> containing the Emb_Node, the need is to _find_ that very object. >> Returning an access value is closer to what you want, I believe. > > That is correct (no copy). The suggestion for System.Address_To_Access_Conversions seems like a potential solution. The only other thing I can do is try to cheat with a C routine returning an address, but GNAT is just as likely to complain. It now seems to me that the solutions suggested so far are too elaborate, and that a very simple solution exists: an embedded list node is just an ordinary component, derived from a tagged root type which holds the Prev and Next links, with an access discriminant referring to the containing object. The OP asked for a "generic" solution, but IMO a generic would not be simpler than this direct form. Example code follows. Compiled but not tested. package Emb_List is -- The class of "embedded list nodes": type Emb_Node_T is tagged; type Emb_Node_Ref_T is access all Emb_Node_T'Class; type Emb_Node_T is tagged record Prev, Next : Emb_Node_Ref_T; -- Prev and Next are null if the node is not in any list. -- When the node is first in a list, Prev points to the list head. -- When the node is last in a list, Next is null. end record; subtype List_T is Emb_Node_T; -- A list head. -- Next points to the first node in the list. -- Prev is null. procedure Insert_At_Head ( List : access List_T; Node : in Emb_Node_Ref_T); -- Prepends Node at the head of the list. -- Assumes that Node is not in any list, to start with. procedure Delete (Node : in Emb_Node_Ref_T); -- Deletes the Node from the list it lies in, assuming that -- the Node does lie in a list. -- An example type with two embedded list nodes: type Integer_Object_T; type Integer_Emb_Node_T (Obj : access Integer_Object_T) is new Emb_Node_T with null record; type Integer_Object_T is limited record Value : Integer; Node1 : aliased Integer_Emb_Node_T (Integer_Object_T'Access); Node2 : aliased Integer_Emb_Node_T (Integer_Object_T'Access); end record; -- An example object: Int_Obj : Integer_Object_T; -- Two example lists, empty by default: List1, List2 : aliased List_T; end Emb_List; package body Emb_List is procedure Insert_At_Head ( List : access List_T; Node : in Emb_Node_Ref_T) is begin List.Next.Prev := Node; Node.Next := List.Next; List.Next := Node; Node.Prev := Emb_Node_Ref_T (List); end Insert_At_Head; procedure Delete (Node : in Emb_Node_Ref_T) is begin Node.Prev.Next := Node.Next; Node.Next.Prev := Node.Prev; Node.Prev := null; Node.Next := null; end Delete; begin -- Add the example object to the example lists: Insert_At_Head (List1'Access, Int_Obj.Node1'Access); Insert_At_Head (List2'Access, Int_Obj.Node2'Access); -- Delete from List2: Delete (Int_Obj.Node2'Access); end Emb_List; -- Niklas Holsti Tidorum Ltd niklas holsti tidorum fi . @ .