Re: if statements

[Duncan Sands <sands@topo.math.u-psud.fr>]

David Starner (speaking for IBM) writes:
>> On Fri, 03 Nov 2000 14:42:28 +0000, sc297 wrote:
>>>can anyone show me an if statement that will swap the values of A and B,
>>>if A is the greater value
>>
>> Yes. I can, and I bet your teacher can too.
>>
>Over in comp.arch they treat 'homework' questions a little differently
>than here. It seems to be an invitation to come up with the most
>reasonable, yet outlandish answers possible. Makes for fun reading.

That is an irresponsable attitude, and we should all blow our noses
at it.  We should instead show how the use of ADA allows us to write
a solution in a way that naturally reflects the problem domain.  Here
is a code snippet using the Beer oriented methodology (which naturally
reflects the life style of many students) that swaps the values of two
integers A and B if A is the greater value.  It uses an if statement.

if True then
   declare
      type Beer is new Integer;

      type Beer_Mug is record
         Refreshing_Fluid : Beer;
      end record;

      procedure Put_Beer_Into_Mug (
        Fluid : in     Beer;
        Mug   : in out Beer_Mug
      ) is
      begin
         Mug.Refreshing_Fluid := Fluid;
      end;

      function Make_Beer (X : Integer) return Beer is
      begin
         return Beer (X);
      end;

      procedure Burp_At_Wimpy_C_Programmers is
         task type Int_Swapper (X, Y : access Integer);
         task body Int_Swapper is
            type Int_Pointer is access all Integer;
            Z_Value : aliased Integer;
            Z : Int_Pointer := Z_Value'Access;
         begin
            Z.all := X.all;
            X.all := Y.all;
            Y.all := Z.all;
            A := X.all;
            B := Y.all;
         end;
         Swapper : Int_Swapper (new Integer' (A), new Integer' (B));
      begin
         null;
      end;

      procedure Drink_Beer (Fluid : in out Beer) is
      begin
         Fluid := 0;
         Burp_At_Wimpy_C_Programmers;
      end;

      type Hand is (Left_Hand, Right_Hand);

      Mugs : array (Hand) of Beer_Mug;

      Right_Hand_Mug : Beer_Mug renames Mugs (Left_Hand);
      Left_Hand_Mug  : Beer_Mug renames Mugs (Right_Hand);

      type Table is record
         Mug : Beer_Mug;
      end record;

      A_Convenient_Table : Table;

      procedure Move_Mug (From, To : Hand) is
      begin
         if From = To or Mugs (From).Refreshing_Fluid = -1 then
            raise Tasking_Error;
         else
            Mugs (To) := Mugs (From);
            Mugs (From).Refreshing_Fluid := -1; -- Null mug
         end if;
      end;

      procedure Move_Mug_To_Table (Member : Hand) is
      begin
         A_Convenient_Table.Mug := Mugs (Member);
         Mugs (Member).Refreshing_Fluid := -1;
      end;

      procedure Pick_Up_Mug (Member : Hand) is
      begin
         Mugs (Member) := A_Convenient_Table.Mug;
         A_Convenient_Table.Mug.Refreshing_Fluid := -1;
      end Pick_Up_Mug;

      procedure Pour_Beer (
        From : in out Beer_Mug;
        To   :    out Integer
      ) is
      begin
         To := Integer (From.Refreshing_Fluid);
         From.Refreshing_Fluid := 0;
      end;

      function Weight (Member : Hand) return Float is
         Density_Of_Beer : constant Float := 3.799237428472040235723029;
         Weight_Of_Hand  : constant Float := 2.369000038490274207765490;
      begin
         return Density_Of_Beer * Float (Mugs (Member).Refreshing_Fluid) +
           Weight_Of_Hand;
      end;
      
      subtype Excess is Float range 0.0 .. Float'Last;

      Excess_Weight : Excess;
   begin
      Put_Beer_Into_Mug (
        Fluid => Make_Beer (A),
        Mug   => Left_Hand_Mug
      );

      Put_Beer_Into_Mug (
        Fluid => Make_Beer (B),
        Mug   => Right_Hand_Mug
      );
      
      -- Round to one decimal place to compensate for experimental error
      -- in weighing the beer
      Excess_Weight := Float (
        Integer (100.0 * (Weight (Left_Hand) - Weight (Right_Hand)))
      ) / 100.0;
      Drink_Beer (Left_Hand_Mug.Refreshing_Fluid);
      Drink_Beer (Right_Hand_Mug.Refreshing_Fluid);
   exception
      when Constraint_Error => -- Beer off?  Swap mugs and try again
         Move_Mug_To_Table (Left_Hand);
         Move_Mug (
           From => Right_Hand,
           To   => Left_Hand
         );
         Pick_Up_Mug (Right_Hand);
         Excess_Weight := Float (
           Integer (100.0 * (Weight (Left_Hand) - Weight (Right_Hand)))
         ) / 100.0;
         Pour_Beer (
           From => Mugs (Right_Hand),
           To   => A
         );
         Pour_Beer (
           From => Mugs (Left_Hand),
           To   => B
         );
   end;
else
   -- Memory corruption due to solar radiation
   raise Storage_Error;
end if;