In the examples we've already seen, when the subject notifies its
observer(s) about a state change, the observer queries the subject for
the actual value.
What we do here is pass the data to the observer directly, instead of
the observer having to call back the subject to get it.
Implementation
The nature of the data the subject passes back to the observer depends
on the abstraction, so clearly a generic is called for.
During a notification, the subject passes the state to Notify, which
just passes it in turn to each of the observers in the Update.
The spec of Subjects_And_Observers now looks like this:
generic
type State_Type (<>) is limited private; <--!!!
package Subjects_And_Observers is
type Subject_Type is
tagged limited private;
type Subject_Access is
access all Subject_Type'Class;
procedure Notify
(Subject : in out Subject_Type'Class;
State : in State_Type); <--!!!
type Observer_Type is
abstract tagged limited private;
procedure Update
(Observer : access Observer_Type;
State : in State_Type) is abstract; <--!!!
procedure Attach (...);
procedure Detach (...);
private
...
end Subjects_And_Observers;
The generic formal type is limited and indefinite, since here it's just
being passed as a subprogram argument. The data isn't copied, nor are
instances declared.
Notify and Update now take an additional argument, the new value of the
state.
Notify is implemented as before, by traversing the observer list and
Update'ing each observer. The only difference is that it passes the
state to Update.
procedure Notify
(Subject : in out Subject_Type'Class;
State : in State_Type) is <--!!!
Observer : Observer_Access := Subject.Head;
begin
while Observer /= null loop
Update (Observer, State); <--!!!
Observer := Observer.Next;
end loop;
end Notify;
That about covers the salient changes to Subjects_And_Observers.
Our Clock_Timer subject has three attributes that get observed. That
means there will be three separate instantiations of the generic
version of Subjects_And_Observers.
The public part of the spec looks like this:
package Clock_Timers is
type Clock_Timer is limited private;
procedure Tick
(Timer : in out Clock_Timer);
subtype Hour_Number is
Natural range 0 .. 23;
package Hour_Subjects is
new Subjects_And_Observers (Hour_Number);
function Get_Hour_Subject
(Timer : access Clock_Timer)
return Hour_Subjects.Subject_Access;
subtype Minute_Number is
Natural range 0 .. 59;
package Minute_Subjects is
new Subjects_And_Observers (Minute_Number);
function Get_Minute_Subject
(Timer : access Clock_Timer)
return Minute_Subjects.Subject_Access;
subtype Second_Number is
Natural range 0 .. 59;
package Second_Subjects is
new Subjects_And_Observers (Second_Number);
function Get_Second_Subject
(Timer : access Clock_Timer)
return Second_Subjects.Subject_Access;
private
...
end Clock_Timers;
There are a few things to notice about this spec:
1) There are three different instantiations of Subjects_And_Observers,
one each for Hour_Number, Minute_Number, and Second_Number.
2) The selector functions that return a subject (e.g. Get_Hour_Subject)
return the subject type provided by the respective instantiation.
3) There are no selector functions to query the Clock_Timer's state,
since the state is passed directly from the subject to the observer,
during the state change notification.
The private part of the spec now looks like this:
package Clock_Timers is
...
private
function Get_Default_Time return Natural;
type Clock_Timer is
limited record
Current_Time : Natural := Get_Default_Time;
Hour : Integer := -1;
Hour_Subject : aliased Hour_Subjects.Subject_Type;
Minute : Integer := -1;
Minute_Subject : aliased Minute_Subjects.Subject_Type;
Second : Integer := -1;
Second_Subject : aliased Second_Subjects.Subject_Type;
end record;
end Clock_Timers;
This implementation is much like we've seen before, except that each
subject attribute is a different subject type, one for each
instantiation of Subjects_And_Observers.
Since there are now three different subject types, there are now three
different Notify procedures. In the implementation of Tick, we use
expanded name notation to make this clear:
procedure Do_Tick
(Timer : in out Clock_Timer) is
<calculate new hour, min, and sec>
begin
if Timer.Hour /= Hour then
Timer.Hour := Hour;
Hour_Subjects.Notify (Timer.Hour_Subject, Hour); <--!!!
end if;
if Timer.Minute /= Minute then
Timer.Minute := Minute;
Minute_Subjects.Notify (Timer.Minute_Subject, Minute); <--!!!
end if;
if Timer.Second /= Second then
Timer.Second := Second;
Second_Subjects.Notify (Timer.Second_Subject, Second); <--!!!
end if;
end Do_Tick;
When the subject notifies its observers of a state change, it passes the
new state value as an argument of Notify.
That about covers the changes to the Clock_Timer subject. Next up are
the changes to the Digital_Clock observer.
There are three different subjects to observe, that means there will be
three different observer derivations, each one from a different observer
type.
The spec of Digital_Clocks now looks like this:
package Digital_Clocks is
type Digital_Clock (Timer : access Clock_Timer) is
limited private;
private
type H_Obs_Type is
new Hour_Subjects.Observer_Type with null record;
procedure Update
(Observer : access H_Obs_Type;
Hour : in Hour_Number);
type M_Obs_Type is
new Minute_Subjects.Observer_Type with null record;
procedure Update
(Observer : access M_Obs_Type;
Minute : in Minute_Number);
type S_Obs_Type is
new Second_Subjects.Observer_Type with null record;
procedure Update
(Observer : access S_Obs_Type;
Second : in Second_Number);
type Control_Type (Clock : access Digital_Clock) is
new Limited_Controlled with null record;
procedure Initialize (Control : in out Control_Type);
procedure Finalize (Control : in out Control_Type);
type Digital_Clock
(Timer : access Clock_Timer) is
limited record
H_Obs : aliased H_Obs_Type;
M_Obs : aliased M_Obs_Type;
S_Obs : aliased S_Obs_Type;
-- The Control component MUST be declared LAST!!!
Control : Control_Type (Digital_Clock'Access);
end record;
end Digital_Clocks;
There are a few things to make note of:
1) Previous observers needed an access discriminant designating the
enclosing record, in order to get access to its discriminant, which
designated the subject.
The observer doesn't need to query the subject anymore, so
discriminant is no longer necessary. (The data needed by an observer
is passed as part of the Update call.)
Of course, in some other application, the observer may need access to
the enclosing record for some other reason, perhaps because there's
some local state it needs. In that case, just do as we've done
before, and extend the observer parent type with an access
discriminant.
2) Each (non-abstract) observer derives from a different observer parent
type, the one provided by the respective instantiation of
Subjects_And_Observers. Expanded name notation is needed here to
unambiguously name the parent type.
3) The Update procedure overridden by each observer each takes an
additional parameter, for the new state value. This is why the
observer doesn't need to call back the subject anymore, because it's
given the data directly.
4) Per the idiom, there is a Control component to attach the observers
to their subjects during elaboration, and detach them at end of
scope.
I have said it before, and I'll say it again: the Control component
MUST be declared as the LAST component of the record, in order to
ensure that the observer components have already been elaborated.
The Update procedure now receives the state directly, and so it doesn't
have to query the subject for it. The observer just displays the state
in the normal way:
procedure Update
(Observer : access H_Obs_Type;
Hour : in Hour_Number) is
Image : constant String :=
Integer'Image (Hour + 100);
begin
Put_Line ("new hour is " & Image (3 .. Image'Last));
end;
There are now different Attach (and Detach) operations, one for each
different instantiation of Subjects_And_Observers.
In the implementation of the Initialize (and Finalize) operation, we use
expanded name notation to make this clear:
procedure Initialize (Control : in out Control_Type) is
Clock : Digital_Clock renames Control.Clock.all;
begin
Hour_Subjects.Attach <--!!!
(Observer => Clock.H_Obs'Access,
To => Get_Hour_Subject (Clock.Timer));
Minute_Subjects.Attach <--!!!
(Observer => Clock.M_Obs'Access,
To => Get_Minute_Subject (Clock.Timer));
Second_Subjects.Attach <--!!!
(Observer => Clock.S_Obs'Access,
To => Get_Second_Subject (Clock.Timer));
end Initialize;
That's it! This variation may simplify your life if the sequence of
notifications and queries gets unwieldy, especially when there are
concurrency issues to deal with.
--STX
package body Clock_Timers is
function Get_Default_Time return Natural is
begin
return 1 * 3600 + 59 * 60 + 55;
end;
procedure Do_Tick
(Timer : in out Clock_Timer) is
Hour : constant Hour_Number :=
Timer.Current_Time / 3600;
Minute : constant Minute_Number :=
(Timer.Current_Time - 3600 * Hour) / 60;
Second : constant Second_Number :=
Timer.Current_Time -
3600 * Hour -
60 * Minute;
begin
if Timer.Hour /= Hour then
Timer.Hour := Hour;
Hour_Subjects.Notify (Timer.Hour_Subject, Hour);
end if;
if Timer.Minute /= Minute then
Timer.Minute := Minute;
Minute_Subjects.Notify (Timer.Minute_Subject, Minute);
end if;
if Timer.Second /= Second then
Timer.Second := Second;
Second_Subjects.Notify (Timer.Second_Subject, Second);
end if;
end Do_Tick;
procedure Tick
(Timer : in out Clock_Timer) is
begin
Timer.Current_Time := Timer.Current_Time + 1;
Do_Tick (Timer);
end Tick;
function Get_Hour_Subject
(Timer : access Clock_Timer)
return Hour_Subjects.Subject_Access is
begin
return Timer.Hour_Subject'Access;
end;
function Get_Minute_Subject
(Timer : access Clock_Timer)
return Minute_Subjects.Subject_Access is
begin
return Timer.Minute_Subject'Access;
end;
function Get_Second_Subject
(Timer : access Clock_Timer)
return Second_Subjects.Subject_Access is
begin
return Timer.Second_Subject'Access;
end;
end Clock_Timers;
with Subjects_And_Observers;
pragma Elaborate (Subjects_And_Observers);
package Clock_Timers is
pragma Preelaborate;
type Clock_Timer is limited private;
procedure Tick
(Timer : in out Clock_Timer);
subtype Hour_Number is
Natural range 0 .. 23;
package Hour_Subjects is
new Subjects_And_Observers (Hour_Number);
function Get_Hour_Subject
(Timer : access Clock_Timer)
return Hour_Subjects.Subject_Access;
subtype Minute_Number is
Natural range 0 .. 59;
package Minute_Subjects is
new Subjects_And_Observers (Minute_Number);
function Get_Minute_Subject
(Timer : access Clock_Timer)
return Minute_Subjects.Subject_Access;
subtype Second_Number is
Natural range 0 .. 59;
package Second_Subjects is
new Subjects_And_Observers (Second_Number);
function Get_Second_Subject
(Timer : access Clock_Timer)
return Second_Subjects.Subject_Access;
private
function Get_Default_Time return Natural;
type Clock_Timer is
limited record
Current_Time : Natural := Get_Default_Time;
Hour : Integer := -1;
Hour_Subject : aliased Hour_Subjects.Subject_Type;
Minute : Integer := -1;
Minute_Subject : aliased Minute_Subjects.Subject_Type;
Second : Integer := -1;
Second_Subject : aliased Second_Subjects.Subject_Type;
end record;
end Clock_Timers;
with Ada.Text_IO; use Ada.Text_IO;
package body Digital_Clocks is
procedure Update
(Observer : access H_Obs_Type;
Hour : in Hour_Number) is
Image : constant String :=
Integer'Image (Hour + 100);
begin
Put_Line ("new hour is " & Image (3 .. Image'Last));
end;
procedure Update
(Observer : access M_Obs_Type;
Minute : in Minute_Number) is
Image : constant String :=
Integer'Image (Minute + 100);
begin
Put_Line ("new min is " & Image (3 .. Image'Last));
end;
procedure Update
(Observer : access S_Obs_Type;
Second : in Second_Number) is
Image : constant String :=
Integer'Image (Second + 100);
begin
Put_Line ("new sec is " & Image (3 .. Image'Last));
end;
procedure Initialize (Control : in out Control_Type) is
Clock : Digital_Clock renames Control.Clock.all;
begin
Hour_Subjects.Attach
(Observer => Clock.H_Obs'Access,
To => Get_Hour_Subject (Clock.Timer));
Minute_Subjects.Attach
(Observer => Clock.M_Obs'Access,
To => Get_Minute_Subject (Clock.Timer));
Second_Subjects.Attach
(Observer => Clock.S_Obs'Access,
To => Get_Second_Subject (Clock.Timer));
end Initialize;
procedure Finalize (Control : in out Control_Type) is
Clock : Digital_Clock renames Control.Clock.all;
begin
Hour_Subjects.Detach
(Observer => Clock.H_Obs'Access,
From => Get_Hour_Subject (Clock.Timer));
Minute_Subjects.Detach
(Observer => Clock.M_Obs'Access,
From => Get_Minute_Subject (Clock.Timer));
Second_Subjects.Detach
(Observer => Clock.S_Obs'Access,
From => Get_Second_Subject (Clock.Timer));
end Finalize;
end Digital_Clocks;
with Clock_Timers; use Clock_Timers;
with Ada.Finalization;
package Digital_Clocks is
pragma Elaborate_Body;
type Digital_Clock (Timer : access Clock_Timer) is
limited private;
private
type H_Obs_Type is
new Hour_Subjects.Observer_Type with null record;
procedure Update
(Observer : access H_Obs_Type;
Hour : in Hour_Number);
type M_Obs_Type is
new Minute_Subjects.Observer_Type with null record;
procedure Update
(Observer : access M_Obs_Type;
Minute : in Minute_Number);
type S_Obs_Type is
new Second_Subjects.Observer_Type with null record;
procedure Update
(Observer : access S_Obs_Type;
Second : in Second_Number);
use Ada.Finalization;
type Control_Type (Clock : access Digital_Clock) is
new Limited_Controlled with null record;
procedure Initialize (Control : in out Control_Type);
procedure Finalize (Control : in out Control_Type);
type Digital_Clock
(Timer : access Clock_Timer) is
limited record
H_Obs : aliased H_Obs_Type;
M_Obs : aliased M_Obs_Type;
S_Obs : aliased S_Obs_Type;
-- The Control component MUST be declared LAST!!!
Control : Control_Type (Digital_Clock'Access);
end record;
end Digital_Clocks;
package body Subjects_And_Observers is
procedure Notify
(Subject : in out Subject_Type'Class;
State : in State_Type) is
Observer : Observer_Access := Subject.Head;
begin
while Observer /= null loop
Update (Observer, State);
Observer := Observer.Next;
end loop;
end Notify;
procedure Attach
(Observer : access Observer_Type'Class;
To : access Subject_Type'Class) is
OA : constant Observer_Access :=
Observer.all'Unchecked_Access;
begin
OA.Next := To.Head;
To.Head := OA;
end Attach;
procedure Detach
(Observer : access Observer_Type'Class;
From : access Subject_Type'Class) is
OA : constant Observer_Access :=
Observer.all'Unchecked_Access;
Prev : Observer_Access;
Index : Observer_Access;
begin
if From.Head = OA then
From.Head := From.Head.Next;
else
Prev := From.Head;
Index := From.Head.Next;
while Index /= OA loop
Prev := Index;
Index := Index.Next;
end loop;
Prev.Next := Index.Next;
end if;
end Detach;
end Subjects_And_Observers;
generic
type State_Type (<>) is limited private;
package Subjects_And_Observers is
pragma Preelaborate;
type Subject_Type is
tagged limited private;
type Subject_Access is
access all Subject_Type'Class;
procedure Notify
(Subject : in out Subject_Type'Class;
State : in State_Type);
type Observer_Type is
abstract tagged limited private;
procedure Update
(Observer : access Observer_Type;
State : in State_Type) is abstract;
procedure Attach
(Observer : access Observer_Type'Class;
To : access Subject_Type'Class);
procedure Detach
(Observer : access Observer_Type'Class;
From : access Subject_Type'Class);
private
type Observer_Access is access all Observer_Type'Class;
pragma Suppress (Access_Check, On => Observer_Access);
type Subject_Type is
tagged limited record
Head : Observer_Access;
end record;
type Observer_Type is
abstract tagged limited record
Next : Observer_Access;
end record;
end Subjects_And_Observers;
with Ada.Text_IO; use Ada.Text_IO;
with Clock_Timers; use Clock_Timers;
with Digital_Clocks; use Digital_Clocks;
procedure Test_Observers is
Timer : aliased Clock_Timer;
Clock : Digital_Clock (Timer'Access);
procedure Do_Ticks is
begin
Tick (Timer);
Tick (Timer);
Tick (Timer);
New_Line;
end Do_Ticks;
begin
Put_Line ("(one observer)");
Do_Ticks;
declare
Another_Clock : Digital_Clock (Timer'Access);
begin
Put_Line ("(two observers)");
Do_Ticks;
declare
Yet_Another_Clock : Digital_Clock (Timer'Access);
begin
Put_Line ("(three observers)");
Do_Ticks;
end;
Put_Line ("(two observers)");
Do_Ticks;
end;
Put_Line ("(one observer)");
Do_Ticks;
end Test_Observers;
|
