Re: String_Holder ?

[Martin <martin@thedowies.com>]

On Dec 18, 12:34 pm, Natasha Kerensikova <lithium...@gmail.com> wrote:
> Hello,
>
> in my few Ada projects so far, I have quite often encountered the need
> of storing a string along with other information in records. So I went
> for discriminants containing the string size, and putting the string
> directly in the record.
>
> This works well when there is only one or two strings, but with several
> of them, or in variant records, I find it quite heavy. So I was thinking
> about something like that:
>
> type String_Holder is still to be defined;
>
> function Hold (S : String) return String_Holder;
>
> function To_String (Holder : String_Holder) return String;
>
> procedure Query (Holder : String_Holder;
>                  Process : not null access procedure (S : String));
>
> I'm still unsure on what kind of type String_Holder should be (private,
> tagged private or interface). It would basically be a constant-size
> reference to an immutable string that is stored "somewhere".
>
> The simplest implementation would be an Unbounded_String, though if
> needed it could be improved reference counting to make assignments
> cheaper, or with a hash table to deduplicate identical strings, etc.
>
> So my question is, does it make sense to have such objects? Or am I
> getting blinded by my C past, where strings are always manipulated
> through a char* object?
>
> Assuming it does make sense, am I right in thinking it's better to have
> such a type, even if it's a thin wrapper around Unbounded_String,
> instead of using directly Unbounded_String?
>
> Assuming it does make sense to have a String_Holder, would it be better
> to have it private, tagged private or interface?
> My guess is that tagged private has no advantage over interface,
> especially with a default implementation around Unbounded_String, which
> doesn't need to be controlled, but then controlled extension would be
> heavier. Then the choice between private and interface amounts to
> whether or not it could be useful to use simultaneously several
> implementations of String_Holder in the same project. I cannot think of
> any project where it would be the case, so I would lean towards private,
> but maybe I'm lacking imagination here.
>
> Still under the same assumption, is the above specification sane, or am
> I missing something? Query procedure is probably not absolutely
> necessary, but I guess it can be occasionally useful to save a string
> copy compared to To_String, and it seems to be a very small
> implementation burden anyway.
>
> Still under the same assumption, can it be useful to provide unary "+"
> functions to tersely convert String_Holder to String, and maybe
> vice-versa, or would it do more harm (obfuscation) than good?
>
> And lastly, is there any trick to allow a String_Holder object or
> similar to be pre-elaborable?
>
> Thanks in advance for your insights,
> Natasha

Have you considered a "Flyweight"?

Here's an example in Ada2012 (which is soooo much easier to acheive
than in previous Ada versions).

The coffee flavour string is repeated in each order but only unique
strings are stored and each order context contains a reference to the
string.

In a real application, you'd want probably want to add finalization.

-- Martin



-- main.adb
with Applications; use Applications;
procedure Main is
   App : Application := Create;
begin
   App.Execute;
end Main;

-- applications.ads
        private with Ada.Containers.Vectors;
        private with Coffee_Orders.Flavours;
        private with Coffee_Orders.Flavours.Factories;
limited private with Coffee_Order_Contexts;
package Applications is
   type Application (<>) is tagged limited private;
   function Create return Application;
   procedure Execute (A : in out Application);
private
   use Coffee_Orders.Flavours.Factories;
   type Order is record
      Context : access Coffee_Order_Contexts.Coffee_Order_Context;
      Flavour : access Coffee_Orders.Flavours.Flavour;
   end record;
   package Order_Vectors is
      new Ada.Containers.Vectors (Natural, Order);
   type Application is tagged limited record
      Orders          : Order_Vectors.Vector;
      Flavour_Factory : Coffee_Orders.Flavours.Factories.Factory;
   end record;
   procedure Take_Orders (A       : in out Application;
                          Flavour :        String;
                          Table   :        Integer);
end Applications;

