Re: some questions re. Ada/GNAT from a C++/GCC user

[jsa@organon.com (Jon S Anthony)]

In article <ROGOFF.96Mar29163036@sccm.Stanford.EDU> rogoff@sccm.Stanford.EDU (Brian Rogoff) writes:

>    > Is there any way in Ada to iterate abstractly over the contents of a 
>    > container,...
> 
>    Several ways:
> [typical stuff for doing this...]
>
> Jon Anthony, where are you? :-)
> (FYI, Jon has a very nice approach to simulating Sather iters in Ada
> 95. I'll leave it for him to post.)

Thanks Brian!

OK, this has come up before and I've sent it out to various folk who
were interested, but I will just append it to this post.  It was done
around a year or so ago.  Note that the approach is reasonably neat
(IMO, of course!), but suffers some drawbacks vis-a-vis the real thing
in Sather.  In particular, an exception is involved (though it looks
like 3.04 Gnat is an example going in the right direction for making
simple cases very efficient) and you have to build the implementations
at a lower level (you joe programmer build the state machines for the
iterators...) - the Sather compiler does this dross work for you.
 
>    None of these is as pretty as the Sather solution, but they achieve the
>    main goal, which is to have the module that defines the data structure
>    define how to loop, and the clients define what they do at each
>    iteration.
> 
> The Sather iteration abstraction is great, and should be considered for 
> inclusion in future variants of Ada. Maybe now that GNAT exists, someone 
> will make an iter enhanced Ada like language (Sada? Sadie?).

Yes, the Sather stuff is really quite excellent.  In fact, in general
Sather is quite excellent.  Re new lang: Why not Sade? ;-)


>    - Bob
> 
>    P.S. I hope you enjoy Ada.  Why not get a copy of GNAT, and try it out?
> 
> Seconded!
> 
> -- Brian

Three-peted!

--------------Sather iterators in Ada95-------------------

Hi,

I've been looking into Sather quite a lot recently (it is a very good
language design) and in particular Sather iterators.  These have been
discussed a bit in comp.object and comp.lang.ada (as well as
comp.lang.sather!), so you may be a bit familiar with them.  Anyway, I
also retrieved and read over the technical report TR-93-045 (very good
paper from the Sather home page) and while reading this it occured to
me that Sather iterators were very close to a kind of special case use
of Ada (all references are to Ada95) protected types. Conceptually,
Sather iterators work as follows:

Sather has a single looping construct: loop stmt_seq end.  It also
allows for "classes" to have special operations called iterators which
are pretty much like any other Sather routine except

a) They are indicated by a "!" in their declaration: my_iter! (...) is ...end

b) They may only be called from within a loop statement

c) Any iterator in a loop is implicitly declared and initialized at
   the beginning of the loop and only exists for the life of the loop.

d) They may "yield" as well as "quit" (return...)

e) Between calls they *maintain state* (when yielding)

f) when any one quits, the loop is exited.


The canonical implementation would be coroutines (where a loop is also
the "main" coroutine which controls the order of "calls").  At this
point it occured to me that you could sort of do this with tasks but
they are much too expensive for a simple efficient iteration scheme
and entries don't allow for composing - they can't return values.
Then it occured to me that Sather iterators are really simple state
machines and that this would be an efficient implementation.  Of
course, at the end of the paper the authors also point this out and my
guess is that the Sather compiler implements them as such.

The paper also points out many of the problems of the cursors/riders,
streams, and blocks/lambda-expressions style of iterators.  Some of
these problems do not exist with these constructs in Ada.  For
example, in Ada (thanks to separation of class and module!), cursors
do not "require maintaining a parallel cursor object hierarchy
alongside each container class hierarchy".  However, many of the
problems mentioned are equally true of such iteration techniques in
Ada as well.  In general, Sather iterators do not have any of the
problems mentioned and hence are indeed a very clever and well thought
out scheme for general iteration.

What I am proposing here is a canonical idiom to code Sather iterators
in Ada using protected types and access discriminants.  The protected
types encapsulate iter operations and the access discriminants allow
them to

a) have and maintain protected state (between calls),
b) be implicitly initialized when declared,
c) force them to operate on a particular instance of a "class" and
d) "disappear" at the end of a loop decl block.

One other nice aspect is that since protected types are used, your
iterators are tasking safe for "free".  At present this does not
appear to be true of Sather iterators (but that is OK since Sather is
not multithreaded).

