Thinking about it a bit more, I was able to make a custom one using the interface but implemented with a custom protected type wrapped around a bounded list. If interested, click on the spoiler section below. I’m sure there are better ways, this was just a first stab. I didn’t know if your finished flag was externally set or if your logic set it automatically somehow, so added it as an external settable flag. You can omit that if you like.
generic
type Element_Type is private;
Default_Capacity : Ada.Containers.Count_Type;
Default_Ceiling : System.Any_Priority := System.Priority'Last;
with function "=" (Left, Right : Element_Type) return Boolean is <>;
package Haltable_Synchronized_Queues is
-- you can instead "with" this in as a generic package, but doing it
-- here for simplicity. If you do with it in, then you can then do
-- subtype Element_Type is <package_name>.Element_Type;
-- to make things easier below
package Core_Interfaces is
new Ada.Containers.Synchronized_Queue_Interfaces(Element_Type);
-- Extend the interface to including halting
type Queue_Interface is synchronized interface and Core_Interfaces.Queue;
procedure Finished(Self : in out Queue_Interface; Flag : Boolean) is abstract;
-- local renaming to using it easier
subtype Count_Type is Ada.Containers.Count_Type;
use all type Count_Type;
-- Underlying implementation of the queue
package Lists is new Ada.Containers.Bounded_Doubly_Linked_Lists(Element_Type);
subtype List is Lists.List;
-- Your custom queue type
protected type Queue
(Capacity : Count_Type := Default_Capacity;
Ceiling : System.Any_Priority := Default_Ceiling)
is new Queue_Interface with
overriding entry Enqueue(Value : Element_Type);
overriding entry Dequeue(Value : out Element_Type);
entry Dequeue_With_Status
(Value : out Element_Type;
Empty_And_Finished : out Boolean);
overriding procedure Finished(Set : Boolean);
overriding function Current_Use return Count_Type;
overriding function Peak_Use return Count_Type;
private
Data : List(Capacity);
Finished_Flag : Boolean := False;
Peak : Count_Type := 0; -- Needed for the Ada standard interface
end Queue;
procedure Dequeue(Self : in out Queue; Value : out Element_Type; Empty_And_Finished : out Boolean);
end Haltable_Synchronized_Queues;
with that separate Dequeue operation because you can’t overload names in a protected type, so you have to declare a wrapper procedure for it. Implemented like this:
package body Haltable_Synchronized_Queues is
procedure Dequeue(Self : in out Queue; Value : out Element_Type; Empty_And_Finished : out Boolean) is
begin
Self.Dequeue_With_Status(Value, Empty_And_Finished);
end Dequeue;
protected body Queue is
-- Your implementation
end Queue;
end Haltable_Synchronized_Queues;
I make use of the features AdaCL. Notably the smart pointer which makes using limited types that much easer. If you want to see the queue in action the unit test are a good start. Unit test make good documentation as you can see the package in action.
Some critical points to the design, if I did not fully understand the implementation feel free to correct me:
Using storage pool from a protected action is a bad idea. Protected actions must be not only non-blocking, e.g. not calling Ada.Text_IO, but also logically instant. If you want to interlock a lengthy action split it into two protected actions and a normal execution in between. This is how a mutex works. You can still keep it an entry by using the requeue statement.
If you copy elements as you do, then using doubly-linked list is wasting space and time. Why do not you store elements into the body of a queue implemented as a plain array of elements?
Why do you use doubly linked list anyway?
What about indefinite elements, you can still use a storage element buffer to keep indefinite elements in the queue. For that use stream attributes or else memory pools.
Queue size should not be a generic parameter.
In general it looks massively overdesigned to me. But it also lacks some functionality like purging the queue, e.g. removing all elements according to some criterium. In practice it is a very important operation. Consider a queue of I/O requests. When a request (or a series of requests) gets cancelled, you want to remove it from the queue. This is what purging is for.
Thanks for the hints. A purge operation might indeed be helpful. As would be making queue size runtime configurable. I probably will do those two changes.
However, let me explain the design philosophy of AdaCL. As already mentioned AdaCL is meat for modern desktop systems. What I have yet not mentioned is the design goal. It’s programmers convenience and unabashedly so. For example the Ada 95 version used the Boehm–Demers–Weiser garbage collector for memory management. I moved back to smart pointer as they are probably more reliable then a garbage collector. Still, AdaCL has always unsuitable for real time or system programming.
For example AUnit is designed to test bare metal system which makes using AUnit rather cumbersome. AdaCL offers several extension to AUnit to make testing more convenient. But those extensions are entirely unsuitable for testing bare metal system.
Having said that here is the actual protected body:
protected body Sychronized_Object is
procedure Finish is
pragma Debug (AdaCL.Trace.Entering);
begin
Finish_Flag := True;
pragma Debug (AdaCL.Trace.Exiting);
return;
end Finish;
function Available return Ada.Containers.Count_Type is (if Finish_Flag then 0 else Maximum_Size - Current_Use);
function Current_Use return Ada.Containers.Count_Type is (Data.Length);
function Peak_Use return Ada.Containers.Count_Type is (Maximum_Size);
function Has_Finished return Boolean is (Is_Finishing and then Is_Empty);
function Is_Empty return Boolean is (Data.Is_Empty);
function Is_Finishing return Boolean is (Finish_Flag);
entry Enqueue (Element : in Element_Type) when Available > 0 is
pragma Debug (AdaCL.Trace.Entering (In_Parameter => Element'Image));
begin
Data.Prepend (Element);
pragma Debug (AdaCL.Trace.Exiting);
return;
end Enqueue;
entry Dequeue (Value : out Element_Type) when not Is_Empty is
pragma Debug (AdaCL.Trace.Entering);
begin
Value := Data.Last_Element;
Data.Delete_Last;
pragma Debug (AdaCL.Trace.Exiting (Out_Parameter => Value'Image));
return;
end Dequeue;
entry Dequeue (Value : out Element_Type; EmptyAndFinished : out Boolean) when Finish_Flag or else not Is_Empty is
pragma Debug (AdaCL.Trace.Entering);
begin
if Is_Empty then
EmptyAndFinished := True;
Value := Null_Element;
else
EmptyAndFinished := False;
Value := Data.Last_Element;
Data.Delete_Last;
end if;
pragma Debug (AdaCL.Trace.Exiting (Out_Parameter => Value'Image));
return;
end Dequeue;
end Sychronized_Object;
I don’t see any blocking, non instantaneous operations in there. All memory operations including use of smart pointer are outside the protected body.
The pragma Debug are not active in release code but I’ll remove them to make the protected body even more lightweight. That is good idea as well.
You allocate memory pool, if I correctly interpret your code. That is not blocking, but it is slow for a protected action. As a general rule avoid memory pool, loops etc.
I see no reason why would you use doubly-linked list at all.
It is a strange attitude for an Ada programmer. Any design decision must be justified by some rationale… Grapes are sour is not.
Anyway, here is an elementary implementation of a protected queue:
generic
type Element_Type is private;
package Generic_FIFO is
type Element_Array is array (Positive range <>) of Element_Type;
protected type FIFO (Size : Positive) is
entry Get (Element : out Element_Type);
function Is_Empty return Boolean;
function Is_Full return Boolean;
entry Put (Element : Element_Type);
private
Full : Boolean := False;
Empty : Boolean := True;
Free : Positive := 1;
First : Positive := 1;
Buffer : Element_Array (1..Size);
end FIFO;
end Generic_FIFO;
The body:
package body Generic_FIFO is
protected body FIFO is
entry Get (Element : out Element_Type) when not Empty is
begin
Element := Buffer (First);
if First = Size then
First := 1;
else
First := First + 1;
end if;
Empty := First = Free;
Full := False;
end Get;
function Is_Empty return Boolean is
begin
return Empty;
end Is_Empty;
function Is_Full return Boolean is
begin
return Full;
end Is_Full;
entry Put (Element : Element_Type) when not Full is
begin
Buffer (Free) := Element;
if Free = Size then
Free := 1;
else
Free := Free + 1;
end if;
Full := First = Free;
Empty := False;
end Put;
end FIFO;
end Generic_FIFO;
Synchronized_Queue_Interfaces.Queue is a synchronized interface. It has no implementation (is null kludge does not count) and there is nothing substantial to override.
You can derive from a synchronized interface a protected type once providing overriding which you could not override anymore.
For example, the queue I provided can be easily modified to implement the Synchronized_Queue_Interfaces.Queue:
generic
type Element_Type is private;
with package Queue_Interfaces is
new Ada.Containers.Synchronized_Queue_Interfaces (Element_Type);
package Generic_FIFO is
use Ada.Containers;
type Element_Array is array (Count_Type range <>) of Element_Type;
protected type FIFO (Size : Count_Type) is
new Queue_Interfaces.Queue with
overriding entry Dequeue (Element : out Element_Type);
overriding function Current_Use return Count_Type;
function Is_Empty return Boolean;
function Is_Full return Boolean;
overriding entry Enqueue (Element : Element_Type);
overriding function Peak_Use return Count_Type;
private
Full : Boolean := False;
Empty : Boolean := True;
Free : Count_Type := 1;
First : Count_Type := 1;
Peak : Count_Type := 0;
Buffer : Element_Array (1..Size);
end FIFO;
end Generic_FIFO;
The body:
package body Generic_FIFO is
protected body FIFO is
entry Dequeue (Element : out Element_Type) when not Empty is
begin
Element := Buffer (First);
if First = Size then
First := 1;
else
First := First + 1;
end if;
Empty := First = Free;
Full := False;
end Dequeue;
function Current_Use return Count_Type is
begin
if Full then
return 0;
else
return Size - First + Free;
end if;
end Current_Use;
function Is_Empty return Boolean is
begin
return Empty;
end Is_Empty;
function Is_Full return Boolean is
begin
return Full;
end Is_Full;
function Peak_Use return Count_Type is
begin
return Peak;
end Peak_Use;
entry Enqueue (Element : Element_Type) when not Full is
begin
Buffer (Free) := Element;
if Free = Size then
Free := 1;
else
Free := Free + 1;
end if;
Full := First = Free;
Empty := False;
Peak := Count_Type'Max (Peak, Size - First + Free);
end Enqueue;
end FIFO;
end Generic_FIFO;
The usage of the synchronized interface is in having a class. For example you could implement a class-wide Erase procedure that would work on all implementations of the interface:
generic
with package Queue_Interface is
new Ada.Containers.Synchronized_Queue_Interfaces (<>);
procedure Erase (FIFO : in out Queue_Interface.Queue'Class);
The body:
procedure Erase (FIFO : in out Queue_Interface.Queue'Class) is
use Ada.Containers;
use Queue_Interface;
Dummy : Element_Type;
begin
while FIFO.Peak_Use > 0 loop
select
FIFO.Dequeue (Dummy);
else -- We do not want to wait
exit;
end select;
end loop;
end Erase;
Note the race condition in Peak_Use and Dequeue. The interface is not designed very well. So in order to work around it a conditional entry call is made. If some another task emptied the queue between Peak_Use and Dequeue, Dequeue will not be engaged.