⟦5d4730c93⟧

TextFile

with File;
with Object;  
with Integer_Class;
with String_Class;
with Bounded_String;
with String_Utilities;
with Bug;
package body Scanner is

    function Look_For_Token return Token;
    New_Reference : Object.Reference := Object.Void_Reference;
    Current_Token : Token := Token'(T_Unknown);
    Current_String : Message.Tiny_String;
    Current_Message : Message.Selector := Message.Sans_Parametre;
    Current_Line_Number : Natural := 1;
    Tmp_Line_Number : Natural := 1;

    procedure Open (Fichier_Name : String) is
    begin
        File.Open (Fichier_Name => Fichier_Name);
    end Open;

    procedure Close is
    begin
        File.Close;
    end Close;

    function At_End return Boolean is
    begin
        return File.At_End;
    end At_End;

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

    procedure Set_Line_Number (To : Natural) is
    begin
        Current_Line_Number := To;
    end Set_Line_Number;

    function Get_Value return Message.Tiny_String is
    begin
        return Current_String;
    end Get_Value;

    function Get_Value return Object.Reference is
    begin
        return New_Reference;
    end Get_Value;

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

    function Get_Value return Message.Selector is
    begin
        return Current_Message;
    end Get_Value;

    function Look_For_Special
                (The_String : Message.Tiny_String) return Special is
        Index : Special := Non_Special;
    begin
        for I in Special'First .. Special'Last loop
            if String_Utilities.Equal
                  (Str1 => Special'Image (I),
                   Str2 => Bounded_String.Image (V => The_String),
                   Ignore_Case => True) then
                Index := I;
            end if;
        end loop;
        return Index;
    end Look_For_Special;

    function State_Integer (The_Character : Character) return Token is
        Current_Char : Character;  
        Current_Value : Integer;
    begin
        Bounded_String.Append (Target => Current_String,
                               Source => The_Character);
        Current_Char := File.Get;
        case Current_Char is

            when '0' .. '9' =>
                return State_Integer (Current_Char);

            when others =>
                File.Unget;
                Current_Value := Standard.Integer'Value
                                    (Bounded_String.Image (Current_String));
                New_Reference := Integer_Class.Create (Value => Current_Value);
                return Token'(T_Integer);
        end case;
    end State_Integer;

    function State_Identifier (The_Character : Character) return Token is
        Current_Char : Character;  
    begin
        Bounded_String.Append (Target => Current_String,
                               Source => The_Character);
        Current_Char := File.Get;
        case Current_Char is
            when 'a' .. 'z' | 'A' .. 'Z' =>
                return State_Identifier (Current_Char);

            when ':' =>  
                return Token'(T_Keyword);

            when others =>
                File.Unget;
                case Look_For_Special (Current_String) is
                    when Pour =>
                        return Token'(T_Pour);
                    when Avec =>
                        return Token'(T_Avec);
                    when Renvoyer =>
                        return Token'(T_Renvoyer);
                    when Prendre =>
                        return Token'(T_Prendre);
                    when Non_Special =>
                        return Token'(T_Identifier);  
                end case;
        end case;
    end State_Identifier;

    function State_String return Token is
        Current_Char : Character;
    begin
        Current_Char := File.Get;
        case Current_Char is

            when '"' =>
                New_Reference := String_Class.Create (Current_String);
                return Token'(T_String);

            when Ascii.Cr =>
                Current_Line_Number := Current_Line_Number + 1;  
                Bounded_String.Append (Target => Current_String,
                                       Source => Current_Char);
                return State_String;

            when Ascii.Eot =>
                return Token'(T_Eof);

            when others =>
                Bounded_String.Append (Target => Current_String,
                                       Source => Current_Char);
                return State_String;
        end case;
    end State_String;


    function State_Less return Token is
        Current_Char : Character;
    begin
        Current_Char := File.Get;
        case Current_Char is

            when '=' =>
                Current_Message := Message.Inferieur_Egal;
                return Token'(T_Binary_Message);

            when others =>
                File.Unget;
                Current_Message := Message.Inferieur;
                return Token'(T_Binary_Message);
        end case;
    end State_Less;

    function State_Great return Token is
        Current_Char : Character;
    begin
        Current_Char := File.Get;
        case Current_Char is

            when '=' =>
                Current_Message := Message.Superieur_Egal;
                return Token'(T_Binary_Message);
            when others =>
                File.Unget;
                Current_Message := Message.Superieur;
                return Token'(T_Binary_Message);
        end case;
    end State_Great;

    function State_Include return Token is
        Current_Char : Character;
    begin
        Current_Char := File.Get;
        case Current_Char is

            when 'a' .. 'z' | 'A' .. 'Z' | '_' | '0' .. '9' =>
                Bounded_String.Append (Target => Current_String,
                                       Source => Current_Char);
                return State_Include;

            when '.' =>
                Open (Bounded_String.Image (Current_String));
                Tmp_Line_Number := Current_Line_Number;
                Current_Line_Number := 1;
                Current_Message := Message.Sans_Parametre;
                Bounded_String.Free (Current_String);
                New_Reference := Object.Void_Reference;
                return Look_For_Token;

            when others =>
                raise Bug.Unexpected_Include_File_Name;
        end case;
    end State_Include;

    function Look_For_Token return Token is  
        Current_Char : Character;
    begin
        Current_Char := File.Get;
        case Current_Char is

            when ' ' | Ascii.Ht =>
                return Look_For_Token;

            when Ascii.Cr =>  
                Current_Line_Number := Current_Line_Number + 1;
                return Look_For_Token;

            when '0' .. '9' =>
                return State_Integer (Current_Char);

            when 'a' .. 'z' | 'A' .. 'Z' =>
                return State_Identifier (Current_Char);

            when '{' =>
                return Token'(T_Block_Open);

            when '}' =>
                return Token'(T_Block_End);
            when '#' =>
                return State_Include;
            when '.' =>
                return Token'(T_Dot);
            when '(' =>
                return Token'(T_Parenthese_Open);
            when ')' =>
                return Token'(T_Parenthese_End);
            when '+' =>
                Current_Message := Message.Plus;
                return Token'(T_Binary_Message);
            when '-' =>
                Current_Message := Message.Moins;
                return Token'(T_Binary_Message);
            when '*' =>
                Current_Message := Message.Multiplier;
                return Token'(T_Binary_Message);
            when '/' =>  
                Current_Message := Message.Diviser;
                return Token'(T_Binary_Message);
            when '<' =>
                return State_Less;
            when '>' =>
                return State_Great;
            when '=' =>
                Current_Message := Message.Egal;
                return Token'(T_Binary_Message);
            when '"' =>
                return State_String;
            when '&' =>
                Current_Message := Message.Et;
                return Token'(T_Binary_Message);
            when '|' =>
                Current_Message := Message.Ou;
                return Token'(T_Binary_Message);
            when '[' =>  
                Current_Char := File.Get;
                while Current_Char /= ']' loop
                    Current_Char := File.Get;
                    if Current_Char = Ascii.Cr then
                        Current_Line_Number := Current_Line_Number + 1;
                    end if;
                end loop;
                return Look_For_Token;
            when others =>
                return Token'(T_Unknown);
        end case;
    end Look_For_Token;


    procedure Next is
    begin  
        Current_Message := Message.Sans_Parametre;
        Bounded_String.Free (Current_String);
        New_Reference := Object.Void_Reference;
        if not At_End then  
            Current_Token := Look_For_Token;
        else
            if File.Is_Include_Open then
                File.Close;  
                Current_Line_Number := Tmp_Line_Number;
                Tmp_Line_Number := 1;
                Current_Token := Look_For_Token;
            else
                Current_Token := Token'(T_Eof);
            end if;
        end if;

    end Next;


end Scanner;
DataMuseum.dk

Rational R1000/400 Tapes

⟦5d4730c93⟧ TextFile

Derivation

TextFile
