|
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 - downloadIndex: ┃ B T ┃
Length: 14411 (0x384b)
Types: TextFile
Names: »B«
└─⟦5829e5ed5⟧ Bits:30000534 8mm tape, Rational 1000, RCI 2_0_5
└─ ⟦c9a165082⟧ »DATA«
└─⟦2162db02b⟧
└─⟦this⟧
separate (Parameter_Parser)
procedure Parse (Parameter : String;
Options : out Iterator;
Success : out Boolean) is
Iter : Iterator := new Iterator_Data;
Itns : Iteration;
procedure Parse (Parameter : String) is
Pos : Integer := Parameter'First;
Last : Integer := Parameter'Last;
Token : Token_Kind;
Start, Finish : Integer;
Name : Image;
Value : Image;
function New_Iteration (Id : Option_Id) return Iteration is
Itn : Iteration := new Iteration_Data;
begin
Itn.Name := Find (Id);
if Itn.Name /= null then
Itn.Status := Ok;
else
Itn.Status := Undefined_Id;
Itn.Diagnosis := new String'(Option_Id'Image (Id));
end if;
return Itn;
end New_Iteration;
function New_Iteration (Name : Image) return Iteration is
Itn : Iteration := new Iteration_Data;
Id : Option_Id;
begin
if Name = null then
Itn.Status := Missing_Name;
Itn.Diagnosis := new String'(Parameter (Start .. Finish));
else
declare
Norm : constant String := Normal (Name.all);
begin
Itn.Name := Find (Norm, True);
if Itn.Name = null then
Itn.Status := Undefined_Name;
Itn.Diagnosis := Name;
return Itn;
end if;
if Norm /= Itn.Name.Name.all and then
Find (Norm, True, Itn.Name.Next) /= null then
Itn.Name := Find (Norm); -- look for exact match
if Itn.Name = null then
-- No exact, 2 prefixes match
Itn.Status := Ambiguous_Name;
Itn.Diagnosis := Name;
return Itn;
end if;
end if;
Itn.Status := Ok;
Itn.Kind := Itn.Name.Kind;
if Itn.Kind = Literal then
Itn.Value := Name;
Id := Itn.Name.Id;
Itn.Name := Find (Id);
if Itn.Name = null then
Itn.Status := Undefined_Id;
Itn.Diagnosis := new String'(Option_Id'Image (Id));
end if;
end if;
end;
end if;
return Itn;
end New_Iteration;
procedure Add_Iteration (Itn : Iteration) is
Pnt : Iteration;
begin
if Itn.Status = Ok then
Pnt := Itns;
while Pnt /= null loop
if Pnt.Status = Ok and then Pnt.Name.Id = Itn.Name.Id then
return;
else
Pnt := Pnt.Next;
end if;
end loop;
end if;
Itn.Next := Itns;
Itns := Itn;
end Add_Iteration;
procedure Add_Iteration (Name1 : Image) is
begin
Add_Iteration (New_Iteration (Name1));
end Add_Iteration;
procedure Add_Iteration (Name1, Name2 : Image) is
Itn1 : Iteration;
Itn2 : Iteration;
begin
Itn1 := New_Iteration (Name1);
Itn2 := New_Iteration (Name2);
Add_Iteration (Itn1);
if Itn1.Status = Ok and then Itn2.Status = Ok then
for I in Option_Id'Succ (Itn1.Name.Id) ..
Option_Id'Pred (Itn2.Name.Id) loop
Add_Iteration (New_Iteration (I));
end loop;
end if;
Add_Iteration (Itn2);
end Add_Iteration;
procedure Add_Range (Id1, Id2 : Option_Id) is
Opt : Option;
Itn : Iteration;
begin
for Id in Id1 .. Id2 loop
Opt := Find (Id);
if Opt /= null then
Itn := new Iteration_Data;
Itn.Name := Opt;
Itn.Status := Ok;
Add_Iteration (Itn);
end if;
end loop;
end Add_Range;
procedure Eat_Token is
begin
loop
if Pos not in Parameter'First .. Last then
Token := End_String;
Start := Parameter'First;
Finish := Start - 1;
return;
end if;
exit when Parameter (Pos) /= ' ';
Pos := Pos + 1;
end loop;
Start := Pos;
Finish := Pos;
Token := Other;
case Parameter (Pos) is
when '=' =>
if Pos < Last and then Parameter (Pos + 1) = '>' then
Finish := Pos + 1;
end if;
Token := Arrow;
when ':' =>
if Pos < Last and then Parameter (Pos + 1) = '=' then
Finish := Pos + 1;
Token := Arrow;
end if;
when '|' =>
Token := Bar;
when '.' =>
if Pos < Last and then Parameter (Pos + 1) = '.' then
Finish := Pos + 1;
Token := Dots;
end if;
when '~' =>
Token := Tilde;
when ',' | ';' | Ascii.Lf =>
Token := Separator;
when others =>
null;
end case;
Pos := Finish + 1;
end Eat_Token;
procedure Get_Value is
D : Integer := 0;
begin
case Token is
when Separator | End_String =>
-- null Value
Pos := Finish;
Finish := Start - 1;
when others =>
if Parameter (Start) = '(' or else
Parameter (Start) = '[' or else
Parameter (Start) = '{' then
while Pos <= Last loop
case Parameter (Pos) is
when '(' | '[' | '{' =>
D := D + 1;
when ')' | ']' | '}' =>
exit when D = 0;
D := D - 1;
when '\' =>
Pos := Pos + 1;
when others =>
null;
end case;
Pos := Pos + 1;
end loop;
Finish := Pos;
Pos := Pos + 1;
else
while Pos <= Last loop
case Parameter (Pos) is
when ',' | ';' | Ascii.Lf =>
exit;
when '\' =>
Pos := Pos + 1;
Finish := Pos;
when ' ' =>
null;
when others =>
Finish := Pos;
end case;
Pos := Pos + 1;
end loop;
end if;
end case;
Value := new String'(Parameter (Start .. Finish));
Eat_Token;
end Get_Value;
procedure Get_Name is
begin
if Token = Other then
while Pos <= Last loop
case Parameter (Pos) is
when '=' | ';' | ',' | ' ' | Ascii.Lf | '|' =>
exit;
when ':' =>
exit when Pos < Last and then
Parameter (Pos + 1) = '=';
when '.' =>
exit when Pos < Last and then
Parameter (Pos + 1) = '.';
when others =>
null;
end case;
Pos := Pos + 1;
end loop;
Finish := Pos - 1;
Name := new String'(Parameter (Start .. Finish));
Eat_Token;
else
Name := null;
end if;
end Get_Name;
procedure Get_Range is
Name1 : Image;
begin
Get_Name;
if Token = Dots then
if Name = null then
Add_Iteration (Name);
Eat_Token;
Get_Name;
Add_Iteration (Name);
else
Name1 := Name;
Eat_Token;
Get_Name;
Add_Iteration (Name1, Name);
end if;
elsif Name /= null and then Normal (Name.all) = "OTHERS" then
Add_Range (Lowest, Highest);
else
Add_Iteration (Name);
end if;
end Get_Range;
procedure Get_Option is
Fence : Iteration := Itns;
Itn : Iteration;
I : Integer;
F : Float;
Boolean_Sense : Boolean := True;
Tilded : Boolean := False;
Defaulted : Boolean;
begin
while Token = Tilde loop
Boolean_Sense := not Boolean_Sense;
Tilded := True;
Eat_Token;
end loop;
loop
Get_Range;
exit when Token /= Bar;
Eat_Token;
end loop;
Itn := Itns;
if Token = Arrow then
Eat_Token;
Get_Value;
Defaulted := Value.all = "<>";
while Itn /= Fence loop
if Tilded then
Itn.Status := Tilded_Value;
elsif Itn.Status = Ok then
if Itn.Kind = Literal then
Itn.Status := Literal_Has_Value;
Itn.Diagnosis := Value;
elsif Defaulted then
if Itn.Name.Value /= null then
Itn.Value := new String'(Itn.Name.Value.all);
end if;
else
Itn.Value := Value;
case Itn.Kind is
when Boolean_Valued =>
if Su.Locate (Value.all, "False", True) /=
1 and then
Su.Locate (Value.all, "True", True) /=
1 then
Itn.Status := Malformed_Boolean;
end if;
when Integer_Valued =>
I := Get_Integer
(Itn); -- exec for side-effect
when Float_Valued =>
F := Get_Float
(Itn); -- exec for side-effect
when Literal | Unspecified =>
null;
end case;
end if;
else
Itn.Value := Value;
end if;
Itn := Itn.Next;
end loop;
else
while Itn /= Fence loop
if Itn.Status = Ok then
if Itn.Kind = Literal then
if Tilded then
Itn.Status := Tilded_Literal;
end if;
elsif Itn.Name.Kind = Boolean_Valued then
Itn.Value := Boolean_Value (Boolean_Sense);
elsif Itn.Name.Value /= null and then
(Su.Locate (Itn.Name.Value.all, "False", True) =
1 or else
Su.Locate (Itn.Name.Value.all, "True", True) =
1) then
Itn.Value := Boolean_Value (Boolean_Sense);
else
Itn.Status := Has_No_Value;
end if;
end if;
Itn := Itn.Next;
end loop;
end if;
end Get_Option;
begin
Eat_Token;
loop
if Token /= Separator and then Token /= End_String then
Get_Option;
end if;
while Token = Separator loop
Eat_Token;
end loop;
exit when Token = End_String;
end loop;
end Parse;
function Inverted (Itns : Iteration) return Iteration is
Itn : Iteration := Itns;
Nxt : Iteration;
Prv : Iteration;
begin
Iter.Success := True;
while Itn /= null loop
Nxt := Itn.Next;
Itn.Next := Prv;
-- Advance Prv to this iteration if it should be kept.
if Itn.Status /= Ok then
Iter.Success := False;
Prv := Itn;
elsif Itn.Value /= null then
Prv := Itn;
end if;
Itn := Nxt;
end loop;
return Prv;
end Inverted;
begin
Parse (Parameter);
Iter.Start := Inverted (Itns);
Iter.Point := Iter.Start;
Success := Iter.Success;
Options := Iter;
end Parse;