SOLVED! Decoupled Mutual Recursion Challenger

[jgv@swl.msd.ray.com (John Volan)]

[Okay, I give in.  Nobody seems to want to bite on this one, and a lot of
people seem to be waiting with baited breath.  Well, fine.  Here goes ... 
Oh, by the way, *LONG POST WARNING* -- as if I needed to tell you! :-) ]

--------------------------------------------------------------------------------

DECOUPLED MUTUAL RECURSION CHALLENGER -- SOLVED!
------------------------------------------------

Yes, folks, there *is* an ANSWER.  A simple, elegant ANSWER.  (No,
it's not "42".  This in only Ada, after all, not Life, the Universe,
and Everything. :-)

In a word, the solution is: GENERICS.

Think about it.  What are generics, really?  Loosely speaking,
generics are "incomplete" pieces of code, with "blanks" that need to
be "filled in" later.  This makes them ideal for two very important
uses, one which is well-known and much ballyhoo-ed, and another which
gets very little press at all:

(1) REUSE -- Just fill in the blanks as many times as you like!

(2) DEFERRED COUPLING -- Just write whatever you can now, and worry about
    filling in the blanks later, when you know more.

Isn't the problem of decoupled mutual recursion just a case of
deferred coupling?  Consider: We need to be able to establish some
kind of type that can express the "identity" of objects of a given
class, even before the interface for that class has been defined.  It
doesn't matter if this "identity" type is "opaque", as long as it will
be possible to convert that "opaque identity" into a "transparent"
identity (say, a pointer type) -- *eventually*, once we've had a chance
to establish the interface for the class.

Here's my solution, and it takes advantage of both applications of
generics -- reuse as well as deferred coupling: 

First, we need to establish the following support package:

    ----------------------------------------------------------------------

    generic                  -- Note: Ada allows parameterless generics!
    package Identity is

      -- Identity.Value
      type Value is private; 

      -- Each instantiation of this package establishes a new Identity.Value
      -- type for (presumably) a new class of object.  At first, this type
      -- is "opaque": the only operations available for it are assignment 
      -- ( ":=" ) and predefined equality and inequality ( "=" and "/=" ).
      -- However, because of the nested generic package below, each such
      -- type has the *potential* to be translatable into some "transparent"
      -- pointer type -- eventually.  But at this point, there is no
      -- way to actually generate any Identity.Value other than Identity.None.

      -- Identity.None    
      None : constant Identity.Value;

      -- NOTE: Identity.Value objects are guaranteed to be default-initialized
      -- to the value Identity.None, mimicking the default initialization 
      -- of access types to the value null.
    
      -- Identity.Translation
      generic
        type Object (<>) is limited private; -- matches any type
        type Pointer is access Object;
      package Translation is

        -- This nested generic allows us to establish a translation between
        -- an "opaque" Identity.Value type and some "transparent" Pointer
        -- type ... *later*.  Once instantiated, it becomes possible to generate
        -- Identity.Values other than Identity.None, but only by translating
        -- from Pointer values designating the given Object type.

        -- NOTE: Only one instantiation of this package will be allowed (per
        -- instantiation of the outer package).  Any attempt to establish
        -- more than one Translation for a given Identity.Value type will
        -- raise Standard.Program_Error on elaboration.  By admitting only
        -- one valid Translation, we can guarantee type safety: the only
        -- Pointers that we can get out of Identity.Values will be the
        -- Pointers that we actually put into them.

        -- Identity.Translation.To_Pointer
        function To_Pointer (The_Identity : in Identity.Value) return Pointer;
        pragma Inline (To_Pointer);

        -- Identity.Translation.To_Identity
        function To_Identity (The_Pointer : in Pointer) return Identity.Value;
        pragma Inline (To_Identity);

      end Translation;
    
    private -- Identity

      ... more about the implementation in a while ...

    end Identity;

    ----------------------------------------------------------------------

Before looking at a possible implementation of this support package,
let's first take a look at how we might make use of it.

