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

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

STT = stt@dsd.camb.inmet.com (Tucker Taft) writes:

STT>In article <1994Sep29.014611.20263@swlvx2.msd.ray.com>,
STT>John Volan <jgv@swl.msd.ray.com> wrote:

[snip my own drivel claiming you need unsafe Unchecked_Conversion to downcast]

STT>Actually, you can "down cast" (aka "narrow") safely in Ada 9X.
STT>There is no need to revert to unchecked conversion.
STT>If you have (a pointer to) a class-wide type, you can explicitly convert
STT>it to (a pointer to) any type "covered" by the class-wide type.
STT>A run-time check is performed as appropriate to make sure what you are
STT>doing is copacetic.  See RM9X-4.6(15, 23, 42, 50);5.0.

[snip good example showing safe downcasting]

STT>This capability of Ada 9X is vaguely related to the "assignment attempt"
STT>of Eiffel, and the dynamic_cast of ANSI/ISO C++-to-be, but manages
STT>to fit quite nicely into the existing Ada 83 concept of (safe) explicit
STT>conversion.
STT>
STT>Note that Ada 9X also has a way to check whether a given object
STT>is in a give class before attempting a conversion, as a generalization
STT>of the Ada 83 concept of membership test:
STT>
STT>    if A in T1'Class then ...  -- Checks whether "tag" of A indicates
STT>                               -- that it is in class of types rooted at T1.
STT>
STT>    if Y = null or else Y.all in T1'Class then ...
STT>           -- Checks that PT1(Y) will succeed, before
STT>	   -- attempting it.
STT>

Er, I think you meant:

        if Y /= null and then Y.all in T1'Class then ...

Or maybe, if you wanted to cover the contrary case first:

        if Y = null or else Y.all not in T1'Class then ...

STT>So using access-to-root-abstract-class-wide-type is a viable and safe
STT>approach in Ada 9X, particularly when you "know" there is only
STT>one direct derivative of the root abstract type, and you are
STT>converting to that. 


Ahh, the light begins to dawn.  I could kick myself -- saw this once in the
RM9X and totally forgot about it.  Should have guessed it was there anyway,
on first principles: "If there's something reasonable you want to do, more than
likely there's a SAFE way to do it in Ada 9X."  (An old saying I just made up.)

So -- this now gives me a safe, systematic technique for coding up object 
classes that are each fully encapsulated in their own packages, yet allowing 
any degree of mutual dependency among them.  I'll outline this technique at
the end of this article, but first ...


STT>However, putting two mutually recursive types in the same
STT>package is the traditional Ada way of solving this problem, and
STT>seems preferable to me.  You can preserve modularity by
STT>making these types abstract, while eliminating the need for
STT>explicit type conversions by declaring all of the interesting 
STT>mutually-recursive primitives in this one package.


I won't argue with your personal preference, but let me point out that this
"traditional" technique will have a difficult time scaling up.  For the
sake of discussion, I deliberately chose a very simple situation involving only
two classes, mutually related in a simple one-to-one association.  But, without
loss of generality, I was looking for a solution that could be systematically
applied to systems comprising many, many object classes, each one participating
in mutually recursive associations with possibly many, many other classes, with
any degree of cardinality (one-to-one, one-to-many, many-to-many, etc). 

Unfortunately, the "traditional" technique you suggest (and which I outlined in
my original post) requires breaking encapsulation between any pair of classes 
that happen to be mutually recursive -- and this effect is transitive!  The end
result would be one huge, monolithic package containing *all* (or perhaps most)
of the classes in a system.  I don't think I need to elaborate on the
detrimental effect that would have on a large, long-term project involving 
continously-changing requirements.  The whole point to packaging was to avoid
monolithic coding techniques.  (There you go again, John, preaching to the
choir -- nay, preaching to the *minister*! :-)

