1. private with Ada.Containers.Ordered_Maps; 
  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. -- This generic package implements a thread-safe linked list that can be 
  10. -- modified by one thread while another is iterating. The list is locked at two 
  11. -- levels- the list level and the element level. The only restrictions are that 
  12. -- new elements can only be prepended or appended, and an element can't be 
  13. -- modified or removed from the list while it is being examined. 
  14. package Fully_Mutable_Lists is 
  15.  
  16.     type Cursor is private; 
  17.  
  18.     -- Closes the cursor, unlocking the list element it was examining. 
  19.     procedure Close( position : in out Cursor ); 
  20.  
  21.     -- Returns the value of the element the cursor is examining. 
  22.     function Element( position : Cursor ) return Element_Type; 
  23.  
  24.     -- Returns True if the cursor is examining a valid element. 
  25.     function Has_Element( position : Cursor ) return Boolean; 
  26.  
  27.     -- Traverses to the next element in the list. The caller will block until 
  28.     -- the next element is unlocked. 
  29.     procedure Next( position : in out Cursor ); 
  30.  
  31.     type List is tagged limited private; 
  32.  
  33.     -- Appends an element to the list. 
  34.     procedure Append( this : access List; element : Element_Type ); 
  35.  
  36.     -- Finds an element in the list, returning a cursor to it. If the element 
  37.     -- isn't in the list, an empty cursor will be returned. 
  38.     procedure Find( this : access List; element : Element_Type; position : out Cursor ); 
  39.  
  40.     -- Returns a cursor examining the first element in the list. 
  41.     function First( this : access List ) return Cursor; 
  42.  
  43.     -- Returns True if the list is empty. 
  44.     function Is_Empty( this : access List ) return Boolean; 
  45.  
  46.     -- Iterates forward over the list. 
  47.     procedure Iterate( this    : access List; 
  48.                        examine : access procedure( element : Element_Type ) ); 
  49.  
  50.     -- Iterates forward over the list with an early exit option. Set 'quit' to 
  51.     -- True in the 'examine' procedure to stop iterating. 
  52.     procedure Iterate_With_Quit( this    : access List; 
  53.                                  examine : access procedure( element : Element_Type; 
  54.                                                              quit    : in out Boolean ) ); 
  55.  
  56.     -- Returns the current size of the list. This should not be relied upon, as 
  57.     -- the list size may be changed by another thread immediately after return. 
  58.     function Length( this : access List ) return Natural; 
  59.  
  60.     -- Prepends an element to the list. 
  61.     procedure Prepend( this : access List; element : Element_Type ); 
  62.  
  63.     -- It is possible that the position being removed is currently being 
  64.     -- examined. So- if the list contains pointers it is not safe to assume an 
  65.     -- object can be deleted after removing it from the list. 
  66.     procedure Remove( this : access List; position : in out Cursor ); 
  67.  
  68.     -- Raised when a cursor is used to access the list improperly. 
  69.     CONTAINER_ERROR : exception; 
  70.  
  71. private 
  72.  
  73.     use Locking_Objects; 
  74.  
  75.     type Node is limited 
  76.         record 
  77.             element : Element_Type; 
  78.         end record; 
  79.     type A_Node is access all Node; 
  80.  
  81.     procedure Delete( n : in out A_Node ); 
  82.  
  83.     package Element_Maps is new Ada.Containers.Ordered_Maps( Integer, A_Node, "<", "=" ); 
  84.  
  85.     type List is tagged limited 
  86.         record 
  87.             lock     : A_Locking_Object := new Locking_Object; 
  88.             least    : Integer := 0; 
  89.             greatest : Integer := 0; 
  90.             contents : Element_Maps.Map; 
  91.         end record; 
  92.  
  93.     -- Result will be 0 / null if there isn't a following node. 
  94.     procedure Find_Next( this     : access List; 
  95.                          id       : Integer; 
  96.                          nextId   : out Integer; 
  97.                          nextNode : out A_Node ); 
  98.     pragma Postcondition( nextId = 0 xor nextNode /= null ); 
  99.  
  100.     type Cursor is 
  101.         record 
  102.             list : access Fully_Mutable_Lists.List := null; 
  103.             id   : Integer := 0; 
  104.             node : A_Node := null; 
  105.         end record; 
  106.  
  107. end Fully_Mutable_Lists;