⟦3240fa356⟧

TextFile

with Text_Io;
with Erreurs;
with Lexical;
use Lexical;

package body Semantique is

    Max : constant := 255;


    type Un_Acteur is
        record
            L_Acteur : Standard_String.Object;
            L_Adresse : Integer;
            Le_Type : Standard_String.Object;
        end record;

    type Une_Action is
        record
            L_Action : Standard_String.Object;
            Le_Type : Standard_String.Object;
            Le_Code : Integer;
            De, Vers, En : Lexical.Token;
        end record;

    Tableau_Actions : array (1 .. Max) of Une_Action;
    Tableau_Acteurs : array (1 .. Max) of Un_Acteur;

    Nombre_Actions : Integer range 0 .. Max;
    Nombre_Acteurs : Integer range 0 .. Max;


    package Materiels is

        procedure Ouvrir_Bloc_Materiel;
        procedure Fermer_Bloc_Materiel;
        procedure Nouveau_Type (Un_Type : Standard_String.Object);
        procedure Fin_Nouveau_Type;
        procedure Nouvelle_Action (Une_Action : Standard_String.Object);
        procedure Donner_Code_Action (Un_Code : Integer);
        procedure Fin_Nouvelle_Action;
        procedure Ouvrir_Champ_Option;
        procedure Option (Une_Option : Lexical.Token);
        procedure Fermer_Champ_Option;  
        procedure Imprimer_Materiel;
        function Type_Existe (Un_Type : Standard_String.Object) return Boolean;
        function Action_Existe
                    (Un_Type : Standard_String.Object;
                     Une_Action : Standard_String.Object) return Boolean;
        function Action_Existe
                    (L_Action : Standard_String.Object) return Boolean;

    end Materiels;


    procedure Ouvrir_Bloc_Materiel is  
    begin
        Materiels.Ouvrir_Bloc_Materiel;
    end Ouvrir_Bloc_Materiel;


    procedure Fermer_Bloc_Materiel is
    begin
        Materiels.Fermer_Bloc_Materiel;
    end Fermer_Bloc_Materiel;


    procedure Nouveau_Type (Un_Type : Standard_String.Object) is
    begin
        Materiels.Nouveau_Type (Un_Type);
    end Nouveau_Type;


    procedure Fin_Nouveau_Type is
    begin
        Materiels.Fin_Nouveau_Type;
    end Fin_Nouveau_Type;


    procedure Nouvelle_Action (Une_Action : Standard_String.Object) is
    begin
        Materiels.Nouvelle_Action (Une_Action);
    end Nouvelle_Action;


    procedure Donner_Code_Action (Un_Code : Integer) is
    begin
        Materiels.Donner_Code_Action (Un_Code);
    end Donner_Code_Action;


    procedure Fin_Nouvelle_Action is
    begin
        Materiels.Fin_Nouvelle_Action;
    end Fin_Nouvelle_Action;


    procedure Ouvrir_Champ_Option is
    begin
        Materiels.Ouvrir_Champ_Option;
    end Ouvrir_Champ_Option;


    procedure Option (Une_Option : Lexical.Token) is
    begin
        Materiels.Option (Une_Option);
    end Option;


    procedure Fermer_Champ_Option is
    begin
        Materiels.Fermer_Champ_Option;
    end Fermer_Champ_Option;


    procedure Imprimer_Materiel is
    begin
        Materiels.Imprimer_Materiel;
    end Imprimer_Materiel;


    package body Materiels is separate;


    package Acteurs is
        procedure Ouvrir_Bloc_Acteur;
        procedure Fermer_Bloc_Acteur;
        procedure Nouvel_Acteur (Un_Acteur : Standard_String.Object);
        procedure Fin_Nouvel_Acteur;
        procedure Donner_Type_Acteur (Un_Type : Standard_String.Object);
        procedure Donner_Adresse_Station (Une_Adresse : Integer);  
        procedure Imprimer_Acteur;
        function Acteur_Existe
                    (Un_Acteur : Standard_String.Object) return Boolean;
        function Donne_Type_Acteur (Un_Acteur : Standard_String.Object)
                                   return Standard_String.Object;
    end Acteurs;


    procedure Ouvrir_Bloc_Acteur is
    begin
        Acteurs.Ouvrir_Bloc_Acteur;
    end Ouvrir_Bloc_Acteur;


    procedure Fermer_Bloc_Acteur is
    begin
        Acteurs.Fermer_Bloc_Acteur;
    end Fermer_Bloc_Acteur;


    procedure Nouvel_Acteur (Un_Acteur : Standard_String.Object) is
    begin
        Acteurs.Nouvel_Acteur (Un_Acteur);
    end Nouvel_Acteur;


    procedure Fin_Nouvel_Acteur is
    begin
        Acteurs.Fin_Nouvel_Acteur;
    end Fin_Nouvel_Acteur;


    procedure Donner_Type_Acteur (Un_Type : Standard_String.Object) is
    begin
        Acteurs.Donner_Type_Acteur (Un_Type);
    end Donner_Type_Acteur;


    procedure Donner_Adresse_Station (Une_Adresse : Integer) is
    begin
        Acteurs.Donner_Adresse_Station (Une_Adresse);
    end Donner_Adresse_Station;


    procedure Imprimer_Acteur is
    begin
        Acteurs.Imprimer_Acteur;
    end Imprimer_Acteur;


    package body Acteurs is separate;


    package Verif_Actions is

        function Action_Possible
                    (Une_Action : Standard_String.Object;
                     Un_Acteur : Standard_String.Object;
                     De, Vers, En : Lexical.Token := L_Unk) return Boolean;
        function Donne_Indice_Tableau_Acteurs
                    (Un_Type, Un_Acteur : Standard_String.Object)
                    return Integer;
        function Donne_Indice_Tableau_Actions
                    (Un_Type, Une_Action : Standard_String.Object)
                    return Integer;

    end Verif_Actions;


    function Action_Possible
                (Une_Action : Standard_String.Object;
                 Un_Acteur : Standard_String.Object;
                 De, Vers, En : Lexical.Token := L_Unk) return Boolean is  
    begin
        return Verif_Actions.Action_Possible
                  (Une_Action, Un_Acteur, De, Vers, En);
    end Action_Possible;


    package body Verif_Actions is separate;


    package Script is

        procedure Ouvrir_Nouveau_Bloc_Scenario;
        procedure Fermer_Bloc_Scenario;
        procedure Ouvrir_Nouveau_Bloc_Scene
                     (Une_Scene : Standard_String.Object);
        procedure Fermer_Bloc_Scene;
        procedure Ouvrir_Bloc_Enchainement;
        procedure Fermer_Bloc_Enchainement;
        procedure Ouvrir_Bloc (Nature : Lexical.Token);
        procedure Fermer_Bloc (Nature : Lexical.Token);
        procedure Lire_Liste_Temps;
        procedure Lire_Nombre (Un_Nombre : Integer);
        procedure Lire_Nombre (Un_Id : Standard_String.Object);
        procedure Complete_Liste (Un_Nom : Standard_String.Object);
        procedure Controle_Option (Une_Option : Lexical.Token);
        procedure Complete_Action (Une_Action : Standard_String.Object);
        procedure Insere_Action;
        procedure Nouveau_Bloc_Groupe_Temps (Un_Jeton : Lexical.Token);
        procedure Ajouter_Bloc_Groupe_Temps (Un_Nom : Standard_String.Object);  
        procedure Ajouter_Bloc_Groupe_Temps (Un_Nombre : Integer);  
        procedure Fermer_Bloc_Groupe_Temps;
        function Donne_Id_Courant return Standard_String.Object;
        function Donne_Nombre_Courant return Integer;
        procedure Inserer_Liste_Symbole (Un_Element : Standard_String.Object;
                                         Une_Valeur : Integer);
        procedure Genere_Scene (Une_Scene : Standard_String.Object);
        procedure Nouveau_Bloc_Groupe_Affecte
                     (Un_Groupe : Standard_String.Object);
        procedure Nouveau_Bloc_Groupe;
        procedure Fermer_Bloc_Groupe;
        procedure Ajouter_Bloc_Groupe (Un_Groupe : Standard_String.Object);
        procedure Fermer_Bloc_Groupe_Affecte;

    end Script;


    procedure Ouvrir_Nouveau_Bloc_Scenario is
    begin
        Script.Ouvrir_Nouveau_Bloc_Scenario;
    end Ouvrir_Nouveau_Bloc_Scenario;


    procedure Fermer_Bloc_Scenario is
    begin
        Script.Fermer_Bloc_Scenario;
    end Fermer_Bloc_Scenario;


    procedure Ouvrir_Nouveau_Bloc_Scene (Une_Scene : Standard_String.Object) is
    begin
        Script.Ouvrir_Nouveau_Bloc_Scene (Une_Scene);
    end Ouvrir_Nouveau_Bloc_Scene;


    procedure Fermer_Bloc_Scene is
    begin
        Script.Fermer_Bloc_Scene;
    end Fermer_Bloc_Scene;


    procedure Ouvrir_Bloc_Enchainement is
    begin
        Script.Ouvrir_Bloc_Enchainement;
    end Ouvrir_Bloc_Enchainement;


    procedure Fermer_Bloc_Enchainement is
    begin
        Script.Fermer_Bloc_Enchainement;
    end Fermer_Bloc_Enchainement;


    procedure Ouvrir_Bloc (Nature : Lexical.Token) is
    begin
        Script.Ouvrir_Bloc (Nature);
    end Ouvrir_Bloc;


    procedure Fermer_Bloc (Nature : Lexical.Token) is
    begin
        Script.Fermer_Bloc (Nature);
    end Fermer_Bloc;


    procedure Lire_Liste_Temps is
    begin
        Script.Lire_Liste_Temps;
    end Lire_Liste_Temps;


    procedure Lire_Nombre (Un_Nombre : Integer) is
    begin
        Script.Lire_Nombre (Un_Nombre => Un_Nombre);
    end Lire_Nombre;


    procedure Lire_Nombre (Un_Id : Standard_String.Object) is
    begin
        Script.Lire_Nombre (Un_Id => Un_Id);
    end Lire_Nombre;


    procedure Complete_Liste (Un_Nom : Standard_String.Object) is
    begin
        Script.Complete_Liste (Un_Nom);
    end Complete_Liste;


    procedure Controle_Option (Une_Option : Lexical.Token) is
    begin
        Script.Controle_Option (Une_Option);
    end Controle_Option;


    procedure Complete_Action (Une_Action : Standard_String.Object) is
    begin
        Script.Complete_Action (Une_Action);
    end Complete_Action;


    procedure Insere_Action is
    begin
        Script.Insere_Action;
    end Insere_Action;


    procedure Nouveau_Bloc_Groupe_Temps (Un_Jeton : Lexical.Token) is
    begin
        Script.Nouveau_Bloc_Groupe_Temps (Un_Jeton);
    end Nouveau_Bloc_Groupe_Temps;


    procedure Ajouter_Bloc_Groupe_Temps (Un_Nom : Standard_String.Object) is
    begin
        Script.Ajouter_Bloc_Groupe_Temps (Un_Nom);
    end Ajouter_Bloc_Groupe_Temps;


    procedure Ajouter_Bloc_Groupe_Temps (Un_Nombre : Integer) is
    begin
        Script.Ajouter_Bloc_Groupe_Temps (Un_Nombre);
    end Ajouter_Bloc_Groupe_Temps;


    procedure Fermer_Bloc_Groupe_Temps is
    begin
        Script.Fermer_Bloc_Groupe_Temps;
    end Fermer_Bloc_Groupe_Temps;


    procedure Genere_Scene (Une_Scene : Standard_String.Object) is  
    begin
        Script.Genere_Scene (Une_Scene);
    end Genere_Scene;


    procedure Nouveau_Bloc_Groupe_Affecte
                 (Un_Groupe : Standard_String.Object) is
    begin
        Script.Nouveau_Bloc_Groupe_Affecte (Un_Groupe);
    end Nouveau_Bloc_Groupe_Affecte;


    procedure Nouveau_Bloc_Groupe is
    begin
        Script.Nouveau_Bloc_Groupe;
    end Nouveau_Bloc_Groupe;


    procedure Ajouter_Bloc_Groupe (Un_Groupe : Standard_String.Object) is
    begin
        Script.Ajouter_Bloc_Groupe (Un_Groupe);
    end Ajouter_Bloc_Groupe;


    procedure Fermer_Bloc_Groupe is
    begin
        Script.Fermer_Bloc_Groupe;
    end Fermer_Bloc_Groupe;


    procedure Fermer_Bloc_Groupe_Affecte is
    begin
        Script.Fermer_Bloc_Groupe_Affecte;
    end Fermer_Bloc_Groupe_Affecte;


    package body Script is separate;


    package Calcul is

        procedure Demarre_Calcul;  
        procedure Empiler (Un_Jeton : Lexical.Token; Une_Valeur : Integer := 0);
        procedure Evaluer_Expression (La_Valeur : out Integer);

    end Calcul;


    procedure Demarre_Calcul is
    begin
        Calcul.Demarre_Calcul;
    end Demarre_Calcul;


    procedure Empiler (Un_Jeton : Lexical.Token; Une_Valeur : Integer := 0) is
    begin
        Calcul.Empiler (Un_Jeton, Une_Valeur);
    end Empiler;


    procedure Empiler (Un_Id : Standard_String.Object) is
        La_Valeur : Integer;
    begin

        Script.Lire_Nombre (Un_Id);
        La_Valeur := Script.Donne_Nombre_Courant;
        Calcul.Empiler (L_Number, La_Valeur);
    end Empiler;


    procedure Evaluer_Expression is
        La_Valeur : Integer := 0;
    begin  
        Calcul.Empiler (Un_Jeton => L_Ok);
        Calcul.Evaluer_Expression (La_Valeur);
        if Acteurs.Acteur_Existe (Script.Donne_Id_Courant) or else
           Materiels.Action_Existe (L_Action => Script.Donne_Id_Courant) then
            Erreurs.Ajouter ("Impossible d'affecter un acteur ou une action");
        else
            Script.Inserer_Liste_Symbole
               (Un_Element => Script.Donne_Id_Courant, Une_Valeur => La_Valeur);
            Text_Io.Put_Line (Integer'Image (La_Valeur));  
        end if;

    end Evaluer_Expression;


    package body Calcul is separate;


    package Groupe is

        procedure Complete_Action;
        procedure Complete_Liste_Action (Une_Action : Lexical.Token);
        procedure Ajoute_Action (Une_Action : Standard_String.Object);
        procedure Nouveau_Bloc_Groupe (Une_Action : Lexical.Token;
                                       Un_Nom : Standard_String.Object);
        procedure Nouveau_Bloc_Groupe (Une_Action : Lexical.Token);
        procedure Ajouter_Bloc_Groupe (Une_Valeur : Integer);
        procedure Retourner_Valeur;

    end Groupe;


    procedure Complete_Action is
    begin
        Groupe.Complete_Action;
    end Complete_Action;


    procedure Complete_Liste_Action (Une_Action : Lexical.Token) is
    begin
        Groupe.Complete_Liste_Action (Une_Action);
    end Complete_Liste_Action;


    procedure Ajoute_Action (Une_Action : Standard_String.Object) is
    begin
        Groupe.Ajoute_Action (Une_Action);
    end Ajoute_Action;


    procedure Nouveau_Bloc_Groupe (Une_Action : Lexical.Token;
                                   Un_Nom : Standard_String.Object) is
    begin
        Groupe.Nouveau_Bloc_Groupe (Une_Action, Un_Nom);
    end Nouveau_Bloc_Groupe;


    procedure Nouveau_Bloc_Groupe (Une_Action : Lexical.Token) is
    begin
        Groupe.Nouveau_Bloc_Groupe (Une_Action);
    end Nouveau_Bloc_Groupe;


    procedure Ajouter_Bloc_Groupe (Une_Valeur : Integer) is
    begin
        Groupe.Ajouter_Bloc_Groupe (Une_Valeur);
    end Ajouter_Bloc_Groupe;


    procedure Retourner_Valeur is
    begin
        Groupe.Retourner_Valeur;
    end Retourner_Valeur;


    package body Groupe is separate;


    procedure La_Fin is  
    begin
        null;
    end La_Fin;

end Semantique;
DataMuseum.dk

Rational R1000/400 Tapes

⟦3240fa356⟧ TextFile

Derivation

TextFile