I am an unabashed fanatic of the 1 Package = 1 Type = 1 Class approach, and
making that approach workable was the whole point of this thread.  In part, I'm
influenced by Karl Lieberherr's work on the Demeter method, and his so-called 
"Law of Demeter".  This law more or less asserts that each class in an 
object-oriented system should be completely encapsulated and self-administering.
A class should only "know about" the classes it is immediately associated with,
and only "know about" them in terms of their own encapsulated interfaces.
Moreover, this encapsulation should never be broken down, even if some
functionality of the system requires propagating an algorithm across many
classes of object.  Instead, the algorithm should be realized by a collaborative
interaction among the public subprograms of the various classes.  I think this 
is the essence of the whole object-oriented paradigm.


STT>S. Tucker Taft    stt@inmet.com
STT>Ada 9X Mapping/Revision Team
STT>Intermetrics, Inc.
STT>Cambridge, MA 02138


Well, thanks to you and to everyone else who contributed to this thread!

-- 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.");
--------------------------------------------------------------------------------

As promised, here's an outline of my coding strategy:

1. "Forward declare" the classes by writing a "root" package for each, 
containing a featureless abstract tagged type and an accompanying 
access-to-classwide-type.  This establishes a way of manipulating the
*identities* of objects without having to know their *structure* in advance:

    package Employee is
      type Object is abstract tagged limited null record;
      type Pointer is access all Object'Class;
      None : constant Pointer := null;
    end Employee;

    package Office is
      type Object is abstract tagged limited null record;
      type Pointer is access all Object'Class;
      None : constant Pointer := null;
    end Office;

    ... root packages for other object classes in the problem domain


2. Flesh out the "actual" abstraction for each class, in a package spec that is
a child of its corresponding "root" package.  Derive an "actual" concrete
type from the root abstract tagged type.  Wherever the class in question visibly
supports an association with another class, import the other class's root 
package via a "with" clause, and use the corresponding pointer-to-abstract type:

