From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Thread: 103376,a8d137db7a5f6c81 X-Google-Attributes: gid103376,public X-Google-Language: ENGLISH,ASCII-7-bit Path: g2news1.google.com!news2.google.com!fu-berlin.de!uni-berlin.de!individual.net!not-for-mail From: Nick Roberts Newsgroups: comp.lang.ada Subject: Re: OO problem: Performing actions on messages (very long, sorry) Date: Fri, 24 Dec 2004 18:52:33 +0000 Message-ID: References: <1103723394.299024.314670@c13g2000cwb.googlegroups.com> Content-Type: text/plain; charset=us-ascii X-Trace: individual.net bhMHKbfU/ldR4WmDDpibOQwACvnZP5WUcUVDgCKLyrRRwR0QQ= X-Orig-Path: not-for-mail User-Agent: Gemini/1.45d (Qt/3.3.2) (Windows-XP) Xref: g2news1.google.com comp.lang.ada:7208 Date: 2004-12-24T18:52:33+00:00 List-Id: "per" 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