Re: Dispatching and generics - language lawyer question

[Stephen Leake <stephen.a.leake.1@gsfc.nasa.gov>]

Stephen Leake <stephen.a.leake.1@gsfc.nasa.gov> writes:

> There is a problem with "reemergence" of predefined operators for
> generic formal types, but I don't have an example of when it occurs. I
> didn't see a discussion of this in Cohen's "Ada as a Second Language",
> either. Nor in the Rationale. But maybe I just didn't look hard
> enough.

Based on a hint from Christoph Grein, I wrote the following code to
demonstrate the "reemergence problem". It occurs for non-tagged types;
for tagged types, Ada 95 fixed the problem.

 
with Ada.Text_IO; use Ada.Text_IO;
procedure Reemerge
is
   type X is new Integer;
   function "=" (L, R: X) return Boolean;  -- redefine

   function "=" (L, R: X) return Boolean
   is begin
      Put_Line ("in redefined ""="" (X)");
      return Integer (L + R) = 0;
   end "=";

begin
Type_Compose :
    declare
       type Y is record
          C : X;
       end record;

       A : Y := (C => 1);
       B : Y := (C => 1);
    begin
       Put_Line ("Type_Compose");
       Put_Line ("A = B => " & Boolean'Image (A = B));
       -- Here predefined "=" on component C is used, not the
       -- equality redefined above

       New_Line;
       Put_Line ("A.C = B.C => " & Boolean'Image (A.C = B.C));
       -- Here the equality redefined above is used.
    end Type_Compose;

    New_Line;

Generic_Reemerge:
    declare

       generic
          type T is private;
       procedure Compare (L, R : in T);
       -- Print a message with the result of "=" (L, R).

       procedure Compare (L, R : in T)
       is begin
          Put_Line ("L = R => " & Boolean'Image (L = R));
       end Compare;

       procedure Compare_X is new Compare (X);

    begin
       Put_Line ("Generic_Reemerge");
       Compare_X (1, 1);
    end Generic_Reemerge;

    New_Line;
Generic_Correct:
    declare

       generic
          type T is private;
          with function "=" (L, R : in T) return Boolean is <>;
       procedure Compare (L, R : in T);
       -- Print a message with the result of "=" (L, R).

       procedure Compare (L, R : in T)
       is begin
          Put_Line ("L = R => " & Boolean'Image (L = R));
       end Compare;

       procedure Compare_X is new Compare (X);

    begin
       Put_Line ("Generic_Correct");
       Compare_X (1, 1);
    end Generic_Correct;

    New_Line;
Generic_Tagged:
    declare

       package Tagged_Type is
          type Y is tagged record
             Z : Integer;
          end record;

          function "=" (L, R : in Y) return Boolean;
       end Tagged_Type;

       package body Tagged_Type is

          function "=" (L, R : in Y) return Boolean
          is begin
             return L.Z + R.Z = 0;
          end "=";
       end Tagged_Type;

       generic
          type T is private;
       procedure Compare (L, R : in T);
       -- Print a message with the result of "=" (L, R).

       procedure Compare (L, R : in T)
       is begin
          Put_Line ("L = R => " & Boolean'Image (L = R));
       end Compare;

       procedure Compare_Y is new Compare (Tagged_Type.Y);

    begin
       Put_Line ("Generic_Tagged");
       Compare_Y ((Z => 1), (Z => 1));
    end Generic_Tagged;

end Reemerge;

-- 
-- Stephe