Overloading one instance of a dispatching function

Overloading one instance of a dispatching function

[Vincent Smeets]

Hallo,

I am trying to make an implementation of the ABNF syntax defined in RFC2234.
It defines rules for parsing mail messages. Here are some examples:

    BIT  = "0" / "1"    ; Character "0" or character "1"
    CRLF = CR LF        ; Rule CR followed by rule LF
    X    = BIT / CRLF   ; Rule BIT or rule CRLF

I have added my source code so far. A rule is implemented as an tagged type,
a character rule as a Character_Set and an alternation of rules by a record
with class wide pointers.

The "or"-operation for two rules works OK, but I want to optimize the case
that the "or"-opration is used for two Character_Set's. This case can
produce a new Character_Set with the characters from both Character_Set's. I
have tryed to solve this problem by adding a function to the specification:

   function "or" (Left, Right : in Character_Set) return Character_Set;

This gives a problem at the place where I am using the "or"-operator. The
compiler can't resolve which "or"-operator has to be used because both
"or"-operators match by type. I would suspect (and hoped) that an exact type
(like Character_Set) had an higher precedance than a class wide type (like
Rule'Class), but it isn't. :-(

How can I solve this problem? I would like to optimize the "or" for two
Character_Set's but don't want to require that the user has to classify
which "or" he will use.

Thanks,
Vincent

PS: This is no homework. See news:ajrisv$lc9$03$1@news.t-online.com

----------------------------------------------------------------------------
with Ada.Finalization;
with Ada.Strings.Maps;
with Ada.Strings.Unbounded;

package ABNF is

   type Rule is abstract tagged private;

   type Alternative is abstract new Rule with private;
   function "or" (Left, Right : in Rule'Class) return Alternative'Class;

   type Character_Set is new Alternative with private;
   function "or" (Left, Right : in Character_Set) return Character_Set;

   function To_Rule (Item : in Character) return Character_Set;

   type Concatination is new Rule with private;
   function "and" (Left, Right : in Rule'Class) return Concatination;

private

   type Rule is abstract new Ada.Finalization.Controlled with null record;
   type Rule_Access is access Rule'Class;

   type Alternative is abstract new Rule with null record;

   type Alternative_Rule is new Alternative with
      record
         Left, Right : Rule_Access;
      end record;
   --  procedure Adjust (Item : in out Alternative_Rule);
   --  procedure Finalize (Item : in out Alternative_Rule);

   type Character_Set is new Alternative with
      record
         Set : Ada.Strings.Maps.Character_Set;
      end record;

   type Concatination is new Rule with
      record
         Left, Right : Rule_Access;
      end record;
   --  procedure Adjust (Item : in out Concatination);
   --  procedure Finalize (Item : in out Concatination);

end ABNF;

----------------------------------------------------------------------------
with ABNF;
pragma Elaborate_All (ABNF);

procedure Forward_PGP is
   use ABNF;

   A : constant ABNF.Rule'Class :=
      ABNF.To_Rule ('a') or
      ABNF.To_Rule ('A');
   AB : constant ABNF.Rule'Class :=
      A and
      ABNF.To_Rule ('b');
   AC : constant ABNF.Rule'Class :=
      A and
      ABNF.To_Rule ('C');
   AB_AC : constant ABNF.Rule'Class :=
      AB or AC;
begin
   null;
end Forward_PGP;

Re: Overloading one instance of a dispatching function

[Dmitry A.Kazakov]

Vincent Smeets wrote:

> I have added my source code so far. A rule is implemented as an tagged
> type, a character rule as a Character_Set and an alternation of rules by a
> record with class wide pointers.
> 
> The "or"-operation for two rules works OK, but I want to optimize the case
> that the "or"-opration is used for two Character_Set's. This case can
> produce a new Character_Set with the characters from both Character_Set's.
> I have tryed to solve this problem by adding a function to the
> specification:
> 
>    function "or" (Left, Right : in Character_Set) return Character_Set;
> 
> This gives a problem at the place where I am using the "or"-operator. The
> compiler can't resolve which "or"-operator has to be used because both
> "or"-operators match by type. I would suspect (and hoped) that an exact
> type (like Character_Set) had an higher precedance than a class wide type
> (like Rule'Class), but it isn't. :-(
> 
> How can I solve this problem? I would like to optimize the "or" for two
> Character_Set's but don't want to require that the user has to classify
> which "or" he will use.

It looks like a typical multiple dispatch case. Unfortunately Ada 95 has no 
proper MD (only a restricted form). I faced this problem while 
implementation of smart pointers 
[http://www.dmitry-kazakov.de/ada/components.htm]. The following is an 
adaptation of the idea I used to your case:

Your binary operation 'or' has to be dispatching on both arguments and the 
result, but you cannot define it so because then tags of the arguments 
should be same. So you define it assymmetric with only one dispatching 
argument:

function Impl_Or
   (Left : Rule; Right : Rule'Class; Flag : Boolean := False) 
      return Rule'Class;

Impl_Or would implement "or" for each type. It has only one dispatching 
argument. The parameter Flag indicates whether the second argument has 
already gone through dispatch or not. It is used to avoid endless 
recursion. Impl_Or should be overridden as necessary.

function "or" (Left, Right : in Rule'Class) return Rule'Class is
begin
   return Impl_Or (Left, Right);
end "or";

This is a class-wide wrapper.
--------------------
for the type Rule. [In your case it is abstract, but to simplify the case I 
assume that it is not.] Impl_Or should be provided for the first 
non-abstract type.

function Impl_Or
   (Left : Rule; Right : Rule'Class; Flag : Boolean := False) 
      return Rule'Class is
begin
   if Flag or else Right in Rule then
      -- Implementation of "or" if both arguments are of
      -- Rule:
      ...
   else
      -- Dispatch on the second argument to a more
      -- specific implementation. We assume that 'or'
      -- is a symmetric operation. Flag is set to True.
      -- to prevent recursion.
      Impl_Or (Right, Left, True); 
   end if;
end Impl_Or;
---------------------
for the type Character_Set. Here there is pitfall. You must provide an 
implementation not only for the case Character_Set x Character_Set, but 
also for Character_Set x any ancestor of Character_Set.

function Impl_Or
   (Left : Character_Set; Right : Rule'Class; Flag : Boolean := False) 
      return Rule'Class is
begin
   if (  Flag
      or else
         Right in Character_Set
      or else
         Right not in Character_Set'Class
      )
   then
      -- Implementation of "or" if the second argument
      -- is of Character_Set or its ancestor
      ...
   else
      -- Dispatch on the second argument.
      Impl_Or (Right, Left, True);
   end if;
end Impl_Or;

The idea is to find the most specific overriding of Impl_Or for a given 
combination of arguments. The standard dispatching mechanism does it for 
the first argument. For the second argument one should make the check 
manually. If the argument is either of the type (Right in Character_Set) or 
of an ancestor type (Right not in Character_Set'Class), then it is our 
case. Flag should deal with the cases when some descendant of Character_Set 
does not override Impl_Or.

-- 
Regards,
Dmitry Kazakov
www.dmitry-kazakov.de