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

⟦472e05308⟧ TextFile

    Length: 13907 (0x3653)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Text_Io;
with Letter_Utilities;

package body Lex is
    The_File : Text_Io.File_Type;
    Lookahead : Boolean := False;
    Current_Token : Token.Object;
    Current_Value : Personnal_String.Object;
    Current_Char : Character;


    type State is (St_Normal, St_Less, St_Great, St_Word, St_Heure,
                   St_Heure_Number, St_Min, St_Min_Number,
                   St_Sec, St_Number, St_Commentaire, St_Found);

    procedure Lex_Open (Nom_Fichier : String) is  
        Mode : Text_Io.File_Mode := Text_Io.In_File;
    begin
        Text_Io.Open
           (File => The_File, Mode => Mode, Name => Nom_Fichier, Form => "");
    end Lex_Open;

    function Lex_Time_Value (Stime : String) return String is
        Ptr : Integer := 1;
        Valeur : Integer := 0;

    begin  
        for I in 1 .. Stime'Length loop
            if Stime (I) in '0' .. '9' then
                null;
            else
                case Stime (I) is
                    when 'h' =>
                        Valeur :=
                           Valeur +
                              Integer'Value (Stime (Ptr .. I - 1)) * 36000;
                        Ptr := I + 1;
                    when 'm' =>  
                        Valeur := Valeur + Integer'Value
                                              (Stime (Ptr .. I - 1)) * 600;
                        Ptr := I + 1;
                    when '.' =>
                        Valeur := Valeur + Integer'Value
                                              (Stime (Ptr .. I - 1)) * 10;
                        Ptr := I + 1;
                        if Stime (Ptr) in '0' .. '9' then
                            Valeur := Valeur + Integer'Value
                                                  (Stime (Ptr .. Ptr));
                            Ptr := Ptr + 1;
                        end if;
                    when ' ' =>
                        Valeur := Valeur + Integer'Value (Stime (Ptr .. I - 1));
                        Ptr := Ptr + 1;
                    when others =>
                        null;
                end case;
            end if;
        end loop;
        return Integer'Image (Valeur);
    end Lex_Time_Value;

    procedure Lex_Close is
    begin
        Text_Io.Close (The_File);
    end Lex_Close;

    function Lex_Get_Char return Character is
    begin
        if Lookahead then
            Lookahead := False;
        else
            if Text_Io.End_Of_Line (The_File) then
                Text_Io.Skip_Line (The_File);
                Current_Char := Ascii.Cr;
            else
                Text_Io.Get (The_File, Current_Char);
            end if;
        end if;  
        return Current_Char;
    end Lex_Get_Char;

    procedure Lex_Unget is  
    begin
        Lookahead := True;
    end Lex_Unget;



    procedure Lex_Next is  
        The_Char : Character;  
        Current_State : State;
    begin
        if not Text_Io.End_Of_File (The_File) then
            Personnal_String.Raz (Current_Value);
            Current_State := St_Normal;
            while Current_State /= St_Found loop
                if not Text_Io.End_Of_File (The_File) then
                    The_Char := Letter_Utilities.Convert_Upper_To_Lower
                                   (Lex_Get_Char);
                else
                    The_Char := Ascii.Eot;
                end if;
                case Current_State is
                    when St_Normal =>
                        case The_Char is
                            when ' ' | Ascii.Cr =>
                                null;
                            when Ascii.Eot =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Eof;
                            when '<' =>
                                Current_State := St_Less;
                            when '>' =>
                                Current_State := St_Great;
                            when '=' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Egal;
                            when ':' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Deuxpoints;
                            when ',' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Virgule;
                            when '.' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Point;
                            when '(' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Parentheseg;
                            when ')' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Parenthesed;
                            when '+' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Plus;
                            when '-' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Moins;
                            when '/' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Slash;
                            when '*' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Star;
                            when '[' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Crochetg;
                            when ']' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Crochetd;
                            when '{' =>
                                Current_State := St_Commentaire;
                            when others =>
                                if The_Char in 'a' .. 'z' then
                                    Personnal_String.Put
                                       (Current_Value, The_Char);
                                    Current_State := St_Word;
                                else
                                    if The_Char in '0' .. '9' then
                                        Personnal_String.Put
                                           (Current_Value, The_Char);
                                        Current_State := St_Number;
                                    else
                                        Current_State := St_Found;
                                        Current_Token := Token.L_Unk;
                                    end if;
                                end if;
                        end case;

                    when St_Commentaire =>
                        if The_Char = '}' then
                            Current_State := St_Normal;
                        end if;

                    when St_Less =>
                        case The_Char is
                            when '=' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Inf_Ou_Egal;
                            when '>' =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Different;
                            when others =>
                                Current_State := St_Found;
                                Current_Token := Token.L_Inf;
                                Lex_Unget;
                        end case;

                    when St_Great =>
                        if The_Char = '=' then
                            Current_State := St_Found;
                            Current_Token := Token.L_Sup_Ou_Egal;
                        else
                            Current_State := St_Found;
                            Current_Token := Token.L_Sup;
                            Lex_Unget;
                        end if;

                    when St_Word =>
                        if The_Char in 'a' .. 'z' or
                           The_Char in '0' .. '9' or The_Char = '_' then
                            Personnal_String.Put (Current_Value, The_Char);
                        else  
                            Current_State := St_Found;  
                            Current_Token := Token.Search_Token
                                                (Personnal_String.Value
                                                    (Current_Value));
                            Lex_Unget;
                        end if;

                    when St_Number =>
                        if The_Char in '0' .. '9' then
                            Personnal_String.Put (Current_Value, The_Char);
                        else
                            case The_Char is
                                when 'h' =>
                                    Current_State := St_Heure_Number;
                                    Personnal_String.Put
                                       (Current_Value, The_Char);
                                when 'm' =>
                                    Current_State := St_Min_Number;
                                    Personnal_String.Put
                                       (Current_Value, The_Char);
                                when '.' =>
                                    Current_State := St_Sec;
                                    Personnal_String.Put
                                       (Current_Value, The_Char);
                                when others =>
                                    Current_State := St_Found;
                                    Current_Token := Token.L_Int;
                                    Lex_Unget;  
                            end case;
                        end if;

                    when St_Heure_Number =>
                        if The_Char in '0' .. '9' then
                            Personnal_String.Put (Current_Value, The_Char);
                            Current_State := St_Heure;
                        else
                            Current_State := St_Found;
                            Current_Token := Token.L_Time;
                            Lex_Unget;
                        end if;

                    when St_Heure =>
                        if The_Char in '0' .. '9' then
                            Personnal_String.Put (Current_Value, The_Char);
                        else
                            case The_Char is
                                when 'm' =>
                                    Current_State := St_Min_Number;
                                    Personnal_String.Put
                                       (Current_Value, The_Char);
                                when '.' =>
                                    Current_State := St_Sec;
                                    Personnal_String.Put
                                       (Current_Value, The_Char);
                                when others =>
                                    Current_State := St_Found;
                                    Current_Token := Token.L_Unk;
                                    Lex_Unget;
                            end case;
                        end if;

                    when St_Min_Number =>
                        if The_Char in '0' .. '9' then
                            Personnal_String.Put (Current_Value, The_Char);
                            Current_State := St_Min;
                        else
                            Current_State := St_Found;
                            Current_Token := Token.L_Time;
                            Lex_Unget;
                        end if;

                    when St_Min =>
                        if The_Char in '0' .. '9' then
                            Personnal_String.Put (Current_Value, The_Char);
                        else
                            if The_Char = '.' then
                                Personnal_String.Put (Current_Value, The_Char);
                                Current_State := St_Sec;
                            else
                                Current_State := St_Found;
                                Current_Token := Token.L_Unk;
                                Lex_Unget;
                            end if;
                        end if;

                    when St_Sec =>
                        if The_Char in '0' .. '9' then
                            Personnal_String.Put (Current_Value, The_Char);
                            Current_State := St_Found;
                            Current_Token := Token.L_Time;
                        else
                            Current_State := St_Found;
                            Current_Token := Token.L_Unk;
                        end if;

                    when others =>
                        null;
                end case;
            end loop;  
        else
            Current_Token := Token.L_Eof;
        end if;

    end Lex_Next;


    function Lex_Get_Token return Token.Object is
    begin
        return Current_Token;
    end Lex_Get_Token;


    function Lex_Get_Value return Personnal_String.Pstring is
        Ptr : Personnal_String.Pstring;
    begin
        case Current_Token is
            when Token.L_Time =>
                Ptr := new String'(Lex_Time_Value
                                      (Personnal_String.Value (Current_Value)));
            when others =>
                Ptr := new String'(Personnal_String.Value (Current_Value));
        end case;
        return Ptr;
    end Lex_Get_Value;

    function Lex_At_End return Boolean is

    begin
        return Text_Io.End_Of_File (The_File);
    end Lex_At_End;

end Lex;