Re: Proper program structure

[Brad Moore <brad.moore@shaw.ca>]

Maciej Sobczak wrote:
> On 1 Paz', 08:34, Brad Moore <brad.mo...@shaw.ca> wrote:
> 
>> See my example below. I have each component as a private child of Cars.
> 
> Well, I was too quick to reply.
> Your example does not do what I need. It allows the components to see
> the visible spec of the containing car (in your example, Gear_Box
> calls *public* procedure Shift_Gear in Vehicle), but not the car's
> structure.
> In other words, the Engine still cannot see the Gear_Box within the
> same car.
> 
> It is of course possible to expose delegating operations, but this
> pollutes the public interface of the car with operations that are of
> interest only to its private components. Users should not have access
> to these operations.
> 
> --
> Maciej Sobczak * www.msobczak.com * www.inspirel.com
> 
> Database Access Library for Ada: www.inspirel.com/soci-ada

OK, but I can apply a similar technique to hide the routines from the 
public interface of the car. In this case, I renamed the Cars.Vehicle
package to be Cars.Vehicle_Internal, then created a public Cars.Vehicle
package that wraps the internal one, but hides the interfaces that you
do not want to expose.

Is this version acceptable?

Revised Example:

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

with Cars.Vehicle;
procedure Main is
    My_Car : Cars.Vehicle.Vehicle_Type := Cars.Vehicle.Construct;
begin
    null;
end Main;

-----------------------------------------------
package Cars is
    pragma Pure;
end Cars;

--------------------------------------------
private with Cars.Vehicle_Internal;
package Cars.Vehicle is
    type Vehicle_Type (<>) is limited private;
    function Construct return Vehicle_Type;

private
    use Cars.Vehicle_Internal;
    type Vehicle_Type is
       record
          Internals : Vehicle_Internal_Type;
       end record;
end Cars.Vehicle;
-----------------------------------------
package body Cars.Vehicle is

    function Construct return Vehicle_Type is
    begin
       return  New_Vehicle : Vehicle_Type :=
         Vehicle_Type'(Internals => Vehicle_Internal.Construct) do
          return;
         end return;

    end Construct;
end Cars.Vehicle;
------------------------------------------
with Cars.Types; use Cars.Types;
private with Cars.Wheels, Cars.Chassis, Cars.Engine, Cars.Gear_Box;
private package Cars.Vehicle_Internal is

    type Vehicle_Internal_Type is limited private;
    procedure Shift_Gears
      (Car : in out Vehicle_Internal_Type;
       Gear : Gear_Type);

    function Construct return Vehicle_Internal_Type;

private
    use Cars.Wheels, Cars.Chassis, Cars.Engine, Cars.Gear_Box;
    type Wheel_Array_Type is array (1 .. 4) of Wheel_Type;
    type Vehicle_Internal_Type is limited
       record
          Wheels : Wheel_Array_Type;
          Chassis : Chassis_Type;
          Engine : Engine_Type;
          Gear_Box : Gear_Box_Type (Vehicle_Internal_Type'Access);
       end record;
end Cars.Vehicle_Internal;
--------------------------------------
package body Cars.Vehicle_Internal is

    function Construct return Vehicle_Internal_Type is
    begin
       return New_Vehicle : Vehicle_Internal_Type do
          Gear_Box.Select_Gear (New_Vehicle.Gear_Box, Park);
          return;
       end return;

    end Construct;

    procedure Shift_Gears
      (Car : in out Vehicle_Internal_Type;
       Gear : Gear_Type) is
    begin
       Cars.Engine.Shift_Gears (Motor => Car.Engine, Gear  => Gear);
    end Shift_Gears;

end Cars.Vehicle_Internal;

-------------------------------------------
private package Cars.Wheels is
    type Wheel_Type is private;
private
    type Length_In_Inches is new Natural;
    subtype Wheel_Diameter_Type is Length_In_Inches range 30 .. 80;
    type Wheel_Type is
       record
          Diameter : Wheel_Diameter_Type := 50;
       end record;
end Cars.Wheels;
--------------------------
with Cars.Types; use Cars.Types;
limited with Cars.Vehicle_Internal;
private package Cars.Gear_Box is
    type Gear_Box_Type
      (Containing_Vehicle : access 
Cars.Vehicle_Internal.Vehicle_Internal_Type)
    is private;

    procedure Select_Gear (Gear_Shift : in out Gear_Box_Type; Gear : 
Gear_Type);
    --  Somehow this gets called, presumably by user action.
private
    type Gear_Box_Type
      (Containing_Vehicle : access 
Cars.Vehicle_Internal.Vehicle_Internal_Type)
      is null record;
end Cars.Gear_Box;
-------------------------------------
with Cars.Vehicle_Internal;
package body Cars.Gear_Box is
    procedure Select_Gear
      (Gear_Shift : in out Gear_Box_Type;
       Gear : Gear_Type) is
    begin
       Cars.Vehicle_Internal.Shift_Gears
         (Car => Gear_Shift.Containing_Vehicle.all, Gear => Gear);
    end Select_Gear;
end Cars.Gear_Box;
--------------------------
with Cars.Types; use Cars.Types;
private package Cars.Engine is
    type Engine_Type is private;

    procedure Shift_Gears (Motor : in out Engine_Type; Gear : Gear_Type);
private
    type Engine_Type is
       record
          Current_Gear : Gear_Type;
       end record;
end Cars.Engine;
------------------------------
package body Cars.Engine is

    procedure Shift_Gears
      (Motor : in out Engine_Type;
       Gear : Gear_Type) is
    begin
       Motor.Current_Gear := Gear;
    end Shift_Gears;

end Cars.Engine;
--------------------
private package Cars.Chassis is
    type Chassis_Type is private;
private
    type Chassis_Type is null record;
end Cars.Chassis;