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=-0.8 required=5.0 tests=BAYES_00,INVALID_DATE, T_FILL_THIS_FORM_SHORT autolearn=no autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 1108a1,93fa00d728cc528e X-Google-Attributes: gid1108a1,public X-Google-Thread: 103376,93fa00d728cc528e X-Google-Attributes: gid103376,public X-Google-ArrivalTime: 1994-10-26 09:08:53 PST Path: nntp.gmd.de!xlink.net!howland.reston.ans.net!news.moneng.mei.com!hookup!news.kei.com!eff!blanket.mitre.org!linus.mitre.org!linus!mbunix!eachus From: eachus@spectre.mitre.org (Robert I. Eachus) Newsgroups: comp.lang.ada,comp.object Subject: Generic association example (was Re: Mutual Recursion Challenge) Date: 26 Oct 94 11:42:21 Organization: The Mitre Corp., Bedford, MA. Message-ID: References: <1994Oct18.221751.15457@swlvx2.msd.ray.com> <38289r$79m@oahu.cs.ucla.edu> <1994Oct19.143843.372@wdl.loral.com> <38fi4r$l81@oahu.cs.ucla.edu> <1994Oct24.203214.4967@swlvx2.msd.ray.com> NNTP-Posting-Host: spectre.mitre.org In-reply-to: jgv@swl.msd.ray.com's message of Mon, 24 Oct 1994 20:32:14 GMT Xref: nntp.gmd.de comp.lang.ada:16204 comp.object:16631 Date: 1994-10-26T11:42:21+00:00 List-Id: In article <1994Oct24.203214.4967@swlvx2.msd.ray.com> jgv@swl.msd.ray.com (John Volan) writes: > Could you clarify this a bit, and elaborate on how using mixins would > work here? I think I understand what you're driving at, but perhaps > other folks won't. What, precisely, do you mean by the "baggage" that > would be there anyway? Also, how well does the mixin technique really > scale up, when you imagine many classes, many associations, and each > class participating in many associations? >It may seem that creating a dozen abstract types which are only there >as placeholders is a problem, but in fact the only problem I have >found with it is coming up with names. (The best strategy I have >found is to use the base class name joined with the generic package >name as the name of the package instance: > package Persons_Office_Assignment is new Office_Assignment(Person); > and elsewhere: > package Office_Staff_Assignment is new Staff_Assignment(Office); > I take it that Persons_Office_Assignment would declare a derived type > inheriting from Person, with an extension supporting the association > with Office. Likewise, Office_Staff_Assignment would declare a > derived type inheriting from Office, with an extension supporting the > association with Person. Yes and yes. > One problem I see with this particular formulation is that a > Person-who-can-occupy-an-Office can point to any Office, not > necessarily only an Office-that-can-be-occupied; likewise, an > Office-that-can-be-occupied can point to any Person, not > necessarily only a Person-who-can-occupy-an-Office. That is what abstract types are for. In particular, the feature added last August that abstract types need not have any abstract operations makes it easy. All the types that you can point to but shouldn't are abstract, and since the type determination in a dispacthing operation comes from the object, the issue doesn't arise. > Is there a way of putting this together that guarantees the > invariant that if a Person occupies an Office, then that Office is > occupied by that Person? Yes. It is best understood with the "double generic" version, but doesn't depend on it. However, make sure you reserve one-to-one mappings for where they are appropriate. Supporting many-to-many mappings requires a lot more complexity in the Association abstraction, so there should probably be several--one-to-one and onto, one-to-many, and many-to-many. They only need to be written once, so let's try the simplest case: (I spent a lot of time barking up the wrong tree on this. Querying the attributes is not a problem, but defining an operation to set them resulted in all sorts of visible kludges or silly looking code. There are two facets to the solution. The first is that in the one-to-one case there are two necessary set operations: un-set and set, not set for office and set for person. The second is that, while the query functions want to be class-wide in one parameter, these should be symmetric, and thus class-wide in both.) generic type Father is abstract tagged private; -- probably all the abstract types should be limited too. type Target_Ancestor is abstract tagged private; -- ancester of the destination type, for example, Controlled. package Association is type Extended is abstract new Father with private; function Get(E: in Extended) return Target_Ancestor'CLASS; -- If you follow the above directions about abstraction, this -- must always return the "right" type. But if you have several -- non-abstract types which are specializations of say Person, -- you want the attribute declared this way anyway. Raises -- Constraint_Error if the attribute is not set. function Is_Set(E: in Extended) return Boolean; -- Inquiry function to avoid Constraint_Error. generic type Mother is abstract tagged private; package Inner_Association is type Inner_Extended is new Mother with private; function Get(E: in Inner_Extended) return Extended'CLASS; -- Again we want the 'CLASS even in cases where it may not be -- necessary to complete the code... function Is_Set(E: in Extended) return Boolean; -- Inquiry function to avoid Constraint_Error as above. procedure Safe_Set (E: in out Extended'CLASS; IE: in out Inner_Extended'CLASS); procedure Force_Set(E: in out Extended'CLASS; IE: in out Inner_Extended'CLASS); -- There are two choices here, set in any case, but preserve -- the invariants, or raise an exception and change nothing if -- one or the other is already set. Since it is simple to -- provide both, I do so. (Safe_Set does the checks and may -- raise an exception, Force_Set unsets the partner of any -- object that is being reassigned.) procedure UnSet(E: in out Extended'CLASS); procedure UnSet(IE: in out Extended'CLASS); -- UnSet the attribute. If already set, unset the partner as well. private type Outer_Ref is access all Extended; type Inner_Extended is new Mother with record Attribute: Outer_Ref; end record; end Inner_Association; pragma INLINE(Get, Is_Set, Safe_Set, Force_Set); private type Inner_Ref is access all Target_Ancestor; type Extended is new Father with record Attribute: Inner_Ref; end record; pragma INLINE(Get, Is_Set); end Association; -- generic -- type Father is abstract tagged private; -- type Target_Ancestor is abstract tagged private; package body Association is -- type Extended is new Father with record -- Attribute: Inner_Ref; end record; function Get(E: in Extended) return Target_Ancestor'CLASS is begin return E.Attribute.all; end Get; function Is_Set(E: in Extended) return Boolean is begin return E.Attribute = null; end Is_Set; -- generic -- type Mother is abstract tagged private; package Inner_Association is -- type Inner_Extended is new Mother with record -- Attribute: Outer_Ref; end record; function Get(E: in Inner_Extended) return Extended'CLASS is begin return E.Attribute.all; end Get; function Is_Set(E: in Extended) return Boolean is begin return E.Attribute = null; end Is_Set; procedure Safe_Set (E: in out Extended'CLASS; IE: in out Inner_Extended'CLASS) is begin if Is_Set(E) or Is_Set(IE) then raise Constraint_Error; else end if; end Safe_Set; procedure Force_Set(E: in out Extended'CLASS; IE: in out Inner_Extended'CLASS) is begin if Is_Set(E) then UnSet(E); end if; if Is_Set(IE) then UnSet(IE); end if; E.Attribute := IE'Access; IE.Attribute := E'Access; end Force_Set; procedure UnSet(E: in out Extended'CLASS) is begin if E.Attribute /= null then E.Attribute.Attribute := null; E.Attribute := null; end if; end UnSet; procedure UnSet(IE: in out Extended'CLASS) is begin if IE.Attribute /= null then IE.Attribute.Attribute := null; IE.Attribute := null; end if; end UnSet; end Inner_Association; end Association; (If anyone can compile this successfully, please let me know. There is a bug in GNAT 1.83 that is supposed to be fixed in 1.84 that the spec runs into.) Okay, now using this package goes like this... with Ada.Finalization; with Assignments; package People is type Base_Person is abstract new Ada.Finalization.Controlled with private; package Office_Assignments is new Assignments(Base_Person,Ada.Finalization.Controlled); type Person is new Office_Assignments.Extended with null; function Office(P: in Person) return Controlled'CLASS renames Get; function Has_Office(P: in Person) return Boolean renames Is_Set; private ... end People; with Ada.Finalization; with People; package Offices is type Office_Base is abstract new Ada.Finalization.Controlled with private; package People_Assignments is new People.Office_Assignments.Inner_Association(Office_Base); type Office is new People_Assignments.Inner_Extended with null; function Occupant(O: in Office) return People.Office_Assignments.Extended'CLASS renames Get; function Is_Occupied(O: in Office) return Boolean renames Is_Set; procedure Reassign(P: in out People.Office_Assignments.Extended'CLASS; O: in out People_Assignments.Inner_Extended'CLASS); ... private ... end Offices; > If I'm totally mixed-up about mixins :-), please help me out. Thanks. I hope this helps. The trick is to get as much of the "plumbing" code into generics which are written once, and then use appropriate renamings to make it understandable. (In fact, in the code above I probably would use subtype definitions to make those ugly 'CLASS parameters go away. The other possible approach is to replace the renamings with operations on the parent types which do the ugly calls in the body. It's a matter of style and in this case, I'm trying to show the workings...) -- Robert I. Eachus with Standard_Disclaimer; use Standard_Disclaimer; function Message (Text: in Clever_Ideas) return Better_Ideas is...