From: aio!aio.jsc.nasa.gov!dean@tmc.edu (Jack Dean)
Subject: Re: Passing procedures as parameters to procedures.
Date: 10 May 93 22:56:19 GMT [thread overview]
Message-ID: <DEAN.93May10155619@wind.sweetpea.jsc.nasa.gov> (raw)
>>>>> andrewd@winnie.cs.adelaide.edu.au (Andrew Dunstan,,2285592,) writes:
Andrew> NNTP-Posting-Host: winnie.cs.adelaide.edu.au
Andrew> As I pointed out in this group about a year ago, there are some things
Andrew> that you want to be able to do that you just can't with generics. If
Andrew> anybody can provide me with a good, clean, Ada equivalent of the
Andrew> following Pascal code, I'll send him/her (first winner only!) a good
Andrew> bottle of Australian red wine (damn this Beaujolais business!).
Andrew> procedure a(b : procedure(c : procedure));
Andrew> procedure d;
Andrew> begin;
Andrew> end;
Andrew> begin
Andrew> b(d);
Andrew> end;
Andrew> procedure x(y : procedure);
Andrew> begin
Andrew> y;
Andrew> end;
Andrew> .
Andrew> .
Andrew> .
Andrew> a(x);
Andrew> .
Andrew> .
OK, here is my entry. The following is legal, portable Ada 83, and it
implement the functional equivalent of procedure pointers.
I'll start off with the Ada equivalent of the Pascal fragment you
provided:
WITH Text_Io;
WITH Procedure_Parameter_Profile;
PROCEDURE Test_Pointer IS
SUBTYPE Dummy IS Integer;
PACKAGE D_Proc IS NEW Procedure_Parameter_Profile (Args => Dummy);
PACKAGE B_Proc IS NEW Procedure_Parameter_Profile (Args => D_Proc.Pointer);
D_Pointer : D_Proc.Pointer;
X_Pointer : B_Proc.Pointer;
PROCEDURE A (B : B_Proc.Pointer) IS
PROCEDURE D (Ignore : Dummy) IS
BEGIN
Text_Io.Put_Line ("In procedure A.D");
END D;
PACKAGE D_Designate IS NEW D_Proc.Designate (The_Pointer => D_Pointer,
Designated_Procedure => D)
;
BEGIN
B_Proc.Invoke (The_Procedure => B, With_Args => D_Pointer);
D_Designate.Leave_Scope;
END A;
PROCEDURE X (Y : D_Proc.Pointer) IS
BEGIN
Text_Io.Put_Line ("In Procedure X");
D_Proc.Invoke (The_Procedure => Y, With_Args => 0);
END X;
PACKAGE X_Designate IS NEW B_Proc.Designate (The_Pointer => X_Pointer,
Designated_Procedure => X);
BEGIN
A (X_Pointer);
X_Designate.Leave_Scope;
Text_Io.Put_Line ("That's all, folks!");
END Test_Pointer;
And now for the magic that makes it work:
GENERIC
TYPE Args IS PRIVATE;
PACKAGE Procedure_Parameter_Profile IS
TYPE Id IS LIMITED PRIVATE;
TYPE Pointer IS ACCESS Id;
GENERIC
The_Pointer : IN OUT Pointer;
WITH PROCEDURE Designated_Procedure (The_Args : IN Args);
PACKAGE Designate IS
PROCEDURE Leave_Scope;
END Designate;
PROCEDURE Invoke (The_Procedure : IN Pointer; --
With_Args : IN Args);
PRIVATE
Max_Number_Of_Procedure_Pointers : CONSTANT := 20;
TYPE Id IS RANGE 0 .. Max_Number_Of_Procedure_Pointers;
END Procedure_Parameter_Profile;
and its implementation:
PACKAGE BODY Procedure_Parameter_Profile IS
Last_Id : Id := 0;
FUNCTION New_Id RETURN Id IS
BEGIN
Last_Id := Last_Id + 1;
RETURN Last_Id;
END New_Id;
TASK Dispatcher IS
ENTRY Invoke (The_Procedure_Pointer : IN Id; With_Args : IN Args);
ENTRY Wait_For_Start (Id) (The_Args : OUT Args);
ENTRY Wait_For_Finish (Id);
ENTRY Signal_Finished (The_Procedure_Pointer : IN Id);
ENTRY Shutdown;
END Dispatcher;
TASK BODY Dispatcher IS
The_Args : Args;
BEGIN
LOOP
SELECT
ACCEPT Invoke (The_Procedure_Pointer : IN Id;
With_Args : IN Args) DO
ACCEPT Wait_For_Start (The_Procedure_Pointer)
(The_Args : OUT Args) DO
The_Args := With_Args;
END Wait_For_Start;
END Invoke;
OR
ACCEPT Signal_Finished (The_Procedure_Pointer : IN Id) DO
ACCEPT Wait_For_Finish (The_Procedure_Pointer);
END Signal_Finished;
OR
TERMINATE;
END SELECT;
END LOOP;
END Dispatcher;
PACKAGE BODY Designate IS
My_Id : Id;
TASK Hidden IS
ENTRY Start;
END Hidden;
TASK BODY Hidden IS
The_Args : Args;
Continue : Boolean;
BEGIN
ACCEPT Start;
LOOP
Dispatcher.Wait_For_Start (My_Id) (The_Args);
Designated_Procedure (The_Args);
Dispatcher.Signal_Finished (My_Id);
END LOOP;
END Hidden;
PROCEDURE Leave_Scope IS
BEGIN
ABORT Hidden;
The_pointer := NULL;
END Leave_Scope;
BEGIN
IF The_Pointer = NULL THEN
The_Pointer := NEW Id;
The_Pointer.ALL := New_Id;
END IF;
My_Id := The_Pointer.ALL;
Hidden.Start;
END Designate;
PROCEDURE Invoke (The_Procedure : IN Pointer; --
With_Args : IN Args) IS
BEGIN
Dispatcher.Invoke (The_Procedure.ALL, With_Args);
Dispatcher.Wait_For_Finish (The_Procedure.ALL);
END Invoke;
END Procedure_Parameter_Profile;
Try it. It works. I'm ready for my bottle of wine.
--
Jack Dean dean@sweetpea.jsc.nasa.gov
next reply other threads:[~1993-05-10 22:56 UTC|newest]
Thread overview: 22+ messages / expand[flat|nested] mbox.gz Atom feed top
1993-05-10 22:56 Jack Dean [this message]
-- strict thread matches above, loose matches on Subject: below --
1993-05-06 9:39 Passing procedures as parameters to procedures cis.ohio-state.edu!zaphod.mps.ohio-state.edu!howland.reston.ans.net!darwi
1993-05-06 7:33 cis.ohio-state.edu!zaphod.mps.ohio-state.edu!howland.reston.ans.net!torn!
1993-05-05 21:35 cis.ohio-state.edu!news.sei.cmu.edu!ajpo.sei.cmu.edu!progers
1993-05-05 17:39 Robert Dewar
1993-05-05 17:35 Robert Dewar
1993-05-05 16:30 cis.ohio-state.edu!zaphod.mps.ohio-state.edu!magnus.acs.ohio-state.edu!us
1993-05-05 11:40 cis.ohio-state.edu!news.sei.cmu.edu!firth
1993-05-05 9:50 cis.ohio-state.edu!magnus.acs.ohio-state.edu!usenet.ins.cwru.edu!howland.
1993-05-04 23:44 cis.ohio-state.edu!magnus.acs.ohio-state.edu!zaphod.mps.ohio-state.edu!ho
1993-05-04 22:13 John Goodsen
1993-05-04 19:39 cis.ohio-state.edu!pacific.mps.ohio-state.edu!zaphod.mps.ohio-state.edu!m
1993-05-04 16:41 cis.ohio-state.edu!zaphod.mps.ohio-state.edu!howland.reston.ans.net!ira.u
1993-05-04 16:25 Mark A Biggar
1993-05-04 15:43 Tucker Taft
1993-05-04 14:29 cis.ohio-state.edu!pacific.mps.ohio-state.edu!linac!uwm.edu!spool.mu.edu!
1993-05-04 13:59 Tucker Taft
1993-05-04 13:45 cis.ohio-state.edu!magnus.acs.ohio-state.edu!usenet.ins.cwru.edu!howland.
1993-05-04 13:45 cis.ohio-state.edu!pacific.mps.ohio-state.edu!linac!uwm.edu!cs.utexas.edu
1993-05-04 10:25 cis.ohio-state.edu!zaphod.mps.ohio-state.edu!magnus.acs.ohio-state.edu!us
1993-05-03 20:36 Mark A Biggar
1993-05-03 19:07 cis.ohio-state.edu!magnus.acs.ohio-state.edu!zaphod.mps.ohio-state.edu!ho
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox