|
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: 11083 (0x2b4b)
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 Source_Io;
with List_Double_Iterator_Managed_Unbounded;
package body Token_Package is
type State is
(Start,
-- build IDENTIFIER or KEYWORD
Build_Identifier_Or_Keyword, Build_Underline_For_Identifier,
-- build NUMERIC_LITERAL
Build_Numeric_Literal, Build_Underline_For_Numeric_Literal,
Build_Real_Literal, Build_Rest_Of_Real_Literal,
Build_Underline_For_Real_Literal, Build_Exponent,
Build_First_Digit_Of_Exponent, Build_Rest_Of_Exponent,
Build_Underline_For_Exponent, Build_Based_Literal,
Build_Rest_Of_Based_Literal, Build_Underline_For_Based_Literal,
Build_Optional_Exponent, Build_Real_Based_Literal,
Build_Rest_Of_Real_Based_Literal,
-- build STRING_LITERAL
Build_Standard_String_Literal, Build_Quote_For_String_Literal,
Build_Alternate_String_Literal, Build_Percent_For_String_Literal,
-- build CHARACTER_LITERAL
Build_Character_Literal, Build_Rest_Of_Character_Literal,
-- build PUNCTUATION
Build_Compound_Delimiter,
Stop);
-- This is a state variable that keeps track of the value of
-- current character.
Current_Character : Character := ' ';
-- contains the value of the previous token. We use Previous_Token
-- to determine whether or not an APOSTROPHE indicates a character
-- literal or a tick.
Get_Previous_Token : Token;
Peek_Previous_Token : Token;
-- used to determine whether a line is EMPTY or not
Is_Blank_Line : Boolean := False;
-- used to check whether or not first delimiter matches the
-- second one, e.g., ...#...#..., or ...:...:..., etc.
Delimiter : Character := Ascii.Nul;
package New_List is
new List_Double_Iterator_Managed_Unbounded (Item => Token);
-- List_Of_Tokens contains peeked-at tokens.
List_Of_Tokens : New_List.List;
-- Next_Token_Location points to the location of the
-- location of the next token to get from the List_Of_Tokens.
-- Initially, Next_Token_Location points to Null_List.
Next_Token_Location : New_List.List;
-- Peek_Token_Location points to the location of the
-- location of the next token to peek at in the List_Of_Tokens.
-- Initially, Peek_Token_Location points to Null_List.
Peek_Token_Location : New_List.List;
type Buffer_Value is
record
Length : Token_Length := 0;
Content : String (1 .. Max_Token_Length) := (others => ' ');
end record;
procedure Store (Item : in Character; Into : in out Buffer_Value) is
--============================================================
-- Store puts Item into a given buffer. ==
--============================================================
begin
-- Store
if Into.Length = Max_Token_Length then
raise Token_Too_Long;
end if;
Into.Length := Into.Length + 1;
Into.Content (Into.Length) := Item;
end Store;
function Class_Of (Token_With_Class : in Token) return Token_Class is
--============================================================
-- returns the class of a given token ==
--============================================================
begin
-- Class_Of
return (Token_With_Class.Content.Class);
end Class_Of;
function Value_Of (This_Token : in Token) return String is
--======================================================
-- This function returns the string representation of ==
-- a given token. ==
--======================================================
begin
-- Value_Of
case This_Token.Content.Class is
when Identifier .. Character_Literal =>
return This_Token.Content.String_Value.Content;
when Punctuation =>
case This_Token.Content.Enumeration_Value is
when Ampersand_Token =>
return ("&");
when Plus_Token =>
return ("+");
when Apostrophe_Token =>
return ("'");
when Left_Parenthesis_Token =>
return ("(");
when Right_Parenthesis_Token =>
return (")");
when Star_Token =>
return ("*");
when Comma_Token =>
return (",");
when Hyphen_Token =>
return ("-");
when Dot_Token =>
return (".");
when Slash_Token =>
return ("/");
when Colon_Token =>
return (":");
when Semicolon_Token =>
return (";");
when Less_Than_Token =>
return ("<");
when Equal_Token =>
return ("=");
when Greater_Than_Token =>
return (">");
when Vertical_Bar_Token =>
return ("|");
when Exclamation_Mark_Token =>
return ("!");
when Arrow_Token =>
return ("=>");
when Double_Dot_Token =>
return ("..");
when Double_Star_Token =>
return ("**");
when Assignment_Token =>
return (":=");
when Inequality_Token =>
return ("/=");
when Greater_Than_Or_Equal_Token =>
return (">=");
when Less_Than_Or_Equal_Token =>
return ("<=");
when Left_Label_Bracket_Token =>
return ("<<");
when Right_Label_Bracket_Token =>
return (">>");
when Box_Token =>
return ("<>");
end case;
when others =>
-- undefined
return ("");
end case;
end Value_Of;
function Value_Of (Given_Token : in Token) return Token_Value is
--============================================================
-- returns the enumeration value of a given token ==
--============================================================
begin
-- Value_Of
case Given_Token.Content.Class is
when Punctuation =>
return Given_Token.Content.Enumeration_Value;
when Keyword =>
return Token_Value'Value (Value_Of (Given_Token) & "_Token");
when others =>
return Undefined;
end case;
end Value_Of;
function Is_Tick (Previous_Token : in Token) return Boolean is
--=============================================================
-- returns TRUE if previous token found was an IDENTIFIER or ==
-- CHARACTER_LITERAL, or STRING_LITERAL, or ")", or "ALL" ==
--=============================================================
begin
-- Is_Tick
case Previous_Token.Content.Class is
when Identifier | Character_Literal |
Standard_String_Literal | Alternate_String_Literal =>
return True;
when Punctuation =>
if Previous_Token.Content.Enumeration_Value =
Right_Parenthesis_Token then
return True;
else
return False;
end if;
when Keyword =>
if Value_Of (Previous_Token) = "ALL" then
return True;
else
return False;
end if;
when others =>
return False;
end case;
end Is_Tick;
procedure Skip_Rest_Of_Line is
--===========================================================
-- skip every character until new line character is found. ==
--===========================================================
begin
-- Skip_Rest_Of_Line
Find_New_Line:
loop
-- Current_Character is a STATE VARIABLE defined
-- above in the package body.
Source_Io.Get (Current_Character);
exit Find_New_Line when Current_Character = Source_Io.New_Line;
end loop Find_New_Line;
end Skip_Rest_Of_Line;
procedure Label (This_Token : out Token;
With_This_Class : in Token_Class) is separate;
-- Label constraints This_Token with With_This_Class
procedure Receive_Symbol (Current_State : in out State;
Current_Token : in out Token;
Previous_Token : in Token;
Present_Buffer : in out Buffer_Value) is separate;
--=============================================================
-- This is the FINITE-STATE MACHINE of the lexical analyzer. ==
-- Receive_Symbol will determine which next STATE shoule be ==
-- taken based on the PRESENT_STATE and current character. ==
--=============================================================
procedure Build (New_Token : out Token;
Previous_Token : in Token) is separate;
--==============================================================
-- This procedure builds a New_Token from the standard input. ==
--==============================================================
procedure Get (Next_Token : out Token) is separate;
--==============================================================
-- Get the next token from list of tokens or standard input ==
-- (i.e., by calling Build) ==
--==============================================================
procedure Peek (Next_Token : out Token) is separate;
--==============================================================
-- Peek at the next token from list of tokens or standard ==
-- input. ==
--==============================================================
procedure Set_Peek_Back is separate;
--==============================================================
-- Set peek token pointer to the next available token. ==
--==============================================================
begin
-- Token_Package
New_List.Clear (The_List => List_Of_Tokens);
New_List.Clear (The_List => Next_Token_Location);
New_List.Clear (The_List => Peek_Token_Location);
end Token_Package;