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

⟦e886c4194⟧ TextFile

    Length: 15325 (0x3bdd)
    Types: TextFile
    Names: »B«

Derivation

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

TextFile

with Text_Io;
with Lexical;
use Lexical;
package body Parse is
    procedure Error (Nature : in Token;
                     Regle : in out Token;
                     Type_Error : String) is
    begin
        Text_Io.Put_Line (Type_Error);
        Regle := Nature;
    end Error;

    function Quid return Token is
        Response : Lexical.Token;
    begin
        Lexical.Next;
        Response := Lexical.Get_Token;
        Text_Io.Put_Line (Lexical.Token'Image (Response));
        return Response;
    end Quid;

    function Expression_Red_Nbre return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Id then
            null;
        end if;
        if Lu = L_Number then
            null;
        end if;
        return Lu;
    end Expression_Red_Nbre;

    function Facteur return Token is
        Lu : Token;
    begin
        Lu := Quid;
        return Lu;
    end Facteur;

    function Expr_Bis return Token is
        Lu : Token;
    begin
        Lu := Quid;
        loop
            case Lu is
                when L_Plus =>
                    Lu := Expr_Bis;
                when L_Sub =>
                    Lu := Expr_Bis;
                when L_Star =>
                    Lu := Expr_Bis;
                when L_Number =>
                    Lu := Expr_Bis;
                when L_Open =>
                    Lu := Facteur;
                when others =>
                    exit;
            end case;
        end loop;
        return Lu;
    end Expr_Bis;

    function Calcul return Token is
    begin
        return Expr_Bis;
    end Calcul;

    procedure Expression_Red is
        Lu : Token;
    begin
        Lu := Quid;
        case Lu is
            when L_Id =>
                null;
            when L_Number =>
                null;
            when L_Temps =>
                null;
            when others =>
                null;
        end case;
        null;
    end Expression_Red;

    function Bloc_Groupe return Token;
    function Bloc_Groupe_Bis return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Virgule then
            Lu := Bloc_Groupe;
        end if;
        return Lu;
    end Bloc_Groupe_Bis;

    function Bloc_Groupe return Token is
        Lu : Token;
    begin
        Lu := Quid;
        case Lu is
            when L_Hasard =>
                if Quid = L_De then
                    if Quid = L_Open then
                        if Bloc_Groupe = L_Close then
                            Lu := L_Close;
                        end if;
                    end if;
                end if;

            when L_Premier =>
                if Quid = L_De then
                    if Quid = L_Open then
                        if Bloc_Groupe = L_Close then
                            Lu := L_Close;
                        end if;
                    end if;
                end if;  
            when L_Id =>
                null;
            when L_Number =>
                null;
            when L_Temps =>
                null;
            when others =>
                null;  
        end case;
        return Lu;
        Expression_Red;


    end Bloc_Groupe;

    function Op_Groupe return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Avec then
            if Quid = L_Open then
                if Bloc_Groupe = L_Close then
                    Lu := L_Close;
                end if;
            end if;
        end if;
        if Lu = L_Sans then
            if Quid = L_Open then
                if Bloc_Groupe = L_Close then
                    Lu := L_Close;
                end if;
            end if;
        end if;
        return Lu;
    end Op_Groupe;

    function Groupe return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Id then
            if Quid = L_Est then
                if Quid = L_Open then
                    if Bloc_Groupe = L_Close then
                        Lu := Op_Groupe;
                    end if;
                end if;
            end if;
        end if;
        return Lu;
    end Groupe;

    procedure Expression_Red_Tps is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Id then
            null;
        end if;
        if Lu = L_Temps then
            null;
        end if;
    end Expression_Red_Tps;

    function Cont_Gpe_Temps return Token;
    function Cont_Gpe_Temps_Bis return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Virgule then
            Lu := Cont_Gpe_Temps;
        end if;
        return Lu;
    end Cont_Gpe_Temps_Bis;

    function Cont_Gpe_Temps return Token is
        Lu : Token;
    begin
        Expression_Red_Tps;
        Lu := Cont_Gpe_Temps_Bis;
        return Lu;
    end Cont_Gpe_Temps;

    function Groupe_Tps return Token is
        Lu : Token;
    begin
        Lu := Quid;
        case Lu is
            when L_Open =>
                Lu := Cont_Gpe_Temps;
            when L_Id =>
                null;
            when L_Temps =>
                null;
            when others =>
                null;
        end case;
        return Lu;
    end Groupe_Tps;

    function Oper_Temps return Token is
        Lu : Token;
    begin
        Lu := Quid;
        case Lu is
            when L_Duree =>
                if Quid = L_De then
                    if Quid = L_Open then
                        if Quid = L_Id then
                            Lu := Quid;
                        end if;
                    end if;
                end if;
            when L_Hasard =>
                if Quid = L_De then
                    Lu := Groupe_Tps;
                end if;
            when L_Premier =>
                if Quid = L_De then
                    Lu := Groupe_Tps;
                end if;
            when others =>
                Lu := Groupe_Tps;
                return Lu;
        end case;
    end Oper_Temps;

    function Ordre_Bis return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_De then
            Expression_Red;
            if Quid = L_Vers then
                Expression_Red;
                Lu := Quid;
                if Lu = L_En then
                    Expression_Red;
                end if;
            end if;
        end if;
        return Lu;
    end Ordre_Bis;

    function Ordre return Token is
        Lu : Token;
    begin
        Lu := Bloc_Groupe;
        if Lu = L_Close then
            Lu := Ordre_Bis;
        end if;
        return Lu;
    end Ordre;

    function Petites_Instructions return Token is
        Lu : Token;
    begin
        Lu := Quid;
        case Lu is
            when L_Id =>
                Lu := Ordre_Bis;
            when L_Open =>
                Lu := Ordre;
            when L_Equal =>
                Lu := Calcul;
            when others =>
                null;
        end case;
        return Lu;
    end Petites_Instructions;

    function Instructions return Token;
    function Liste_Instructions return Token is
        Lu : Token;
    begin
        Lu := Quid;
        loop
            case Lu is
                when L_Dans =>
                    if Oper_Temps = L_Faire then
                        if Quid = L_Debut then
                            Lu := Instructions;  
                        end if;
                    end if;
                when L_Repeter =>
                    if Expression_Red_Nbre = L_Fois then
                        if Quid = L_Debut then
                            Lu := Instructions;
                        end if;
                    end if;
                when L_Repeter_Ad_Eternam =>
                    if Quid = L_Debut then
                        Lu := Instructions;
                    end if;
                when L_Toutes =>
                    if Quid = L_Les then
                        if Oper_Temps = L_Pendant then
                            if Oper_Temps = L_Faire then
                                if Quid = L_Debut then
                                    Lu := Instructions;
                                end if;
                            end if;
                        end if;
                    end if;
                when L_Id =>
                    Lu := Petites_Instructions;
                when L_Groupe =>
                    Lu := Groupe;
                when L_Fin =>
                    exit;
                when others =>
                    null;
            end case;
        end loop;
        return Lu;
    end Liste_Instructions;


    function Instructions return Token is
        Lu : Token;
    begin
        Lu := Liste_Instructions;
        return Lu;
    end Instructions;

    function Bloc_Enchainement return Token is
        Lu : Token;
    begin
        Lu := Liste_Instructions;
        if Lu = L_Fin then ----or Lu = L_Close or Lu = L_Id then---
            Lu := Bloc_Enchainement;
        end if;
        return Lu;
    end Bloc_Enchainement;

    procedure Def_Enchainement is
    begin
        if Quid = L_Enchainement then
            if Quid = L_Debut then
                if Bloc_Enchainement = L_Fin then
                    null;
                end if;
            end if;
        end if;
    end Def_Enchainement;

    function Bloc_Sequence return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Scene then
            if Quid = L_Id then
                if Quid = L_Debut then
                    if Instructions = L_Fin then
                        Lu := L_Fin;
                    end if;
                end if;
            end if;
        end if;
        return Lu;
    end Bloc_Sequence;

    function Bloc_Scenario return Token is
        Lu : Token;
    begin
        Lu := Bloc_Sequence;
        if Lu = L_Fin then
            Lu := Bloc_Scenario;
        end if;
        return Lu;
    end Bloc_Scenario;

    procedure Def_Scenario is
    begin
        if Quid = L_Scenario then
            if Quid = L_Debut then
                if Bloc_Scenario = L_Fin then
                    null;
                end if;
            end if;
        end if;
    end Def_Scenario;

    function Bloc_Experience return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Effet then
            if Quid = L_Id then
                if Quid = L_Open then
                    if Bloc_Groupe = L_Close then
                        if Quid = L_Debut then
                            if Instructions = L_Fin then
                                Lu := Bloc_Experience;
                            end if;
                        end if;
                    end if;
                end if;
            end if;
        end if;
        return Lu;
    end Bloc_Experience;

    procedure Def_Experience is
    begin
        if Quid = L_Experience then
            if Quid = L_Debut then
                if Bloc_Experience = L_Fin then
                    null;
                end if;
            end if;
        end if;
    end Def_Experience;

    function Bloc_Acteur return Token is --------------
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Id then
            if Quid = L_Est then
                if Quid = L_Id then
                    if Quid = L_Sur then
                        if Quid = L_Station then
                            if Quid = L_Number then
                                Lu := Bloc_Acteur;
                            end if;
                        end if;
                    end if;
                end if;
            end if;
        end if;
        return Lu;
    end Bloc_Acteur;

    procedure Def_Acteurs is
    begin
        if Quid = L_Acteurs then
            if Quid = L_Debut then
                if Bloc_Acteur = L_Fin then
                    null;
                end if;
            end if;
        end if;
    end Def_Acteurs;

    procedure Un_Type is
        Lu : Token;
    begin
        Lu := Quid;
        case Lu is
            when L_Discret =>
                null;
            when L_Temporel =>
                null;
            when others =>
                Error (L_Close, Lu, "abscence de type discret ou temporel");
        end case;
    end Un_Type;

    function Contenu_Option_Bis return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_En then
            Un_Type;
            Lu := Quid;
            if Lu = L_Close then
                null;
            else
                Error (L_Close, Lu, "une parenthese fermante est attendue");
            end if;
        end if;
        return Lu;
    end Contenu_Option_Bis;

    function Contenu_Option return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Vers then
            Un_Type;
            Lu := Contenu_Option_Bis;
            if Lu = L_Close then
                null;
            end if;
        end if;
        return Lu;
    end Contenu_Option;

    function Option return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Open then
            if Quid = L_De then
                Un_Type;
                Lu := Contenu_Option;
                if Lu = L_Close then
                    Lu := Quid;
                end if;
            end if;
        end if;
        return Lu;
    end Option;

    function Liste return Token is
        Lu : Token;
    begin
        Lu := Quid;
        while Lu = L_Id loop
            if Quid = L_Est then
                if Quid = L_Number then
                    Lu := Option;
                else
                    exit;
                end if;
            else
                Error (L_Fin, Lu, "pas de 'est'");
                exit;
            end if;
        end loop;
        return Lu;
    end Liste;

    function Bloc_Materiel return Token is
        Lu : Token;
    begin
        Lu := Quid;
        if Lu = L_Id then
            if Quid = L_Fait then
                if Quid = L_Debut then
                    if Liste = L_Fin then
                        Lu := Bloc_Materiel;
                    else
                        Error (L_Fin, Lu, "pas de fin");
                    end if;
                else
                    Error (L_Fin, Lu, "pas de 'debut'");
                end if;
            else
                Error (L_Fin, Lu, "pas de 'fait'");
            end if;
        else
            Error (L_Fin, Lu, "pas d'identificateur");
        end if;
        return Lu;
    end Bloc_Materiel;

    procedure Def_Materiel is
        Lu : Token;
    begin
        if Quid = L_Materiel then
            if Quid = L_Debut then
                if Bloc_Materiel = L_Fin then
                    null;
                else
                    Error (L_Fin, Lu, "pas de fin du bloc materiel");
                end if;
            else
                Error (L_Debut, Lu, "pas de debut du bloc materiel");
            end if;
        else
            Error (L_Materiel, Lu, "pas de definition du materiel");
        end if;
    end Def_Materiel;

    procedure Code is
    begin
        Def_Materiel;
        Def_Acteurs;
        Def_Experience;
        Def_Scenario;
        Def_Enchainement;
        if Quid = L_Eof then
            null;
        end if;
    end Code;

    procedure Parseur is
    begin
        Code;
    end Parseur;

end Parse;