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

lace.event: Add 'Containers' package.

Browse Source
This commit is contained in:
Rod Kay
2024-10-10 20:48:42 +11:00
parent ad38c1ec3d
commit 3077f2a4cd
4 changed files with 89 additions and 74 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -55,7 +55,7 @@ is
Sequence : sequence_Id;
begin
Self.sequence_Id_Map.get_Next (Sequence,
for_Observer);
for_Observer.Name);
return Sequence;
end next_Sequence;
@@ -71,7 +71,7 @@ is
is
begin
Self.safe_Observers .add (the_Observer, of_Kind);
Self.sequence_Id_Map.add (the_Observer);
Self.sequence_Id_Map.add (the_Observer.Name);
if Subject.Logger /= null
then
@@ -129,7 +129,7 @@ is
loop
begin
Self.sequence_Id_Map.get_Next (Sequence,
for_Observer => my_Observers (i));
for_Name => my_Observers (i).Name);
my_Observers (i).receive (the_Event,
from_Subject => Subject.item'Class (Self.all).Name,
@@ -178,7 +178,7 @@ is
loop
begin
Self.sequence_Id_Map.get_Next (s_Id,
for_Observer => my_Observers (i));
for_Name => my_Observers (i).Name);
my_Observers (i).receive (the_Event,
from_Subject => Subject.view (Self).Name,
@@ -229,7 +229,7 @@ is
if Self.Sender = null
then
Self.sequence_Id_Map.get_Next (s_Id,
for_Observer => to_Observer);
for_Name => to_Observer.Name);
begin
to_Observer.receive (the_Event,
from_Subject => Subject.view (Self).Name,
@@ -263,46 +263,6 @@ 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
--

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

@@ -7,8 +7,8 @@ private
with
lace.event_Emitter,
lace.event_Sender,
lace.event.Containers,
ada.Strings.Hash,
ada.Containers.Vectors,
ada.Containers.indefinite_hashed_Maps;
@@ -88,33 +88,6 @@ 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.
--
@@ -171,7 +144,7 @@ private
with
record
safe_Observers : make_Subject.safe_Observers;
sequence_Id_Map : safe_sequence_Id_Map;
sequence_Id_Map : Containers.safe_sequence_Id_Map;
Emitter : event_Emitter_view;
Sender : event_Sender_view;
end record;

40
1-base/lace/source/events/mixin/private/lace-event-containers.adb Normal file
View File

@@ -0,0 +1,40 @@
package body lace.event.Containers
is
------------------------
-- Safe sequence Id map.
--
protected
body safe_sequence_Id_Map
is
procedure add (Name : in String)
is
begin
if not the_Map.Contains (Name)
then
the_Map.insert (Name,
new_Item => 0);
end if;
end add;
procedure rid (Name : in String)
is
begin
the_Map.delete (Name);
end rid;
procedure get_Next (Id : out event.sequence_Id;
for_Name : in String)
is
next_Id : name_Maps_of_sequence_Id.Reference_type renames the_Map (for_Name);
begin
Id := next_Id;
next_Id := next_Id + 1;
end get_Next;
end safe_sequence_Id_Map;
end lace.event.Containers;

42
1-base/lace/source/events/mixin/private/lace-event-containers.ads Normal file
View File

@@ -0,0 +1,42 @@
with
ada.Strings.Hash,
ada.Containers.indefinite_hashed_Maps;
private
package lace.event.Containers
--
-- Common containers.
--
is
pragma remote_Types;
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 (String,
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 (Name : in String);
procedure rid (Name : in String);
procedure get_Next (Id : out event.sequence_Id;
for_Name : in String);
private
the_Map : name_Map_of_sequence_Id;
end safe_sequence_Id_Map;
end lace.event.Containers;