From 3077f2a4cd17bc4fdcd6512e0c263419a7e41895 Mon Sep 17 00:00:00 2001 From: Rod Kay Date: Thu, 10 Oct 2024 20:48:42 +1100 Subject: [PATCH] lace.event: Add 'Containers' package. --- .../events/mixin/lace-event-make_subject.adb | 50 ++----------------- .../events/mixin/lace-event-make_subject.ads | 31 +----------- .../mixin/private/lace-event-containers.adb | 40 +++++++++++++++ .../mixin/private/lace-event-containers.ads | 42 ++++++++++++++++ 4 files changed, 89 insertions(+), 74 deletions(-) create mode 100644 1-base/lace/source/events/mixin/private/lace-event-containers.adb create mode 100644 1-base/lace/source/events/mixin/private/lace-event-containers.ads diff --git a/1-base/lace/source/events/mixin/lace-event-make_subject.adb b/1-base/lace/source/events/mixin/lace-event-make_subject.adb index 126a4dd..df3c322 100644 --- a/1-base/lace/source/events/mixin/lace-event-make_subject.adb +++ b/1-base/lace/source/events/mixin/lace-event-make_subject.adb @@ -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 -- diff --git a/1-base/lace/source/events/mixin/lace-event-make_subject.ads b/1-base/lace/source/events/mixin/lace-event-make_subject.ads index 113e77e..459aff0 100644 --- a/1-base/lace/source/events/mixin/lace-event-make_subject.ads +++ b/1-base/lace/source/events/mixin/lace-event-make_subject.ads @@ -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; diff --git a/1-base/lace/source/events/mixin/private/lace-event-containers.adb b/1-base/lace/source/events/mixin/private/lace-event-containers.adb new file mode 100644 index 0000000..da30626 --- /dev/null +++ b/1-base/lace/source/events/mixin/private/lace-event-containers.adb @@ -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; diff --git a/1-base/lace/source/events/mixin/private/lace-event-containers.ads b/1-base/lace/source/events/mixin/private/lace-event-containers.ads new file mode 100644 index 0000000..e99530b --- /dev/null +++ b/1-base/lace/source/events/mixin/private/lace-event-containers.ads @@ -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;