Natools

natools-s_expressions-atom_buffers.adb at [87228b7a84]
Login

File src/natools-s_expressions-atom_buffers.adb artifact 65ea325a50 part of check-in 87228b7a84


------------------------------------------------------------------------------
-- Copyright (c) 2014, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.S_Expressions.Atom_Buffers is

   procedure Preallocate (Buffer : in out Atom_Buffer; Length : in Count) is
      Old_Size, New_Size : Count := 0;
   begin
      if Buffer.Used + Length <= Buffer.Available then
         return;
      end if;

      Old_Size := Buffer.Available;
      New_Size := Buffer.Used + Length;

      if Buffer.Ref.Is_Empty then
         declare
            function Create return Atom;

            function Create return Atom is
            begin
               return Atom'(1 .. New_Size => <>);
            end Create;
         begin
            Buffer.Ref.Replace (Create'Access);
         end;
      else
         declare
            function Create return Atom;

            Old_Accessor : constant Atom_Refs.Accessor := Buffer.Ref.Query;

            function Create return Atom is
            begin
               return Result : Atom (1 .. New_Size) do
                  Result (1 .. Old_Size) := Old_Accessor.Data.all;
               end return;
            end Create;
         begin
            Buffer.Ref.Replace (Create'Access);
         end;
      end if;

      Buffer.Available := New_Size;
   end Preallocate;


   procedure Append (Buffer : in out Atom_Buffer; Data : in Atom) is
   begin
      if Data'Length > 0 then
         Preallocate (Buffer, Data'Length);
         Buffer.Ref.Update.Data.all
           (Buffer.Used + 1 .. Buffer.Used + Data'Length)
           := Data;
         Buffer.Used := Buffer.Used + Data'Length;
      end if;
   end Append;


   procedure Append (Buffer : in out Atom_Buffer; Data : in Octet) is
   begin
      Preallocate (Buffer, 1);
      Buffer.Ref.Update.Data.all (Buffer.Used + 1) := Data;
      Buffer.Used := Buffer.Used + 1;
   end Append;


   procedure Append_Reverse (Buffer : in out Atom_Buffer; Data : in Atom) is
      procedure Process (Target : in out Atom);

      procedure Process (Target : in out Atom) is
      begin
         for I in reverse Data'Range loop
            Buffer.Used := Buffer.Used + 1;
            Target (Buffer.Used) := Data (I);
         end loop;
      end Process;
   begin
      Preallocate (Buffer, Data'Length);
      Buffer.Ref.Update (Process'Access);
   end Append_Reverse;


   procedure Invert (Buffer : in out Atom_Buffer) is
      procedure Process (Data : in out Atom);

      procedure Process (Data : in out Atom) is
         Low : Count := Data'First;
         High : Count := Buffer.Used;
         Tmp : Octet;
      begin
         while Low < High loop
            Tmp := Data (Low);
            Data (Low) := Data (High);
            Data (High) := Tmp;
            Low := Low + 1;
            High := High - 1;
         end loop;
      end Process;
   begin
      if not Buffer.Ref.Is_Empty then
         Buffer.Ref.Update (Process'Access);
      end if;
   end Invert;


   function Length (Buffer : Atom_Buffer) return Count is
   begin
      return Buffer.Used;
   end Length;


   function Capacity (Buffer : Atom_Buffer) return Count is
   begin
      return Buffer.Available;
   end Capacity;


   function Data (Buffer : Atom_Buffer) return Atom is
   begin
      if Buffer.Ref.Is_Empty then
         pragma Assert (Buffer.Available = 0 and Buffer.Used = 0);
         return Null_Atom;
      else
         return Buffer.Ref.Query.Data.all (1 .. Buffer.Used);
      end if;
   end Data;


   function Raw_Query (Buffer : Atom_Buffer) return Atom_Refs.Accessor is
      function Create return Atom;

      function Create return Atom is
      begin
         return Null_Atom;
      end Create;
   begin
      if Buffer.Ref.Is_Empty then
         declare
            Tmp_Ref : constant Atom_Refs.Reference
              := Atom_Refs.Create (Create'Access);
         begin
            return Tmp_Ref.Query;
         end;
      else
         return Buffer.Ref.Query;
      end if;
   end Raw_Query;


   procedure Query
     (Buffer : in Atom_Buffer;
      Process : not null access procedure (Data : in Atom)) is
   begin
      if Buffer.Ref.Is_Empty then
         Process.all (Null_Atom);
      else
         Process.all (Buffer.Ref.Query.Data.all (1 .. Buffer.Used));
      end if;
   end Query;


   procedure Peek
     (Buffer : in Atom_Buffer;
      Data : out Atom;
      Length : out Count)
   is
      Transmit : constant Count := Count'Min (Data'Length, Buffer.Used);
   begin
      Length := Buffer.Used;

      if Buffer.Ref.Is_Empty then
         pragma Assert (Length = 0);
         null;
      else
         Data (Data'First .. Data'First + Transmit - 1)
           := Buffer.Ref.Query.Data.all (1 .. Transmit);
      end if;
   end Peek;


   function Element (Buffer : Atom_Buffer; Position : Count) return Octet is
   begin
      return Buffer.Ref.Query.Data.all (Position);
   end Element;


   procedure Pop (Buffer : in out Atom_Buffer; Data : out Octet) is
   begin
      Data := Buffer.Ref.Query.Data.all (Buffer.Used);
      Buffer.Used := Buffer.Used - 1;
   end Pop;


   procedure Hard_Reset (Buffer : in out Atom_Buffer) is
   begin
      Buffer.Ref.Reset;
      Buffer.Available := 0;
      Buffer.Used := 0;
   end Hard_Reset;


   procedure Soft_Reset (Buffer : in out Atom_Buffer) is
   begin
      Buffer.Used := 0;
   end Soft_Reset;


   overriding procedure Write
     (Buffer : in out Atom_Buffer;
      Item : in Ada.Streams.Stream_Element_Array)
     renames Append;


   overriding procedure Read
     (Buffer : in out Atom_Buffer;
      Item : out Ada.Streams.Stream_Element_Array;
      Last : out Ada.Streams.Stream_Element_Offset) is
   begin
      if Item'Length < Buffer.Used then
         declare
            Mutator : constant Atom_Refs.Mutator := Buffer.Ref.Update;
         begin
            Last := Item'Last;
            Item := Mutator.Data.all (1 .. Item'Length);
            Buffer.Used := Buffer.Used - Item'Length;
            Mutator.Data.all (1 .. Buffer.Used) := Mutator.Data.all
              (Item'Length + 1 .. Item'Length + Buffer.Used);
         end;
      else
         Last := Item'First + Buffer.Used - 1;
         Item (Item'First .. Last)
           := Buffer.Ref.Query.Data.all (1 .. Buffer.Used);
         Buffer.Used := 0;
      end if;
   end Read;

end Natools.S_Expressions.Atom_Buffers;