|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 16384 (0x4000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Ext_String, seg_0491a1
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Lex, Text_Io, Our_String;
use Lex;
package body Ext_String is
subtype Chiffres is Character range '0' .. '9';
subtype Minuscules is Character range 'a' .. 'z';
subtype Majuscules is Character range 'A' .. 'Z';
Val_False : constant String := Boolean'Image (False);
Val_True : constant String := Boolean'Image (True);
Verify_Is_On_Line : Boolean := True;
Output_Is_Standard : Boolean := True;
----------------------------------------------------------------------------
-- Procedures d'ecriture du fichier de verification --
----------------------------------------------------------------------------
procedure Init_Verify_False is
begin
Verify_Is_On_Line := False;
Output_Is_Standard := True;
end Init_Verify_False;
----------------------------------------------------------------------------
procedure Init_Verify_True is
begin
Verify_Is_On_Line := True;
Output_Is_Standard := True;
end Init_Verify_True;
----------------------------------------------------------------------------
procedure Init_Verify_True (Verify : Text_Io.File_Type) is
begin
Text_Io.Set_Output (Verify);
Verify_Is_On_Line := True;
Output_Is_Standard := True;
end Init_Verify_True;
----------------------------------------------------------------------------
function Verify_Is_Ok return Boolean is
begin
return Verify_Is_On_Line;
end Verify_Is_Ok;
----------------------------------------------------------------------------
function Verify_Output return Text_Io.File_Type is
begin
if Output_Is_Standard then
return Text_Io.Standard_Output;
else
return Text_Io.Current_Output;
end if;
end Verify_Output;
----------------------------------------------------------------------------
procedure Verify_New_Line is
begin
if Verify_Is_On_Line then
Text_Io.New_Line (File => Verify_Output);
end if;
end Verify_New_Line;
----------------------------------------------------------------------------
procedure Verify_Print (My_Message : String) is
begin
if Verify_Is_On_Line then
Text_Io.Put_Line (File => Verify_Output, Item => My_Message);
end if;
end Verify_Print;
----------------------------------------------------------------------------
procedure Verify_Print (My_Message : Var_String) is
begin
Verify_Print (Our_String.Image (My_Message));
end Verify_Print;
----------------------------------------------------------------------------
procedure Print_New_Line is
begin
Text_Io.New_Line;
if not Output_Is_Standard then
Verify_New_Line;
end if;
end Print_New_Line;
----------------------------------------------------------------------------
procedure Print (My_Message : String) is
begin
Text_Io.Put_Line (Item => My_Message);
if not Output_Is_Standard then
Verify_Print (My_Message);
end if;
end Print;
----------------------------------------------------------------------------
procedure Print (My_Message : Var_String) is
begin
Print (Our_String.Image (My_Message));
end Print;
----------------------------------------------------------------------------
-- Fonctions de consultation --
----------------------------------------------------------------------------
function Is_Token_Op (Val : Var_String) return Boolean is
Local : constant String := Our_String.Image (Val);
begin
return (Local = "+") or else (Local = "-") or else
(Local = "*") or else (Local = "/") or else
(Local = "=") or else (Local = "<>") or else
(Local = "<") or else (Local = "<=") or else
(Local = ">") or else (Local = ">=") or else
(Local = "non") or else (Local = "et") or else
(Local = "ou") or else (Local = ".") or else
(Local = ",") or else (Local = "(") or else (Local = ")");
end Is_Token_Op;
----------------------------------------------------------------------------
function Is_Boolean (Val : Var_String) return Boolean is
Local : constant String := Our_String.Image (Val);
begin
return ((Local = Val_False) or else (Local = Val_True));
end Is_Boolean;
----------------------------------------------------------------------------
function Is_Integer (Val : Var_String) return Boolean is
Local : constant String := Our_String.Image (Val);
begin
if (Local (Local'First) in Chiffres) then
return True;
elsif (Local (Local'First + 1) in Chiffres) then
case (Local (Local'First)) is
when ' ' | '+' | '-' =>
return True;
when others =>
return False;
end case;
else
return False;
end if;
end Is_Integer;
----------------------------------------------------------------------------
function Is_String (Val : Var_String) return Boolean is
Local : constant String := Our_String.Image (Val);
begin
return ((Local (Local'First) in Minuscules) or else
(Local (Local'First) in Majuscules)) and then
not (Is_Boolean (Val) or else Is_Token_Op (Val));
end Is_String;
----------------------------------------------------------------------------
-- Fonctions de conversion --
----------------------------------------------------------------------------
function Convert (Val : Var_String) return Lex.Token is
Local : constant String := Our_String.Image (Val);
begin
if (Local = "+") then
return Plus;
elsif (Local = "-") then
return Minus;
elsif (Local = "*") then
return Cross;
elsif (Local = "/") then
return Slash;
elsif (Local = "=") then
return Equal;
elsif (Local = "<>") then
return Not_Equal;
elsif (Local = "<") then
return Less;
elsif (Local = "<=") then
return Less_Equal;
elsif (Local = ">") then
return Great;
elsif (Local = ">=") then
return Great_Equal;
elsif (Local = "non") then
return Non;
elsif (Local = "et") then
return Et;
elsif (Local = "ou") then
return Ou;
elsif (Local = ".") then
return Dot;
elsif (Local = ",") then
return Coma;
elsif (Local = "(") then
return Left_Bracket;
elsif (Local = ")") then
return Right_Bracket;
end if;
end Convert;
----------------------------------------------------------------------------
function Convert (Val : Var_String) return Boolean is
begin
if Is_Boolean (Val) then
return Boolean'Value (Our_String.Image (Val));
end if;
end Convert;
----------------------------------------------------------------------------
function Convert (Val : Var_String) return Integer is
begin
if Is_Integer (Val) then
return Integer'Value (Our_String.Image (Val));
end if;
end Convert;
----------------------------------------------------------------------------
function Convert (Val : Lex.Token) return Var_String is
begin
case Val is
when Plus =>
return Our_String.Value ("+");
when Minus =>
return Our_String.Value ("-");
when Cross =>
return Our_String.Value ("*");
when Slash =>
return Our_String.Value ("/");
when Equal =>
return Our_String.Value ("=");
when Not_Equal =>
return Our_String.Value ("<>");
when Less =>
return Our_String.Value ("<");
when Less_Equal =>
return Our_String.Value ("<=");
when Great =>
return Our_String.Value (">");
when Great_Equal =>
return Our_String.Value (">=");
when Non =>
return Our_String.Value ("non");
when Et =>
return Our_String.Value ("et");
when Ou =>
return Our_String.Value ("ou");
when Dot =>
return Our_String.Value (".");
when Coma =>
return Our_String.Value (",");
when Left_Bracket =>
return Our_String.Value ("(");
when Right_Bracket =>
return Our_String.Value (")");
when others =>
return Our_String.Value ("INCONNU");
end case;
end Convert;
----------------------------------------------------------------------------
function Convert (Val : Boolean) return Var_String is
begin
return Our_String.Value (Boolean'Image (Val));
end Convert;
----------------------------------------------------------------------------
function Convert (Val : Integer) return Var_String is
begin
return Our_String.Value (Integer'Image (Val));
end Convert;
----------------------------------------------------------------------------
function Convert (Val : Var_String) return Var_String is
begin
return Val;
end Convert;
----------------------------------------------------------------------------
-- Fonctions de consultation --
----------------------------------------------------------------------------
function Cmp (Val1, Val2 : Var_String) return Boolean is
begin
return (Our_String.Image (Val1) = Our_String.Image (Val2));
end Cmp;
function Cmp (Val1 : Var_String; Val2 : String) return Boolean is
begin
return (Our_String.Image (Val1) = Val2);
end Cmp;
function Cmp (Val1 : String; Val2 : Var_String) return Boolean is
begin
return (Val1 = Our_String.Image (Val2));
end Cmp;
----------------------------------------------------------------------------
-- Fonctions de concatenation --
----------------------------------------------------------------------------
function "&" (Val1, Val2 : Var_String) return Var_String is
begin
return Our_String.Value (Our_String.Image (Val1) &
Our_String.Image (Val2));
end "&";
function "&" (Val1 : Var_String; Val2 : String) return Var_String is
begin
return Our_String.Value (Our_String.Image (Val1) & Val2);
end "&";
function "&" (Val1 : String; Val2 : Var_String) return Var_String is
begin
return Our_String.Value (Val1 & Our_String.Image (Val2));
end "&";
----------------------------------------------------------------------------
end Ext_String;
nblk1=f
nid=5
hdr6=1a
[0x00] rec0=1d rec1=00 rec2=01 rec3=01a
[0x01] rec0=1d rec1=00 rec2=0f rec3=012
[0x02] rec0=1d rec1=00 rec2=08 rec3=08e
[0x03] rec0=19 rec1=00 rec2=02 rec3=054
[0x04] rec0=07 rec1=00 rec2=0e rec3=024
[0x05] rec0=1a rec1=00 rec2=03 rec3=01a
[0x06] rec0=1f rec1=00 rec2=0b rec3=018
[0x07] rec0=27 rec1=00 rec2=0c rec3=074
[0x08] rec0=21 rec1=00 rec2=0a rec3=014
[0x09] rec0=26 rec1=00 rec2=0d rec3=032
[0x0a] rec0=0b rec1=00 rec2=09 rec3=02e
[0x0b] rec0=1b rec1=00 rec2=04 rec3=070
[0x0c] rec0=16 rec1=00 rec2=06 rec3=000
[0x0d] rec0=05 rec1=00 rec2=07 rec3=000
[0x0e] rec0=00 rec1=00 rec2=00 rec3=019
tail 0x215467564865b44cc030f 0x42a00088462060003
Free Block Chain:
0x5: 0000 00 07 03 fc 00 21 20 20 20 20 20 20 20 20 69 66 ┆ ! if┆
0x7: 0000 00 00 00 0f 80 0c 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ┆ ----------┆