First, for every class that you want to introduce into a system, write
an instantiation of the Identity package:

    ----------------------------------------------------------------------

    with Identity;
    package Employee_Identity is new Identity;

    ----------------------------------------------------------------------

    with Identity;
    package Manager_Identity is new Identity;

    ----------------------------------------------------------------------

    with Identity;
    package Office_Identity is new Identity;

    ----------------------------------------------------------------------

    with Identity;
    package Project_Identity is new Identity;

    ----------------------------------------------------------------------

    with Identity;
    package Building_Identity is new Identity;

    ----------------------------------------------------------------------

    ... etc.  (Note: these are all separately-compilable library units.)


In effect, this "forward declares" each class.  Note that this takes very
little work to do: a couple of lines of code for each class.

Later, you can procede with writing your package specs for each class.  Each
package spec can make use of the opaque identity packages for any other classes
that it is associated with.  Additionally, each package spec should provide an
instantiation of the Translation generic for its corresponding Identity.Value
type.  (Note that this only costs four lines of code per class.)

    ----------------------------------------------------------------------

    with Office_Identity;
    with Employee_Identity;
    ...

    package Office is

      -- Office.Object
      type Object is tagged limited private;

      -- Office.Pointer
      type Pointer is access all Office.Object'Class;

      -- Office.None
      None : constant Office.Pointer := null;

      -- Office.Translation
      package Translation is new
        Office_Identity.Translation
          (Object  => Office.Object'Class,
           Pointer => Office.Pointer);

      ----------------------------------------
      -- Primitives supporting association
      -- Office--occupied_by--Employee
      ----------------------------------------

      -- Office.Occupant_Employee_Of
      function Occupant_Employee_Of
        (The_Office : in Office.Object'Class) 
        return Employee_Identity.Value;

      -- Office.Associate_With_Occupant_Employee
      proccedure Associate_With_Occupant_Employee
        (The_Office   : in out Office.Object'Class;
         New_Employee : in     Employee_Identity.Value);
        -- mutually recursive with:
        -- Employee.Associate_With_Occupied_Office

      -- Office.Dissociate_From_Occupant_Employee
      proccedure Dissociate_From_Occupant_Employee
        (The_Office   : in out Office.Object'Class);
        -- mutually recursive with:
        -- Employee.Dissociate_From_Occupied_Office

      ... -- other primitives

    private -- Office

      -- Office.Object
      type Object is tagged limited
        record
          ...
          Its_Occupant_Employee : Employee_Identity.Value;
          ... -- other components
        end record;

    end Office;

    ----------------------------------------------------------------------

It's even possible for a class to be mutually-recursive with one of
its own subclasses:

    ----------------------------------------------------------------------

    with Employee_Identity;
    with Office_Identity;
    with Manager_Identity; -- Manager will (eventually) inherit from Employee
    ...

    package Employee is

      -- Employee.Object
      type Object is abstract tagged limited private;

      -- Employee.Pointer
      type Pointer is access all Employee.Object'Class;

      -- Employee.None
      None : constant Employee.Pointer := null;

      -- Employee.Translation
      package Translation is new 
        Employee_Identity.Translation 
          (Object  => Employee.Object'Class, 
           Pointer => Employee.Pointer);

      ----------------------------------------
      -- Primitives supporting association 
      -- Employee--occupies--Office
      ----------------------------------------

      -- Employee.Occupied_Office_Of
      function Occupied_Office_Of
        (The_Employee : in Employee.Object'Class) 
        return Office_Identity.Value;

      -- Employee.Associate_With_Occupied_Office
      procedure Associate_With_Occupied_Office
        (The_Employee : in out Employee.Object'Class;
         New_Office   : in     Office_Identity.Value);
        -- mutually recursive with:
        -- Office.Associate_With_Occupant_Employee

      -- Employee.Dissociate_From_Occupied_Office
      procedure Dissociate_From_Occupied_Office
        (The_Employee : in out Employee.Object'Class);
        -- mutually recursive with:
        -- Office.Dissociate_From_Occupant_Employee

      ----------------------------------------
      -- Primitives supporting association
      -- Employee--supervised_by--Manager
      ----------------------------------------

      -- Employee.Supervising_Manager_Of
      function Supervising_Manager_Of
        (The_Employee : in Employee.Object'Class) 
        return Manager_Identity.Value;

      -- Employee.Associate_With_Supervising_Manager
      procedure Associate_With_Supervising_Manager
        (The_Employee : in out Employee.Object'Class;
         New_Manager  : in     Manager_Identity.Value);
        -- mutually recursive with:
        -- Manager.Associate_With_Subordinate_Employee

      -- Employee.Dissociate_From_Supervising_Manager
      procedure Dissociate_From_Supervising_Manager
        (The_Employee : in out Employee.Object'Class);
        -- mutually recursive with:
        -- Manager.Dissociate_From_Subordinate_Employee

      ... -- other primitives

    private -- Employee

      -- Employee.Object
      type Object is abstract tagged
        record
          ...
          Its_Occupied_Office     : Office_Identity.Value;
          Its_Supervising_Manager : Manager_Identity.Value;
          ... -- other components
        end record;

    end Employee;

    ----------------------------------------------------------------------

    with Manager_Identity;       -- To support associations with cardinality > 1
    with Employee_Identity;      -- assume that generic Identity package has
    with Employee_Identity.Set;  -- generic child package Identity.Set, which
    with Project_Identity;       -- can be instantiated to provide Set.Object
    with Project_Identity.Set;   -- types representing sets of identities.
    ...

    with Employee; -- Manager will inherit from Employee.  (Actually, this means
                   -- that Manager can forgo the use of Employee_Identity, but
                   -- for the sake of uniformity, I'll keep to the pattern.)

    package Manager is

      -- Manager.Object
      type Object is new Employee.Object with private;

      -- Manager.Pointer
      type Pointer is access all Manager.Object'Class;

      -- Manager.None
      None : constant Manager.Pointer := null;

      -- Manager.Translation
      package Translation is new
        Manager_Identity.Translation
          (Object  => Manager.Object'Class,
           Pointer => Manager.Pointer);

      ----------------------------------------
      -- Primitives supporting association:
      -- Manager--coordinates--Project(s)
      ----------------------------------------

      -- Manager.Coordinated_Projects_Of
      function Coordinated_Projects_Of
        (The_Manager : in Manager.Object'Class)
        return Project_Identity.Set.Object;

      -- Manager.Is_Associated_With_Coordinated_Project
      function Is_Associated_With_Coordinated_Project
        (The_Manager : in Manager.Object'Class;
         The_Project : in Project_Identity.Value) return Boolean;

      -- Manager.Associate_With_Coordinated_Project
      procedure Associate_With_Coordinated_Project
        (The_Manager : in out Manager.Object'Class;
         New_Project : in     Project_Identity.Value);
        -- mutually recursive with:
        -- Project.Associate_With_Coordinating_Manager

      -- Manager.Dissociate_From_Coordinated_Project
      procedure Dissociate_From_Coordinated_Project
        (The_Manager : in out Manager.Object'Class;
         Old_Project : in     Project_Identity.Value);
        -- mutually recursive with:
        -- Project.Dissociate_From_Coordinating_Manager

      ----------------------------------------
      -- Primitives supporting association
      -- Manager--supervises--Employee(s)
      ----------------------------------------

      -- Manager.Subordinate_Employees_Of
      function Subordinate_Employees_Of
        (The_Manager : in Manager.Object'Class)
        return Employee_Identity.Set.Object;

      -- Manager.Is_Associated_With_Subordinate_Employee
      function Is_Associated_With_Subordinate_Employee
        (The_Manager  : in Manager.Object'Class;
         The_Employee : in Employee_Identity.Value) return Boolean;

      -- Manager.Associate_With_Subordinate_Employee
      procedure Associate_With_Subordinate_Employee
        (The_Manager  : in out Manager.Object'Class;
         New_Employee : in     Employee_Identity.Value);
        -- mutually recursive with:
        -- Employee.Associate_With_Supervising_Manager

      -- Manager.Dissociate_From_Subordinate_Employee
      procedure Dissociate_From_Subordinate_Employee
        (The_Manager  : in out Manager.Object'Class;
         Old_Employee : in     Employee_Identity.Value);
        -- mutually recursive with:
        -- Employee.Dissociate_From_Supervising_Manager

      .... -- other primitives

    private -- Manager

      -- Manager.Object
      type Object is new Employee.Object with
        record
          ...
          Its_Coordinated_Projects  : Project_Identity.Set.Object;
          Its_Subordinate_Employees : Employee_Identity.Set.Object;
          ... -- other components
        end record;

    end Manager;
    
    ----------------------------------------------------------------------

The bodies of these packages can import each other's specs.  Since
each package spec provides a Translation facility for its
corresponding Identity.Value type, the package bodies can make
use of each other's Translation facilities whenever necessary.
For instance:

    ----------------------------------------------------------------------

    with Employee;
    ...

    package body Office is

      ----------------------------------------
      -- Primitives supporting association
      -- Office--occupied_by--Employee
      ----------------------------------------

      ----------------------------------------
      -- Office.Occupant_Employee_Of
      ----------------------------------------

      function Occupant_Employee_Of
        (The_Office : in Office.Object'Class) 
        return Employee_Identity.Value is
      begin
        return The_Office.Its_Occupant_Employee;
      end Occupant_Employee_Of;


      ----------------------------------------
      -- Office.Associate_With_Occupant_Employee
      --   mutually recursive with:
      --   Employee.Associate_With_Occupied_Office
      ----------------------------------------

      proccedure Associate_With_Occupant_Employee
        (The_Office   : in out Office.Object'Class;
         New_Employee : in     Employee_Identity.Value)
      is
        use type Employee_Identity.Value;
      begin
        if New_Employee /= Employee_Identity.None and then
           New_Employee /= The_Office.Its_Occupant_Employee
        then

          Office.Dissociate_From_Occupant_Employee (The_Office);

          The_Office.Its_Occupant_Employee := New_Employee;

          Employee.Associate_With_Occupied_Office
          ( The_Employee => Employee.Translation.To_Pointer(New_Employee).all,
            New_Office   => Office.Translation.To_Identity(The_Office'Access) );

                            -- Okay, if you really want to shorten these
                            -- expressions, you could throw in some use-clauses.
                            -- But my feeling is that this style is very
                            -- readable as is.

        end if;
      end Associate_With_Occupant_Employee;


      ----------------------------------------
      -- Office.Dissociate_From_Occupant_Employee
      --   mutually recursive with:
      --   Employee.Dissociate_From_Occupied_Office
      ----------------------------------------

      proccedure Dissociate_From_Occupant_Employee
        (The_Office   : in out Office.Object'Class)
      is
        use type Employee_Identity.Value;

        Old_Employee : constant Employee_Identity.Value :=
          The_Office.Its_Occupant_Employee;

      begin
        if Old_Employee /= Employee_Identity.None then

          The_Office.Its_Occupant_Employee := Employee_Identity.None;

          Employee.Dissociate_From_Occupied_Office
          ( The_Employee => Employee.Translation.To_Pointer(Old_Employee).all );

        end if;
      end Dissociate_From_Ocupant_Employee;


      ... -- other primitives

    end Office;

    ----------------------------------------------------------------------

(The bodies of Employee, Manager, Project, etc. would be similar.)

Thus, looking at the dependencies between compilation units, it's clear
that this scheme achieves the Identity/Interface/Implementation Trichotomy:

              +--------+           +--------+           +--------+
              |Manager |           |Employee|           | Office |
              |Identity|<--_   _-->|Identity|<--_   _-->|Identity|
              +--------+    \ /    +--------+    \ /    +--------+
                             X                    X               
              +--------+    / \    +--------+    / \    +--------+
              |Manager |___/   \___|Employee|___/   \___| Office |
              |        |--INHERIT->|        |           |        |
              |  Spec  |<--_   _-->|  Spec  |<--_   _-->|  Spec  |
              +--------+    \ /    +--------+    \ /    +--------+
                             X                    X               
              +--------+    / \    +--------+    / \    +--------+
              |Manager |___/   \___|Employee|___/   \___| Office |
              |        |           |        |           |        |
              |  Body  |           |  Body  |           |  Body  |
              +--------+           +--------+           +--------+

                       (Where -----> indicates dependency)

Note that this scheme holds up even where we have a generalization/
specialization relationship:  Manager can still inherit from Employee,
even though Employee depends on Manager_Identity.

To show the benefits of decoupling, let's see what happens when we add 
a new class (Project) and a new association (Manager--coordinates--Project).
The above diagram becomes:


    ##########           +--------+           +--------+           +--------+
    #Project #           |Manager |           |Employee|           | Office |
    #Identity#<--_   _-->|Identity|<--_   _-->|Identity|<--_   _-->|Identity|
    ##########    \ /    +--------+    \ /    +--------+    \ /    +--------+
                   X                    X                    X               
    ##########    / \    ##########    / \    +--------+    / \    +--------+
    #Project #___/   \___#Manager #___/   \___|Employee|___/   \___| Office |
    #        #           #        #--INHERIT->|        |           |        |
    #  Spec  #<--_   _-->#  Spec  #<--_   _-->|  Spec  |<--_   _-->|  Spec  |
    ##########    \ /    ##########    \ /    +--------+    \ /    +--------+
                   X                    X                    X               
    ##########    / \    ##########    / \    @@@@@@@@@@    / \    +--------+
    #Project #___/   \___#Manager #___/   \___@Employee@___/   \___| Office |
    #        #           #        #           @        @           |        |
    #  Body  #           #  Body  #           @  Body  @           |  Body  |
    ##########           ##########           @@@@@@@@@@           +--------+


           ####
    Where  #  #  =  compilation unit that must be written or modified
           ####

           @@@@
           @  @  =  compilation unit that must be recompiled (but not modified)
           @@@@

           +--+
           |  |  =  compilation unit that is unaffected by the change
           +--+

As you can see, we need to write or modify the package specs and
package bodies for the classes involved in the association: Project
and Manager.  And, because the spec of package Manager is changed, the
package bodies for other classes associated with Manager, such as
Employee, have to be recompiled, although they do not need to be
modified.  But, because *Manager_Identity* is not touched, the package
*specs* for classes such as Employee not only do not need to be
modified but they do not even need to be recompiled.  Classes beyond
the immediate vicinity of Manager and Project (for instance, Office)
are not affected at all.

Now let's go back and consider how to implement the Identity package.
To implement the Identity.Value type, all we need is some kind of
"black box" that is guaranteed to be the same storage size as an
access type.  Almost anything would do, but System.Address seems the
most convenient for this purpose.

(Er ... I've been scouring the RM9X 5.0 and much to my surprise I can't
seem to find positive confirmation for the fact that System.Address will
have the same bit-representation as access types.  Tucker, if you're
listening, can you give me a hand here?)

Revisiting the Identity package spec, here's how we could fill in the
private part:

    ----------------------------------------------------------------------

    with System;

    generic
    package Identity is

      ... -- public part as shown above

    private -- Identity
    
      -- Identity.Value
      type Value is
        record
          Its_Address : System.Address := System.Null_Address;
        end record;

      -- Identity.None      
      None : constant Identity.Value := (Its_Address => System.Null_Address);

    end Identity;

    ----------------------------------------------------------------------

I considered just deriving Identity.Value directly from System.Address:

      -- Identity.Value
      type Value is new System.Address;

      -- Identity.None
      None : constant Identity.Value := Identity.Value (System.Null_Address);

However, the record type is preferable because it allows for default
initialization.  That way, Identity.Values can mimick the way access
types are always automatically initialized to null.

In the package body, we're going to need to make use of
Unchecked_Conversions between System.Address and the given Pointer
type.  At first blush, this might seen like a violation of
type-safety.  But it really isn't, because those Addresses are never
going to be used *as* Addresses.  They're just "black boxes" for
holding Pointer values opaquely.  Pointers go in, and Pointers come
out, period.  And only one kind of Pointer at that -- as long as we
can guarantee that only one instantiation of Translation (per Identity
instantiation) will be allowed within a single program.

Here's a possible implementation of the Identity package body:

    ----------------------------------------------------------------------

    with Ada.Unchecked_Conversion;

    package body Identity is

      One_Translation_Registered_Already : Boolean := False;

      -- This flag helps guarantee type-safety, by allowing us to
      -- establish only one Translation for a given instantiation of
      -- Identity.

      -----------------------
      -- Identity.Translation
      -----------------------

      package body Translation is

        function Address_To_Pointer is new 
          Ada.Unchecked_Conversion (System.Address, Pointer);

        function Pointer_To_Address is new
          Ada.Unchecked_Conversion (Pointer, System.Address);

        -- Alternatively, an instantiation of the generic package
        -- System.Storage_Elements.Address_To_Access_Conversions 
        -- could be used.  But Unchecked_Conversion is sufficient,
        -- because we never really use an Identity.Value's Address 
        -- component *as* an Address.  As long as the bit-pattern
        -- of the original Pointer value is preserved, it doesn't
        -- matter whether its interpretation as an Address makes
        -- any semantic sense.

        ----------------------------------
        -- Identity.Translation.To_Pointer
        ----------------------------------

        function To_Pointer (The_Identity : in Identity.Value) 
          return Pointer is
        begin
          return Address_To_Pointer (The_Identity.Its_Address);
        end To_Pointer;

        -----------------------------------
        -- Identity.Translation.To_Identity
        -----------------------------------

        function To_Identity (The_Pointer : in Pointer) 
          return Identity.Value is
        begin
          return (Its_Address => Pointer_To_Address (The_Pointer));
        end To_Identity;


        -- Note: Unchecked_Conversions are intrinsic, and both of the
        -- functions To_Pointer and To_Identity are inlined.  So it is 
        -- conceivable that an optimizing compiler can reduce the cost
        -- calling these functions to *zero*.


      begin -- Translation

        -- On elaboration of an instantiation of this nested generic,
        -- confirm that this instantiation is the only one:

        if One_Translation_Registered_Already then
          raise Standard.Program_Error;
        else
          One_Translation_Registered_Already := True;
        end if;

        -- For the final delivery of a fully-tested system, even this
        -- validity check could be eliminated.  (Substitute an alternate
        -- body for package Identity without this check, and then
        -- recompile the world.)

      end Translation;

    end Identity;

    ----------------------------------------------------------------------

And there you have it.  No more "withing" problem.  And we didn't have
to replace it with an "inheritance collision" problem, where competing
uses for inheritance interfere with each other.  Ada9X's inheritance
mechanism is available to do what inheritance was always meant to do:
support generalization/specialization relationships that come from the
*problem* domain.  Mutual recursion is being achieved in a decoupled
way while still preserving type-safety -- but it's Ada's generic
facilities that are providing the decoupling.  By coming up with a
*reusable* solution as well, we have effectively "extended" the
language -- without actually having to do violence to the definition
of the language itself.  Remember the mantra: "Ada's already expressive
enough!"

There's room for a lot of variation with this technique.  For
instance, you could combine it with child units: If the association
operations don't need to be primitives, you could off-load them to
child packages, where the transparent Pointer types for both classes
are available.  Yet, as an *implementation* choice, you can keep the
opaque Identity values within the tagged record types.  The child
packages could take care of using the appropriate Translations to
convert between hidden Identity values and published Pointer values.

More broadly, I hope that the whole idea of using generics for
"deferred coupling" will open up a lot of interesting possibilities
for you folks out there, not just for this particular problem,
but for many others as well.

Happy OOPing!

-- John Volan

--------------------------------------------------------------------------------
--  Me : Person := (Name                => "John Volan",
--                  Company             => "Raytheon Missile Systems Division",
--                  E_Mail_Address      => "jgv@swl.msd.ray.com",
--                  Affiliation         => "Enthusiastic member of Team Ada!",
--                  Humorous_Disclaimer => "These opinions are undefined " &
--                                         "by my employer and therefore " &
--                                         "any use of them would be "     &
--                                         "totally erroneous.");
--------------------------------------------------------------------------------