tupplespacepackage-realtupples.adb

pragma Ada_2022;
with Ada.Unchecked_Deallocation;
with Ada.Text_io;
use Ada.text_io;

package body tupplespacepackage.RealTupples is
    function Encode (I: Integer; Pos: Positive; A: String) return Integer_Positive_String_Tupple is (I,Pos,To_Unbounded_String(A));
    function Encode (A, B: String) return String_String_Tupple is (String_String_Tupple'(To_Unbounded_String(A),To_Unbounded_String(B)));
    procedure Decode (the_Tupple: Integer_Positive_String_Tupple; I: out Integer; Pos: out Positive; A: out Ada.Strings.Unbounded.Unbounded_String) is
        use Ada.Strings.Unbounded;
    begin
        I := the_Tupple.I;
        Pos := the_Tupple.Pos;
        A := the_Tupple.A;
    end Decode;
    procedure Decode (the_Tupple: String_String_Tupple; A, B: out Ada.Strings.Unbounded.Unbounded_String) is
        use Ada.Strings.Unbounded;
    begin
        A := the_Tupple.A;
        B := the_Tupple.B;
    end Decode;
    procedure Copy_Into (A: Tupple'Class; B: out Integer_Positive_String_Tupple) is
    begin
        B := Integer_Positive_String_Tupple (A);
    end Copy_Into;
    procedure Copy_Into (A: Tupple'Class; B: out String_String_Tupple) is
    begin
        B := String_String_Tupple (A);
    end Copy_Into;
    protected body RealtuppleSpace is
        procedure Matches (T: Tupple'Class; QueueAccess: out AccessToProtected)  is
        begin
            if not The_Map.Contains (T'Tag) then
                The_Map.Insert (Key => T'Tag, New_Item => new LockedQueue);
            end if;
            QueueAccess := The_Map.Element(T'Tag);
        end Matches;
        procedure Out_Operation (T: Tupple'Class) is
            M: AccessToProtected;
        begin
            Matches (T, M);
            M.Out_Operation (T);
        end Out_Operation;
        entry In_Operation (Result: out Tupple'Class) when True is
            M: AccessToProtected;
        begin
            Matches (Result, M);
            requeue M.In_Operation with abort;
        end In_Operation;

        entry RD_Operation
            (Result  : out Tupple'Class) when True is
            M: AccessToProtected;
        begin
            Matches (Result, M);
            requeue M.RD_Operation with abort;
        end RD_Operation;

       procedure Inp_Operation
         (Result  : out Tupple'Class) is
            M: AccessToProtected;
        begin
            Matches (Result, M);
            select
                M.In_Operation (Result);
            else
                raise No_Immediate_Message;
            end select;
        end Inp_Operation;

        procedure RDP_Operation (Result  : out Tupple'Class) is
            M: AccessToProtected;
        begin
            Matches (Result, M);
            select
                M.RD_Operation (Result);
            else
                raise No_Immediate_Message;
            end select;
        end RDP_Operation;
    end RealtuppleSpace;

    protected body  LockedQueue is
        procedure Out_Operation (T: Tupple'Class) is
        begin
            Put_line(T'Image);
            PatternQueue.Prepend (new Tupple'Class'(T));
        end Out_Operation;

        entry In_Operation (Result: out Tupple'Class) when not PatternQueue.Is_Empty is
            procedure Free is new Ada.Unchecked_Deallocation (Tupple'Class, AccessToClass);
            Var_To_Delete: AccessToClass := PatternQueue.Last_Element;
        begin
            Var_To_Delete.Copy_Into (Result);

            Free (Var_To_Delete);
            PatternQueue.Delete_Last;
        end In_Operation;

        entry RD_Operation (Result: out Tupple'Class) when not PatternQueue.Is_Empty is
        begin
            PatternQueue.Last_Element.Copy_Into (Result);
        end RD_Operation;

    end LockedQueue;

end tupplespacepackage.RealTupples;