-- applications.adb
with Ada.Text_IO;            use Ada.Text_IO;
with Coffee_Order_Contexts;  use Coffee_Order_Contexts;
with Coffee_Orders.Flavours; use Coffee_Orders.Flavours;
package body Applications is
   function Create return Application is
   begin
      return Result : Application do
         null;
      end return;
   end Create;
   procedure Take_Orders (A       : in out Application;
                          Flavour :        String;
                          Table   :        Integer) is
   begin
      A.Orders.Append ((Context => new Coffee_Order_Context'(Create
(Table)),
                        Flavour =>
Flavour_Ref'(A.Flavour_Factory.Get_Flavour (Flavour))));
   end Take_Orders;
   procedure Execute (A : in out Application) is
   begin
      A.Take_Orders ("Cappuccino", 2);
      A.Take_Orders ("Cappuccino", 2);
      A.Take_Orders ("Frappe", 1);
      A.Take_Orders ("Frappe", 1);
      A.Take_Orders ("Xpresso", 1);
      A.Take_Orders ("Frappe", 897);
      A.Take_Orders ("Cappuccino", 97);
      A.Take_Orders ("Cappuccino", 97);
      A.Take_Orders ("Frappe", 3);
      A.Take_Orders ("Xpresso", 3);
      A.Take_Orders ("Cappuccino", 3);
      A.Take_Orders ("Xpresso", 96);
      A.Take_Orders ("Frappe", 552);
      A.Take_Orders ("Cappuccino", 121);
      A.Take_Orders ("Xpresso", 121);
      for Order of A.Orders loop
         Order.Flavour.Serve_Coffee (Order.Context.all);
      end loop;
      Put_Line ("Total Coffee_Flavor objects made:" & Integer'Image
(A.Flavour_Factory.Total_Flavours_Made));
   end Execute;
end Applications;

-- coffee_order_contexts.ads
package Coffee_Order_Contexts is
   type Coffee_Order_Context (<>) is tagged private;
   function Create (Table : Integer) return Coffee_Order_Context;
   function Table_No (COC : Coffee_Order_Context) return Integer;
private
   type Coffee_Order_Context is tagged record
      Table : Integer := 0;
   end record;
end Coffee_Order_Contexts;

-- coffee_order_contexts.adb
package body Coffee_Order_Contexts is
   function Create (Table : Integer) return Coffee_Order_Context is
   begin
      return Result : Coffee_Order_Context do
         Result.Table := Table;
      end return;
   end Create;
   function Table_No (COC : Coffee_Order_Context) return Integer is
   begin
      return COC.Table;
   end Table_No;
end Coffee_Order_Contexts;

-- coffee_order_contexts-vectors.ads
with Ada.Containers.Indefinite_Vectors;
package Coffee_Order_Contexts.Vectors is
   new Ada.Containers.Indefinite_Vectors (Natural,
Coffee_Order_Context);

-- coffee_orders.ads
with Coffee_Order_Contexts; use Coffee_Order_Contexts;
package Coffee_Orders is
   type Coffee_Order is interface;
   procedure Serve_Coffee (CO  : Coffee_Order;
                           COC : Coffee_Order_Context) is abstract;
end Coffee_Orders;

-- coffee_orders-flavours.ads
private with Ada.Strings.Unbounded;
        with Coffee_Order_Contexts; use Coffee_Order_Contexts;
package Coffee_Orders.Flavours is
   type Flavour (<>) is new Coffee_Order with private;
   type Flavour_Ref is access all Flavour'Class;
   function Create (Name : String) return Flavour;
   function "=" (L, R : Flavour) return Boolean;
   overriding
   procedure Serve_Coffee (F   : Flavour;
                           COC : Coffee_Order_Context);
private
   use Ada.Strings.Unbounded;
   type Flavour is new Coffee_Order with record
      Name : Unbounded_String;
   end record;
end Coffee_Orders.Flavours;

-- coffee_orders-flavours.adb
with Ada.Strings.Equal_Case_Insensitive;
with Ada.Text_IO; use Ada.Text_IO;
package body Coffee_Orders.Flavours is
   function Create (Name : String) return Flavour is
   begin
      return Result : Flavour do
         Result.Name := To_Unbounded_String (Name);
      end return;
   end Create;
   function "=" (L, R : Flavour) return Boolean is
   begin
      return Ada.Strings.Equal_Case_Insensitive (To_String (L.Name),
To_String (R.Name));
   end "=";
   procedure Serve_Coffee (F   : Flavour;
                           COC : Coffee_Order_Context) is
   begin
      Put_Line ("Serving Coffee flavor " & To_String (F.Name)
                & " to table number " & Integer'Image (COC.Table_No));
   end Serve_Coffee;
end Coffee_Orders.Flavours;

-- coffee_orders-flavours-vectors.ads
with Ada.Containers.Vectors;
package Coffee_Orders.Flavours.Vectors is
   new Ada.Containers.Vectors (Natural, Flavour_Ref);

-- coffee_orders-flavours-factories.ads
private with Ada.Containers.Indefinite_Hashed_Maps;
private with Ada.Strings.Equal_Case_Insensitive;
private with Ada.Strings.Hash_Case_Insensitive;
private with Ada.Strings.Unbounded;
package Coffee_Orders.Flavours.Factories is
   type Factory is tagged private;
   function Get_Flavour (F    : in out Factory;
                         Name :        String)
                         return not null access Flavour;
   function Total_Flavours_Made (F : Factory) return Natural;
private
   use Ada.Strings.Unbounded;
   package Maps is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        =>
String,
                                                Element_Type    =>
Flavour,
                                                Hash            =>
Ada.Strings.Hash_Case_Insensitive,
                                                Equivalent_Keys =>
Ada.Strings.Equal_Case_Insensitive);
   type Factory is tagged record
      Flavours : Maps.Map;
   end record;
end Coffee_Orders.Flavours.Factories;

-- coffee_orders-flavours-factories.adb
package body Coffee_Orders.Flavours.Factories is
   function Get_Flavour (F    : in out Factory;
                         Name :        String) return not null access
Flavour is
      use type Maps.Cursor;
      C : constant Maps.Cursor := F.Flavours.Find (Name);
   begin
      if C /= Maps.No_Element then
         return F.Flavours.Constant_Reference (Name).Element;
      end if;
      F.Flavours.Insert (Name, Create (Name));
      return F.Flavours.Constant_Reference (Name).Element;
   end Get_Flavour;
   function Total_Flavours_Made (F : Factory) return Natural is
   begin
      return Natural (F.Flavours.Length);
   end Total_Flavours_Made;
end Coffee_Orders.Flavours.Factories;