DataMuseum.dk

top - metrics - download

    Length: 6185 (0x1829)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

--------------------------------- COPYRIGHT ------------------------------------
-- (C) 1986 Swiss Federal Institute of Technology (EPFL).                     --
--     Represented by A. Strohmeier DMA-EPFL 1015 Lausanne Switzerland.       --
--     All Rights Reserved.                                                   --
--------------------------------------------------------------------------------

--+ TITLE:      PACKAGE FOR STORED STRING OF VARIABLE LENGTH.
--+ SUPPORT:    S.R.Y. Louboutin CGL-DMA-EPFL 1015 LAUSANNE.
--+ APPROVAL:   16-APR-87 C. Genillard
--+ REVISION 1: 04-APR-87 A. Strohmeier. Suppression of the subprograms with
--+ parameter or result of type V_STRING. Normalization of the representation
--+ of a null STRING as a null pointer.
--+ CREATION:   11-SEP-86 F. Mercier.

with Unchecked_Deallocation;

package body Stored_String is

--+ ALGORITHM:
--+   A null string is always represented by a null pointer. The alternative
--+ representation of a pointer to a null string is never used.

--/ LOCAL SUBPROGRAM:
    procedure Dispose is new Unchecked_Deallocation
                                (Object => String, Name => S_String);
    pragma Inline (Dispose);

--/ CONSTRUCTORS:

    procedure Create (Destination : in out S_String; Source : in Character) is
    begin
        Dispose (Destination);
        Destination := new String'((1 => Source));
    end Create;

    procedure Create (Destination : in out S_String; Source : in String) is
    begin
        Dispose (Destination);
        if Source /= "" then
            Destination := new String'(Source);
        end if;
    end Create;

    procedure Assign (Destination : in out S_String; Source : in S_String) is
    begin
        if Access_String (Destination) /= Access_String (Source) then
            Dispose (Destination);
            if Access_String (Source) /= null then
                Destination := new String'(Source.all);
            end if;
        end if;
    end Assign;

--/ QUERIES:

    function Is_Empty (Source : S_String) return Boolean is
    begin
        return Access_String (Source) = null;
    end Is_Empty;

    function Length (Source : S_String) return Natural is
    begin
        if Access_String (Source) = null then
            return 0;
        else
            return Source.all'Length;
        end if;
    end Length;

    function To_String (Source : S_String) return String is
    begin
        if Access_String (Source) = null then
            return "";
        else
            return Source.all;
        end if;
    end To_String;

    function "<" (Left : S_String; Right : S_String) return Boolean is
    begin
        if Access_String (Right) = null then
            return False;
        elsif Access_String (Left) = null then
            return True;
        else
            return Left.all < Right.all;
        end if;
    end "<";

    function "<" (Left : S_String; Right : String) return Boolean is
    begin
        if Right = "" then
            return False;
        elsif Access_String (Left) = null then
            return True;
        else
            return Left.all < Right;
        end if;
    end "<";

    function "<" (Left : String; Right : S_String) return Boolean is
    begin
        if Access_String (Right) = null then
            return False;
        else
            return Left < Right.all;
        end if;
    end "<";

    function "<=" (Left : S_String; Right : S_String) return Boolean is
    begin
        if Access_String (Left) = null then
            return True;
        elsif Access_String (Right) = null then
            return False;
        else
            return Left.all <= Right.all;
        end if;
    end "<=";

    function "<=" (Left : S_String; Right : String) return Boolean is
    begin
        if Access_String (Left) = null then
            return True;
        else
            return Left.all <= Right;
        end if;
    end "<=";

    function "<=" (Left : String; Right : S_String) return Boolean is
    begin
        if Left = "" then
            return True;
        elsif Access_String (Right) = null then
            return False;
        else
            return Left <= Right.all;
        end if;
    end "<=";

    function ">" (Left : S_String; Right : S_String) return Boolean is
    begin
        return Right < Left;
    end ">";

    function ">" (Left : S_String; Right : String) return Boolean is
    begin
        return Right < Left;
    end ">";

    function ">" (Left : String; Right : S_String) return Boolean is
    begin
        return Right < Left;
    end ">";

    function ">=" (Left : S_String; Right : S_String) return Boolean is
    begin
        return Right <= Left;
    end ">=";

    function ">=" (Left : S_String; Right : String) return Boolean is
    begin
        return Right <= Left;
    end ">=";

    function ">=" (Left : String; Right : S_String) return Boolean is
    begin
        return Right <= Left;
    end ">=";

    function "=" (Left, Right : S_String) return Boolean is
    begin
        if Access_String (Left) = null and Access_String (Right) = null then
            return True;
        elsif Access_String (Left) = null then
            return False;
        elsif Access_String (Right) = null then
            return False;
        else
            return Left.all = Right.all;
        end if;
    end "=";

    function Equal (Left : S_String; Right : S_String) return Boolean is
    begin
        return Left = Right;
    end Equal;

    function Equal (Left : S_String; Right : String) return Boolean is
    begin
        if Access_String (Left) = null then
            return Right = "";
        else
            return Left.all = Right;
        end if;
    end Equal;

    function Equal (Left : String; Right : S_String) return Boolean is
    begin
        if Access_String (Right) = null then
            return Left = "";
        else
            return Left = Right.all;
        end if;
    end Equal;

--/ HEAP MANAGEMENT:

    procedure Destroy (Source : in out S_String) is
    begin
        if Access_String (Source) /= null then
            Dispose (Source);
        end if;
    end Destroy;

end Stored_String;