nichkara/lace
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lace.event: Add event sequence to subjects.

Browse Source
This commit is contained in:
Rod Kay
2024-10-10 20:25:35 +11:00
parent 37e3e74783
commit ad38c1ec3d
20 changed files with 263 additions and 133 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
1-base/lace/source/events/concrete/lace-observer-deferred.ads
View File

@@ -1,5 +1,5 @@
with
lace.make_Observer.deferred,
lace.event.make_Observer.deferred,
lace.Any;
private
@@ -36,8 +36,8 @@ private
pragma Suppress (Container_Checks); -- Suppress expensive tamper checks.
package Observer is new lace.make_Observer (Any.limited_item);
package Deferred is new Observer.deferred (Observer.item);
package Observer is new event.make_Observer (Any.limited_item);
package Deferred is new Observer.deferred (Observer.item);
type Item is limited new Deferred.item with
record

4
1-base/lace/source/events/concrete/lace-observer-instant.ads
View File

@@ -1,5 +1,5 @@
with
lace.make_Observer,
lace.event.make_Observer,
lace.Any;
private
@@ -35,7 +35,7 @@ private
pragma Suppress (Container_Checks); -- Suppress expensive tamper checks.
package Observer is new make_Observer (Any.limited_item);
package Observer is new event.make_Observer (Any.limited_item);
type Item is limited new Observer.item with
record

4
1-base/lace/source/events/concrete/lace-subject-local.ads
View File

@@ -1,5 +1,5 @@
with
lace.make_Subject,
lace.event.make_Subject,
lace.Any;
private
@@ -39,7 +39,7 @@ private
pragma Suppress (Container_Checks); -- Suppress expensive tamper checks.
package Subject is new make_Subject (Any.limited_item);
package Subject is new event.make_Subject (Any.limited_item);
type Item is limited new Subject.item with
record

10
1-base/lace/source/events/concrete/lace-subject_and_deferred_observer.ads
View File

@@ -1,8 +1,8 @@
with
lace.Subject,
lace.Observer,
lace.make_Subject,
lace.make_Observer.deferred,
lace.event.make_Subject,
lace.event.make_Observer.deferred,
lace.Any;
private
@@ -42,9 +42,9 @@ private
pragma Suppress (Container_Checks); -- Suppress expensive tamper checks.
package Subject is new make_Subject (Any.limited_item);
package Observer is new make_Observer (Subject .item);
package Deferred is new Observer.deferred (Observer .item);
package Subject is new event.make_Subject (Any.limited_item);
package Observer is new event.make_Observer (Subject .item);
package Deferred is new Observer.deferred (Observer .item);
type Item is limited new Deferred.item with
record

8
1-base/lace/source/events/concrete/lace-subject_and_instant_observer.ads
View File

@@ -1,6 +1,6 @@
with
lace.make_Subject,
lace.make_Observer,
lace.event.make_Subject,
lace.event.make_Observer,
lace.Any,
lace.Subject,
lace.Observer;
@@ -39,8 +39,8 @@ private
pragma Suppress (Container_Checks); -- Suppress expensive tamper checks.
package Subject is new make_Subject (Any.limited_item);
package Observer is new make_Observer (Subject .item);
package Subject is new event.make_Subject (Any.limited_item);
package Observer is new event.make_Observer (Subject .item);
type Item is limited new Observer.item with
record

6
1-base/lace/source/events/interface/lace-observer.ads
View File

@@ -29,6 +29,7 @@ is
function Name (Self : in Item) return event.observer_Name is abstract;
------------
-- Responses
--
@@ -45,15 +46,18 @@ is
(Self : in out Item; To : in Observer.view) is abstract;
-------------
-- Operations
--
procedure receive (Self : access Item; the_Event : in Event.item'Class;
from_Subject : in event.subject_Name) is abstract;
from_Subject : in event.subject_Name;
Sequence : in event.sequence_Id) is abstract;
--
-- Accepts an Event from a Subject.
procedure respond (Self : access Item) is abstract;
--
-- Performs the Response for (and then removes) each pending Event.

5
1-base/lace/source/events/interface/lace-subject.ads
View File

@@ -35,8 +35,9 @@ is
-- Attributes
--
function Name (Self : in Item) return Event.subject_Name is abstract;
function Name (Self : in Item) return Event.subject_Name is abstract;
function next_Sequence (Self : in out Item; for_Observer : in Observer.view) return event.sequence_Id is abstract;
-- function next_Sequence (Self : in out Item; for_Observer : in event.observer_Name) return event.sequence_Id is abstract;
------------

