DataMuseum.dk

top - metrics - download

    Length: 5821 (0x16bd)
    Types: TextFile
    Names: »V«

└─⟦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⟧ 

TextFile

package Token_Package is

    --==============================================================
    -- This package provides the user with the necessary           =
    -- operations to support an abstract data type for a Token.    =
    -- These operations include getting the token from the source  =
    -- file, returning the class of the token, returning the       =
    -- actual value of the token, and peeking at the next token.   =
    --                                                             =
    -- written  by  JM  with  help  from  GER  and  b2             =
    --==============================================================

    type Token_Class is (Undefined, Identifier, Keyword, Numeric_Literal,
                         Standard_String_Literal,      -- "..."
                         Alternate_String_Literal,     -- %...%
                         Character_Literal, Punctuation, Comment,
                         Blank_Line, New_Line, End_Of_File,
                         Begin_Compilation_Unit, End_Compilation_Unit);

    type Token_Value is
       (Undefined,

        -- punctuations
        Ampersand_Token, Apostrophe_Token, Left_Parenthesis_Token,
        Right_Parenthesis_Token, Star_Token, Plus_Token, Comma_Token,
        Hyphen_Token, Dot_Token, Slash_Token, Colon_Token, Semicolon_Token,
        Less_Than_Token, Equal_Token, Greater_Than_Token, Vertical_Bar_Token,
        Exclamation_Mark_Token, Arrow_Token, Double_Dot_Token,
        Double_Star_Token, Assignment_Token, Inequality_Token,
        Greater_Than_Or_Equal_Token, Less_Than_Or_Equal_Token,
        Left_Label_Bracket_Token, Right_Label_Bracket_Token, Box_Token,

        -- keywords
        Abort_Token, Abs_Token, Accept_Token, Access_Token, All_Token,
        And_Token, Array_Token, At_Token, Begin_Token, Body_Token,
        Case_Token, Constant_Token, Declare_Token, Delay_Token, Delta_Token,
        Digits_Token, Do_Token, Else_Token, Elsif_Token, End_Token,
        Entry_Token, Exception_Token, Exit_Token, For_Token, Function_Token,
        Generic_Token, Goto_Token, If_Token, In_Token, Is_Token, Limited_Token,
        Loop_Token, Mod_Token, New_Token, Not_Token, Null_Token, Of_Token,
        Or_Token, Others_Token, Out_Token, Package_Token, Pragma_Token,
        Private_Token, Procedure_Token, Raise_Token, Range_Token, Record_Token,
        Rem_Token, Renames_Token, Return_Token, Reverse_Token, Select_Token,
        Separate_Token, Subtype_Token, Task_Token, Terminate_Token, Then_Token,
        Type_Token, Use_Token, When_Token, While_Token, With_Token, Xor_Token);

    type Token is private;

    Start_Of_Compilation_Unit : constant Token;
    -- token with Begin_Compilation_Unit class

    End_Of_Compilation_Unit : constant Token;
    -- token with End_Compilation_Unit class

    procedure Get (Next_Token : out Token);
    -- Gets a token from the standard input or token list. If
    -- there is no more tokens to get from the token list,
    -- Get will get the next token from the standard input;
    -- otherwise Get will get the next token from the token
    -- list.

    procedure Peek (Next_Token : out Token);
    -- Peeks at the next token either from the standard input
    -- or token list. If Set_Peek_Back has NOT been invoked or
    -- there is no more tokens to peek at in the token list,
    -- then Peek will peek at the next token from the standard
    -- input; otherwise, Peek will peek at the next token
    -- from the token list.

    procedure Set_Peek_Back;
    -- Set the location of the peeked-at token to be the one
    -- NEXT to the current token in the token list if the token
    -- list is not empty. If the token list is empty, this
    -- operation will have NO effect.

    function Class_Of (Token_With_Class : in Token) return Token_Class;
    -- Gets the class of the token

    function Value_Of (This_Token : in Token) return String;
    function Value_Of (Given_Token : in Token) return Token_Value;
    -- These two operations return the values of the token in either
    -- string or Token_Value format depending on which operation

    Token_Too_Long : exception;
    -- This exception is raised if the token found is too long
    -- (i.e., > 132 characters long)

    Lexical_Error : exception;
    -- This exception is raised if a lexical error is found while
    -- searching for tokens

    Error_Reading_File : exception;
    -- This exception is raised if there is an error while reading
    -- the input file

private

    Max_Token_Length : constant := 132;
    subtype Token_Length is Natural range 0 .. Max_Token_Length;
    type Variable_Token (Length : Token_Length := 0) is
        record
            Content : String (1 .. Length);
        end record;

    subtype Punctuation_Value is Token_Value range Ampersand_Token .. Box_Token;

    type Actual_Token (Class : Token_Class := Undefined) is
        record
            case Class is
                when Identifier | Keyword | Numeric_Literal |
                     Standard_String_Literal |
                     Alternate_String_Literal | Character_Literal =>
                    String_Value : Variable_Token;
                when Punctuation =>
                    Enumeration_Value : Punctuation_Value;
                when others =>
                    null;
            end case;
        end record;

    -- Token is defined as followed because we can NOT instantiate
    -- a generic formal parameter of type PRIVATE with unconstrained
    -- type.
    type Token is
        record
            Content : Actual_Token;
        end record;

    Start_Of_Compilation_Unit : constant Token :=
       (Content => (Class => Begin_Compilation_Unit));

    End_Of_Compilation_Unit : constant Token :=
       (Content => (Class => End_Compilation_Unit));

end Token_Package;