Re: User defined assignment/controlled types

[agate!howland.reston.ans.net!noc.near.net!inmet!spock!stt@ucbvax.Berkeley .EDU (Tucker Taft)]

In article <20409@goanna.cs.rmit.oz.au> dale@pitvax.xx.rmit.edu.au writes:

>In John Barnes report on Ada9x, he states:
>---
>3.2.2  Assignments and Control Structures
>An assignment statement causes the value of a variable to be replaced by that
>of an expression of the same type.  Assignment is normally performed by a
>simple bit copy of the value provided by the expression.  However, in the case
>of non-limited controlled types assignment may be defined by the user.
>---
>
>I can't find any information about non limited 
>controlled types in the document,
>nor of how any such user defined assignment would be created. I assume it will
>form the basis of the wonderful 'variable' length string package quoated
>in the document.
>
>Does anyone know where I can get more info than this?

The most recent public documents are available for anonymous ftp
from ajpo.sei.cmu.edu in the directory public/ada9x/mrtcomments/rm9x/v2.0
or .../rm9x/v2.0.compressed.

Newer versions should be showing up around July 1st.

Here is a quick summary of the user-defined assignment facility:

    Any type derived from the type Finalization.Controlled
    inherits three operations, Initialize, Finalize, and Duplicate.
    These operations may be overridden by the user in the
    normal way for derived types.  Finalize and Duplicate must
    be overridden as they are abstract subprograms.
    Initialize is called automatically when an 
    object is created without an explicit initial value.
    Finalize is called when an object "goes away," as well
    as immediately prior to being reassigned a value.
    Duplicate is called immediately after the object
    is (re)assigned a value.

    Here is the declaration for Finalization.Controlled (approximately):

     with impl-defined-package;
     package Finalization is
       type Controlled is new impl-defined-tagged-type with null record;
       Null_Controlled : constant impl-defined-tagged-type renames 
          impl-defined-constant;

       procedure Initialize(Obj : in out Controlled);  
         -- By default, does nothing
       procedure Finalize(Obj : in out Controlled) is <>;
       procedure Duplicate(Obj : in out Controlled) is <>;
         -- These two are abstract, and must be overridden
      . . .
     end Finalization;

    [The impl-defined-package, impl-defined-tagged-type, and 
     impl-defined-constant are not of interest to the user, except for the
     fact that the impl-defined-tagged-type is not an abstract
     type, so it may define a constant for use as the ancestor
     part in an extension aggregate.  See below how Null_Controlled is
     used to define Null_DString.]

    Here is how you might use the facility for a "dynamic" string:

    with Finalization;
    package Dyn_Strings is
       type DString is private;  -- dynamic array of characters
       Null_DString : constant DString;  -- the empty (dynamic) string

       function Elem(D : DString; Index : Positive) return Character
         -- Return character at given index
       procedure Set_Elem(
         D : in out DString; Index : Positive; Value : Character)
         -- Set character at given index

       function To_DString(Str : String) return DString;
       function To_String(Str : DString) return String;
         -- Conversion functions (some might prefer unary "+", aka "identity",
         --                        for these)

       function "="(L, R : DString) return Boolean;
         -- override equality so it works right
         -- (the "/=" operator is implicitly defined in terms of this)

       function "&"(L, R : DString) return DString;
       function "&"(L : DString; R : String) return DString;
       . . .
         -- Miscellaneous other operations
    private
         -- Here is a possible implementation, optimized
         -- for short strings
       Initial_Part_Max : constant := 8;  -- Strings of up
          -- to 8 chars handled without indirection.
       type String_Ptr is access String_Ptr;

       type DString is new Finalization.Controlled with
         record
            Length : Natural := 0;
            Initial_Part : String(1..Initial_Part_Max);
            The_Rest : String_Ptr := null;
         end record;

       Null_DString : constant DString := 
         (Finalization.Null_Controlled with 
           Length => 0, Initial_Part => (others => ' '), The_Rest => null);
             -- extension aggregate

       -- Announce intention to override by providing explicit declarations
       procedure Finalize(Str : in out DString);
       procedure Duplicate(Str : in out DString);
    end Dyn_Strings;
       
    with Unchecked_Deallocation;
    package body Dyn_Strings is
       function Free is new Unchecked_Deallocation(String, String_Ptr);

       -- provide implementations for Finalize and Duplicate
       procedure Finalize(Str : in out DString) is
          -- Release any heap storage and set length back to 0.
       begin
          if Str.The_Rest /= null then
             Free(Str.The_Rest);
          end if;
          Str.Length := 0;
       end Finalize;

       procedure Duplicate(Str : in out DString) is
          -- Copy any heap storage (since predefined assignment created
          -- sharing)
       begin
          if Str.The_Rest /= null then
             -- just break the sharing (could use reference counting instead)
             Str.The_Rest := new String'(Str.The_Rest.all);
          end if;
       end Duplicate;

       function "="(L, R : DString) return Boolean is
         -- override equality so it works right
       begin
           if L.Length /= R.Length then
              return False;
           elsif L.Length <= Initial_Part_Max then
              return L.Initial_Part(1..L.Length) = R.Initial_Part(1..L.Length);
           else
              return L.Initial_Part = R.Initial_Part and then
                 L.The_Rest.all = R.The_Rest.all;
           end if;
       end "=";

       function To_DString(Str : String) return DString is
          Result : DString;
       begin
          if Str'Length > Initial_Part_Max then
             -- Long string, needs some heap storage for tail of string
             Result.The_Rest := 
               new String'(
                 Str(Str'First + Initial_Part_Max .. Str'Last));
             -- Now copy the initial part
             Result.Initial_Part := 
               Str(Str'First .. Str'First + Initial_Part_Max-1);
          else
             -- No heap storage needed, just copy the string
             Result.Initial_Part(1..Str'Length) := Str;
          end if;

          -- set length and return result
          Result.Length := Str'Length;
          return Result;
       end To_DString;

       ... -- and so on for other operations
    end Dyn_Strings;

The above type now supports assignment like any 
>Thanks in advance

My pleasure.  The above is perhaps more than you wanted to
see in the reply, but others might find the example interesting...

>Dale Stanbrough
>RMIT (Royal Melbourne Institute of Technology)
>Melbourne Australia.
>dale@goanna.cs.rmit.edu.au

S. Tucker Taft     stt@inmet.com
Ada 9X Mapping/Revision Team
Intermetrics, Inc.
Cambridge, MA  02138