⟦1837e221c⟧

TextFile

with File;
with Object;  
with Integer_Classe;
with String_Classe;
with Bounded_String;
with String_Utilities;
with Symbol;
with Table;  
with Text_Io;
package body Scanner is

    Void_Id_Object : constant := 0;
    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_Bloc_Number : Natural := 0;
    Line_Number : Natural := 0;

    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 Integer is
    begin
        return Line_Number;
    end Get_Line_Number;

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

    function Get_Value return String is
    begin
        return Bounded_String.Image (V => Current_String);
    end Get_Value;

    function Get_Value return Object.Reference is
        New_Object : Object.Reference := Object.Void_Reference;
        Current_Table : Table.Symbol_Kind;
        In_Table : Boolean := False;
    begin  
        if Current_Token = T_Identifier then
            Symbol.Find (Name => Current_String,
                         New_Reference => New_Reference,
                         Current_Table => Current_Table,
                         Is_Found => In_Table);
            if not In_Table then
                Table.Insert (The_Table => Current_Table,
                              Name => Current_String,
                              New_Reference => New_Object);
            end if;
            return New_Object;
        else
            return New_Reference;
        end if;
    end Get_Value;

    procedure Get_Value (Current_Table : in out Table.Symbol_Kind;
                         S : out Message.Tiny_String) is
        In_Table : Boolean := False;
    begin
        Table.Find (The_Table => Current_Table,
                    Name => Current_String,
                    New_Reference => New_Reference,
                    Success => In_Table);
        if not In_Table then
            Table.Insert (The_Table => Current_Table,
                          Name => Current_String,
                          New_Reference => New_Reference);
        end if;
        S := Current_String;
    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_Classe.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;
        In_Table : Boolean := False;
    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 ':' =>  
                Bounded_String.Append (Target => Current_String,
                                       Source => Current_Char);
                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_Classe.Create (Current_String);
                return Token'(T_String);

            when Ascii.Cr =>
                Line_Number := 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 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 =>  
                Line_Number := 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 '{' =>
                Bounded_String.Append (Current_String, "Bloc_N__");
                Bounded_String.Append (Target => Current_String,
                                       Source => Natural'Image
                                                    (Current_Bloc_Number));  
                Current_Bloc_Number := Current_Bloc_Number + 1;
                return Token'(T_Bloc_Open);

            when '}' =>
                return Token'(T_Bloc_End);
            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
                        Line_Number := Line_Number + 1;
                    end if;
                end loop;
                return Look_For_Token;

            when Ascii.Eot =>
                return Token'(T_Eof);
            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
            Current_Token := Token'(T_Eof);
        end if;

    end Next;


end Scanner;
DataMuseum.dk

Rational R1000/400 Tapes

⟦1837e221c⟧ TextFile

Derivation

TextFile