(NOTE: Where two classes are mutually recursive, *both* can provide primitive
subprograms to support the association between them.  Where necessary,
these subprograms can be ... mutually recursive!)

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

    with Office;
    with ... ; -- other stuff, possibly including other class root packages

    package Employee.Actual is

      type Object is new Employee.Object with private;
      type Pointer is access all Object'Class;
      None : constant Pointer := null;

      ... -- subprograms involving other stuff

      -- Public support for association with Office:

      function Office_Occupied_By
      ( The_Employee : in Employee.Actual.Object'Class ) return Office.Pointer;

      procedure Occupy_Office
      ( The_Employee : in out Employee.Actual.Object'Class;
        New_Office   : in     Office.Pointer );
      -- Mutually recursive with Office.Actual.Accomodate_Employee

      procedure Vacate_Office
      ( The_Employee : in out Employee.Actual.Object'Class );
      -- Mutually recursive with Office.Actual.Evict_Employee

      ...

    private
      type Object is new Employee.Object with
        record
          ... -- components involving other stuff
          Its_Occupied_Office : Office.Pointer;
        end record;
    end Employee.Actual;

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

    with Employee;
    with ... ; -- other stuff, possibly including other class root packages

    package Office.Actual is

      type Object is new Office.Object with private;
      type Pointer is access all Object'Class;
      None : constant Pointer := null;

      ... -- subprograms involving other stuff

      -- Public support for association with Employee:

      function Employee_Occupying
      ( The_Office : in Office.Actual.Object'Class ) return Employee.Pointer;

      procedure Accomodate_Employee
      ( The_Office   : in out Office.Actual.Object'Class;
        New_Employee : in     Employee.Pointer );
      -- Mutually recursive with Employee.Actual.Occupy_Office

      procedure Evict_Employee
      ( The_Office : in out Office.Actual.Object'Class );
      -- Mutually recursive with Employee.Actual.Vacate_Office

      ...

    private
      type Object is new Office.Object with
        record
          ... -- components involving other stuff
          Its_Occupying_Employee : Employee.Pointer;
        end record;
    end Office.Actual;

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

    ... "actual" packages for other classes in the problem domain


3. Implement the "actual" abstraction for each class, within the corresponding
child package body.  Wherever the class in question needs access to the full
abstraction of some other class in order to support an association with that
class, import the other class's "actual" package via a "with" clause in the
package body.  Then, wherever the subprograms must interact with a specific
other-class object, downcast the access-to-abstract-root-type into an
access-to-actual-type.  (No explicit validity check is needed -- we'll take
it as an assertion of our design that all designated objects will be of the
correct actual types, and rely on Ada 9X's implicit checks to detect any
inadvertent coding errors.  The run-time cost of these implicit checks can,
if necessary, be eliminated from the final fielded system by using an
appropriate suppressing pragma, once full testing is complete):

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

    with Office.Actual;
    with ... ; -- actual packages for other classes

    package body Employee.Actual is

      ... -- subprogram bodies involving other stuff

      -- Public support for association with Office:

      function Office_Occupied_By
      ( The_Employee : in Employee.Actual.Object'Class ) 
        return Office.Pointer is
      begin
        return The_Employee.Its_Occupied_Office;
      end Office_Occupied_By;
        
      procedure Occupy_Office
      ( The_Employee : in out Employee.Actual.Object'Class;
        New_Office   : in     Office.Pointer )
      is
        use type Office.Pointer;
      begin
        if New_Office /= Office.None and then
           New_Office /= The_Employee.Its_Occupied_Office 
        then
          Employee.Actual.Vacate_Office (The_Employee);
          The_Employee.Its_Occupied_Office := New_Office;
          Office.Actual.Accomodate_Employee
          ( The_Office   => Office.Actual.Pointer(New_Office).all,
            New_Employee => The_Employee'Access );
        end if;
      end Occupy_Office;

      procedure Vacate_Office
      ( The_Employee : in out Employee.Actual.Object'Class )
      is
        Old_Office : constant Office.Pointer := 
          The_Employee.Its_Occupied_Office;
        use type Office.Pointer;
      begin
        if Old_Office /= Office.None then
          The_Employee.Its_Occupied_Office := Office.None;
          Office.Actual.Evict_Employee
          ( The_Office => Office.Actual.Pointer(Old_Office).all );
        end if;
      end Vacate_Office;

      ...

    end Employee.Actual;

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

    with Employee.Actual;
    with ... ; -- actual packages for other classes

    package body Office.Actual is

      ... -- subprogram bodies involving other stuff

      -- Public support for association with Employee:

      function Employee_Occupying
      ( The_Office : in Office.Actual.Object'Class ) return Employee.Pointer is
      begin
        return The_Office.Its_Occupying_Employee;
      end Employee_Occupying;
        
      procedure Accomodate_Employee
      ( The_Office   : in out Office.Actual.Object'Class;
        New_Employee : in     Employee.Pointer )
      is
        use type Employee.Pointer;
      begin
        if New_Employee /= Employee.None and then
           New_Employee /= The_Office.Its_Occupying_Employee 
        then
          Office.Actual.Evict_Employee (The_Office);
          The_Office.Its_Occupying_Employee := New_Employee;
          Employee.Actual.Occupy_Office
          ( The_Employee => Employee.Actual.Pointer(New_Employee).all,
            New_Office   => The_Office'Access );
        end if;
      end Accomodate_Employee;

      procedure Vacate_Employee
      ( The_Office : in out Office.Actual.Object'Class )
      is
        Old_Employee : constant Employee.Pointer := 
          The_Office.Its_Occupying_Employee;
        use type Employee.Pointer;
      begin
        if Old_Employee /= Employee.None then
          The_Office.Its_Occupying_Employee := Employee.None;
          Employee.Actual.Vacate_Office
          ( The_Employee => Employee.Actual.Pointer(Old_Employee).all );
        end if;
      end Vacate_Employee;

      ...

    end Office.Actual;

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