|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 18193 (0x4711)
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⟧
--------------------------------- 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;