Re: OOD in Ada?

[Craig Carey <research@ada95.ijs.com>]

On Fri, 21 Jun 2002 17:39:07 +0100, "David Crocker"
   <dcrocker@eschertech.com> wrote:
>I know that Ada95 tries to support O-O development, but from my perspective
>as an OO developer but Ada novice, it appears to me that any attempt to
>implement a large OO design in Ada will run into the following problems:
>
>1. The infamous "withing" problem (i.e. it is not possible to declare 2
>classes A and B, each in its own package, such that A has a method taking a

If it is about 'methods' then there might not be a withing problem. What
about Java: has that got a withing problem(?).

>paremeter of type "access B", and B has a method with a parameter of type
>"access A"); and
...
>
>So: is there anyone on this list who does serious object-oriented
>development in Ada and would like to comment?

There are comments on resolving the withing problem in this HTML record
of a February 2002 ARG meeting:

http://www.ada-auth.org/ai-files/minutes/min-0202.html


On Fri, 28 Jun 2002 18:57:11 -0500, "Randy Brukardt"
    <randy@rrsoftware.com> wrote:
...
>Well, the good news is that while this was being debated here, the ARG
>was meeting in Vienna. And we approved (to my great surprise)
>AI-00217-04. So we have a "final" solution. How long it will be before
...
>(I haven't posted the final update to the AI yet.)

http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00217.TXT


--

The first poster wrote about a withing problem with "methods". That
sounds like there may have been an idea that packages with procedures
calling each other can't all be with-ed together.

It is possible to have 4 child package bodies that call subroutines named
in the other three bodies. The code below shows two package bodies
withing each other.

Another obvious option is to use unchecked conversions on pointers (or on
records, with something like Gnatmake's "-gnatR" option saying how many
bytes the compiler would allocate, and then the programmer can add a
safety margin and unchecked conversions can allow a field can be
resevered in a record for a type that has not yet been defined). Avoiding
the use of pointers can speed a progam up a little.

Here is some code showing that use of child packages can get around a
withing problem that is not a withing problem with types.

Below is demonstration of how to put more than one case statement in a
variant record allowing bypassing of the problem of the compiler saying
that a field named "X" can not be defined in more than one "when"
alternative.

The program produces this output:

  Cycles of P.A.FA & P.B.FB return 11.00500500000000000
  Excessive = FALSE

The pointer to the task is made to be a pointer to a null record inside
of package P, because package P does not with package Q, and Q is the
package that defines the task type.

-begin-
--------------------------------------------------------------------
with Ada.Text_IO;
with P;
with P.A;
with Q;

procedure Main is
   package Tio renames Ada.Text_IO;
   package Rio is new Tio.Float_IO (Num => P.Real_R);
   G     : P.G_Type_Ptr;
begin
   G := new P.G_Type'(P.Heavy,
               Q_Task => P.Hoof_Ptr_Type'(P.Heavy, null),
               Excessive => False);
   Q.Start_Up_New_Task (G => G.all);
   P.Free (G);
   Tio.Put ("Cycles of P.A.FA & P.B.FB return ");
   Rio.Put (P.A.FA (1.0), Exp => 0);
   Tio.New_Line;
end Main;
--  "gnatmake main.adb -gnatl -gnata -gnatq -gnato -gnatf -v -gnatU
--  -O0 -g -gnaty3abcefhikrlM79pt -gnatwa -bargs -E -p -we -static
--  -largs  -v -v -L. >@.adl"

--------------------------------------------------------------------
with P;
pragma Elaborate_All (P);

package Q is

   type Q_Task is limited private;
   type Q_Task_Ptr is access Q_Task;

   procedure Start_Up_New_Task (G : in out P.G_Type);

   function IfElse is new P.IfElse_G (T => P.Real_R);

private
   task type Q_Task is
      entry Activate (G : P.G_Type);
   end Q_Task;
end Q;
--------------------------------------------------------------------
with Ada.Unchecked_Conversion;
with Ada.Text_IO;
with P;

package body Q is
   task body Q_Task is
      Excessive : Boolean;
   begin
      accept Activate (G : P.G_Type) do
         Q_Task.Excessive := G.Excessive;
      end Activate;
      Ada.Text_IO.Put_Line ("Excessive = " & Boolean'Image (Excessive));
   end Q_Task;

   function From_Task is new Ada.Unchecked_Conversion (
            Source => Q_Task_Ptr,
            Target => P.Hoof_Ptr);

   function To_Task is new Ada.Unchecked_Conversion (
            Source => P.Hoof_Ptr,
            Target => Q_Task_Ptr);

   procedure Start_Up_New_Task (G : in out P.G_Type) is
   begin
         --  An unchecked conversion of a pointer to a task gets
         --  around the 'withing (of types) problem'
      G.Q_Task.Ptr := From_Task (new Q_Task);
      To_Task (G.Q_Task.Ptr).Activate (G);
   end Start_Up_New_Task;
end Q;
--------------------------------------------------------------------
with Ada.Unchecked_Deallocation;
with System;

package P is

   type Hoof is limited null record;
   type Hoof_Ptr is access Hoof;
   type Mode_Enum is (Light, Medium, Heavy);

   type Hoof_Ptr_Type (Mode : Mode_Enum) is
      record
         case Mode is
            when Light => null;
            when Medium  | Heavy =>
               Ptr   : Hoof_Ptr;
         end case;
      end record;

   type G_Type (Mode : Mode_Enum) is
      record
         Q_Task   : Hoof_Ptr_Type (Mode);
         case Mode is
            when Light | Medium => null;
            when Heavy =>
               Excessive : Boolean;
         end case;
      end record;

   type G_Type_Ptr is access all P.G_Type;

   procedure Free is
         new Ada.Unchecked_Deallocation (P.G_Type, G_Type_Ptr);

   generic
      type T is private;
   function IfElse_G (B : Boolean; P, Q : T) return T;

   type Real_R is digits System.Max_Digits;

end P;
--------------------------------------------------------------------
package body P is
   function IfElse_G (B : Boolean; P, Q : T) return T is
   begin
      if B then return P; else return Q; end if;
   end IfElse_G;
end P;
--------------------------------------------------------------------
package P.A is
   function FA (X : Real_R) return Real_R;
end P.A;
--------------------------------------------------------------------
with P.B;
with Q;

package body P.A is
   function FA (X : Real_R) return Real_R is
   begin
      return Q.IfElse (X <= 10.0, P.B.FB (X + 1.0) + 0.001, X);
   end FA;
end P.A;
--------------------------------------------------------------------
package P.B is
   function FB (X : Real_R) return Real_R;
end P.B;
--------------------------------------------------------------------
with P.A;  --  Note that the body of B needs the spec of A, and the
           --  body of A needs the spec of B. There 
          
package body P.B is
   function FB (X : Real_R) return Real_R is
   begin
      if X <= 10.0 then return A.FA (X + 1.0) + 0.000001;
      else return X;
      end if;
   end FB;
end P.B;
--------------------------------------------------------------------
-end-


Gnatchop.exe can be run on the above to split it into pieces
(method: "gnatchop <filename>").



Craig Carey
Ada mailing lists: http://www.ijs.co.nz/ada_95.htm