Re: OO problem: Performing actions on messages (very long, sorry)

[Nick Roberts <nick.roberts@acm.org>]

"per" <commander@death-star.com> wrote:

From what I can gather about the design you are looking for, my impression
is that you need two tagged types -- one for messages, one for actions --
and a mechanism of 'multiple dispatch' to select the appropriate Put
procedure.

Some languages support a form of method selection called 'multiple
selection', where a method can be selected depending on the type of not just
one but several parameters. Multiple dispatch is the workmanlike way that
you do the equivalent of multiple selection in languages that don't support
it (such as Ada). The essence is that first you dispatch selecting on one
kind of tagged type (in this case, a message), into a procedure that then
itself dispatches selecting on another tagged type (in this case, an
action), and possibly so on for yet more parameters.

I'll try to illustrate this idea.

   with AI302.Indefinite_Double_Linked_Lists; -- for private part only
   package Messaging is

      type Message is abstract tagged limited private;
      type Action  is abstract tagged private;

      procedure Execute (M: in out Message;
                         A: in     Action'Class) is abstract;

      procedure Enqueue (M: in out Message'Class;
                         A: in     Action'Class);

      procedure Execute_Actions (M: in out Message'Class);

      Unsupported_Action: exception; -- message could not execute action
      Execution_Error: exception; -- something went wrong in Execute_Actions

   private
      type Action is abstract tagged limited null record;

      package Action_Queueing is new
         AI302.Indefinite_Doubly_Linked_Lists( Action'Class );
      subtype Action_Queue is Action_Queueing.Vector;

      type Message is abstract tagged limited
         record
            Queue: Action_Queueing.Action_Queue;
         end record;

   end Messaging;

   package body Messaging is

      use Action_Queueing;

      procedure Enqueue (M: in out Message'Class;
                         A: in     Action'Class) is
      begin
         Append( M.Queue, A );
      end;

      procedure Execute_Actions (M: in out Message'Class) is
         C: Action_Queueing.Cursor_Type := First(M.Queue);
         Error: Boolean := False;
      begin
         while C /= Action_Queueing.No_Element loop
            begin
               Execute( M, Element(M.Queue,C) ); -- dispatching
            exception
               when others => Error := True; -- note if something failed
            end;
            C := Next(C);
         end loop;
         Clear(M.Queue);
         if Error then raise Execution_Error; end if;
      end;

   end Messaging;

   package Messaging.Scoring is

      type Scoring_Action is new Action with
         record
            Score: Float;
         end;

      Minimum_Score: constant Float := 0.1;

   end;

   package Messaging.Hierarchy is

      type Hierarchy_Action is new Action with
         record
            Level: Natural;
         end;

   end;

   package Messaging.Stock_Movement is

      type Stock_Arrival_Message  is new Message with private;
      type Stock_Despatch_Message is new Message with private;

      procedure Execute (M: in out Stock_Arrival_Message;
                         A: in     Action'Class);

      procedure Execute (M: in out Stock_Despatch_Message;
                         A: in     Action'Class);

      Stock_Item_Error: exception; -- not a current stock item

   private
      type Stock_Movement_Message is new Message with
         record
            Item: Stock_ID;
         end record;

      type Stock_Arrival_Message is new Stock_Movement_Message with 
         record
            ...
         end record;

      type Stock_Despatch_Message is new Stock_Movement_Message with
         record
            ...
         end record;

   end;

   with Scoring, Hierarchy;
   package body Messaging.Stock_Movement is

      procedure Check_ID (M: in out Stock_Movement_Message'Class) is
      begin
         if not Is_Current(M.Item) then
            raise Stock_Item_Error;
         end if;
      end Check_ID;

      procedure Execute (M: in out Stock_Arrival_Message;
                         A: in     Action'Class) is
      begin
         Check_ID( M );
         if A in Scoring.Scoring_Action'Class then
            declare
               use Scoring;
               SA: constant Scoring_Action := Scoring_Action(A);
            begin
               if SA.Score < Minimum_Score then
                  ...
               else
                  ...
               end if;
            end;
         elsif A in Hierarchy.Hierarchy_Action'Class then
            ...
         else
            raise Unsupported_Action;
         end if;
      end Execute; -- for Stock_Arrival_Message

      procedure Execute (M: in out Stock_Despatch_Message;
                         A: in     Action'Class) is
      begin
         Check_ID( M );
         if A in Scoring.Scoring_Action'Class then
            ...
         elsif A in Hierarchy.Hierarchy_Action'Class then
            ...
         else
            raise Unsupported_Action;
         end if;
      end Execute; -- for Stock_Despatch_Message

   end Messaging.Stock_Movement;

The idea here is that the Execute procedure dispatches (singly) on a type
derived from Message, and within the body of any such Execute procedure, we
select again based on the actual type of the action.

In fact, to select again, we have to resort to the old fashioned technique
of a series of 'if' statements. This is because we cannot know in advance
all the possible types derived from Action (because new types could be added
after we have compiled), and Ada demands that all possible tags are known to
perform dynamic dispatch (so that there is no danger of jumping to a
procedure that is not there, and expensive tests can be avoided). If an
action is of a type we do not recognise, we raise an exception
(Unsupported_Action). Note the form of the tests ("if A in X'Class then
...") and the convenient conversion so that we can easily refer to specific
components (e.g. SA.Score).

Both new actions and new messages can be added. However, if a new action is
added, it might be necessary to modify the implementations of some (or all)
of the existing messages to support it.

Please study the code I've written carefully. However, I've not tested it in
any way, so it's likely to have some faults! I'm hoping that I've got close
here to providing a design that will be of genuine use to you, Per. If not,
please say! You will probably have a lot of questions, but that's fine by
me.

I've tried to demonstrate how it is often more appropriate to declare more
than one tagged type in a particular package, if they are closely related.
I've done this twice in my example above. In Messaging, I've declared
Message and Action. In Messaging.Stock_Movement, I've declared both
Stock_Arrival_Message and Stock_Despatch_Message, which share a common
private subancestor (Stock_Movement_Message) with common data and a private
operation of it own (Check_ID).

I've used Matthew Heaney's AI-302 implementation of containers for the queue
implementation, available at:

   http://home.earthlink.net/~matthewjheaney/charles/ai302-20040227.zip

Note that the Ada 2005 standard, when it is published, is likely to have
some minor differences to this package.

-- 
Nick Roberts