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

⟦41e3df54a⟧ TextFile

    Length: 13967 (0x368f)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Bounded_String;
with File;
with Msg_Report;
with String_Utilities;
with Text_Io;


package body Scanner is

    function Is_Equal_String
                (Str1 : String; Str2 : String; Ignore_Case : Boolean := True)
                return Boolean renames String_Utilities.Equal;


    type State is (S_Found, S_Start, S_Integer, S_Identifier,
                   S_String, S_Minus, S_Less, S_Great, S_Comment);

    Current_String : B_String;
    Current_Token : Token;
    Current_Line : Integer := 1;


    -- ouverture du fichier
    -- ====================

    procedure Open (File_Name : String) is
    begin
        File.Open (File_Name);

    exception
        -- signaler l'erreur sur ouverture d'un fichier inexistant
        when Text_Io.Name_Error =>
            Msg_Report.Lexical_Error
               ("The file """ & File_Name & """ doesn't exist !!!", False);
            raise Inexistant_File;

    end Open;


    -- fermeture du fichier
    -- ====================

    procedure Close is
    begin
        File.Close;
    end Close;


    -- renvoi VRAI si fin de l'analyse lexicale (avec fermeture du fichier)
    -- ====================================================================

    function Is_At_End return Boolean is
    begin
        if File.Is_At_End_File then
            Close;
            return True;
        else
            return False;
        end if;
    end Is_At_End;


    -- retourne le type "token identificateur" de la chaine courante
    -- =============================================================

    function Eval_Identifier (Ident : String) return Token is
    begin  
        if Is_Equal_String (Ident, "avec") then
            return L_Avec;
        elsif Is_Equal_String (Ident, "pour") then
            return L_Pour;
        elsif Is_Equal_String (Ident, "prendre") then
            return L_Prendre;
        elsif Is_Equal_String (Ident, "renvoyer") then
            return L_Renvoyer;
        else
            return L_Identifier;
        end if;
    end Eval_Identifier;


    -- analyse lexicale du symbole suivant
    -- ===================================

    procedure Next is

        Current_Char : Character;
        Current_State : State;

    begin
        if Is_At_End then
            Current_Token := L_Eof;
        else
            -- initialiser la chaine a vide
            Bounded_String.Free (Current_String);

            -- initialiser l'etat de depart
            Current_State := S_Start;

            while (Current_State /= S_Found) loop

                if File.Is_At_End_File then

                    case Current_State is

                        when S_Integer =>
                            Current_Token := L_Integer;

                        when S_Identifier =>
                            -- recherche sur l'identificateur (reserve ou non)
                            Current_Token := Eval_Identifier
                                                (Bounded_String.Image
                                                    (Current_String));
                        when others =>
                            -- fermeture du fichier
                            Close;
                            Current_Token := L_Eof;

                    end case;
                    Current_State := S_Found;

                else

                    if File.Is_At_End_Line then
                        -- caractere = CR, avancer d'une position dans le fichier
                        Current_Char := File.Get_Cr;
                        Current_Line := Current_Line + 1;
                    else
                        -- avancer dans le fichier et lire le caractere courant
                        Current_Char := File.Get;
                    end if;

                    case Current_State is

                        when S_Start =>
                            case Current_Char is

                                when ' ' | Ascii.Ht | Ascii.Cr =>
                                    null;

                                when '0' .. '9' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_State := S_Integer;

                                when 'A' .. 'Z' | 'a' .. 'z' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_State := S_Identifier;

                                when '"' =>
                                    Current_State := S_String;

                                when '{' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Open_Bracket;
                                    Current_State := S_Found;

                                when '}' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Close_Bracket;
                                    Current_State := S_Found;

                                when '.' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Dot;
                                    Current_State := S_Found;

                                when '(' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Open_Parenthesis;
                                    Current_State := S_Found;

                                when ')' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Close_Parenthesis;
                                    Current_State := S_Found;

                                when '-' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_State := S_Minus;

                                when '+' | '*' | '/' | '=' | '&' | '|' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Binary_Msg;
                                    Current_State := S_Found;

                                when '<' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_State := S_Less;

                                when '>' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_State := S_Great;

                                when others =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Unknown;
                                    Current_State := S_Found;
                                    Msg_Report.Lexical_Error
                                       (", undefined character -> ");

                            end case;

                        when S_Integer =>
                            case Current_Char is

                                when 'A' .. 'Z' | 'a' .. 'z' | '_' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Unknown;
                                    Current_State := S_Found;
                                    Msg_Report.Lexical_Error
                                       (", alphabetic character not allowed in integer -> ");

                                when '0' .. '9' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);

                                when others =>  
                                    File.Unget;
                                    Current_Token := L_Integer;
                                    Current_State := S_Found;

                            end case;

                        when S_Identifier =>
                            case Current_Char is

                                when 'A' .. 'Z' | 'a' .. 'z' | '_' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);

                                when ':' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Key_Word;
                                    Current_State := S_Found;

                                when '0' .. '9' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Unknown;
                                    Current_State := S_Found;
                                    Msg_Report.Lexical_Error
                                       (", numeric character not allowed in identifier -> ");

                                when others =>  
                                    File.Unget;
                                    -- recherche sur l'identificateur (reserve ou non)
                                    Current_Token := Eval_Identifier
                                                        (Bounded_String.Image
                                                            (Current_String));
                                    Current_State := S_Found;

                            end case;

                        when S_String =>
                            if Current_Char = '"' then
                                Current_Token := L_String;
                                Current_State := S_Found;
                            else
                                Bounded_String.Append
                                   (Current_String, Current_Char);
                            end if;

                        when S_Minus =>
                            if Current_Char = '-' then
                                Current_State := S_Comment;
                            else
                                File.Unget;
                                Current_Token := L_Binary_Msg;
                                Current_State := S_Found;
                            end if;

                        when S_Less =>
                            case Current_Char is

                                when ' ' | Ascii.Ht | Ascii.Cr =>
                                    null;

                                when '=' | '>' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Binary_Msg;
                                    Current_State := S_Found;

                                when others =>  
                                    File.Unget;
                                    Current_Token := L_Binary_Msg;
                                    Current_State := S_Found;

                            end case;

                        when S_Great =>
                            case Current_Char is

                                when ' ' | Ascii.Ht | Ascii.Cr =>
                                    null;

                                when '=' =>
                                    Bounded_String.Append
                                       (Current_String, Current_Char);
                                    Current_Token := L_Binary_Msg;
                                    Current_State := S_Found;

                                when others =>
                                    File.Unget;
                                    Current_Token := L_Binary_Msg;
                                    Current_State := S_Found;

                            end case;

                        when S_Comment =>
                            if (Current_Char = Ascii.Cr) then
                                -- fin de commentaire, retour a l'etat initial
                                Current_State := S_Start;

                                -- initialiser la chaine a vide
                                Bounded_String.Free (Current_String);
                            end if;

                        when S_Found =>
                            null;

                    end case;
                end if;
            end loop;

            -- fermeture du fichier en cas d'erreur lexicale
            if Current_Token = L_Unknown and then not Is_At_End then
                Close;
            end if;

        end if;
        Msg_Report.Information ("token: " & Token'Image (Current_Token));

    end Next;


    -- retourne la chaine courante
    -- ===========================

    function Value return String is
    begin
        return Bounded_String.Image (Current_String);
    end Value;


    -- retourne le token courant
    -- =========================

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


    -- retourne la ligne courante du fichier
    -- =====================================

    function Line_Number return Integer is
    begin
        return Current_Line;
    end Line_Number;

end Scanner;