Re: Does GNAT support a thread-free RTS?

[Georg Bauhaus <rm.dash-bauhaus@futureapps.de>]

On 13.09.11 22:35, Dmitry A. Kazakov wrote:
> On Tue, 13 Sep 2011 18:54:53 +0200, Georg Bauhaus wrote:
>
>> On 13.09.11 14:18, Dmitry A. Kazakov wrote:
>>
>>> Protected objects are not tagged, you need inheritance to provide typed
>>> channels. You meed multiple dispatch to handle channel-type + value-type
>>> hierarchies. You need entries returning indefinite values. You need MI to
>>> have handles to the channels/devices implementing the interface of a
>>> protected object.
>>
>> Is there an AI on "limited holders"?
>
> Holder is useless without delegation, interface inheritance, MI, otherwise
> it quickly becomes an endless swamp of generic instantiations. Note also
> classical MD case: channel-type x value-type (<=>  handle-type).
>
> BTW, protected objects are unsuitable for distributed interfaces anyway.
> You need a background task to prevent blocking upon I/O. The usual
> technique of re-queueing does not help here. The interfaces must be tasks,
> rather than objects.

To be fair, writing Erlang is perhaps associated with a more
"pragmatic" attitude towards static typing, which means you
will be tracing and debugging anyway when looking for things
frequently detected by Ada compilers before running the program.

With this in mind, an owner of a protected channel object (Ada)
can "receive" (access to) Any'Class objects and trigger dispatching
calls, primitive subprograms of the received objects, where Erlang
would perform a case distinction.

Can "agents" then simply share a physical task by being selected
for acting, perhaps triggered by messages sent (rendezvous if ready),
or by some simple scheduler task selecting them in a round robin fashion,
or in a way that resembles reacting to HTTP requests in AWS?

Yes, when some agent needs to both deliver a message and be
sure the message is sent, then it may wait in the channel's queue
forever until delivery is signaled.  If the system allows messages
to be dropped, then barriers can reflect this permission.
How would tasks be more helpful?

Thus, reducing the Channel PO to a very basic thing,
and, unfortunately, exhibiting all the pointers inherent
in most functional programming languages,

package Sys is

    type Any is abstract tagged limited null record;
    --  ... parent/interface of every message type

    type Box is tagged private;
    --  holds a value of type `Any'Class`; see `Ref` and `Deref`

    --  functions for wrapping and unwrapping:
    function Ref (Item : Any'Class) return Box;
    function Deref (This : Box) return access constant Any'Class;

private
    type Poly_Cell is access constant Any'Class;
    type Box is tagged
        record
           Storage :  Poly_Cell;
        end record;
end Sys;


package Sys.Messages is

    type Vector is array (Natural range <>) of Box;
    --  a channel object's container of boxes; message box

    protected type Channel (Capacity : Natural) is

       entry Send (Object : in Box);
       --  ! operation

       entry Receive (Object : out Box);
       --  pattern matching will correspond to dispatching
       --  based on what is in `Object`

    private
       Queue : Vector (1 .. Capacity);
       Front : Natural := 0;
       Rear : Natural := 0;
    end Channel;

end Sys.Messages;


with Sys.Messages;

procedure Test_Sys is

    use Sys;

    --  a user-defined type that has the same interface as `Sys.Any`:

    type Taste is (Sour, Sweet, EU);

    type Apple is new Sys.Any with
        record
           Quality : Taste;
        end record;

    Foul: exception;

    C1 : Messages.Channel (Capacity => 5);

    Granny_Smith : Apple := (Any with Quality => Sour);

    Gift : Box := Ref (Granny_Smith);

begin
    C1.Send (Gift);
    C1.Send (Gift);
    Granny_Smith.Quality := EU;  -- tamper with trees
    C1.Receive (Gift);
    C1.Receive (Gift);
    if Apple(Deref(Gift).all).Quality /= Sour then
       raise Foul;
    end if;
end Test_Sys;


package body Sys is

    function Ref (Item : Any'Class) return Box is
    begin
       return Box'(Storage => Item'Unchecked_Access);
    end Ref;

    function Deref (This : Box) return access constant Any'Class is
    begin
       return This.Storage;
    end Deref;

end Sys;


package body Sys.Messages is

    protected body Channel is
       entry Send (Object : Box) when Rear < Capacity is
       begin
          Rear := Rear + 1;
          Queue (Rear) := Object;
       end Send;

       entry Receive (Object : out Box) when Front < Rear is
       begin
          Front := Front + 1;
          Object := Queue (Front);
          if Front = Rear then
             Front := 0; Rear := 0;
          end if;
       end Receive;
    end Channel;

    function Ref (Item : Any'Class) return Box is
    begin
       return Box'(Storage => Item'Unchecked_Access);
    end Ref;

    function Deref (This : Box) return access constant Any'Class is
    begin
       return This.Storage;
    end Deref;

end Sys.Messages;