Re: Mut. Recurs. in Ada9X w/o Breaking Encaps.? (LONG)

[ncohen@watson.ibm.com (Norman H. Cohen)]

In article <1994Sep27.165203.9192@swlvx2.msd.ray.com>, jgv@swl.msd.ray.com
(John Volan) writes: 

|> But what if we need to be able to traverse the association in *both*
|> directions?  The most straightforward design to meet this requirement would
|> make the data types for Employee and Office mutually recursive: Each class
|> of object would contain a reference [1] to an object of the other class.  This
|> is easy enough to do (in either Ada or C++) by "forward declaring" the types
|> so that both of them can "know" about each other -- but it appears that we'd
|> have to relinquish the idea of putting the two classes in separate packages.
|>
|> Here's my attempt at mutually recursive classes in Ada 9X: 
|>
|>     ----------------------------------------------------------------------
|>
|>     with ... ; -- other stuff needed by Employee
|>     with ... ; -- other stuff needed by Office
|>
|>     package Employee_And_Office is
|>
|>       type Employee is tagged limited private; -- already acts as a forward decl
|>       type Employee_Pointer is access all Employee'Class;
|>       No_Employee : constant Employee_Pointer := null;
|>
|>       ... -- Employee subprograms involving that "other stuff"
|>
|>       type Object is tagged limited private; -- already acts as a forward decl
|>       type Office_Pointer is access all Office'Class;
|>       No_Office : constant Office_Pointer := null;
|>
|>       ... -- Office subprograms involving that "other stuff"
|>
|>       function Office_Occupied_By (The_Employee : in Employee)
|>         return Office_Pointer;
|>
|>       function Employee_Occupying (The_Office : in Office)
|>         return Employee_Pointer;
|>
|>       procedure Occupy (The_Office   : in Office_Pointer;
|>                         The_Employee : in Employee_Pointer);
|>       -- Hmm ... does this count as a primitive/dispatching operation for
|>       -- *both* tagged types, and therefore a compiler error?

(Actually, it's not a dispatching operation for either, since you didn't
use access parameters.)

|>
|>     private
|>
|>       type Employee is tagged
|>         record
|>           ... -- various components involving that "other stuff"
|>           Its_Occupied_Office : Office_Pointer;
|>           ...
|>         end record;
|>
|>       type Office is tagged
|>         record
|>           ... -- various components involving that "other stuff"
|>           Its_Occupying_Employee : Employee_Pointer;
|>           ...
|>         end record;
|>
|>     end Employee_And_Office;

One variation on this is to declare recursive types meant to serve as the
parents of types Employee and Office, but to provide no operations for
these recursive types.  Then, in child packages, declare Employee and
Office themselves as derived types and declare primitive operations in
those child packages: 

    with ... ; -- other stuff needed by Employee
    with ... ; -- other stuff needed by Office

    package Employees_And_Offices is

      type Employee_Parent is tagged limited private;
      type Employee_Pointer is access all Employee'Class;

      type Office_Parent is tagged limited private;
      type Office_Pointer is access all Office'Class;

    private

      type Employee_Parent is tagged
        record
          ... -- various components involving that "other stuff"
          Its_Occupied_Office : Office_Pointer;
          ...
        end record;

      type Office_Parent is tagged
        record
          ... -- various components involving that "other stuff"
          Its_Occupying_Employee : Employee_Pointer;
          ...
        end record;

    end Employees_And_Offices;

    package Employees_And_Offices.Employees is
       type Employee is tagged private;
       No_Employee : constant Employee_Pointer := null;
      ... -- Employee subprograms involving that "other stuff"
    private
       type Employee is new Employee_Parent with null record;
    end Employees_And_Offices.Employees;

    package Employees_And_Offices.Offices is
       type Office is tagged private;
       No_Office : constant Office_Pointer := null;
      ... -- Office subprograms involving that "other stuff"
    private
       type Office is new Office_Parent with null record;
    end Employees_And_Offices.Offices;


    with Employees_And_Offices.Employees, Employees_And_Offices.Offices;

    package Employees_And_Offices.Common is

      function Office_Occupied_By (The_Employee : in Employee)
        return Office_Pointer;

      function Employee_Occupying (The_Office : in Office)
        return Employee_Pointer;

      procedure Occupy (The_Office   : in Office_Pointer;
                        The_Employee : in Employee_Pointer);

    end Employees_And_Offices.Common;

The operations in the Common child are not primitive operations of either
type.  (Two types cannot possibly both have primitive operations with
parameters of the other type, because the declarations of the packages
declaring those types would have to name each other in with clauses.  If
you don't mind breaking the symmetry, you can make the Offices child
depend on the Employees child and put ALL the common operations in the
Offices child as primitive operations of type Office, or vice versa.)
The bodies of all three child packages have complete visibility into the
mutually recursive data structure declared in Employees_And_Offices.  Since
Office_Pointer is declared to designate Office_Parent'Class rather than
Office_Parent, there is no problem with Office_Pointer values designating
Office objects, and similarly for the Employee-related types.

--
Norman H. Cohen    ncohen@watson.ibm.com