|
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: 24953 (0x6179)
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⟧
with String_Pkg;
use String_Pkg;
with Unchecked_Deallocation;
package body String_Scanner is
White_Space : constant String := " " & Ascii.Ht;
Number_1 : constant String := "0123456789";
Number : constant String := Number_1 & "_";
Quote : constant String := """";
Ada_Id_1 : constant String :=
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz";
Ada_Id : constant String := Ada_Id_1 & Number;
procedure Free_Scanner is new Unchecked_Deallocation (Scan_Record, Scanner);
pragma Page;
function Is_Valid (T : in Scanner) return Boolean is
begin
return T /= null;
end Is_Valid;
function Make_Scanner (S : in String_Type) return Scanner is
T : Scanner := new Scan_Record;
begin
T.Text := String_Pkg.Make_Persistent (S);
return T;
end Make_Scanner;
----------------------------------------------------------------
procedure Destroy_Scanner (T : in out Scanner) is
begin
if Is_Valid (T) then
String_Pkg.Flush (T.Text);
Free_Scanner (T);
end if;
end Destroy_Scanner;
----------------------------------------------------------------
function More (T : in Scanner) return Boolean is
begin
if Is_Valid (T) then
if T.Index > String_Pkg.Length (T.Text) then
return False;
else
return True;
end if;
else
return False;
end if;
end More;
----------------------------------------------------------------
function Get (T : in Scanner) return Character is
begin
if not More (T) then
raise Out_Of_Bounds;
end if;
return String_Pkg.Fetch (T.Text, T.Index);
end Get;
----------------------------------------------------------------
procedure Forward (T : in Scanner) is
begin
if Is_Valid (T) then
if String_Pkg.Length (T.Text) >= T.Index then
T.Index := T.Index + 1;
end if;
end if;
end Forward;
----------------------------------------------------------------
procedure Backward (T : in Scanner) is
begin
if Is_Valid (T) then
if T.Index > 1 then
T.Index := T.Index - 1;
end if;
end if;
end Backward;
----------------------------------------------------------------
procedure Next (T : in Scanner; C : out Character) is
begin
C := Get (T);
Forward (T);
end Next;
----------------------------------------------------------------
function Position (T : in Scanner) return Positive is
begin
if not More (T) then
raise Out_Of_Bounds;
end if;
return T.Index;
end Position;
----------------------------------------------------------------
function Get_String (T : in Scanner) return String_Type is
begin
if Is_Valid (T) then
return String_Pkg.Make_Persistent (T.Text);
else
return String_Pkg.Make_Persistent ("");
end if;
end Get_String;
----------------------------------------------------------------
function Get_Remainder (T : in Scanner) return String_Type is
S_Str : String_Type;
begin
if More (T) then
String_Pkg.Mark;
S_Str := String_Pkg.Make_Persistent
(String_Pkg.Substr
(T.Text, T.Index,
String_Pkg.Length (T.Text) - T.Index + 1));
String_Pkg.Release;
else
S_Str := String_Pkg.Make_Persistent ("");
end if;
return S_Str;
end Get_Remainder;
----------------------------------------------------------------
procedure Mark (T : in Scanner) is
begin
if Is_Valid (T) then
if T.Mark /= 0 then
raise Scanner_Already_Marked;
else
T.Mark := T.Index;
end if;
end if;
end Mark;
----------------------------------------------------------------
procedure Restore (T : in Scanner) is
begin
if Is_Valid (T) then
if T.Mark /= 0 then
T.Index := T.Mark;
T.Mark := 0;
end if;
end if;
end Restore;
pragma Page;
function Is_Any (T : in Scanner; Q : in String) return Boolean is
N : Natural;
begin
if not More (T) then
return False;
end if;
String_Pkg.Mark;
N := String_Pkg.Match_Any (T.Text, Q, T.Index);
if N /= T.Index then
N := 0;
end if;
String_Pkg.Release;
return N /= 0;
end Is_Any;
pragma Page;
procedure Scan_Any (T : in Scanner;
Q : in String;
Found : out Boolean;
Result : in out String_Type) is
S_Str : String_Type;
N : Natural;
begin
if Is_Any (T, Q) then
N := String_Pkg.Match_None (T.Text, Q, T.Index);
if N = 0 then
N := String_Pkg.Length (T.Text) + 1;
end if;
Result := Result & String_Pkg.Substr (T.Text, T.Index, N - T.Index);
T.Index := N;
Found := True;
else
Found := False;
end if;
end Scan_Any;
pragma Page;
function Quoted_String (T : in Scanner) return Integer is
Count : Integer := 0;
I : Positive;
N : Natural;
begin
if not Is_Valid (T) then
return Count;
end if;
I := T.Index;
while Is_Any (T, """") loop
T.Index := T.Index + 1;
if not More (T) then
T.Index := I;
return 0;
end if;
String_Pkg.Mark;
N := String_Pkg.Match_Any (T.Text, """", T.Index);
String_Pkg.Release;
if N = 0 then
T.Index := I;
return 0;
end if;
T.Index := N + 1;
end loop;
Count := T.Index - I;
T.Index := I;
return Count;
end Quoted_String;
pragma Page;
function Enclosed_String
(B : in Character; E : in Character; T : in Scanner)
return Natural is
Count : Natural := 1;
I : Positive;
Inx_B : Natural;
Inx_E : Natural;
Depth : Natural := 1;
begin
if not Is_Any (T, B & "") then
return 0;
end if;
I := T.Index;
Forward (T);
while Depth /= 0 loop
if not More (T) then
T.Index := I;
return 0;
end if;
String_Pkg.Mark;
Inx_B := String_Pkg.Match_Any (T.Text, B & "", T.Index);
Inx_E := String_Pkg.Match_Any (T.Text, E & "", T.Index);
String_Pkg.Release;
if Inx_E = 0 then
T.Index := I;
return 0;
end if;
if Inx_B /= 0 and then Inx_B < Inx_E then
Depth := Depth + 1;
else
Inx_B := Inx_E;
Depth := Depth - 1;
end if;
T.Index := Inx_B + 1;
end loop;
Count := T.Index - I;
T.Index := I;
return Count;
end Enclosed_String;
pragma Page;
function Is_Word (T : in Scanner) return Boolean is
begin
if not More (T) then
return False;
else
return not Is_Any (T, White_Space);
end if;
end Is_Word;
----------------------------------------------------------------
procedure Scan_Word (T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
S_Str : String_Type;
N : Natural;
begin
if Skip then
Skip_Space (T);
end if;
if Is_Word (T) then
String_Pkg.Mark;
N := String_Pkg.Match_Any (T.Text, White_Space, T.Index);
if N = 0 then
N := String_Pkg.Length (T.Text) + 1;
end if;
Result := String_Pkg.Make_Persistent
(String_Pkg.Substr (T.Text, T.Index, N - T.Index));
T.Index := N;
Found := True;
String_Pkg.Release;
else
Found := False;
end if;
return;
end Scan_Word;
pragma Page;
function Is_Number (T : in Scanner) return Boolean is
begin
return Is_Any (T, Number_1);
end Is_Number;
----------------------------------------------------------------
procedure Scan_Number (T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
C : Character;
S_Str : String_Type;
begin
if Skip then
Skip_Space (T);
end if;
if not Is_Number (T) then
Found := False;
return;
end if;
String_Pkg.Mark;
while Is_Number (T) loop
Scan_Any (T, Number_1, Found, S_Str);
if More (T) then
C := Get (T);
if C = '_' then
Forward (T);
if Is_Number (T) then
S_Str := S_Str & "_";
else
Backward (T);
end if;
end if;
end if;
end loop;
Result := String_Pkg.Make_Persistent (S_Str);
String_Pkg.Release;
end Scan_Number;
----------------------------------------------------------------
procedure Scan_Number (T : in Scanner;
Found : out Boolean;
Result : out Integer;
Skip : in Boolean := False) is
F : Boolean;
S_Str : String_Type;
begin
Scan_Number (T, F, S_Str, Skip);
if F then
Result := Integer'Value (String_Pkg.Value (S_Str));
end if;
Found := F;
end Scan_Number;
pragma Page;
function Is_Signed_Number (T : in Scanner) return Boolean is
I : Positive;
C : Character;
F : Boolean;
begin
if More (T) then
I := T.Index;
C := Get (T);
if C = '+' or C = '-' then
T.Index := T.Index + 1;
end if;
F := Is_Any (T, Number_1);
T.Index := I;
return F;
else
return False;
end if;
end Is_Signed_Number;
----------------------------------------------------------------
procedure Scan_Signed_Number (T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
C : Character;
S_Str : String_Type;
begin
if Skip then
Skip_Space (T);
end if;
if Is_Signed_Number (T) then
C := Get (T);
if C = '+' or C = '-' then
Forward (T);
end if;
Scan_Number (T, Found, S_Str);
String_Pkg.Mark;
if C = '+' or C = '-' then
Result := String_Pkg.Make_Persistent (("" & C) & S_Str);
else
Result := String_Pkg.Make_Persistent (S_Str);
end if;
String_Pkg.Release;
String_Pkg.Flush (S_Str);
else
Found := False;
end if;
end Scan_Signed_Number;
----------------------------------------------------------------
procedure Scan_Signed_Number (T : in Scanner;
Found : out Boolean;
Result : out Integer;
Skip : in Boolean := False) is
F : Boolean;
S_Str : String_Type;
begin
Scan_Signed_Number (T, F, S_Str, Skip);
if F then
Result := Integer'Value (String_Pkg.Value (S_Str));
end if;
Found := F;
end Scan_Signed_Number;
pragma Page;
function Is_Space (T : in Scanner) return Boolean is
begin
return Is_Any (T, White_Space);
end Is_Space;
----------------------------------------------------------------
procedure Scan_Space (T : in Scanner;
Found : out Boolean;
Result : out String_Type) is
S_Str : String_Type;
begin
String_Pkg.Mark;
Scan_Any (T, White_Space, Found, S_Str);
Result := String_Pkg.Make_Persistent (S_Str);
String_Pkg.Release;
end Scan_Space;
----------------------------------------------------------------
procedure Skip_Space (T : in Scanner) is
S_Str : String_Type;
Found : Boolean;
begin
String_Pkg.Mark;
Scan_Any (T, White_Space, Found, S_Str);
String_Pkg.Release;
end Skip_Space;
pragma Page;
function Is_Ada_Id (T : in Scanner) return Boolean is
begin
return Is_Any (T, Ada_Id_1);
end Is_Ada_Id;
----------------------------------------------------------------
procedure Scan_Ada_Id (T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
C : Character;
F : Boolean;
S_Str : String_Type;
begin
if Skip then
Skip_Space (T);
end if;
if Is_Ada_Id (T) then
String_Pkg.Mark;
Next (T, C);
Scan_Any (T, Ada_Id, F, S_Str);
Result := String_Pkg.Make_Persistent (("" & C) & S_Str);
Found := True;
String_Pkg.Release;
else
Found := False;
end if;
end Scan_Ada_Id;
pragma Page;
function Is_Quoted (T : in Scanner) return Boolean is
begin
if Quoted_String (T) = 0 then
return False;
else
return True;
end if;
end Is_Quoted;
----------------------------------------------------------------
procedure Scan_Quoted (T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
Count : Integer;
begin
if Skip then
Skip_Space (T);
end if;
Count := Quoted_String (T);
if Count /= 0 then
Count := Count - 2;
T.Index := T.Index + 1;
if Count /= 0 then
String_Pkg.Mark;
Result := String_Pkg.Make_Persistent
(String_Pkg.Substr (T.Text, T.Index,
Positive (Count)));
String_Pkg.Release;
else
Result := String_Pkg.Make_Persistent ("");
end if;
T.Index := T.Index + Count + 1;
Found := True;
else
Found := False;
end if;
end Scan_Quoted;
pragma Page;
function Is_Enclosed (B : in Character; E : in Character; T : in Scanner)
return Boolean is
begin
if Enclosed_String (B, E, T) = 0 then
return False;
else
return True;
end if;
end Is_Enclosed;
----------------------------------------------------------------
procedure Scan_Enclosed (B : in Character;
E : in Character;
T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
Count : Natural;
begin
if Skip then
Skip_Space (T);
end if;
Count := Enclosed_String (B, E, T);
if Count /= 0 then
Count := Count - 2;
T.Index := T.Index + 1;
if Count /= 0 then
String_Pkg.Mark;
Result := String_Pkg.Make_Persistent
(String_Pkg.Substr (T.Text, T.Index,
Positive (Count)));
String_Pkg.Release;
else
Result := String_Pkg.Make_Persistent ("");
end if;
T.Index := T.Index + Count + 1;
Found := True;
else
Found := False;
end if;
end Scan_Enclosed;
pragma Page;
function Is_Sequence
(Chars : in String_Type; T : in Scanner) return Boolean is
begin
return Is_Any (T, String_Pkg.Value (Chars));
end Is_Sequence;
----------------------------------------------------------------
function Is_Sequence (Chars : in String; T : in Scanner) return Boolean is
begin
return Is_Any (T, Chars);
end Is_Sequence;
----------------------------------------------------------------
procedure Scan_Sequence (Chars : in String_Type;
T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
I : Positive;
Count : Integer := 0;
begin
if Skip then
Skip_Space (T);
end if;
if not Is_Valid (T) then
Found := False;
return;
end if;
I := T.Index;
while Is_Any (T, Value (Chars)) loop
Forward (T);
Count := Count + 1;
end loop;
if Count /= 0 then
String_Pkg.Mark;
Result := String_Pkg.Make_Persistent
(String_Pkg.Substr (T.Text, I, Positive (Count)));
Found := True;
String_Pkg.Release;
else
Found := False;
end if;
end Scan_Sequence;
----------------------------------------------------------------
procedure Scan_Sequence (Chars : in String;
T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
begin
String_Pkg.Mark;
Scan_Sequence (String_Pkg.Create (Chars), T, Found, Result, Skip);
String_Pkg.Release;
end Scan_Sequence;
pragma Page;
function Is_Not_Sequence
(Chars : in String_Type; T : in Scanner) return Boolean is
N : Natural;
begin
if not Is_Valid (T) then
return False;
end if;
String_Pkg.Mark;
N := String_Pkg.Match_Any (T.Text, Chars, T.Index);
if N = T.Index then
N := 0;
end if;
String_Pkg.Release;
return N /= 0;
end Is_Not_Sequence;
----------------------------------------------------------------
function Is_Not_Sequence
(Chars : in String; T : in Scanner) return Boolean is
begin
return Is_Not_Sequence (String_Pkg.Create (Chars), T);
end Is_Not_Sequence;
----------------------------------------------------------------
procedure Scan_Not_Sequence (Chars : in String;
T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
N : Natural;
begin
if Skip then
Skip_Space (T);
end if;
if Is_Not_Sequence (Chars, T) then
String_Pkg.Mark;
N := String_Pkg.Match_Any (T.Text, Chars, T.Index);
Result := String_Pkg.Make_Persistent
(String_Pkg.Substr (T.Text, T.Index, N - T.Index));
T.Index := N;
Found := True;
String_Pkg.Release;
else
Found := False;
end if;
end Scan_Not_Sequence;
----------------------------------------------------------------
procedure Scan_Not_Sequence (Chars : in String_Type;
T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
begin
Scan_Not_Sequence (String_Pkg.Value (Chars), T, Found, Result, Skip);
end Scan_Not_Sequence;
pragma Page;
function Is_Literal
(Chars : in String_Type; T : in Scanner) return Boolean is
N : Natural;
begin
if not Is_Valid (T) then
return False;
end if;
String_Pkg.Mark;
N := String_Pkg.Match_S (T.Text, Chars, T.Index);
if N /= T.Index then
N := 0;
end if;
String_Pkg.Release;
return N /= 0;
end Is_Literal;
----------------------------------------------------------------
function Is_Literal (Chars : in String; T : in Scanner) return Boolean is
Found : Boolean;
begin
String_Pkg.Mark;
Found := Is_Literal (String_Pkg.Create (Chars), T);
String_Pkg.Release;
return Found;
end Is_Literal;
----------------------------------------------------------------
procedure Scan_Literal (Chars : in String_Type;
T : in Scanner;
Found : out Boolean;
Skip : in Boolean := False) is
begin
if Skip then
Skip_Space (T);
end if;
if Is_Literal (Chars, T) then
T.Index := T.Index + String_Pkg.Length (Chars);
Found := True;
else
Found := False;
end if;
end Scan_Literal;
----------------------------------------------------------------
procedure Scan_Literal (Chars : in String;
T : in Scanner;
Found : out Boolean;
Skip : in Boolean := False) is
begin
String_Pkg.Mark;
Scan_Literal (String_Pkg.Create (Chars), T, Found, Skip);
String_Pkg.Release;
end Scan_Literal;
pragma Page;
function Is_Not_Literal
(Chars : in String; T : in Scanner) return Boolean is
N : Natural;
begin
if not Is_Valid (T) then
return False;
end if;
String_Pkg.Mark;
N := String_Pkg.Match_S (T.Text, Chars, T.Index);
if N = T.Index then
N := 0;
end if;
String_Pkg.Release;
return N /= 0;
end Is_Not_Literal;
----------------------------------------------------------------
function Is_Not_Literal
(Chars : in String_Type; T : in Scanner) return Boolean is
begin
if not More (T) then
return False;
end if;
return Is_Not_Literal (String_Pkg.Value (Chars), T);
end Is_Not_Literal;
----------------------------------------------------------------
procedure Scan_Not_Literal (Chars : in String;
T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
N : Natural;
begin
if Skip then
Skip_Space (T);
end if;
if Is_Not_Literal (Chars, T) then
String_Pkg.Mark;
N := String_Pkg.Match_S (T.Text, Chars, T.Index);
Result := String_Pkg.Make_Persistent
(String_Pkg.Substr (T.Text, T.Index, N - T.Index));
T.Index := N;
Found := True;
String_Pkg.Release;
else
Found := False;
return;
end if;
end Scan_Not_Literal;
----------------------------------------------------------------
procedure Scan_Not_Literal (Chars : in String_Type;
T : in Scanner;
Found : out Boolean;
Result : out String_Type;
Skip : in Boolean := False) is
begin
Scan_Not_Literal (String_Pkg.Value (Chars), T, Found, Result, Skip);
end Scan_Not_Literal;
end String_Scanner;
pragma Page;