10
1-base/lace/source/events/lace-event.ads
View File

@@ -9,7 +9,7 @@ package lace.Event
is
pragma Pure;
type Item is tagged private;
type Item is tagged null record;
subtype subject_Name is String;
@@ -31,15 +31,7 @@ is
function Hash (the_Kind : in Kind) return ada.Containers.Hash_type;
private
type sequence_Id is range 0 .. 2**32 - 1;
type Item is tagged
record
s_Id : sequence_Id;
end record;
end lace.Event;

8
1-base/lace/source/events/mixin/lace-make_observer.adb → 1-base/lace/source/events/mixin/lace-event-make_observer.adb
View File

@@ -2,11 +2,10 @@ with
lace.Event.Logger,
lace.Event.utility,
ada.unchecked_Conversion,
ada.unchecked_Deallocation;
package body lace.make_Observer
package body lace.event.make_Observer
is
use type Event.Logger.view;
@@ -64,7 +63,8 @@ is
overriding
procedure receive (Self : access Item; the_Event : in Event.item'Class;
from_Subject : in Event.subject_Name)
from_Subject : in Event.subject_Name;
Sequence : in sequence_Id)
is
begin
Self.Responses.receive (Self, the_Event, from_Subject);
@@ -248,4 +248,4 @@ is
end safe_Responses;
end lace.make_Observer;
end lace.event.make_Observer;

9
1-base/lace/source/events/mixin/lace-make_observer.ads → 1-base/lace/source/events/mixin/lace-event-make_observer.ads
View File

