|
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: 21047 (0x5237)
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⟧
separate (Structure)
function Catalog_From
(This_Data_File : in Full_Name) return Catalog is
--
-- ***** MODIFY AT YOUR OWN RISK *****
--
The_Catalog : Catalog := new Catalog_Node;
subtype Argument is Lines.Line;
Failed : exception;
procedure Report (This_Message : in String;
Of_Kind : in Diagnostics := Error;
Propagate_When_Error : in Boolean := True) is
--
The_Message : Message := new Message_Node;
--
begin
The_Message.Kind := Of_Kind;
The_Message.Contents := Lines.Create (This_Message);
Message_Lists.Add (Message_Lists.List (The_Catalog.The_Diagnostic),
The_Message);
if (Of_Kind = Error) then
The_Catalog.Is_Good := False;
if (Propagate_When_Error) then
raise Failed;
end if;
end if;
end Report;
function Lines_Done return Boolean is
begin
return (Lines.Done (Lines.Iterator (The_Catalog.The_Data_File)));
end Lines_Done;
function Current_Line return Lines.Line is
begin
return (Lines.Current (Lines.Iterator (The_Catalog.The_Data_File)));
end Current_Line;
function Line_Image return String is
begin
return (Lines.Image (Lines.Current
(Lines.Iterator (The_Catalog.The_Data_File))));
end Line_Image;
procedure Next_Line is
begin
if (not Lines.Done (Lines.Iterator (The_Catalog.The_Data_File))) then
Lines.Next (Lines.Iterator (The_Catalog.The_Data_File));
end if;
end Next_Line;
function Current_Position return String is
begin
if (Lines_Done) then
return ("<END_OF_INPUT>");
else
return (String_Utilities.Strip
(Integer'Image (Lines.Position
(Lines.Iterator (The_Catalog.
The_Data_File)))));
end if;
end Current_Position;
function Normalized_Argument return Argument is
begin
return (Lines.Create (Annotations.Value_Of (Current_Line)));
end Normalized_Argument;
function Normalized_Name return Lines.Line is
--
Blank : constant Character := ' ';
Tab : constant Character := Ascii.Ht;
--
Initial : constant String := Annotations.Value_Of (Current_Line);
--
Minus_Blanks : constant String :=
Misc_String_Utilities.Stripped
(This_String => Initial, This_Character => Blank);
--
Minus_Tabs : constant String :=
Misc_String_Utilities.Stripped
(This_String => Minus_Blanks, This_Character => Tab);
--
Normalized : constant String :=
String_Utilities.Upper_Case (Minus_Tabs);
--
begin
return (Lines.Create (Normalized));
end Normalized_Name;
function Normalized_Simple_Name return Argument is
--
Normalized : Lines.Line := Normalized_Name;
--
begin
if (not Names.Is_Simple_Ada_Name (Lines.Image (Normalized))) then
Report ("Argument on line " & Current_Position & " of " &
This_Data_File & " is not simple Ada name");
end if;
return (Normalized);
end Normalized_Simple_Name;
function Normalized_Full_Name return Argument is
--
Normalized : Lines.Line := Normalized_Name;
--
begin
if (not Names.Is_Fully_Qualified_Pathname
(Lines.Image (Normalized))) then
Report ("Argument on line " & Current_Position & " of " &
This_Data_File & " is not fully-qualified pathname");
end if;
return (Normalized);
end Normalized_Full_Name;
function Is_Blank return Boolean is
begin
return (Misc_String_Utilities.Is_Blank (Line_Image));
end Is_Blank;
procedure Skip_Blanks is
begin
loop
exit when (Lines_Done);
exit when (not Is_Blank);
Next_Line;
end loop;
end Skip_Blanks;
function Is_Begin_Comment return Boolean is
begin
return ((Annotations.Is_Simple_Annotation (Current_Line)) and then
(Annotations.Keywords_Match
(Current_Line, Syntax.Begin_Comment)));
end Is_Begin_Comment;
function Is_End_Comment return Boolean is
begin
return ((Annotations.Is_Simple_Annotation (Current_Line)) and then
(Annotations.Keywords_Match
(Current_Line, Syntax.End_Comment)));
end Is_End_Comment;
procedure Skip_Comments is
--
Starting_Line : constant String := Current_Position;
--
begin
if ((not Lines_Done) and then (Is_Begin_Comment)) then
loop
Next_Line;
if (Lines_Done) then
Report
("Encountered end of input looking for @END_COMMENT to match @BEGIN_COMMENT on line " &
Starting_Line & " of " & This_Data_File);
end if;
if (Is_Begin_Comment) then
-- Nested comment.
Skip_Comments;
end if;
if (Is_End_Comment) then
Next_Line;
Skip_Blanks;
-- Might have advanced to another comment, so check.
Skip_Comments;
exit;
end if;
end loop;
end if;
end Skip_Comments;
procedure Advance (Skip_Blank_Lines : in Boolean := True) is
begin
Next_Line;
if (Skip_Blank_Lines) then
Skip_Blanks;
end if;
Skip_Comments;
end Advance;
procedure Parse_Text (The_Resulting_Text : in out Text) is
begin
loop
exit when (Lines_Done);
exit when (Annotations.Is_Annotation (Current_Line));
Lines.Add (Lines.Iterator (The_Resulting_Text), Current_Line);
Advance (Skip_Blank_Lines => False);
end loop;
end Parse_Text;
function Kinds_Match is new Annotations.Arguments_Match (Syntax.Item_Kinds);
function Booleans_Match is
new Annotations.Arguments_Match (Syntax.Booleans);
procedure Parse_Multiples (This_Keyword : in Syntax.Valued_Keywords;
Minimum_Required : in Natural;
Add_To_List : in out Object_List;
Must_Be_Fully_Qualified : in Boolean := False) is
--
Total_Found : Natural := 0;
--
function Plural return String is
begin
if (Minimum_Required > 1) then
return ("(s)");
else
return ("");
end if;
end Plural;
--
begin
loop
exit when (Lines_Done);
exit when (not Annotations.Is_Annotation (Current_Line));
exit when (not Annotations.Keywords_Match
(Current_Line, This_Keyword));
declare
New_Object : Object := new Object_Node;
begin
if (Must_Be_Fully_Qualified) then
New_Object.Name := Normalized_Full_Name;
else
New_Object.Name := Normalized_Simple_Name;
end if;
Object_Lists.Add (To_List => Object_Lists.List (Add_To_List),
This_Element => New_Object);
Total_Found := Total_Found + 1;
end;
Advance;
end loop;
if (Total_Found < Minimum_Required) then
Report ("Unable to find at least " &
String_Utilities.Strip (Natural'Image (Minimum_Required)) &
" " & Syntax.Annotation_Indicator &
Syntax.Valued_Keywords'Image (This_Keyword) &
" annotation" & Plural & " prior to line " &
Current_Position & " while parsing " & This_Data_File);
end if;
end Parse_Multiples;
procedure Fully_Qualify_Names (These_Objects : in out Object_List;
With_Prefix : in Full_Name) is
begin
Object_Lists.Reset (Object_Lists.List (These_Objects));
while (not Object_Lists.Done (Object_Lists.List (These_Objects))) loop
declare
The_Object : Object := Object_Lists.Current
(Object_Lists.List (These_Objects));
begin
The_Object.Name := Lines.Create (With_Prefix & "." &
Simple_Name_Of (The_Object));
end;
Object_Lists.Next (Object_Lists.List (These_Objects));
end loop;
end Fully_Qualify_Names;
procedure Parse_Item (The_Section : in out Section) is
--
The_Item : Item := new Item_Node;
--
Starting_Position : constant String := Current_Position;
--
begin
-- Check for initial conditions.
if (Lines_Done) then
Report ("Expected to find at least one @MODEL annotation, " &
"but encountered end-of-input instead");
end if;
if ((not (Annotations.Keywords_Match
(Current_Line, Syntax.Item))) and then
(not (Annotations.Keywords_Match
(Current_Line, Syntax.Section))) and then
(not (Annotations.Keywords_Match
(Current_Line, Syntax.Model)))) then
Report
("Expected to find @ITEM, @SECTION, or @MODEL annotation on line " &
Current_Position &
", but encountered illegal or out-of-order annotation instead");
end if;
if (Annotations.Keywords_Match (Current_Line, Syntax.Item)) then
-- Found an item.
Item_Lists.Add (The_Section.Items, The_Item);
The_Item.Parent := The_Section;
The_Item.Name := Normalized_Argument;
Advance;
if (not Annotations.Keywords_Match (Current_Line, Syntax.Kind)) then
Report ("Unable to find @KIND annotation on line " &
Current_Position &
" while parsing item started on line " &
Starting_Position &
" of " & This_Data_File);
end if;
if (Kinds_Match (Current_Line, Syntax.Visible_Units)) then
The_Item.Kind := Syntax.Visible_Units;
elsif (Kinds_Match (Current_Line, Syntax.Code_Only)) then
The_Item.Kind := Syntax.Code_Only;
elsif (Kinds_Match (Current_Line, Syntax.Free_Form)) then
The_Item.Kind := Syntax.Free_Form;
elsif (Kinds_Match (Current_Line, Syntax.Environment)) then
The_Item.Kind := Syntax.Environment;
else
Report ("Argument following @KIND annotation on line " &
Current_Position & " for item started on line " &
Starting_Position & " of " &
This_Data_File & " is invalid");
end if;
if (not Kinds_Match (Current_Line, Syntax.Environment)) then
-- Item is not of kind ENVIRONMENT.
Advance;
if (not Annotations.Keywords_Match
(Current_Line, Syntax.Location)) then
Report ("Unable to find @LOCATION annotation on line " &
Current_Position & " of " & This_Data_File &
" while parsing item started on line " &
Starting_Position);
end if;
The_Item.Location := Normalized_Simple_Name;
Advance;
if ((Kind_Of (The_Item) = Syntax.Visible_Units) or else
(Kind_Of (The_Item) = Syntax.Code_Only)) then
Parse_Multiples (This_Keyword => Syntax.Import,
Minimum_Required => 0,
Add_To_List => The_Item.Imports,
Must_Be_Fully_Qualified => True);
Parse_Multiples (This_Keyword => Syntax.Spec_View,
Minimum_Required => 0,
Add_To_List => The_Item.Spec_Views);
Fully_Qualify_Names
(These_Objects => The_Item.Spec_Views,
With_Prefix => Full_Location_Of (The_Item));
Parse_Multiples (This_Keyword => Syntax.Load_View,
Minimum_Required => 1,
Add_To_List => The_Item.Load_Views);
if (Object_Lists.Elements_In
(Object_Lists.List
(The_Item.Load_Views)) < 1) then
Report ("Item """ & Name_Of (The_Item) &
""" started on line " & Starting_Position &
" of " & This_Data_File &
" has no load views specified");
end if;
Fully_Qualify_Names
(These_Objects => The_Item.Load_Views,
With_Prefix => Full_Location_Of (The_Item));
end if;
if (not Annotations.Keywords_Match
(Current_Line, Syntax.Proprietary)) then
Report ("Unable to find @PROPRIETARY annotation on line " &
Current_Position & " of " & This_Data_File &
" while parsing item started on line " &
Starting_Position);
end if;
if (Booleans_Match (Current_Line, Syntax.True)) then
The_Item.Is_Proprietary := Syntax.True;
elsif (Booleans_Match (Current_Line, Syntax.False)) then
The_Item.Is_Proprietary := Syntax.False;
else
Report
("Argument following @PROPRIETARY annotation on line " &
Current_Position & " of " & This_Data_File &
" for item started on line " &
Starting_Position & " is invalid");
end if;
end if;
Advance (Skip_Blank_Lines => False);
Parse_Text (The_Item.Description);
-- Might have advanced to new item, so check.
Parse_Item (The_Section);
end if;
end Parse_Item;
function Kinds_Match is
new Annotations.Arguments_Match (Syntax.Section_Kinds);
procedure Parse_Section is
--
The_Section : Section := new Section_Node;
--
Starting_Position : constant String := Current_Position;
--
begin
-- Check for initial conditions.
if (Lines_Done) then
Report ("Expected to find at least one @MODEL annotation, " &
"but encountered end-of-input instead");
end if;
if ((not (Annotations.Keywords_Match
(Current_Line, Syntax.Section))) and then
(not (Annotations.Keywords_Match
(Current_Line, Syntax.Model)))) then
Report
("Expected to find @SECTION or @MODEL annotation on line " &
Current_Position &
", but encountered illegal or out-of-order annotation instead");
end if;
if (Annotations.Keywords_Match (Current_Line, Syntax.Section)) then
-- Found a section.
Section_Lists.Add (The_Catalog.Sections, The_Section);
The_Section.Parent := The_Catalog;
The_Section.Name := Normalized_Argument;
Advance;
if (not Annotations.Keywords_Match (Current_Line, Syntax.Kind)) then
Report ("Unable to find @KIND annotation on line " &
Current_Position & " of " & This_Data_File &
" while parsing section started on line " &
Starting_Position);
end if;
if (Kinds_Match (Current_Line, Syntax.Items)) then
The_Section.Kind := Syntax.Items;
elsif (Kinds_Match (Current_Line, Syntax.Text)) then
The_Section.Kind := Syntax.Text;
else
Report ("Argument following @KIND annotation on line " &
Current_Position & " of " & This_Data_File &
" for section started on line " &
Starting_Position & " is invalid");
end if;
if (The_Section.Kind = Syntax.Items) then
Advance;
if (not Annotations.Keywords_Match
(Current_Line, Syntax.Location)) then
Report
("Unable to find @LOCATION annotation on line " &
Current_Position & " of " & This_Data_File &
" while parsing section of kind ITEMS started on line " &
Starting_Position);
end if;
The_Section.Location := Normalized_Simple_Name;
end if;
Advance (Skip_Blank_Lines => False);
Parse_Text (The_Section.Description);
if (The_Section.Kind = Syntax.Items) then
Parse_Item (The_Section);
if (Item_Lists.Elements_In (The_Section.Items) < 1) then
Report
("Unable to find any items in section of kind ITEMS started on line " &
Starting_Position & " of " & This_Data_File);
end if;
end if;
-- Might have advanced to new section, so check.
Parse_Section;
end if;
end Parse_Section;
procedure Parse_Catalog is
begin
Skip_Blanks;
Skip_Comments;
if ((Lines_Done) or else (not Annotations.Keywords_Match
(Current_Line, Syntax.Catalog))) then
Report ("Unable to find @CATALOG annotation on line " &
Current_Position & " of " & This_Data_File);
end if;
The_Catalog.Name := Normalized_Argument;
Advance;
if (not Annotations.Keywords_Match (Current_Line, Syntax.Location)) then
Report ("Unable to find @LOCATION annotation on line " &
Current_Position & " of " & This_Data_File);
end if;
The_Catalog.Location := Normalized_Simple_Name;
Advance;
if (not Annotations.Keywords_Match (Current_Line, Syntax.Version)) then
Report ("Unable to find @VERSION annotation on line " &
Current_Position & " of " & This_Data_File);
end if;
The_Catalog.Version := Normalized_Simple_Name;
Advance (Skip_Blank_Lines => False);
Parse_Text (The_Catalog.Description);
Parse_Section;
Parse_Multiples (This_Keyword => Syntax.Model,
Minimum_Required => 1,
Add_To_List => The_Catalog.Allowable_Models,
Must_Be_Fully_Qualified => True);
Parse_Multiples (This_Keyword => Syntax.Link,
Minimum_Required => 0,
Add_To_List => The_Catalog.Allowable_Links,
Must_Be_Fully_Qualified => True);
if (not Lines_Done) then
-- Should have been done.
Report ("Unexpected leftover input on line " &
Current_Position & " of " & This_Data_File);
end if;
end Parse_Catalog;
begin
The_Catalog.Is_Good := True;
The_Catalog.The_Data_File := Data_File (Files.Create (This_Data_File));
Parse_Catalog;
Report (This_Message => "Catalog is good", Of_Kind => Progress);
return (The_Catalog);
--
exception
when Files.Io_Failure =>
Report ("Problem encountered opening/reading input file """ &
This_Data_File & """",
Propagate_When_Error => False);
return (The_Catalog);
--
when Failed =>
return (The_Catalog);
--
when others =>
Report ("EXCEPTION: " & Debug_Tools.Get_Exception_Name &
" encountered while parsing line " &
Current_Position & " of " & This_Data_File,
Propagate_When_Error => False);
return (The_Catalog);
--
end Catalog_From;