1. private with Ada.Containers.Doubly_Linked_Lists; 
  2. private with Locking_Objects; 
  3.  
  4. generic 
  5.    type Element_Type is private; 
  6.  
  7.    with function "="( left, right : Element_Type ) return Boolean is <>; 
  8.  
  9. package Mutable_Lists is 
  10.     pragma Preelaborate; 
  11.  
  12.     -- A Cursor references a location in a list. List elements referenced by 
  13.     -- cursors are locked and can only be examined via the open cursor 
  14.     -- referencing them. Any threads attempting to reference a locked list 
  15.     -- element will block until the element's cursor is closed. Note that while 
  16.     -- a List is thread safe, a Cursor is not. 
  17.     type Cursor is limited private; 
  18.  
  19.     -- Closes the cursor, unlocking the list element under examination. 
  20.     procedure Close( position : in out Cursor ); 
  21.  
  22.     -- Returns the element referenced by the cursor. An exception is raised on 
  23.     -- error. 
  24.     function Element( position : Cursor ) return Element_Type; 
  25.  
  26.     -- Returns True if the cursor is open, referencing an existing list element. 
  27.     function Has_Element( position : Cursor ) return Boolean; 
  28.  
  29.     -- Modifies the cursor to point to the next element in the list, blocking if 
  30.     -- the next element is already being examined. 
  31.     procedure Next( position : in out Cursor ); 
  32.  
  33.     -- A List is a thread-safe mutable list backed by doubly linked list. 
  34.     -- 
  35.     -- Mutable lists may be modified during iteration, so it is possible for a 
  36.     -- thread A to add to or remove elements from the list while a thread B is 
  37.     -- iterating across the list. However, elements which are being examined by 
  38.     -- a cursor or the Iterate procedure are locked to prevent other threads 
  39.     -- from modifying or removing elements referenced by cursors. 
  40.     -- 
  41.     -- Lists only support Append and Prepend additions. 
  42.     -- 
  43.     -- While the atomic list operations provided in this package are thread 
  44.     -- safe, there is no guarantee that the list will not be modified by a 
  45.     -- different thread between calls. For example, the following may fail: 
  46.     -- 
  47.     -- if list.Is_Empty then 
  48.     --     list.Append( element ); 
  49.     -- end if; 
  50.     -- Assert( not list.Is_Empty ); 
  51.     -- 
  52.     -- The list may be modified by other threads between the calls to Is_Empty 
  53.     -- and Append. 
  54.     type List is tagged limited private; 
  55.     type A_List is access all List'Class; 
  56.  
  57.     -- Appends the element to the list. 
  58.     procedure Append( this : access List; element : Element_Type ); 
  59.  
  60.     -- Appends the element to the list unless it's already in the list. Inserted 
  61.     -- will be returned as True if the append was performed. 
  62.     procedure Append_No_Duplicate( this     : access List; 
  63.                                    element  : Element_Type; 
  64.                                    inserted : out Boolean ); 
  65.  
  66.     -- Clears the list, blocking on elements that are being examined. 
  67.     procedure Clear( this : access List ); 
  68.  
  69.     -- Returns a cursor pointing to the element in the list if it is found. The 
  70.     -- procedure will block if the element is being examined. If the element is 
  71.     -- not found in the list, a null cursor will be returned. 
  72.     procedure Find( this : access List; element : Element_Type; position : out Cursor ); 
  73.  
  74.     -- Returns a cursor pointing to the first element in the list, blocking if 
  75.     -- the first element is being examined. 
  76.     procedure First( this : access List; position : out Cursor ); 
  77.  
  78.     -- Returns True if the list has no elements. 
  79.     function Is_Empty( this : access List ) return Boolean; 
  80.  
  81.     -- Iterates forward through the list, blocking on elements that are already 
  82.     -- being examined. Any thread can still modify the list while one thread is 
  83.     -- iterating over it, except for elements that are being examined. 
  84.     procedure Iterate( this    : access List; 
  85.                        examine : access procedure( element : Element_Type ) ); 
  86.  
  87.     -- Iterates forward through the list with the option of an early exit. Set 
  88.     -- quit to True in the examine procedure to abort iteration. See Iterate for 
  89.     -- further details. 
  90.     procedure Iterate_With_Quit( this    : access List; 
  91.                                  examine : access procedure( element : Element_Type; 
  92.                                                              quit    : in out Boolean ) ); 
  93.  
  94.     -- Returns the number of elements in the list. 
  95.     function Length( this : access List ) return Natural; 
  96.  
  97.     -- Prepends an element to the list. 
  98.     procedure Prepend( this : access List; element : Element_Type ); 
  99.  
  100.     -- Removes the element pointed to by position, blocking if the element is 
  101.     -- being examined. The cursor will be closed. 
  102.     procedure Remove( this : access List; position : in out Cursor ); 
  103.  
  104.     -- Deletes the list. If there are any open cursors, the deletion will fail 
  105.     -- without modifying the list and an exception will be raised. 
  106.     procedure Delete( this : in out A_List ); 
  107.  
  108.     -- Raised when any kind of use error occurs while using a mutable list. 
  109.     -- See the exception occurence's message for details. 
  110.     Container_Error : exception; 
  111.  
  112. private 
  113.  
  114.     use Locking_Objects; 
  115.  
  116.     type Node is limited 
  117.         record 
  118.             lock    : A_Locking_Object := new Locking_Object; 
  119.             element : Element_Type; 
  120.         end record; 
  121.     type A_Node is access all Node; 
  122.  
  123.     procedure Delete( n : in out A_Node ); 
  124.  
  125.     package Node_Lists is new Ada.Containers.Doubly_Linked_Lists( A_Node, "=" ); 
  126.  
  127.     type List is tagged limited 
  128.         record 
  129.             lock     : A_Locking_Object := new Locking_Object; 
  130.             refs     : Natural := 0;        -- open cursors referencing the list 
  131.             contents : Node_Lists.List; 
  132.         end record; 
  133.  
  134.     procedure Find_Next( this     : access List; 
  135.                          crsr     : in out Node_Lists.Cursor; 
  136.                          nextNode : out A_Node ); 
  137.  
  138.     type Cursor is limited 
  139.         record 
  140.             list : access Mutable_Lists.List := null; 
  141.             crsr : Node_Lists.Cursor; 
  142.             node : A_Node := null; 
  143.         end record; 
  144.  
  145. end Mutable_Lists;