I will also show a few examples, which are direct cribs of the Sather
iterators presented in the TR paper.  All of this compiles and
executes just fine with Gnat.


Let's start with an encapsulated resource which can benefit from
iteration:


package Obj_Class is
    type element_type is ...;  -- The elements of Obj_Type...
    type Obj_Type is ...;      -- Irrelevant what it is...
    ...                        -- Primitive operations for Obj_Type
end Obj_Class;


We could place all the iterator stuff in Obj_Class, but maybe it makes
more sense to put them in a child package (then again, maybe not...),
but you are free to do whatever makes the most sense for a given
situation.  Also, these packages could be generic for added
flexibility.


package Obj_Class.Iterators is

    Quit : exception;

    type State_Type is (Yield, Done);

    type Iter_State_Type ( Obj : access Obj_Type ) is tagged limited record
	State   : State_Type := Yield;
	Loc     : Location_type := first_loc_function_for_obj_class;
    end record;


    type Iterator;

    protected type Iter_Op_Type ( Iter : access Iterator ) is
	-- Various iteration operations...
    end Iter_Update_Type;

    type Iterator is new Iter_State_Type with record
	Res : Element_Type := null_element;
	Op  : Iter_Op_Type(Iterator'Access);
    end record;

end Obj_Class.Iterators;


A few notes on this.  First, we could have Iter_State_Type be
parameterized by Obj_Type'Class for added flexibility - any
descendents of Obj_Type could use these iterators.

Second, we can have different iterators for each sort of iteration
operation: reading, updating - whatever.  You would then have, say,
Read_Iterator/Iter_Read_Type and Update_Iterator/Iter_Update_Type (in
place of Iterator/Iter_Op_type).  This seems like a better idea than
just dumping all possible iteration operations in one iterator type,
but it probably depends on the situation.

Third, the reason why we have an extra separate enclosing record,
Iter_State_Type, instead of using the data region of a protected type,
is to allow for the iteration operations to be functions.  Function
operations of protected types (for very good real time reasons!)
cannot update any internal state of the type, but iterators will
typically need to do this.

Fourth, the initial values for State, Loc, and Res, guarantee proper
implicit initialization at the point an instance of Iterator is
declared.

The body for the above will look something like:


package body Obj_Class.Iterators is

    procedure Forward ( Iter : access Iter_State_Type'Class ) is
    begin
	if not At_End(Iter.Loc) then
	    Iter.Loc := Next_Iter_Loc(Iter.Loc);
	else
	    Iter.State := Done;
	end if;
    end Forward;
    pragma Inline(Forward);


    protected body Iter_Op_Type is

	procedure Op_1 (...) is
	Begin
	    case Iter.State is
		when Yield =>
		    -- action on/with Iter.Obj at location Iter.Loc
		    Forward(Iter);
		when Done =>
		    raise Quit;
	    end case;
	end Op_1;

        function Op_2 ( e : Element_Type ) return Element_Type is
        Begin
            Case Iter.State Is
                when Yield =>
                    Iter.Res := do_something(Iter.Res, e);
                    return Iter.Res;
                when Done =>
                    raise Quit;
            end case;
        end Op_2;
 
        ... -- Other ops for this iteration type

    END iter_update_type;

END Obj_Class.Iterators;


Note that the particular Obj (of Iter.Obj) is given when an instance
of the Iterator is declared.  Also note that all the Iter.* entities
maintain their state _between calls_ to Op_1, Op_2, etc. for _each_
particular instance of the iterator.


With these resources a user can then use them to do general iteration
like that available in Sather.  For example:


with Obj_Class.Iterators;  use Obj_Class.Iterators;
with Whack_It;
procedure test is

    Obj_1 : Obj_Type := new Obj_Type'(...);

begin

    declare
	Obj_2  : aliased Obj_Type := (others => ...);

	-- Declare an iterator for Obj_1 and Obj_2 and initialize them
	--
	Iter_1 : Iterator(Obj_1'Access);
	Iter_2 : Iterator(Obj_2'Access);
    begin
	loop
	    -- Each time through the loop we are able to twiddle
	    -- Obj_1 via iterator Op_1 with the results of Obj_2
	    -- via iterator Op_2.
	    --
	    Iter_1.Op.Op_1(Whack_It(Iter_2.Op.Op_2));
	end loop;
    exception
	when Quit => null;
    end;

    -- Iterators are deallocated and gone, thus preserving
    -- various semantic integrity aspects per Sather TR 3.2
    -- and 3.3

end;


Notice that like Sather iterators (and unlike cursors) these protected
type iterators (PT iters) are part of the container class itself; PT
iters mangage their own storage and in the example they use the stack
and not the heap; the state of PT iters is confined to a single loop
(though this _can_ be violated); and PT iters may be "arbitrarily"
nested and support recursion (an example of which follows).

As noted, there is a hole in this in that unlike Sather iters, PT
iters can be "passed around in a half-consumed state".  This can
happen if the iters are declared more global than the loop that will
use them.  If the style of the above example is used this can never
happen (of course, this is not as good as the Sather iter
_guarantee_...)

The other obvious question mark is that Quit exception.  While this
could (reasonably easily) be optimized away into a simple exit for the
loop, I doubt that all compilers would support this level of "quality
of service" in this respect.  Unless, of course, this becomes a
popular idiom! :-) But, in general, I think for most cases it will be
quite efficient enough (exceptions can be handled _very_ quickly if
caught by the inner most enclosing block as they do not need to unwind
and do all sorts of other nasty things...)  Beyond any efficiency
question there is the hole that the user must remember to catch the
thing in loop block!  Again, in Sather this is just part of the
semantics of iterators and is a non-issue.


OK, here are some real live working examples.  Both crib examples from
the TR paper and are pretty self explanatory (note that the so called
"same fringe problem" is also easily handled with PT iters).

The Sieve of Eratosthenes example requires a little discussion,
especially if you are familiar with the Sather version.  In Sather,
recursive calls of an iterator create new _invocation_ instances
(conceptually they create a new instance of the coroutine for the
iterator) all of which are able to maintain their own private state.
There is no simple way to do this using only PT iters (you would need
to invoke the god of tasking).  Hence, for the Ada PT version, the
state for the divisor "gauntlet" is made an explicit part of the
declaration of the iter instance (the d field in prime_generator)
while in the Sather version it is implicit in all the created
invocation instances (which is definitely a nifty trick).

------- Start Examples: all work with Gnat 2.03 on Sparc.SunOS ----------

package P is
--
-- Check out protected types as Sather Iterators.
    
    subtype Element_Type is Integer;


    subtype Range_Type is Integer range 1..10;
    type Obj_Type is array (Range_Type) of Element_Type;



    Quit : exception;

    type State_Type is (Yield, Done);

    type Iter_State_Type ( Obj : access Obj_Type ) is tagged limited record
	State   : State_Type := Yield;
	Loc     : Range_Type := Range_Type'First;
    end record;


    type Update_Iterator;

    protected type Iter_Update_Type ( Iter : access Update_Iterator ) is
	procedure Set_Elts ( E: Element_Type );
        function  Sum ( Summand : Element_Type ) return Element_Type;
    end Iter_Update_Type;

    type Update_Iterator is new Iter_State_Type with record
	Res : Element_Type := 0;
	Op  : Iter_Update_Type(Update_Iterator'Access);
    end record;


    protected type Iter_Read_Type ( Iter : access Iter_State_Type'Class ) is
	function  Elts return Element_Type;
    end Iter_Read_Type;

    type Read_Iterator is new Iter_State_Type with record
	Op  : Iter_Read_Type(Read_Iterator'Access);
    end record;


end P;


package body P is
--
-- Check out protected types as Sather Iterators.


    procedure Forward ( Iter : access Iter_State_Type'Class ) is
    begin
	if Iter.Loc < Range_Type'Last then
	    Iter.Loc := Iter.Loc + 1;
	else
	    Iter.State := Done;
	end if;
    end Forward;
    pragma Inline(Forward);



    protected body Iter_Update_Type is

	procedure Set_Elts ( E: Element_Type ) is 
	begin
	    case Iter.State is
		when Yield =>
		    Iter.Obj(Iter.Loc) := E;
		    Forward(Iter);
		when Done =>
		    raise Quit;
	    end case;
	end Set_Elts;


	function  Sum ( Summand : Element_Type ) return Element_Type is 
	begin
	    case Iter.State is
		when Yield =>
		    Iter.Res := Iter.Res + Summand;
		    return Iter.Res;
		when Done =>
		    raise Quit;
	    end case;
	end Sum;

    end Iter_Update_Type;



    protected body Iter_Read_Type is

	function Elts return Element_Type is
	    E : Element_Type;
	begin
	    case Iter.State is
		when Yield =>
		    E := Iter.Obj(Iter.Loc);
		    Forward(Iter);
		    return E;
		when Done =>
		    raise Quit;
	    end case;
	end Elts;

    end Iter_Read_Type;


end P;


with Text_Io;
with P;  use P;

procedure Test_New_Iters is
--
-- Test Sather style iterators in Ada95

    
    A     : aliased Obj_Type := (others => 1);
    B     : aliased Obj_Type := (1, 2, 3, 4, 5, 6, 7, 8, others => 9);
    Ten_A : Obj_Type := (10, 20, 30, 40, 50, 60, 70, 80, others => 90);

    Overall_Passed : Boolean := True;

    procedure Failed ( Code : Integer ) is
    begin
	Text_Io.Put_Line("***FAILED test " & Integer'Image(Code));
	Overall_Passed := False;
    end Failed;


begin

    declare
	Au_Iter : Update_Iterator(A'Access);
	Ar_Iter : Read_Iterator(A'Access);
	Br_Iter : Read_Iterator(B'Access);
    begin
	loop
	    -- Standard matrix multiplication by scalar: A := B*i
	    --
	    Au_Iter.Op.Set_Elts(Br_Iter.Op.Elts * 10);
 	    Text_Io.Put_Line(Integer'Image(Ar_Iter.Op.Elts));

	end loop;
    exception
	when Quit =>
	    if A /= Ten_A then
		Failed(1);
	    end if;
    end;


    declare
	Au_Iter : Update_Iterator(A'Access);
	Ar_Iter : Read_Iterator(A'Access);
	Br_Iter : Read_Iterator(B'Access);
	X       : Element_Type := 0;
    begin
	loop
	    -- Compute the sum of the products of the elements of A & B
	    --
	    X := Au_Iter.Op.Sum(Ar_Iter.Op.Elts * Br_Iter.Op.Elts);

	end loop;
    exception
	when Quit =>
 	    Text_Io.Put_Line("sum A(i)*B(i) =" & Integer'Image(X));
	    if X /= 3660 then
		Failed(2);
	    end if;
    end;

    if Overall_Passed then
        Text_Io.Put_Line("PASSED");
    end if;

end Test_New_Iters;


-----------------Start Sieve Example-------------------

with Text_Io;

procedure Primes is
--
-- Sieve of Eratosthenes using Sather like iterators...


    type Prime_Generator;

    protected type Siever ( Iter : access Prime_Generator ) is
	function Sieve ( Aprime : Positive; I : Positive ) return Boolean;
	function Gen return Positive;
    end Siever;

    type Divisors is array (Positive range <>) of Natural;
    type Prime_Generator (Count : Positive) is limited record
	D   : Divisors(1..Count) := (others => 0);
	Res : Positive := 1;
	Op  : Siever(Prime_Generator'Access);
    end record;


    Quit : exception;

    protected body Siever is

	function Sieve ( Aprime : Positive; I : Positive ) return Boolean is
	begin
	    if Iter.D(I) = 0 then
		Iter.D(I) := Aprime;
		return True;
	    elsif Aprime mod Iter.D(I) = 0 then
		return False;
	    else
		return Sieve(Aprime, I+1);
	    end if;
	end Sieve;

	function Gen return Positive is
	begin
	    Iter.Res := Iter.Res + 1;
	    if Iter.D(Iter.Count) /= 0 then
		raise Quit;
	    elsif Sieve(Iter.Res, 1) then
		return Iter.Res;
	    else
		return Gen;
	    end if;
	end Gen;
		
    end Siever;


begin

    declare
	Primes1 : Prime_Generator(10);
    begin
	loop
	    Text_Io.Put_Line(Integer'Image(Primes1.Op.Gen));
	end loop;
    exception
	when Quit => null;
    end;


    declare
	Primes1 : Prime_Generator(50);
    begin
	loop
	    Text_Io.Put_Line(Integer'Image(Primes1.Op.Gen));
	end loop;
    exception
	when Quit => null;
    end;

end Primes;
-- 
Jon Anthony
Organon Motives, Inc.
1 Williston Road, Suite 4
Belmont, MA 02178

617.484.3383
jsa@organon.com