|
|
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: 5097 (0x13e9)
Types: TextFile
Names: »B«
└─⟦149519bd4⟧ Bits:30000546 8mm tape, Rational 1000, !projects 93-07-13
└─⟦124ff5788⟧ »DATA«
└─⟦this⟧
with Message_Interchange;
with Text_Io;
use Text_Io;
package body Signature is
Sep : Character renames Message_Interchange.Separator;
First : Boolean;
-- used to build images like blah#blah#blah
-- instead of #blah#blah#blah
Prototyping_Stub : exception;
function Create return Signature.Object is
begin
return Object'(others => Parameter.Null_Parameter);
end Create;
procedure Add (To_Signature : in out Signature.Object;
The_Parameter : Parameter.Object;
At_Position : Position) is
begin
To_Signature (At_Position) := The_Parameter;
end Add;
function I (Sig : Object; Pos : Iterator_Range) return String is
begin
if Pos = Iterator_Range'Last then
return ""; -- fin de la recursivite
elsif Parameter.Is_Null (Sig (Position (Pos))) then
--return I (Sig, Pos + 1);
return ""; -- fin de la recursivite
elsif First then
First := False;
return (Parameter.Image (Sig (Position (Pos))) & I (Sig, Pos + 1));
else
return (Sep & Parameter.Image (Sig (Position (Pos))) &
I (Sig, Pos + 1));
end if;
end I;
function Image (Of_Signature : Signature.Object) return String is
begin
First := True;
return I (Of_Signature, Iterator_Range (Position'First));
end Image;
function Value (Of_String : String) return Signature.Object is
S : String renames Of_String;
Name : Positive := S'First;
Next_Name : Positive := S'First;
Class : Positive := S'First;
Value : Positive := S'First;
Current : Positive := S'First;
Param_Pos : Positive := 1;
Sig : Signature.Object := Signature.Create;
begin
while Current <= S'Last loop
Locate_Name:
loop
exit when S (Class) = Sep;
Class := Class + 1;
Current := Current + 1;
end loop Locate_Name;
Current := Current + 1; -- to point after the sep
Value := Current;
Locate_Class:
loop
exit when S (Value) = Sep;
Value := Value + 1;
Current := Current + 1;
end loop Locate_Class;
Current := Current + 1; -- to point after the sep
Next_Name := Current;
Locate_Value:
loop
exit when S (Next_Name) = Sep or Next_Name = S'Last;
Next_Name := Next_Name + 1;
Current := Current + 1;
end loop Locate_Value;
Current := Current + 1; -- to point after the sep
if S (Next_Name) = Sep then
Next_Name := Next_Name - 1;
--[cheat]
-- a parameter is always in the range name .. next_name
-- this is required because there is no sep at the
-- end of the signature
end if;
Signature.Add (To_Signature => Sig,
The_Parameter => Parameter.Value
(S (Name .. Next_Name)),
At_Position => Param_Pos);
Param_Pos := Param_Pos + 1;
Name := Next_Name + 1 + 1;
-- name is incremented twice see [cheat]
Class := Name;
Value := Name;
Next_Name := Name;
end loop;
return Sig;
end Value;
procedure Init (Iter : in out Iterator;
Signature : Standard.Signature.Object) is
begin
Iter.Position := Iterator_Range (Signature'First);
Iter.Signature := Signature;
end Init;
procedure Next (Iter : in out Iterator) is
begin
Iter.Position := Iter.Position + 1;
end Next;
function Is_Done (Iter : Iterator) return Boolean is
begin
return Iter.Position = Iterator_Range'Last;
end Is_Done;
function Value (Iter : Iterator) return Parameter.Object is
begin
return Iter.Signature (Positive (Iter.Position));
end Value;
procedure Reset (Signature : in out Standard.Signature.Object) is
begin
for I in Signature'Range loop
Signature (I) := Parameter.Null_Parameter;
end loop;
end Reset;
function Is_Equal (Left, Right : Signature.Object) return Boolean is
begin
for I in Left'Range loop
if not Parameter.Is_Equal (Left (I), Right (I)) then
return False;
end if;
end loop;
return True;
end Is_Equal;
function Is_Compatible (Left, Right : Signature.Object) return Boolean is
begin
for I in Left'Range loop
if not Parameter.Is_Compatible (Left (I), Right (I)) then
return False;
end if;
end loop;
return True;
end Is_Compatible;
end Signature;