Observer Pattern - Revised

I whipped up a new (better?) version of the observer pattern.

The only unit that changed is package Subjects_And_Observers:

o Notify is now a class-wide operation.

o The private subject operations Register and Unregister are gone, and
the work they did has been incorporated into observer operations
Initialize and Finalize.

o The observer type no longer privately derives from Limited_Controlled.
Instead, a controlled component of the observer does the list
manipulation during its own initialization and finalization:

   type Observer_Control (Observer : access Root_Observer_Type'Class) is
     new Limited_Controlled with null record;

   procedure Initialize (Control : in out Observer_Control);

   procedure Finalize (Control : in out Observer_Control);


   type Root_Observer_Type (Subject : access Root_Subject_Type'Class) is
     abstract tagged limited record
        Control : Observer_Control (Root_Observer_Type'Access);   <--
        Next    : Observer_Access;
     end record;


In general, it's better to make components controlled, rather than the
entire type.  That way there's no conflict if a descendent type
overrides Initialize and Finalize.

o Accessibility checks are turned off using Unchecked_Access instead of
pragma Suppress.

   procedure Initialize (Control : in out Observer_Control) is

      Observer : constant Observer_Access :=
        Control.Observer.all'Unchecked_Access;
      ...


o The component of the subject that denotes the head of the observer
list has been renamed:

   type Root_Subject_Type is
     abstract tagged limited record
        Head : Observer_Access;
     end record;


The following code is ready for GNAT Chop:

--STX
with Ada.Finalization;

package Subjects_And_Observers is

   type Root_Subject_Type is
     abstract tagged limited private;

   procedure Notify (Subject : in out Root_Subject_Type'Class);


   type Root_Observer_Type (Subject : access Root_Subject_Type'Class) is
     abstract tagged limited private;

   procedure Update (Observer : access Root_Observer_Type) is abstract;

private

   type Observer_Access is access all Root_Observer_Type'Class;
   pragma Suppress (Access_Check, On => Observer_Access);

   type Root_Subject_Type is
     abstract tagged limited record
        Head : Observer_Access;
     end record;


   use Ada.Finalization;

   type Observer_Control (Observer : access Root_Observer_Type'Class) is
     new Limited_Controlled with null record;

   procedure Initialize (Control : in out Observer_Control);

   procedure Finalize (Control : in out Observer_Control);


   type Root_Observer_Type (Subject : access Root_Subject_Type'Class) is
     abstract tagged limited record
        Control : Observer_Control (Root_Observer_Type'Access);
        Next    : Observer_Access;
     end record;

end Subjects_And_Observers;


package body Subjects_And_Observers is

   procedure Notify (Subject : in out Root_Subject_Type'Class) is
      Observer : Observer_Access := Subject.Head;
   begin
      while Observer /= null loop
         Update (Observer);
         Observer := Observer.Next;
      end loop;
   end Notify;


   procedure Initialize (Control : in out Observer_Control) is

      Observer : constant Observer_Access :=
        Control.Observer.all'Unchecked_Access;

      Subject : Root_Subject_Type'Class renames
        Observer.Subject.all;

   begin
      Observer.Next := Subject.Head;
      Subject.Head := Observer;
   end;


   procedure Finalize (Control : in out Observer_Control) is

      Observer : constant Observer_Access :=
        Control.Observer.all'Unchecked_Access;

      Subject : Root_Subject_Type'Class renames
        Observer.Subject.all;

      Prev  : Observer_Access;
      Index : Observer_Access;
   begin
      if Subject.Head = Observer then
         Subject.Head := Subject.Head.Next;
      else
         Prev := Subject.Head;
         Index := Subject.Head.Next;

         while Index /= Observer loop
            Prev := Index;
            Index := Index.Next;
         end loop;

         Prev.Next := Index.Next;
      end if;
   end Finalize;


end Subjects_And_Observers;