@@ -1,5 +1,4 @@
with
lace.Event,
lace.Response,
lace.Observer;
@@ -12,7 +11,7 @@ with
generic
type T is abstract tagged limited private;
package lace.make_Observer
package lace.event.make_Observer
--
-- Makes a user class T into an event Observer.
--
@@ -49,7 +48,8 @@ is
overriding
procedure receive (Self : access Item; the_Event : in Event.item'Class;
from_Subject : in Event.subject_Name);
from_Subject : in Event.subject_Name;
Sequence : in sequence_Id);
overriding
procedure respond (Self : access Item);
@@ -63,7 +63,6 @@ private
----------------------
-- Event response maps
--
use type event.Kind;
use type Response.view;
package event_response_Maps is new ada.Containers.indefinite_hashed_Maps (key_type => Event.Kind,
@@ -139,4 +138,4 @@ private
Responses : safe_Responses;
end record;
end lace.make_Observer;
end lace.event.make_Observer;

88
1-base/lace/source/events/mixin/lace-make_subject.adb → 1-base/lace/source/events/mixin/lace-event-make_subject.adb
View File

@@ -5,7 +5,7 @@ with
ada.unchecked_Deallocation;
package body lace.make_Subject
package body lace.event.make_Subject
is
use type Event.Logger.view;
@@ -49,6 +49,18 @@ is
overriding
function next_Sequence (Self : in out Item; for_Observer : in Observer.view) return event.sequence_Id
is
Sequence : sequence_Id;
begin
Self.sequence_Id_Map.get_Next (Sequence,
for_Observer);
return Sequence;
end next_Sequence;
-------------
-- Operations
--
@@ -58,7 +70,8 @@ is
of_Kind : in Event.Kind)
is
begin
Self.safe_Observers.add (the_Observer, of_Kind);
Self.safe_Observers .add (the_Observer, of_Kind);
Self.sequence_Id_Map.add (the_Observer);
if Subject.Logger /= null
then
@@ -110,12 +123,18 @@ is
declare
use lace.Event.utility;
my_Observers : constant Subject.Observer_views := Self.Observers (to_Kind (the_Event'Tag));
Sequence : sequence_Id;
begin
for i in my_Observers'Range
loop
begin
Self.sequence_Id_Map.get_Next (Sequence,
for_Observer => my_Observers (i));
my_Observers (i).receive (the_Event,
from_Subject => Subject.item'Class (Self.all).Name);
from_Subject => Subject.item'Class (Self.all).Name,
Sequence => Sequence);
if Subject.Logger /= null
then
Subject.Logger.log_Emit (Subject.view (Self),
@@ -152,12 +171,19 @@ is
my_Observers : constant Subject.Observer_views := Self.Observers (to_Kind (the_Event'Tag));
bad_Observers : Subject.Observer_views (my_Observers'Range);
bad_Count : Natural := 0;
s_Id : sequence_Id;
begin
for i in my_Observers'Range
loop
begin
Self.sequence_Id_Map.get_Next (s_Id,
for_Observer => my_Observers (i));
my_Observers (i).receive (the_Event,
from_Subject => Subject.view (Self).Name);
from_Subject => Subject.view (Self).Name,
Sequence => s_Id);
if Subject.Logger /= null
then
Subject.Logger.log_Emit (Subject.view (Self),
@@ -197,12 +223,18 @@ is
procedure send (Self : access Item; the_Event : in Event.item'Class;
to_Observer : in Observer.view)
is
s_Id : sequence_Id;
begin
if Self.Sender = null
then
Self.sequence_Id_Map.get_Next (s_Id,
for_Observer => to_Observer);
begin
to_Observer.receive (the_Event,
from_Subject => Subject.view (Self).Name);
from_Subject => Subject.view (Self).Name,
Sequence => s_Id);
if Subject.Logger /= null
then
Subject.Logger.log_Send (Subject.view (Self),
@@ -231,6 +263,46 @@ is
------------------------
-- Safe sequence Id map.
--
protected
body safe_sequence_Id_Map
is
procedure add (the_Observer : in Observer.view)
is
begin
if not the_Map.Contains (the_Observer.Name)
then
the_Map.insert (the_Observer.Name,
new_Item => 0);
end if;
end add;
procedure rid (the_Observer : in Observer.view)
is
begin
the_Map.delete (the_Observer.Name);
end rid;
procedure get_Next (Id : out event.sequence_Id;
for_Observer : in Observer.view)
is
next_Id : name_Maps_of_sequence_Id.Reference_type renames the_Map (for_Observer.Name);
begin
Id := next_Id;
next_Id := next_Id + 1;
end get_Next;
end safe_sequence_Id_Map;
-----------------
-- Safe Observers
--
@@ -265,8 +337,8 @@ is
use event_Observer_Vectors,
event_kind_Maps_of_event_observers;
Cursor : constant event_kind_Maps_of_event_observers.Cursor := the_Observers.find (of_Kind);
the_event_Observers : event_Observer_Vector_view;
Cursor : constant event_kind_Maps_of_event_observers.Cursor := the_Observers.find (of_Kind);
the_event_Observers : event_Observer_Vector_view;
begin
if has_Element (Cursor)
then
@@ -334,4 +406,4 @@ is
end safe_Observers;
end lace.make_Subject;
end lace.event.make_Subject;

43
1-base/lace/source/events/mixin/lace-make_subject.ads → 1-base/lace/source/events/mixin/lace-event-make_subject.ads
View File

@@ -1,5 +1,4 @@
with
lace.Event,
lace.Subject,
lace.Observer;
@@ -9,6 +8,7 @@ with
lace.event_Emitter,
lace.event_Sender,
ada.Strings.Hash,
ada.Containers.Vectors,
ada.Containers.indefinite_hashed_Maps;
@@ -16,7 +16,7 @@ with
generic
type T is abstract tagged limited private;
package lace.make_Subject
package lace.event.make_Subject
--
-- Makes a user class T into an event Subject.
--
@@ -41,6 +41,8 @@ is
overriding
function observer_Count (Self : in Item) return Natural;
overriding
function next_Sequence (Self : in out Item; for_Observer : in Observer.view) return event.sequence_Id;
-------------
@@ -86,6 +88,33 @@ private
pragma suppress (container_Checks); -- Suppress expensive tamper checks.
---------------------------
-- Name map of sequence Id.
--
package name_Maps_of_sequence_Id is new ada.Containers.indefinite_hashed_Maps (event.observer_Name,
event.sequence_Id,
ada.Strings.Hash,
"=");
subtype name_Map_of_sequence_Id is name_Maps_of_sequence_Id.Map;
------------------------
-- Safe sequence Id map.
--
protected
type safe_sequence_Id_Map
is
procedure add (the_Observer : in Observer.view);
procedure rid (the_Observer : in Observer.view);
procedure get_Next (Id : out event.sequence_Id;
for_Observer : in Observer.view);
private
the_Map : name_Map_of_sequence_Id;
end safe_sequence_Id_Map;
--------------------------
-- Event observer vectors.
--
@@ -100,7 +129,6 @@ private
--------------------------------------
-- Event kind Maps of event observers.
--
use type Event.Kind;
package event_kind_Maps_of_event_observers is new ada.Containers.indefinite_hashed_Maps (Event.Kind,
event_Observer_Vector_view,
Event.Hash,
@@ -142,9 +170,10 @@ private
and Subject.item
with
record
safe_Observers : make_Subject.safe_Observers;
Emitter : event_Emitter_view;
Sender : event_Sender_view;
safe_Observers : make_Subject.safe_Observers;
sequence_Id_Map : safe_sequence_Id_Map;
Emitter : event_Emitter_view;
Sender : event_Sender_view;
end record;
end lace.make_Subject;
end lace.event.make_Subject;

38
1-base/lace/source/events/mixin/private/lace-event_emitter.adb
View File

@@ -4,9 +4,7 @@ with
ada.Text_IO,
ada.Exceptions,
ada.unchecked_Deallocation,
ada.Containers.Vectors,
ada.Containers.indefinite_Holders;
ada.unchecked_Deallocation;
package body lace.event_Emitter
@@ -20,10 +18,6 @@ is
subtype string_Holder is string_Holders.Holder;
package event_Holders is new ada.Containers.indefinite_Holders (Element_type => lace.Event.item'Class);
subtype event_Holder is event_Holders.Holder;
package emitter_Vectors is new ada.Containers.Vectors (Positive,
Emitter_view);
subtype emitter_Vector is emitter_Vectors.Vector;
@@ -60,6 +54,7 @@ is
the_Event : in lace.Event.item'Class;
To : in lace.Observer.view;
from_Subject : in String;
Sequence : in event.sequence_Id;
Emitters : in safe_Emitters_view);
end Emitter;
@@ -68,10 +63,12 @@ is
task body Emitter
is
Myself : Emitter_view;
s_Id : event.sequence_Id;
Event : event_Holder;
the_Observer : lace.Observer.view;
subject_Name : string_Holder;
emitter_Pool : safe_Emitters_view;
begin
loop
begin
@@ -80,6 +77,7 @@ is
the_Event : in lace.Event.item'Class;
To : in lace.Observer.view;
from_Subject : in String;
Sequence : in lace.event.sequence_Id;
Emitters : in safe_Emitters_view)
do
Event .replace_Element (the_Event);
@@ -88,6 +86,7 @@ is
Myself := Self;
the_Observer := To;
s_Id := Sequence;
emitter_Pool := Emitters;
end emit;
or
@@ -95,8 +94,10 @@ is
end select;
the_Observer.receive (Event.Reference,
from_Subject => subject_Name.Element);
emitter_Pool.add (Myself); -- Return the emitter to the safe pool.
from_Subject => subject_Name.Element,
Sequence => s_Id);
emitter_Pool.add (Myself); -- Return the emitter to the safe pool.
exception
when E : others =>
@@ -108,6 +109,7 @@ is
ada.Text_IO.put_Line ("Observer: '" & the_Observer.Name & "'.");
ada.Text_IO.put_Line ("Continuing.");
ada.Text_IO.new_Line (2);
emitter_Pool.add (Myself); -- Return the emitter to the safe pool.
end;
end loop;
@@ -161,8 +163,8 @@ is
accept start (Subject : in lace.Subject.view;
Events : in safe_Events_view)
do
the_Subject := Subject;
the_Events := Events;
the_Subject := Subject;
the_Events := Events;
the_subject_Name.replace_Element (Subject.Name);
end start;
@@ -191,11 +193,14 @@ is
use lace.Event.utility;
the_Observers : constant lace.Subject.Observer_views := the_Subject.Observers (of_Kind => Kind_of (each_Event));
begin
for each_Observer of the_Observers
loop
declare
the_Emitter : Emitter_view;
the_Emitter : Emitter_view;
Sequence : constant event.sequence_Id := the_Subject.next_Sequence (for_Observer => each_Observer);
begin
the_Emitters.get (the_Emitter);
@@ -208,6 +213,7 @@ is
the_Event => each_Event,
To => each_Observer,
from_Subject => the_subject_Name.Element,
Sequence => Sequence,
Emitters => the_Emitters'unchecked_Access);
exception
when E : others =>
@@ -251,7 +257,11 @@ is
is
procedure add (new_Event : in lace.Event.item'Class)
-- Sequence : in event.sequence_Id)
is
-- use event_Holders;
-- the_Details : constant event_Details := (Event => to_Holder (new_Event),
-- Sequence => Sequence);
begin
all_Events.append (new_Event);
end add;
@@ -331,10 +341,12 @@ is
procedure add (Self : in out Item; new_Event : lace.Event.item'Class)
procedure add (Self : in out Item; new_Event : in lace.Event.item'Class)
-- Sequence : in event.sequence_Id)
is
begin
Self.Events.add (new_Event);
-- Sequence);
end add;

28
1-base/lace/source/events/mixin/private/lace-event_emitter.ads
View File

@@ -5,7 +5,9 @@ with
private
with
lace.Subject,
ada.Containers.indefinite_Vectors;
ada.Containers.indefinite_Holders,
ada.Containers.indefinite_Vectors,
ada.Containers.Vectors;
private
@@ -15,10 +17,11 @@ is
type Item is tagged limited private;
procedure define (Self : in out Item; Subject : in lace.Subject.view);
procedure define (Self : in out Item; Subject : in lace.Subject.view);
procedure destroy (Self : in out Item);
procedure add (Self : in out Item; new_Event : in lace.Event.item'Class);
procedure add (Self : in out Item; new_Event : in lace.Event.item'Class);
-- Sequence : in event.sequence_Id);
@@ -36,10 +39,22 @@ private
---------------
--- Containers.
--
use type Event.item'Class;
package event_Holders is new ada.Containers.Indefinite_Holders (Event.item'Class);
subtype event_Holder is event_Holders.Holder;
-- type event_Details is
-- record
-- Sequence : event.sequence_Id;
-- Event : event_Holder;
-- end record;
use type lace.Event.item'Class;
package event_Vectors is new ada.Containers.indefinite_Vectors (Positive,
lace.Event.item'Class);
-- package event_Vectors is new ada.Containers.Vectors (Positive,
-- event_Details);
subtype event_Vector is event_Vectors.Vector;
@@ -52,6 +67,7 @@ private
type safe_Events
is
procedure add (new_Event : in lace.Event.item'Class);
-- Sequence : in event.sequence_Id);
procedure get (the_Events : out event_Vector);
function is_Empty return Boolean;
@@ -71,8 +87,8 @@ private
task
type emit_Delegator
is
entry start (Subject : in lace.Subject.view;
Events : in safe_Events_view);
entry start (Subject : in lace.Subject.view;
Events : in safe_Events_view);
entry stop;
end emit_Delegator;

61
1-base/lace/source/events/mixin/private/lace-event_sender.adb
View File

@@ -51,6 +51,7 @@ is
the_Event : in lace.Event.item'Class;
To : in lace.Observer.view;
from_Subject : in String;
Sequence : in event.sequence_Id;
Senders : in safe_Senders_view);
end Sender;
@@ -62,6 +63,7 @@ is
Event : event_Holder;
the_Observer : lace.Observer.view;
subject_Name : string_Holder;
the_Sequence : lace.event.sequence_Id;
sender_Pool : safe_Senders_view;
begin
loop
@@ -71,11 +73,13 @@ is
the_Event : in lace.Event.item'Class;
To : in lace.Observer.view;
from_Subject : in String;
Sequence : in lace.event.sequence_Id;
Senders : in safe_Senders_view)
do
Event .replace_Element (the_Event);
subject_Name.replace_Element (from_Subject);
the_Sequence := Sequence;
Myself := Self;
the_Observer := To;
@@ -86,7 +90,8 @@ is
end select;
the_Observer.receive (Event.Reference,
from_Subject => subject_Name.Element);
from_Subject => subject_Name.Element,
Sequence => the_Sequence);
sender_Pool.add (Myself); -- Return the sender to the safe pool.
exception
@@ -126,8 +131,8 @@ is
the_subject_Name : string_Holder;
the_Senders : aliased safe_Senders;
the_Pairs : safe_Pairs_view;
new_Pairs : pair_Vector;
the_send_Details : safe_send_Details_view;
new_send_Details : send_Details_Vector;
Done : Boolean := False;
@@ -148,11 +153,11 @@ is
begin
accept start (Subject : in lace.Subject.view;
Pairs : in safe_Pairs_view)
accept start (Subject : in lace.Subject.view;
send_Details : in safe_send_Details_view)
do
the_Pairs := Pairs;
the_subject_Name.replace_Element (Subject.Name);
the_send_Details := send_Details;
end start;
@@ -169,11 +174,11 @@ is
exit when Done
and the_Pairs.is_Empty;
and the_send_Details.is_Empty;
the_Pairs.get (new_Pairs);
the_send_Details.get (new_send_Details);
for each_Pair of new_Pairs
for Each of new_send_Details
loop
declare
the_Sender : Sender_view;
@@ -186,9 +191,10 @@ is
end if;
the_Sender.send (Self => the_Sender,
the_Event => each_Pair.Event.Element,
To => each_Pair.Observer,
the_Event => Each.Event.Element,
To => Each.Observer,
from_Subject => the_subject_Name.Element,
Sequence => Each.Sequence,
Senders => the_Senders'unchecked_Access);
exception
when E : others =>
@@ -197,8 +203,8 @@ is
ada.Text_IO.new_Line;
ada.Text_IO.put_Line ("Error detected in 'lace.event_Sender.send_Delegator'.");
ada.Text_IO.put_Line ("Subject '" & the_subject_Name.Element & "'.");
ada.Text_IO.put_Line ("Observer '" & each_Pair.Observer.Name & "'.");
ada.Text_IO.put_Line ("Event '" & each_Pair.Event'Image & "'.");
ada.Text_IO.put_Line ("Observer '" & Each.Observer.Name & "'.");
ada.Text_IO.put_Line ("Event '" & Each.Event'Image & "'.");
ada.Text_IO.put_Line ("Continuing.");
ada.Text_IO.new_Line (2);
end;
@@ -223,26 +229,26 @@ is
---------------
--- Safe Pairs.
------------------------
--- Safe 'send_Details'.
--
protected body safe_Pairs
protected body safe_send_Details
is
procedure add (new_Pair : in event_observer_Pair)
procedure add (new_send_Details : in send_Details)
is
begin
all_Pairs.append (new_Pair);
all_the_send_Details.append (new_send_Details);
end add;
procedure get (the_Pairs : out pair_Vector)
procedure get (all_send_Details : out send_Details_Vector)
is
begin
the_Pairs := all_Pairs;
all_Pairs.clear;
all_send_Details := all_the_send_Details;
all_the_send_Details.clear;
end get;
@@ -250,10 +256,10 @@ is
function is_Empty return Boolean
is
begin
return all_Pairs.is_Empty;
return all_the_send_Details.is_Empty;
end is_Empty;
end safe_Pairs;
end safe_send_Details;
@@ -297,8 +303,8 @@ is
procedure define (Self : in out Item; Subject : in lace.Subject.view)
is
begin
Self.Delegator.start (Subject => Subject,
Pairs => Self.Pairs'unchecked_Access);
Self.Delegator.start (Subject => Subject,
send_Details => Self.send_Details'unchecked_Access);
end define;
@@ -317,8 +323,9 @@ is
is
use event_Holders;
begin
Self.Pairs.add (event_observer_Pair' (Event => to_Holder (new_Event),
Observer => for_Observer));
Self.send_Details.add (send_Details' (Event => to_Holder (new_Event),
Observer => for_Observer,
Sequence => from_Subject.next_Sequence (for_Observer => for_Observer)));
end add;

45
1-base/lace/source/events/mixin/private/lace-event_sender.ads
View File

@@ -16,12 +16,12 @@ is
type Item is tagged limited private;
procedure define (Self : in out Item; Subject : in lace.Subject.view);
procedure define (Self : in out Item; Subject : in lace.Subject.view);
procedure destroy (Self : in out Item);
procedure add (Self : in out Item; new_Event : in lace.Event.item'Class;
for_Observer : in lace.Observer.view;
from_Subject : in lace.Subject.view);
procedure add (Self : in out Item; new_Event : in lace.Event.item'Class;
for_Observer : in lace.Observer.view;
from_Subject : in lace.Subject.view);
private
@@ -32,10 +32,11 @@ private
type event_observer_Pair is
type send_Details is
record
Event : event_Holder;
Observer : lace.Observer.view;
Sequence : lace.event.sequence_Id;
end record;
@@ -49,33 +50,33 @@ private
-------------------------------
--- event_observer_Pair_Vector.
--------------------------
--- 'send_Details' Vector.
--
package pair_Vectors is new ada.Containers.Vectors (Positive,
event_observer_Pair);
subtype pair_Vector is pair_Vectors.Vector;
package send_Details_Vectors is new ada.Containers.Vectors (Positive,
send_Details);
subtype send_Details_Vector is send_Details_Vectors.Vector;
---------------
--- Safe pairs.
------------------------
--- Safe 'send_Detail's.
--
protected
type safe_Pairs
type safe_send_Details
is
procedure add (new_Pair : in event_observer_Pair);
procedure get (the_pairs : out pair_Vector);
procedure add (new_send_Details : in send_Details);
procedure get (all_send_Details : out send_Details_Vector);
function is_Empty return Boolean;
private
all_Pairs : pair_Vector;
end safe_Pairs;
all_the_send_Details : send_Details_Vector;
end safe_send_Details;
type safe_Pairs_view is access all safe_Pairs;
type safe_send_Details_view is access all safe_send_Details;
@@ -86,8 +87,8 @@ private
task
type send_Delegator
is
entry start (Subject : in lace.Subject.view;
Pairs : in safe_Pairs_view);
entry start (Subject : in lace.Subject.view;
send_Details : in safe_send_Details_view);
entry stop;
end send_Delegator;
@@ -99,8 +100,8 @@ private
type Item is tagged limited
record
Pairs : aliased safe_Pairs;
Delegator : send_Delegator;
send_Details : aliased safe_send_Details;
Delegator : send_Delegator;
end record;

0
1-base/lace/source/events/mixin/ravenscar/lace-make_observer-deferred.adb → 1-base/lace/source/events/mixin/ravenscar/lace-event-make_observer-deferred.adb
View File

2
1-base/lace/source/events/mixin/ravenscar/lace-make_observer-deferred.ads → 1-base/lace/source/events/mixin/ravenscar/lace-event-make_observer-deferred.ads
View File

@@ -16,7 +16,7 @@ with ada.Containers.indefinite_Vectors,
generic
type T is abstract new lace.make_Observer.item with private;
package lace.make_Observer.deferred
package lace.event.make_Observer.deferred
--
-- Makes a user class T into a deferred event Observer.
--

7
1-base/lace/source/events/mixin/xgc/lace-make_observer-deferred.adb → 1-base/lace/source/events/mixin/xgc/lace-event-make_observer-deferred.adb
View File

@@ -4,7 +4,7 @@ with
ada.unchecked_Deallocation;
package body lace.make_Observer.deferred
package body lace.event.make_Observer.deferred
is
use type Event.Logger.view;
@@ -24,7 +24,8 @@ is
overriding
procedure receive (Self : access Item; the_Event : in Event.item'Class;
from_Subject : in Event.subject_Name)
from_Subject : in Event.subject_Name;
Sequence : in sequence_Id)
is
begin
Self.pending_Events.add (the_Event, from_Subject);
@@ -264,4 +265,4 @@ is
end safe_subject_Map_of_safe_events;
end lace.make_Observer.deferred;
end lace.event.make_Observer.deferred;

14
1-base/lace/source/events/mixin/xgc/lace-make_observer-deferred.ads → 1-base/lace/source/events/mixin/xgc/lace-event-make_observer-deferred.ads
View File

@@ -1,6 +1,3 @@
with
lace.Event;
private
with
ada.Containers.indefinite_Vectors,
@@ -9,9 +6,9 @@ with
generic
type T is abstract new lace.make_Observer.item with private;
type T is abstract new lace.event.make_Observer.item with private;
package lace.make_Observer.deferred
package lace.event.make_Observer.deferred
--
-- Makes a user class T into a deferred event Observer.
--
@@ -32,7 +29,8 @@ is
overriding
procedure receive (Self : access Item; the_Event : in Event.item'Class;
from_Subject : in Event.subject_Name);
from_Subject : in Event.subject_Name;
Sequence : in sequence_Id);
overriding
procedure respond (Self : access Item);
@@ -45,8 +43,6 @@ private
----------------
-- Event Vectors
--
use type Event.item;
package event_Vectors is new ada.Containers.indefinite_Vectors (Positive, Event.item'Class);
subtype event_Vector is event_Vectors.Vector;
type event_Vector_view is access all event_Vector;
@@ -120,4 +116,4 @@ private
pending_Events : safe_subject_Map_of_safe_events;
end record;
end lace.make_Observer.deferred;
end lace.event.make_Observer.deferred;