DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦19709c59f⟧ TextFile

    Length: 11631 (0x2d6f)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Errors;
with String_Utilities;
with Text_Io;
with Tiny_File;
with Trace;

package body Scanner is

    type State is (St_Normal, St_Minus, St_Comm, St_Str, St_Int,
                   St_Id, St_Id_More, St_Less, St_Great, St_Found);

    Current_Lexeme : Lexeme;
    Current_State : State;
    Current_Token : Token;
    Current_Line : Natural;
    Error_Number : Natural;
    Current_String_Length : Natural;
    Current_Id_Length : Natural;

    File_Input : Text_Io.File_Type;

    procedure Start (File_Name : String) is
    begin
        Tiny_File.Open (File_Input, File_Name);
        Current_Line := 1;
    end Start;

    function Get_Token return Token is
    begin
        return Current_Token;
    end Get_Token;

    function Get_Value return Lexeme is
    begin
        return Current_Lexeme;
    end Get_Value;

    function Get_Line_Number return Natural is
    begin
        return Current_Line;
    end Get_Line_Number;

    function Get_Error_Number return Natural is
    begin
        return Error_Number;
    end Get_Error_Number;

    procedure Check_For_Int_Error is
        Current_Number : Integer;
        Ok : Boolean;
    begin
        String_Utilities.String_To_Number
           (Bounded_String.Image (Current_Lexeme), Current_Number, Ok);
        if not Ok then
            Current_Token := L_Unk;
            Error_Number := 5;
        end if;
    end Check_For_Int_Error;

    function Check_If_Reserved (Id : String) return Token is
    begin
        if Custom.Is_Reserved_Word (Id) then
            case Custom.Reserved_Word'Value (Id) is
                when Custom.Avec =>
                    return L_Avec;
                when Custom.Pour =>
                    return L_Pour;
                when Custom.Prendre =>
                    return L_Pren;
                when Custom.Renvoyer =>
                    return L_Renv;
            end case;
        else
            return L_Id;
        end if;
    end Check_If_Reserved;

    procedure Normal_State (Current_Char : in out Character) is
    begin
        case Current_Char is
            when Ascii.Eot =>
                Current_Token := L_Eof;
                Current_State := St_Found;
            when ' ' | Ascii.Cr =>
                null;
            when '-' =>
                Current_State := St_Minus;
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when '"' =>  
                Current_State := St_Str;
                Current_String_Length := 0;
            when '0' .. '9' =>
                Current_State := St_Int;
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when 'a' .. 'z' | 'A' .. 'Z' =>
                Current_State := St_Id;
                String_Utilities.Upper_Case (Current_Char);
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Id_Length := 1;
            when '{' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Obra;  
            when '}' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Cbra;
            when '.' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Dot;
            when '(' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Opar;
            when ')' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Cpar;
            when '+' | '*' | '/' | '^' | '=' | '&' | '|' | '%' =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Binm;
            when '<' =>
                Current_State := St_Less;
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when '>' =>
                Current_State := St_Great;  
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when others =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Unk;
                Error_Number := 1;
        end case;
    end Normal_State;

    procedure Minus_State (Current_Char : Character) is
    begin
        case Current_Char is
            when '-' =>
                Current_State := St_Comm;
            when others =>
                Tiny_File.Unget (File_Input);
                Current_State := St_Found;  
                Current_Token := L_Binm;
        end case;
    end Minus_State;

    procedure Comm_State (Current_Char : Character) is
    begin
        case Current_Char is
            when Ascii.Cr =>
                Current_State := St_Normal;
                Bounded_String.Free (Current_Lexeme);
            when others =>
                null;
        end case;  
    end Comm_State;

    procedure Str_State (Current_Char : Character) is
    begin
        case Current_Char is
            when '"' =>
                Current_State := St_Found;
                Current_Token := L_Str;
            when Ascii.Cr =>
                null;
            when others =>
                Current_String_Length := Current_String_Length + 1;
                if Current_String_Length > Custom.String_Max_Length then
                    Current_State := St_Found;
                    Current_Token := L_Unk;
                    Error_Number := 3;
                else
                    Bounded_String.Append (Current_Lexeme, Current_Char);
                end if;
        end case;
    end Str_State;

    procedure Int_State (Current_Char : Character) is
    begin
        case Current_Char is
            when '0' .. '9' =>
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when others =>  
                Tiny_File.Unget (File_Input);
                Current_State := St_Found;
                Current_Token := L_Int;
                Check_For_Int_Error;
        end case;
    end Int_State;

    procedure Id_State (Current_Char : in out Character) is
    begin
        case Current_Char is
            when '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
                Current_Id_Length := Current_Id_Length + 1;
                if Current_Id_Length > Custom.Id_Max_Length then
                    Current_State := St_Found;
                    Current_Token := L_Unk;
                    Error_Number := 4;
                else
                    String_Utilities.Upper_Case (Current_Char);
                    Bounded_String.Append (Current_Lexeme, Current_Char);
                end if;
            when '_' =>
                Current_Id_Length := Current_Id_Length + 1;
                if Current_Id_Length > Custom.Id_Max_Length then
                    Current_State := St_Found;
                    Current_Token := L_Unk;
                    Error_Number := 4;
                else
                    Current_State := St_Id_More;
                    Bounded_String.Append (Current_Lexeme, Current_Char);
                end if;
            when ':' =>
                Current_Id_Length := Current_Id_Length + 1;
                if Current_Id_Length > Custom.Id_Max_Length then
                    Current_State := St_Found;
                    Current_Token := L_Unk;
                    Error_Number := 4;
                else
                    Bounded_String.Append (Current_Lexeme, Current_Char);
                    Current_State := St_Found;
                    Current_Token := L_Keyw;
                end if;
            when others =>
                Tiny_File.Unget (File_Input);
                Current_State := St_Found;
                Current_Token := Check_If_Reserved
                                    (Bounded_String.Image (Current_Lexeme));
        end case;
    end Id_State;

    procedure Id_More_State (Current_Char : in out Character) is
    begin
        case Current_Char is
            when '0' .. '9' | 'a' .. 'z' | 'A' .. 'Z' =>
                Current_Id_Length := Current_Id_Length + 1;
                if Current_Id_Length > Custom.Id_Max_Length then
                    Current_State := St_Found;
                    Current_Token := L_Unk;
                    Error_Number := 4;
                else
                    Current_State := St_Id;
                    String_Utilities.Upper_Case (Current_Char);
                    Bounded_String.Append (Current_Lexeme, Current_Char);
                end if;
            when others =>
                Current_State := St_Found;
                Bounded_String.Append (Current_Lexeme, Current_Char);
                Current_Token := L_Unk;
                Error_Number := 2;
        end case;
    end Id_More_State;

    procedure Less_State (Current_Char : Character) is
    begin
        case Current_Char is
            when '>' | '=' =>
                Current_State := St_Found;
                Current_Token := L_Binm;
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when others =>  
                Tiny_File.Unget (File_Input);
                Current_State := St_Found;
                Current_Token := L_Binm;
        end case;
    end Less_State;

    procedure Great_State (Current_Char : Character) is
    begin
        case Current_Char is
            when '=' =>
                Current_State := St_Found;
                Current_Token := L_Binm;
                Bounded_String.Append (Current_Lexeme, Current_Char);
            when others =>  
                Tiny_File.Unget (File_Input);
                Current_State := St_Found;
                Current_Token := L_Binm;
        end case;
    end Great_State;

    procedure Next_Token is
        Current_Char : Character;
    begin
        Bounded_String.Free (Current_Lexeme);
        Current_State := St_Normal;
        Error_Number := 0;
        loop
            Current_Char := Tiny_File.Get (File_Input);
            if Current_Char = Ascii.Cr then
                Current_Line := Current_Line + 1;
            end if;
            case Current_State is
                when St_Normal =>
                    Normal_State (Current_Char);
                when St_Minus =>
                    Minus_State (Current_Char);
                when St_Comm =>
                    Comm_State (Current_Char);  
                when St_Str =>
                    Str_State (Current_Char);
                when St_Int =>
                    Int_State (Current_Char);
                when St_Id =>
                    Id_State (Current_Char);
                when St_Id_More =>
                    Id_More_State (Current_Char);
                when St_Less =>
                    Less_State (Current_Char);
                when St_Great =>
                    Great_State (Current_Char);
                when St_Found =>
                    exit;
            end case;
            exit when Current_State = St_Found;
        end loop;
        case Current_Token is
            when L_Unk =>
                raise Errors.Unknown_Lexeme_Found;
            when others =>
                null;
        end case;
        Trace.Display (Current_Token);
        Trace.Display (Current_Lexeme);
    end Next_Token;

    procedure Stop is
    begin
        Tiny_File.Close (File_Input);

    end Stop;

end Scanner;