Re: Avoiding dispatching in procedure's with classwide types

[Jeremiah <jeremiah.breeden@gmail.com>]

On Sunday, June 5, 2016 at 11:12:13 PM UTC-4, riea...@comcast.net wrote:
> On Saturday, May 28, 2016 at 3:01:37 PM UTC-4, Jeremiah wrote:
> > I have a procedure that uses one tagged type (the primitive type) and a classwide type.
> 
> 1) I have no clue as to what you are trying to do here.
> 2) I have no idea why you think that this would improve performance.

Here's a small example I cooked up.  It's a useless example, but hopefully illustrates the problem better.

Say a package declares two types as so:
**************************************************
package Test_Pkg_A is

   type Base_Class_A is tagged limited private;
   procedure Set
      (Object : in out Base_Class_A;
       Value  : in     Integer);
   function Get
      (Object : in Base_Class_A)
       return Integer;
   
   type Base_Class_B is tagged limited private;
   procedure Set
      (Object : in out Base_Class_B;
       Value  : in     Integer);
   function Get
      (Object : in Base_Class_B)
       return Integer;
   
   procedure Copy_Version_1
      (Target : in out Base_Class_A;
       Source : in     Base_Class_B'Class);
   procedure Copy_Version_2
      (Target : in out Base_Class_A;
       Source : in     Base_Class_B'Class);
   
private
   
   type Base_Class_A is tagged limited record
      Value : Integer := 0;
   end record;
   
   type Base_Class_B is tagged limited record
      Value : Integer := 0;
   end record;

end Test_Pkg_A;
**************************************************

The body for these packages is:
**************************************************
package body Test_Pkg_A is
   
   procedure Set
      (Object : in out Base_Class_A;
       Value  : in     Integer)
   is
   begin
      Object.Value := Value;
   end Set;
   
   function Get
      (Object : in Base_Class_A)
       return Integer
   is
   begin
      return Object.Value;
   end Get;
   
   procedure Set
      (Object : in out Base_Class_B;
       Value  : in     Integer)
   is
   begin
      Object.Value := Value;
   end Set;
   
   function Get
      (Object : in Base_Class_B)
       return Integer
   is
   begin
      return Object.Value;
   end Get;
   
   procedure Copy_Version_1
      (Target : in out Base_Class_A;
       Source : in     Base_Class_B'Class)
   is
   begin
      --  This seems a bit dangerous since it bypasses dispatching on Source???
      Target.Value := Source.Value;
   end Copy_Version_1;
   
   procedure Copy_Version_2
      (Target : in out Base_Class_A;
       Source : in     Base_Class_B'Class)
   is
   begin
      --  This seems safer.
      Target.Value := Get(Source);
   end Copy_Version_2;
   
   
   
end Test_Pkg_A;
**************************************************

Notice how both Copy_Version_1 and Copy_Version_2 both take in a class wide source.  However, Copy_Version_1 directly copies the parameter while Copy_Version_2 uses a call to a dispatching Get() function.

If the Source passed in overrides Get, then both of the Copy Functions could give very different answers.  Say for example:

**************************************************
with Test_Pkg_A;

package Test_Pkg_B is

   type Derived_Class_A is new Test_Pkg_A.Base_Class_B with null record;
   
   overriding 
   function Get
      (Object : in Derived_Class_A)
       return Integer;

end Test_Pkg_B;
**************************************************

with body:
**************************************************
package body Test_Pkg_B is
   overriding 
   function Get
      (Object : in Derived_Class_A)
       return Integer
   is
      Value : Integer := Test_Pkg_A.Base_Class_B(Object).Get;
   begin
      if Value > 2 then
         return Value;
      else
         return 0;
      end if;
   end Get;
end Test_Pkg_B;
**************************************************

Here for whatever reason, the Get function for Derived_Class_A bounds the value from returning as a 1 (this is just a random example here).

Now if you have the following main:
**************************************************
with Test_Pkg_A;
with Test_Pkg_B;

with Ada.Text_IO;

procedure Ada_Main is
   Target_A : Test_Pkg_A.Base_Class_A;
   Target_B : Test_Pkg_A.Base_Class_A;
   
   Source_A : Test_Pkg_B.Derived_Class_A;
   Source_B : Test_Pkg_B.Derived_Class_A;
begin
   
   Source_A.Set(1);
   Source_B.Set(1);
   
   Test_Pkg_A.Copy_Version_1
      (Target => Target_A,
       Source => Source_A);
   Test_Pkg_A.Copy_Version_2
      (Target => Target_B,
       Source => Source_B);
   
   Ada.Text_IO.Put_Line
      ("Target_A: " 
       & Integer'Image(Target_A.Get));
   Ada.Text_IO.Put_Line
      ("Target_B: " 
       & Integer'Image(Target_B.Get));
   
   
end Ada_Main;
**************************************************

you get the output:
**************************************************
D:\__workspaces\Ada\Test_Ada\obj\ada_main
Target_A:  1
Target_B:  0
[2016-06-06 22:03:01] process terminated successfully, elapsed time: 02.38s
**************************************************

So my question is if the method used in Copy_Value_1 considered a no-no or since it bypasses dispatching in favor of directly copying the values in a procedure that takes a class wide type?  Or is it ok since there is no guarantee to what the internals of the Copy_Value_1 procedure are?  My gut is it is bad form, but I wanted to know if I was just over thinking it.

As for why I would think it would improve performance:  GNAT doesn't tend to optimize out dispatching calls (at least not in any code I have seen yet) and I do have a couple of more complex types that would have to call 3 or 4 dispatching calls in a procedure with a class wide type passed in.  These calls would be operated on large arrays of objects based on those types.  Taking out the dispatching could reduce the time iterating through those arrays.  But it might also leave the procedure open to bugs on derived children?