A nongeneric bounded string array type (was Re: Is the Writing on the Wall for Ada?)

["Robert I. Eachus" <rieachus@comcast.net>]

Warren W. Gay VE3WWG wrote:

> One of the things that discourages me from using Bounded_Strings is the
> number of instantiations that you end up making (for each different
> string size). I would have preferred one instantiation, and then a
> discriminant that set the maximum size on the object. But that may
> have problems of its own.

Ask, and it shall be given unto you; seek, and you shall find; knock, 
and it shall be opened to you. -- Matthew 7:7

Sorry, I couldn't resist.  Here is a package with NO instantiations, and 
a bounded array type that can handle different length strings.  The 
silly thing is that I could have written this package twenty years ago, 
since it doesn't require anything that wasn't originally in Ada 83.  Do 
I feel stupid that I didn't discover this package then?

Definitely not!  I have never been one to worry in Ada about the number 
of generic instantiations, so the number required to use 
Ada.Strings.Bounded was not something that bothered me much.  But the 
way the pieces of the discussion here all fell together implies to me 
that it could have been another twenty years before someone realized 
that you really could do this.

I would like comments on the interface, and any other operations that 
might make sense.  (For example relational operations between rows and 
Strings.)  You had better believe that if this pattern is this hard to 
find, it probably belongs in the standard, rather than in my back 
pocket.  But please, no comments about the way the body is 
written--unless you are a compiler implementor and want to provide a 
version which takes advantage of your optimizer.  This body is designed 
to be canonical, and a good optimizer should do a decent job on the 
'extra' string copies.

It is possible to use overlays, view conversions, or even 
Unchecked_Conversion in writing the body for the package.  And of 
course, doing that may improve performance when using a specific 
compiler.  (Which is why this package probably does belong in 
Ada.Strings.)  But I wanted a canonical version that said basically when 
Constraint_Error is raised.  As far as I am concerned, the only 
non-obvious bit about exceptions is that I decided that appending a null 
string to a nonexistant row should still raise Constraint_Error.

-------------------------------------------------------------------------

package Ada_Strings_Bounded_Array is

    type Bounded_Array(Size, Max: Natural) is private;

    procedure Set(B: in out Bounded_Array;
                  Row: in Positive;
                  To: in String);

    procedure Append(B: in out Bounded_Array;
                     Row: in Positive;
                     Add: in String);

    function Get(From: Bounded_Array;
                 Row: Positive) return String;

    function Get_Length(From: Bounded_Array;
                        Row: Positive) return Natural;

private

    type Element_Array is
           array (Natural range <>, Natural range <>) of Character;

    type Length_Array is array(Natural range <>) of Natural;

    type Bounded_Array(Size, Max: Natural) is record
       Lengths: Length_Array(1..Size) := (others => 0);
       Contents: Element_Array(1..Size, 1..Max);
    end record;

end Ada_Strings_Bounded_Array;

----------------------------------------------------------------------

package body Ada_Strings_Bounded_Array is

    procedure Set(B: in out Bounded_Array;
                  Row: in Positive;
                  To: in String) is
      Temp: String(1..To'Length) := To; -- insure lower bound is 1.
    begin
      if To'Length > B.Max then raise Constraint_Error; end if;
      B.Lengths(Row) := Temp'Last; -- will raise C_E if Row out of bounds.
      for I in Temp'Range loop
        B.Contents(Row,I) := Temp(I);
      end loop;
    end Set;

    procedure Append(B: in out Bounded_Array;
                     Row: in Positive;
                     Add: in String) is
      Temp: String(B.Lengths(Row)+ 1.. B.Lengths(Row) + Add'Length) := Add;
    begin
      if Temp'Last > B.Max then raise Constraint_Error; end if;
      B.Lengths(Row) := Temp'Last;
      for I in Temp'Range loop
        B.Contents(Row,I) := Temp(I);
      end loop;
    end Append;

    function Get(From: Bounded_Array;
                 Row: Positive) return String is
      Temp: String(1..From.Lengths(Row));
    begin
      for I in Temp'Range loop
        Temp(I) := From.Contents(Row,I);
      end loop;
      return Temp;
    end Get;


    function Get_Length(From: Bounded_Array;
                        Row: Positive) return Natural is
    begin return From.Lengths(Row); end Get_Length;

    pragma Inline(Set, Append, Get, Get_Length);

end Ada_Strings_Bounded_Array;

-------------------------------------------------------------------------

with Ada.Text_IO; use Ada.Text_IO;
with Ada_Strings_Bounded_Array; use Ada_Strings_Bounded_Array;
procedure Bounded_Array_Test is
   BA1: Bounded_Array(5, 30);
   BA2: Bounded_Array(2, 10);
begin
   Set(BA1,1, "Robert I. Eachus");
   Set(BA1,2, "Mortimer Q. Snerd");
   Set(BA2,1, "foo");
   Append(BA2,1, "bar");
   Put_Line(Get(BA1,1));
   Put_Line(Get(BA1,2));
   Put_Line(Get(BA2,1));
   if Get_Length(BA1,1) /= 16 then Put_Line("Oops! BA1,1"); end if;
   if Get_Length(BA2,1) /= 6 then Put_Line("Oops! BA2,1"); end if;
   if Get_Length(BA1,3) /= 0 then Put_Line("Oops! BA1,3"); end if;
end Bounded_Array_Test;

---------------------------------------------------------------------------

-- 
                                       Robert I. Eachus

"Quality is the Buddha. Quality is scientific reality. Quality is the 
goal of Art. It remains to work these concepts into a practical, 
down-to-earth context, and for this there is nothing more practical or 
down-to-earth than what I have been talking about all along...the repair 
of an old motorcycle."  -- from Zen and the Art of Motorcycle 
Maintenance by Robert Pirsig