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

--+ TITLE:    Generic package for variable length strings.
--+ SUPPORT:  S.R.Y. LOUBOUTIN CGL-DMA-EPFL.
--+ APPROVAL: 02-FEB-87 A. STROHMEIER.
--+ CREATION: 12-AUG-86 C. GENILLARD.

package body Varying_String_G is
-----------------------------

--/ LOCAL SUBPROGRAM:
    function Min (A, B : Integer) return Integer is
    begin
        if A < B then
            return A;
        else
            return B;
        end if;
    end Min;
    pragma Inline (Min);

--/ LOCAL SUBPROGRAM:
    function Max (A, B : Integer) return Integer is
    begin
        if A > B then
            return A;
        else
            return B;
        end if;
    end Max;
    pragma Inline (Max);

    function To_V_String (Source : Character) return V_String is
    begin
        return (S => (1, (1 => Source)));
    end To_V_String;

    function To_V_String (Source : String) return V_String is
        Length : constant Natural := Source'Length;
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        declare
            subtype Str_Type is String (1 .. Length);
        begin
            return (S => (Length, Str_Type (Source)));
        end;
    end To_V_String;

    function To_V_String (Source : Integer) return V_String is
        Str : constant String := Integer'Image (Source);
        Length : constant Positive := Str'Length;
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        return (S => (Length, Str));
    end To_V_String;


    function To_Character (Source : V_String; Position : Positive := 1)
                          return Character is
    begin
        if Position > Source.S.Length then
            raise V_String_Position_Error;
        end if;
        return Source.S.Str (Position);
    end To_Character;

    function To_String (Source : V_String) return String is
    begin
        return Source.S.Str;
    end To_String;

    function To_Integer (Source : V_String) return Integer is
    begin
        return Integer'Value (Source.S.Str);
        -- may raise CONSTRAINT_ERROR
    end To_Integer;


    function Length (Source : V_String) return Natural is
    begin
        return Source.S.Length;
    end Length;


    function "&" (Left : V_String; Right : V_String) return V_String is
        Length : constant Natural := Left.S.Length + Right.S.Length;
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        return (S => (Length, Left.S.Str & Right.S.Str));
    end "&";

    function "&" (Left : V_String; Right : String) return V_String is
        Length : constant Natural := Left.S.Length + Right'Length;
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        declare
            subtype Str_Type is String (1 .. Length);
        begin
            return (S => (Length, Str_Type (Left.S.Str & Right)));
        end;
    end "&";

    function "&" (Left : String; Right : V_String) return V_String is
        Length : constant Natural := Left'Length + Right.S.Length;
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        declare
            subtype Str_Type is String (1 .. Length);
        begin
            return (S => (Length, Str_Type (Left & Right.S.Str)));
        end;
    end "&";

    function "&" (Left : V_String; Right : Character) return V_String is
        Length : constant Natural := Left.S.Length + 1;
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        return (S => (Length, Left.S.Str & Right));
    end "&";

    function "&" (Left : Character; Right : V_String) return V_String is
        Length : constant Natural := 1 + Right.S.Length;
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        return (S => (Length, Left & Right.S.Str));
    end "&";


    function "*" (Pattern : Character; Count : Natural) return V_String is
    begin
        if Count > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        return (S => (Count, (1 .. Count => Pattern)));
    end "*";

    function "*" (Count : Natural; Pattern : Character) return V_String is
    begin
        if Count > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        return (S => (Count, (1 .. Count => Pattern)));
    end "*";

    function "*" (Pattern : String; Count : Natural) return V_String is
        Length : constant Natural := Count * Pattern'Length;
        Str : String (1 .. Length);
        Pos : Natural;
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        for I in 0 .. Count - 1 loop
            Pos := I * Pattern'Length;
            Str (Pos + 1 .. Pos + Pattern'Length) := Pattern;
        end loop;
        return (S => (Length, Str));
    end "*";

    function "*" (Count : Natural; Pattern : String) return V_String is
        Length : constant Natural := Count * Pattern'Length;
        Str : String (1 .. Length);
        Pos : Natural;
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        for I in 0 .. Count - 1 loop
            Pos := I * Pattern'Length;
            Str (Pos + 1 .. Pos + Pattern'Length) := Pattern;
        end loop;
        return (S => (Length, Str));
    end "*";

    function "*" (Pattern : V_String; Count : Natural) return V_String is
        Length : constant Natural := Count * Pattern.S.Length;
        Str : String (1 .. Length);
        Pos : Natural;
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        for I in 0 .. Count - 1 loop
            Pos := I * Pattern.S.Length;
            Str (Pos + 1 .. Pos + Pattern.S.Length) := Pattern.S.Str;
        end loop;
        return (S => (Length, Str));
    end "*";

    function "*" (Count : Natural; Pattern : V_String) return V_String is
        Length : constant Natural := Count * Pattern.S.Length;
        Str : String (1 .. Length);
        Pos : Natural;
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        for I in 0 .. Count - 1 loop
            Pos := I * Pattern.S.Length;
            Str (Pos + 1 .. Pos + Pattern.S.Length) := Pattern.S.Str;
        end loop;
        return (S => (Length, Str));
    end "*";


    function "<" (Left, Right : V_String) return Boolean is
    begin
        return Left.S.Str < Right.S.Str;
    end "<";

    function "<=" (Left, Right : V_String) return Boolean is
    begin
        return Left.S.Str <= Right.S.Str;
    end "<=";

    function ">" (Left, Right : V_String) return Boolean is
    begin
        return Left.S.Str > Right.S.Str;
    end ">";

    function ">=" (Left, Right : V_String) return Boolean is
    begin
        return Left.S.Str >= Right.S.Str;
    end ">=";


    function Substring (Source : V_String;
                        Position : Positive := 1;
                        Size : Natural := Max_Length) return V_String is
        Length : Natural;
    begin
        if Position > Source.S.Length then
            raise V_String_Position_Error;
        end if;
        Length := Min (Source.S.Length - Position + 1, Size);
        declare
            subtype Str_Type is String (1 .. Length);
        begin
            return (S => (Length,
                          Str_Type (Source.S.Str
                                       (Position .. Position + Length - 1))));
        end;
    end Substring;


    procedure Delete (Destination : in out V_String;
                      Position : in Positive := 1;
                      Size : in Natural := Max_Length) is
        Length_Deleted : Natural;
        New_D_Length : Natural;
        D_S : Indirect_V_String renames Destination.S;
    begin
        if Position > D_S.Length then
            raise V_String_Position_Error;
        end if;
        if Size > 0 then
            Length_Deleted := Min (D_S.Length - Position + 1, Size);
            New_D_Length := D_S.Length - Length_Deleted;
            declare
                subtype Str_Type is String (1 .. New_D_Length);
            begin
                D_S := (New_D_Length,
                        Str_Type (D_S.Str (1 .. Position - 1) &
                                  D_S.Str (Position + Length_Deleted ..
                                              D_S.Length)));
                -- Type conversion to STR_TYPE for forcing first index to 1.
            end;
        end if;
    end Delete;


    procedure Truncate (Destination : in out V_String; Size : in Natural) is
        D_S : Indirect_V_String renames Destination.S;
    begin
        if Size < D_S.Length then
            D_S := (Size, D_S.Str (1 .. Size));
        end if;
    end Truncate;


    procedure Insert (Destination : in out V_String;
                      Source : in V_String;
                      Position : in Positive) is
        D_S : Indirect_V_String renames Destination.S;
        New_D_Length : constant Natural := Source.S.Length + D_S.Length;
    begin
        if Position > D_S.Length + 1 then
            raise V_String_Position_Error;
        end if;
        if New_D_Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        D_S := (New_D_Length, D_S.Str (1 .. Position - 1) & Source.S.Str &
                                 D_S.Str (Position .. D_S.Length));
    end Insert;

    procedure Insert (Destination : in out V_String;
                      Source : in String;
                      Position : in Positive) is
        D_S : Indirect_V_String renames Destination.S;
        New_D_Length : constant Natural := Source'Length + D_S.Length;
    begin
        if Position > D_S.Length + 1 then
            raise V_String_Position_Error;
        end if;
        if New_D_Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        declare
            subtype Str_Type is String (1 .. New_D_Length);
        begin
            D_S := (New_D_Length, Str_Type
                                     (D_S.Str (1 .. Position - 1) & Source &
                                      D_S.Str (Position .. D_S.Length)));
            -- Type conversion to STR_TYPE for forcing first index to 1.
        end;
    end Insert;

    procedure Insert (Destination : in out V_String;
                      Source : in Character;
                      Position : in Positive) is
        D_S : Indirect_V_String renames Destination.S;
        New_D_Length : constant Natural := 1 + D_S.Length;
    begin
        if Position > D_S.Length + 1 then
            raise V_String_Position_Error;
        end if;
        if New_D_Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        D_S := (New_D_Length, D_S.Str (1 .. Position - 1) & Source &
                                 D_S.Str (Position .. D_S.Length));
    end Insert;


    procedure Replace (Destination : in out V_String;
                       Source : in V_String;
                       Position : in Positive := 1) is
        D_S : Indirect_V_String renames Destination.S;
        New_D_Length : Natural;
    begin
        if Position > D_S.Length + 1 then
            raise V_String_Position_Error;
        end if;
        New_D_Length := Max (D_S.Length, Position + Source.S.Length - 1);
        if New_D_Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        D_S := (New_D_Length,
                D_S.Str (1 .. Position - 1) & Source.S.Str &
                   D_S.Str (Position + Source.S.Length .. D_S.Length));
    end Replace;

    procedure Replace (Destination : in out V_String;
                       Source : in String;
                       Position : in Positive := 1) is
        D_S : Indirect_V_String renames Destination.S;
        New_D_Length : Natural;
    begin
        if Position > D_S.Length + 1 then
            raise V_String_Position_Error;
        end if;
        New_D_Length := Max (D_S.Length, Position + Source'Length - 1);
        if New_D_Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        declare
            subtype Str_Type is String (1 .. New_D_Length);
        begin
            D_S := (New_D_Length,
                    Str_Type (D_S.Str (1 .. Position - 1) & Source &
                              D_S.Str (Position + Source'Length ..
                                          D_S.Length)));
        end;
    end Replace;

    procedure Replace (Destination : in out V_String;
                       Source : in Character;
                       Position : in Positive := 1) is
        D_S : Indirect_V_String renames Destination.S;
    begin
        if Position > D_S.Length + 1 then
            raise V_String_Position_Error;
        end if;
        if Position > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        if Position = D_S.Length + 1 then
            D_S := (D_S.Length + 1, D_S.Str & Source);
        else
            D_S.Str (Position) := Source;
        end if;
    end Replace;


    function Lower_Case (Source : V_String) return V_String is
        Up_Low : constant := Character'Pos ('a') - Character'Pos ('A');
        S : Indirect_V_String := Source.S;
    begin
        for I in 1 .. S.Length loop
            if S.Str (I) in 'A' .. 'Z' then
                S.Str (I) := Character'Val (Character'Pos (S.Str (I)) + Up_Low);
            end if;
        end loop;
        return (S => S);
    end Lower_Case;


    function Upper_Case (Source : V_String) return V_String is
        Low_Up : constant := Character'Pos ('A') - Character'Pos ('a');
        S : Indirect_V_String := Source.S;
    begin
        for I in 1 .. S.Length loop
            if S.Str (I) in 'a' .. 'z' then
                S.Str (I) := Character'Val (Character'Pos (S.Str (I)) + Low_Up);
            end if;
        end loop;
        return (S => S);
    end Upper_Case;


    function Position (Source : V_String;
                       Pattern : V_String;
                       Start : Positive := 1) return Natural is
        P_Length : constant V_String_Length := Pattern.S.Length;
        Index : Positive := Start;
        Limit : constant Integer := Source.S.Length - P_Length + 1;
    begin
        loop
            if Index > Limit then
                return 0;
            end if;
            if Pattern.S.Str = Source.S.Str (Index .. Index + P_Length - 1) then
                return Index;
            else
                Index := Index + 1;
            end if;
        end loop;
    end Position;

    function Position
                (Source : V_String; Pattern : String; Start : Positive := 1)
                return Natural is
        P_Length : constant Natural := Pattern'Length;
        Index : Positive := Start;
        Limit : constant Integer := Source.S.Length - P_Length + 1;
    begin
        loop
            if Index > Limit then
                return 0;
            end if;
            if Pattern = Source.S.Str (Index .. Index + P_Length - 1) then
                return Index;
            else
                Index := Index + 1;
            end if;
        end loop;
    end Position;

    function Position (Source : V_String;
                       Pattern : Character;
                       Start : Positive := 1;
                       Same : Boolean := True) return Natural is
        Index : Positive := Start;
        Limit : constant Integer := Source.S.Length;
    begin
        loop
            if Index > Limit then
                return 0;
            end if;
            if Pattern = Source.S.Str (Index) xor Same then
                Index := Index + 1;
            else
                return Index;
            end if;
        end loop;
    end Position;


    procedure Get (Destination : out V_String; Length : in Natural) is
        Str : String (1 .. Length);
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        Get (Str);
        Destination.S := (Length, Str);
    end Get;

    procedure Get (File : in File_Type;
                   Destination : out V_String;
                   Length : in Natural) is
        Str : String (1 .. Length);
    begin
        if Length > Max_V_String_Length then
            raise V_String_Length_Error;
        end if;
        Get (File, Str);
        Destination.S := (Length, Str);
    end Get;


    procedure Put (Source : in V_String) is
    begin
        Put (Source.S.Str);
    end Put;

    procedure Put (File : in File_Type; Source : in V_String) is
    begin
        Put (File, Source.S.Str);
    end Put;


    procedure Get_Line (Destination : out V_String) is
        Str : String (1 .. Max_V_String_Length);
        Last : Natural;
    begin
        Get_Line (Str, Last);
        Destination.S := (Last, Str (1 .. Last));
    end Get_Line;

    procedure Get_Line (File : in File_Type; Destination : out V_String) is
        Str : String (1 .. Max_V_String_Length);
        Last : Natural;
    begin
        Get_Line (File, Str, Last);
        Destination.S := (Last, Str (1 .. Last));
    end Get_Line;


    procedure Put_Line (Source : in V_String) is
    begin
        Put_Line (Source.S.Str);
    end Put_Line;

    procedure Put_Line (File : in File_Type; Source : in V_String) is
    begin
        Put_Line (File, Source.S.Str);
    end Put_Line;

end Varying_String_G;