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

⟦c3d074179⟧ TextFile

    Length: 12377 (0x3059)
    Types: TextFile
    Names: »B«

Derivation

└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Text_Io;

with Les_Types;
use Les_Types;

with Char;
use Char;

package body Lex is


    type State is (St_Normal, St_Slash, St_Com_St, St_Com_End,
                   St_Less, St_Great, St_Let, St_Word,
                   St_Litt, St_Quote, St_Number, St_Found);


    type Keyword is
        record  
            Name : Pointeur_Chaine;
            Letoken : Token;
        end record;



    type Tableau_Kewords is array (Positive range <>) of Keyword;
    Keywords : constant Tableau_Kewords :=
       ((new String'("ARCCOS"), L_Arccos), (new String'("ARCCOT"), L_Arccot),  
        (new String'("ARCCOTH"), L_Arccoth), (new String'("ARCSIN"), L_Arcsin),
        (new String'("ARCTAN"), L_Arctan), (new String'("ARCTANH"), L_Arctanh),
        (new String'("COS"), L_Cos), (new String'("COTH"), L_Coth),
        (new String'("SIN"), L_Sin), (new String'("SINH"), L_Sinh),
        (new String'("TAN"), L_Tan), (new String'("TANH"), L_Tanh),

        (new String'("a"), L_A), (new String'("acteur"), L_Acteur),
        (new String'("activer"), L_Activer), (new String'("alors"), L_Alors),
        (new String'("attendre"), L_Attendre), (new String'("aucun"), L_Aucun),
        (new String'("bien"), L_Bien), (new String'("binaire"), L_Binaire),
        (new String'("changer"), L_Changer),
        (new String'("collection"), L_Collection),
        (new String'("dans"), L_Dans), (new String'("debut"), L_Debut),
        (new String'("discret"), L_Discret), (new String'("effet"), L_Effet),
        (new String'("est"), L_Est), (new String'("et"), L_Et),
        (new String'("evoluer"), L_Evoluer),
        (new String'("executer"), L_Executer),
        (new String'("experience"), L_Experience),
        (new String'("faire"), L_Faire), (new String'("faux"), L_Faux),
        (new String'("fin"), L_Fin), (new String'("fois"), L_Fois),
        (new String'("fonction"), L_Funct),
        (new String'("flottant"), L_Flottant),
        (new String'("fugitif"), L_Fugitif),
        (new String'("materiel"), L_Materiel), (new String'("non"), L_Non),
        (new String'("ou"), L_Ou), (new String'("oui"), L_Oui),
        (new String'("puis"), L_Puis), (new String'("que"), L_Que),
        (new String'("registre"), L_Registre),
        (new String'("repeter"), L_Repeter),
        (new String'("representation"), L_Representation),
        (new String'("retourne"), L_Retourne), (new String'("selon"), L_Selon),
        (new String'("si"), L_Si), (new String'("sinon"), L_Sinon),
        (new String'("spectacle"), L_Spectacle),
        (new String'("station"), L_Station), (new String'("tant"), L_Tant),
        (new String'("temporel"), L_Temporel),
        (new String'("theatre"), L_Theatre), (new String'("vrai"), L_Vrai)

        );
    The_File : Text_Io.File_Type;
    Current_Value : String (1 .. 256);
    Long_Current_Value : Integer := 0;
    Current_Token : Token;
    Eof : constant Character := '$';
    Nombre_Flottant : Float;




    function Keyword_To_Token (Word : Pointeur_Chaine) return Token is
        Low, High, Mid : Integer;
        B : Boolean;
    begin  
        Low := 1;
        High := Keywords'Last (1);
        while (Low <= High) loop
            Mid := (Low + High) / 2;
            if (Word.all < Keywords (Mid).Name.all) then
                High := Mid - 1;
            else
                if (Word.all = Keywords (Mid).Name.all) then
                    return Keywords (Mid).Letoken;
                else
                    Low := Mid + 1;
                end if;
            end if;
        end loop;
        return L_Reg;
    end Keyword_To_Token;


    function Lex_Get_Value1 return Pointeur_Chaine is
        Chaine : Pointeur_Chaine;
    begin
        if Long_Current_Value /= 0 then
            Chaine := new String'(Current_Value (1 .. Long_Current_Value));
            return Chaine;
        else
            return null;
        end if;

    end Lex_Get_Value1;








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


    function Lex_At_End1 (Afile : Text_Io.File_Type) return Boolean is
    begin
        return Char_At_End (Afile);
    end Lex_At_End1;

    function Isalpha (C : Character) return Boolean is
    begin
        case C is
            when 'A' .. 'Z' =>
                return True;
            when 'a' .. 'z' =>
                return True;
            when others =>
                return False;
        end case;
    end Isalpha;

    function Isdigit (C : Character) return Boolean is
    begin
        if C in '0' .. '9' or C = '.' then
            return True;
        else
            return False;
        end if;
    end Isdigit;

    procedure Lex_Next_Token1 (Afile : Text_Io.File_Type) is
        Crt : String (1 .. 256);
        C : Character;
        The_State : State;
        Long_Chaine : Integer := 0;
    begin
        if not (Char_At_End (Afile)) then
            Crt := Current_Value;
            The_State := St_Normal;
            while (The_State /= St_Found) loop
                if not (Char_At_End (Afile)) then
                    Char_Next (Afile);
                    C := Char_Value (Afile);
                else
                    C := Eof;
                end if;
                case (The_State) is
                    when St_Normal =>
                        case C is
                            when Eof =>
                                Current_Token := L_Eof;
                                The_State := St_Found;
                            when ' ' =>
                                null;

                            when Ascii.Nul .. Ascii.Us =>
                                null;

                            when '/' =>
                                The_State := St_Slash;
                            when '<' =>
                                The_State := St_Less;
                            when '>' =>
                                The_State := St_Great;
                            when '=' =>
                                Current_Token := L_Eq;
                                The_State := St_Found;
                            when '-' =>
                                Current_Token := L_Moins;
                                The_State := St_Found;
                            when '+' =>
                                Current_Token := L_Plus;
                                The_State := St_Found;
                            when '*' =>
                                Current_Token := L_Star;
                                The_State := St_Found;
                            when ';' =>
                                Current_Token := L_Separ;
                                The_State := St_Found;
                            when ',' =>
                                Current_Token := L_Virg;
                                The_State := St_Found;
                            when '?' =>
                                Current_Token := L_Prt;
                                The_State := St_Found;
                            when '(' =>
                                Current_Token := L_Open;
                                The_State := St_Found;
                            when ')' =>
                                Current_Token := L_Close;
                                The_State := St_Found;
                            when '%' =>
                                Current_Token := L_Mod;
                                The_State := St_Found;
                            when ':' =>
                                The_State := St_Let;
                            when '\' =>
                                The_State := St_Litt;
                            when others =>
                                if (Isalpha (C)) then
                                    Long_Chaine := Long_Chaine + 1;
                                    Crt (Long_Chaine) := C;
                                    The_State := St_Word;


                                else
                                    if Isdigit (C) then
                                        Long_Chaine := Long_Chaine + 1;
                                        Crt (Long_Chaine) := C;
                                        The_State := St_Number;
                                    else
                                        Current_Token := L_Unk;
                                        The_State := St_Found;
                                    end if;
                                end if;
                        end case;
                    when St_Slash =>
                        if (C = '*') then
                            The_State := St_Com_St;
                        else
                            Char_Unget (Afile);
                            Current_Token := L_Div;
                            The_State := St_Found;
                        end if;
                    when St_Com_End =>
                        if (C = '*') then
                            The_State := St_Com_End;
                        end if;
                    when St_Less =>
                        case C is
                            when '=' =>
                                Current_Token := L_Leq;
                                The_State := St_Found;
                            when '>' =>
                                Current_Token := L_Neq;
                                The_State := St_Found;
                            when others =>
                                Char_Unget (Afile);
                                Current_Token := L_Lt;
                                The_State := St_Found;
                        end case;
                    when St_Great =>
                        if (C = '=') then
                            Current_Token := L_Geq;
                        else
                            Char_Unget (Afile);
                            Current_Token := L_Gt;
                        end if;
                        The_State := St_Found;
                    when St_Let =>
                        if (C = '=') then
                            Current_Token := L_Affect;
                        else
                            Current_Token := L_Dp;
                        end if;
                        The_State := St_Found;
                    when St_Word =>
                        if (Isalpha (C)) or Isdigit (C) then
                            Long_Chaine := Long_Chaine + 1;
                            Crt (Long_Chaine) := C;
                        else
                            Char_Unget (Afile);
                            Current_Token := Keyword_To_Token (Lex_Get_Value1);
                            The_State := St_Found;
                        end if;
                    when St_Litt =>
                        if (C = '\') then
                            The_State := St_Quote;
                        else
                            Long_Chaine := Long_Chaine + 1;
                            Crt (Long_Chaine) := C;
                        end if;
                    when St_Quote =>
                        if (C = '\') then
                            Long_Chaine := Long_Chaine + 1;
                            Crt (Long_Chaine) := C;
                            The_State := St_Litt;
                        else
                            Current_Token := L_Str;
                            The_State := St_Found;
                        end if;
                    when St_Number =>
                        if (Isdigit (C)) then
                            Long_Chaine := Long_Chaine + 1;
                            Crt (Long_Chaine) := C;
                        else
                            Char_Unget (Afile);
                            Current_Token := L_Digit;
                            The_State := St_Found;
                        end if;
                    when others =>
                        null;
                end case;
                Long_Current_Value := Long_Chaine;
                Current_Value (1 .. Long_Chaine) := Crt (1 .. Long_Chaine);
            end loop;
        else
            Current_Token := L_Eof;
        end if;

        Text_Io.Put_Line ("####### : #" & Current_Value (1 .. Long_Chaine));


    end Lex_Next_Token1;

    procedure Lex_Open1 (Afile : Text_Io.File_Type) is
    begin
        Char_Open (Afile);
    end Lex_Open1;

end Lex;