|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 30218 (0x760a)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Text_Io;
with Lexical;
with Semantique;
use Lexical;--a cause de lexical.token
package body Parse is
Essai : constant := 40;
Anticipe_Fin : exception;
package Error is
procedure Reset;
procedure Inc;
function Valeur return Natural;
procedure Affiche (Type_Error : String);
procedure Affiche (Nature : in Token;
Regle : in out Token;
Type_Error : String);
end Error;
package body Error is separate;
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
-- Semantique;
-- end if;
-- if Lu = L_Number then
-- null;
-- end if;
-- return Lu;
-- end Expression_Red_Nbre;
--
--
function Expr_Bis return Token is
Lu : Token;
Id_Vue : Boolean := False;
begin
Lu := Quid;
loop
case Lu is
when L_Plus | L_Sub | L_Star | L_Open | L_Close =>
Id_Vue := False;
Semantique.Empiler (Un_Jeton => Lu);
Lu := Quid;
when L_Number =>
if not Id_Vue then
Id_Vue := True;
Semantique.Empiler (Un_Jeton => Lu,
Une_Valeur => Lexical.Get_Value);
Lu := Quid;
else
exit;
end if;
when L_Id =>
if not Id_Vue then
Semantique.Empiler (Un_Id => Lexical.Get_Value);
Id_Vue := True;
Lu := Quid;
else
exit;
end if;
when others =>
exit;
end case;
end loop;
return Lu;
end Expr_Bis;
function Calcul return Token is
Lu : Token;
begin
Semantique.Demarre_Calcul;
Lu := Expr_Bis;
Semantique.Evaluer_Expression;
return Lu;
end Calcul;
procedure Expression_Red is
Lu : Token;
begin
Lu := Quid;
case Lu is
when L_Id =>
Semantique.Lire_Nombre (Un_Id => Lexical.Get_Value);
null;
when L_Number | L_Temps =>
Semantique.Lire_Nombre (Un_Nombre => Lexical.Get_Value);
when L_Eof =>
Error.Affiche ("fin de fichier dans une expression ?");
raise Anticipe_Fin;
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 =>
Semantique.Nouveau_Bloc_Groupe (Lu);
Lu := Quid;
if Lu = L_De then
Lu := Quid;
if Lu = L_Open then
Lu := Bloc_Groupe;
if Lu = L_Close then
null;
end if;
end if;
end if;
when L_Premier =>
Lu := Quid;
if Lu = L_De then
Lu := Quid;
if Lu = L_Open then
Lu := Bloc_Groupe;
if Lu = L_Close then
null;
end if;
end if;
end if;
when L_Id =>
Semantique.Ajouter_Bloc_Groupe (Un_Groupe => Lexical.Get_Value);
Lu := Bloc_Groupe_Bis;
when L_Number | L_Temps =>
Semantique.Ajouter_Bloc_Groupe
(Une_Valeur => Lexical.Get_Value);
Lu := Bloc_Groupe_Bis;
when others =>
null;
end case;
return Lu;
end Bloc_Groupe;
function Op_Groupe return Token is
Lu : Token;
begin
Lu := Quid;
case Lu is
when L_Avec =>
Lu := Quid;
if Lu = L_Open then
Semantique.Nouveau_Bloc_Groupe (L_Avec);
Lu := Bloc_Groupe;
if Lu = L_Close then
Semantique.Fermer_Bloc_Groupe;
else
Error.Affiche ("il manque la ')' dans 'avec ()'");
end if;
else
Error.Affiche ("il manque la '(' dans 'avec ('");
end if;
when L_Sans =>
Lu := Quid;
if Lu = L_Open then
Semantique.Nouveau_Bloc_Groupe (L_Sans);
Lu := Bloc_Groupe;
if Lu = L_Close then
Semantique.Fermer_Bloc_Groupe;
else
Error.Affiche ("il manque la ')' dans 'sans ()'");
end if;
else
Error.Affiche ("il manque la '(' dans 'sans ('");
end if;
when others =>
null;
end case;
null;
return Lu;
end Op_Groupe;
function Groupe return Token is
Lu : Token;
begin
Lu := Quid;
if Lu = L_Id then
Semantique.Nouveau_Bloc_Groupe_Affecte (Lexical.Get_Value);
Lu := Quid;
if Lu = L_Est then
Lu := Quid;
Semantique.Nouveau_Bloc_Groupe;
if Lu = L_Open then
Lu := Bloc_Groupe;
if Lu = L_Close then
Semantique.Fermer_Bloc_Groupe;
Lu := Op_Groupe;
Semantique.Fermer_Bloc_Groupe_Affecte;
else
Error.Affiche
("il manque la ')' pour la definition du groupe");
end if;
else
Error.Affiche ("il manque la '(' pour 'groupe xxx est ('");
end if;
else
Error.Affiche ("il manque le 'est' pour 'groupe xxx est'");
end if;
else
Error.Affiche ("il manque l'identificateur de groupe");
end if;
return Lu;
end Groupe;
function Oper_Temps return Token;
function Groupe_Tps return Token is
Lu : Token;
begin
Lu := Quid;
case Lu is
when L_Open =>
Semantique.Nouveau_Bloc_Groupe_Temps (Lu);
Error.Affiche ("il manque la virgule");
Lu := Oper_Temps;
if Lu = L_Close then
Semantique.Fermer_Bloc_Groupe_Temps;
Lu := Quid;
else
Error.Affiche ("manque ')'");
end if;
when L_Id =>
Semantique.Ajouter_Bloc_Groupe_Temps
(Un_Nom => Lexical.Get_Value);
Error.Affiche ("il manque la virgule");
Lu := Quid;
if Lu = L_Virgule then
Lu := Groupe_Tps;
end if;
null;
when L_Temps =>
Semantique.Ajouter_Bloc_Groupe_Temps
(Un_Nom => Lexical.Get_Value);
Error.Affiche ("il manque la virgule");
Lu := Quid;
if Lu = L_Virgule then
Lu := Groupe_Tps;
end if;
null;
when L_Virgule =>
Lu := Oper_Temps;
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 =>
Semantique.Nouveau_Bloc_Groupe_Temps (Lu);
if Quid = L_De then
if Quid = L_Open then
if Quid = L_Id then
Semantique.Ajouter_Bloc_Groupe_Temps
(Un_Nom => Lexical.Get_Value);
Lu := Quid;
if Lu = L_Close then
Lu := Quid;
end if;
else
Error.Affiche
("if faut un identificateur ou un nombre");
end if;
else
Error.Affiche ("il faut une '(' apres 'duree de'");
end if;
else
Error.Affiche ("il faut un 'de' apres 'duree'");
end if;
when L_Hasard =>
Semantique.Nouveau_Bloc_Groupe_Temps (Lu);
if Quid = L_De then
Lu := Groupe_Tps;
else
Error.Affiche ("il faut un 'de' apres 'hasard'");
end if;
when L_Premier =>
Semantique.Nouveau_Bloc_Groupe_Temps (Lu);
if Quid = L_De then
Lu := Groupe_Tps;
else
Error.Affiche ("il faut un 'de' apres 'premier'");
end if;
when L_Open =>
Semantique.Nouveau_Bloc_Groupe_Temps (Lu);
Lu := Oper_Temps;
if Lu = L_Close then
Lu := Quid;
else
Error.Affiche ("manque ')'");
end if;
when L_Id =>
Semantique.Ajouter_Bloc_Groupe_Temps
(Un_Nom => Lexical.Get_Value);
Lu := Groupe_Tps;
when L_Temps | L_Number =>
Semantique.Ajouter_Bloc_Groupe_Temps
(Un_Nombre => Lexical.Get_Value);
Lu := Groupe_Tps;
when L_Close =>
Semantique.Fermer_Bloc_Groupe_Temps;
Lu := Quid;
when others =>
Error.Affiche ("il manque une ')'");
end case;
return Lu;
end Oper_Temps;
function Ordre_Bis return Token is
Lu : Token;
begin
Lu := Quid;
if Lu = L_De then
Expression_Red;
Semantique.Controle_Option (L_De);
Semantique.Complete_Action;
Lu := Quid;
if Lu = L_Vers then
Expression_Red;
Semantique.Controle_Option (L_Vers);
Lu := Quid;
if Lu = L_En then
Expression_Red;
Semantique.Controle_Option (L_En);
end if;
end if;
end if;
Semantique.Insere_Action;
return Lu;
end Ordre_Bis;
function Ordre return Token is
Lu : Token;
begin
Semantique.Nouveau_Bloc_Groupe;
Lu := Bloc_Groupe;
if Lu = L_Close then
Lu := Ordre_Bis;
Semantique.Complete_Action;
end if;
return Lu;
end Ordre;
function Petites_Instructions return Token is
Lu : Token;
begin
Lu := Quid;
case Lu is
when L_Id =>
Semantique.Complete_Action (Une_Action => Lexical.Get_Value);
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 =>
Lu := Oper_Temps;
Semantique.Ouvrir_Bloc (L_Dans);
if Lu = L_Faire then
Lu := Quid;
if Lu = L_Debut then
Lu := Instructions;
if Lu = L_Fin then
Semantique.Fermer_Bloc (L_Dans);
Lu := Quid;
end if;
else
Error.Affiche
("pas de 'debut' dans le bloc 'dans.. faire'");
Lu := Instructions;
end if;
else
Error.Affiche
("pas de 'debut' dans le bloc 'dans ..faire');");
end if;
when L_Repeter =>
Expression_Red;
Semantique.Ouvrir_Bloc (L_Repeter);
Lu := Quid;
if Lu = L_Fois then
Lu := Quid;
if Lu = L_Debut then
Lu := Instructions;
if Lu = L_Fin then
Semantique.Fermer_Bloc (L_Repeter);
Lu := Quid;
end if;
else
Error.Affiche
("pas de 'debut' dans le bloc 'repeter'");
Lu := Instructions;
end if;
else
Error.Affiche
("pas de 'fois' dans le bloc 'repeter');");
end if;
when L_Repeter_Ad_Eternam =>
Semantique.Ouvrir_Bloc (Lu);
Lu := Quid;
if Lu = L_Debut then
Lu := Instructions;
if Lu = L_Fin then
Semantique.Fermer_Bloc (L_Repeter_Ad_Eternam);
Lu := Quid;
end if;
else
Error.Affiche
("pas de 'debut' dans le bloc 'repeter_ad_eternam'");
Lu := Instructions;
end if;
when L_Toutes =>
Lu := Quid;
if Lu = L_Les then
if Oper_Temps = L_Pendant then
if Oper_Temps = L_Faire then
Semantique.Ouvrir_Bloc (L_Toutes);
if Quid = L_Debut then
Lu := Instructions;
if Lu = L_Fin then
Semantique.Fermer_Bloc (L_Toutes);
Lu := Quid;
end if;
else
Error.Affiche
("pas de 'debut' dans le bloc 'toutes'");
end if;
else
Error.Affiche
("pas de 'faire' dans le bloc 'toutes'");
end if;
else
Error.Affiche
("pas de 'pendant' dans le bloc 'toutes'");
end if;
else
Error.Affiche ("pas de 'les' dans le bloc 'toutes'");
end if;
when L_Id =>
Semantique.Complete_Liste (Lexical.Get_Value);
Lu := Petites_Instructions;
when L_Groupe =>
Lu := Groupe;
when L_Fin =>
exit; --ok
when L_Eof =>
exit; -- c'est fini
when L_Debut => --un debut sans fin
Lu := Instructions;
Error.Affiche ("?");
when others =>
Error.Affiche ("pas d'instructions");
Lu := Quid;
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;
procedure Def_Enchainement (Lu : in out Token) is
begin
case Lu is
when L_Enchainement =>
Semantique.Ouvrir_Bloc_Enchainement;
Lu := Quid;
if Lu = L_Debut then
-- Lu := Liste_Instructions;-------------------
Lu := Quid;
loop
case Lu is
when L_Id =>
Semantique.Genere_Scene (Lexical.Get_Value);
Lu := Quid;
when L_Fin =>
exit;
when others =>
Error.Affiche
("Il ne peut y avoir que des scenes declarees a cet endroit");
Lu := Quid;
end case;
end loop;
if Lu = L_Fin then
Semantique.Fermer_Bloc_Enchainement;
Text_Io.Put_Line ("C'est fini..................");
Lu := Quid;
end if;
if Lu = L_Eof then
Text_Io.Put_Line
("C'est vraiment fini..................");
end if;
end if;
when L_Eof =>
Error.Affiche
("deja la fin du fichier dans le bloc enchainement ????");
when others =>
Error.Inc;
if Error.Valeur < Essai then
Error.Affiche ("redefinition du bloc enchainement");
Lu := Quid;
Def_Enchainement (Lu);
Error.Reset;
end if;
end case;
end Def_Enchainement;
function Bloc_Sequence return Token is
Lu : Token;
begin
Lu := Quid;
if Lu = L_Scene then
Lu := Quid;
if Lu = L_Id then
Semantique.Ouvrir_Nouveau_Bloc_Scene (Lexical.Get_Value);
Lu := Quid;
if Lu = L_Debut then
Lu := Instructions;
if Lu = L_Fin then
Semantique.Fermer_Bloc_Scene;
Lu := Bloc_Sequence;
else
Error.Affiche
("pas de 'fin' de bloc dans la partie scenario");
end if;
else
Error.Affiche ("pas de 'debut' de scene");
end if;
else
Error.Affiche ("pas d'identificateur de scene");
end if;
else
null;
end if;
return Lu;
end Bloc_Sequence;
procedure Def_Scenario (Lu : in out Token) is
begin
case Lu is
when L_Scenario =>
Semantique.Ouvrir_Nouveau_Bloc_Scenario;
Lu := Quid;
if Lu = L_Debut then
Lu := Bloc_Sequence;
if Lu = L_Fin then
Semantique.Fermer_Bloc_Scenario;
Lu := Quid;
else
Error.Affiche ("pas de 'fin' de scenario");
end if;
else
Error.Affiche ("pas de 'debut' de scenario");
end if;
when L_Eof =>
Error.Affiche
("deja la fin du fichier dans le bloc scenario ???");
raise Anticipe_Fin;
when others =>
Error.Inc;
if Error.Valeur < Essai then
Error.Affiche ("redefinition du bloc scenario");
Lu := Quid;
Def_Scenario (Lu);
end if;
Error.Reset;
end case;
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 (Lu : in out Token) is
begin
case Lu is
when L_Experience =>
if Quid = L_Debut then
if Bloc_Experience = L_Fin then
Lu := Quid;
null;
else
Error.Affiche ("Pas de 'fin' du bloc experiences");
end if;
else
Error.Affiche ("Pas de 'debut' du bloc experiences");
end if;
when L_Eof =>
Error.Affiche
("deja la fin du fichier dans le bloc experiences????");
raise Anticipe_Fin;
when others =>
Lu := Quid;
Error.Affiche
("Pas de bloc experience ");-- Ce bloc est facultatif
end case;
end Def_Experience;
function Bloc_Acteur return Token is
Lu : Token;
begin
Lu := Quid;
if Lu = L_Id then
Semantique.Nouvel_Acteur (Lexical.Get_Value);
Lu := Quid;
if Lu = L_Est then
Lu := Quid;
if Lu = L_Id then
Semantique.Donner_Type_Acteur (Lexical.Get_Value);
Lu := Quid;
if Lu = L_Sur then
Lu := Quid;
if Lu = L_Station then
Lu := Quid;
if Lu = L_Number then
Semantique.Donner_Adresse_Station
(Lexical.Get_Value);
Semantique.Fin_Nouvel_Acteur;
Lu := Bloc_Acteur;
else
Error.Affiche (L_Fin, Lu,
"pas de numero de station");
end if;
else
Error.Affiche
(L_Fin, Lu,
"pas de 'station' pour le bloc acteur");
end if;
else
Error.Affiche (L_Fin, Lu,
"pas de 'sur' pour le bloc acteur");
end if;
else
Error.Affiche (L_Fin, Lu, "pas d'identificateur de type");
end if;
else
Error.Affiche (L_Fin, Lu, "pas de 'est' pour le bloc acteur");
end if;
else
null;
end if;
return Lu;
end Bloc_Acteur;
procedure Def_Acteurs (Lu : in out Token) is
begin
case Lu is
when L_Acteurs =>
Semantique.Ouvrir_Bloc_Acteur;
Lu := Quid;
if Lu = L_Debut then
Lu := Bloc_Acteur;
if Lu = L_Fin then
Semantique.Fermer_Bloc_Acteur;
Lu := Quid;
null;
else
Error.Affiche ("pas de 'fin' pour le bloc acteur");
end if;
else
Error.Affiche ("pas de 'debut' pour le bloc acteur");
end if;
when L_Eof =>
Error.Affiche
("deja la fin du fichier dans le bloc acteurs ????");
raise Anticipe_Fin;
when others =>
Error.Affiche ("pas de bloc acteur");
Error.Inc;
if Error.Valeur < Essai then
Error.Affiche ("redefinition du bloc acteurs ");
Lu := Quid;
Def_Acteurs (Lu);
end if;
Error.Reset;
end case;
end Def_Acteurs;
function Contenu_Option_Bis return Token is
Lu : Token;
begin
Lu := Quid;
if Lu = L_En then
Semantique.Option (Lu);
Lu := Quid;
if Lu = L_Close then
null;
else
Error.Affiche (L_Close, Lu,
"une parenthese fermente 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
Semantique.Option (Lu);
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
Semantique.Ouvrir_Champ_Option;
if Quid = L_De then
Semantique.Option (L_De);
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
Semantique.Nouvelle_Action (Lexical.Get_Value);
if Quid = L_Est then
if Quid = L_Number then
Semantique.Donner_Code_Action (Lexical.Get_Value);
Lu := Option;
Semantique.Fermer_Champ_Option;
Semantique.Fin_Nouvelle_Action;
else
Error.Affiche ("pas de code bitbus");
exit;
end if;
else
Error.Affiche (L_Fin, Lu, "pas de 'est' dans la liste");
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
Semantique.Nouveau_Type (Lexical.Get_Value);
Lu := Quid;
if Lu = L_Fait then
Lu := Quid;
if Lu = L_Debut then
Lu := Liste;
if Lu = L_Fin then
Semantique.Fin_Nouveau_Type;
Lu := Bloc_Materiel;
if Lu = L_Ok then
Lu := Bloc_Materiel;
end if;
else --recuperation des erreurs
Error.Affiche (L_Fin, Lu, "pas de 'fin' de liste");
end if;
else
Error.Affiche (L_Ok, Lu, "pas de 'debut' de liste");
end if;
else
Error.Affiche (L_Ok, Lu, "pas de 'fait' dans le bloc");
end if;
end if;
return Lu;
end Bloc_Materiel;
procedure Def_Materiel (Lu : in out Token) is
begin
case Lu is
when L_Materiel =>
Lu := Quid;
if Lu = L_Debut then
Semantique.Ouvrir_Bloc_Materiel;--
Lu := Bloc_Materiel;
if Lu = L_Fin then
Semantique.Fermer_Bloc_Materiel;--
Lu := Quid;
null;
else
Error.Affiche (L_Fin, Lu,
"pas de fin du bloc materiel");
end if;
else
Error.Affiche (L_Debut, Lu,
"pas de debut du bloc materiel");
end if;
when L_Eof =>
Error.Affiche
("deja la fin du fichier dans le bloc materiel ???");
raise Anticipe_Fin;
when others =>
Error.Affiche (L_Fin, Lu, "pas de definition du materiel");
Error.Inc;
if Error.Valeur < Essai then
Lu := Quid;
Def_Materiel (Lu);
end if;
Error.Reset;
end case;
end Def_Materiel;
procedure Code is
Lu : Token;
begin
Error.Reset;
Lu := Quid;
Def_Materiel (Lu);
Def_Acteurs (Lu);
Def_Experience (Lu);
Def_Scenario (Lu);
Def_Enchainement (Lu);
end Code;
procedure Parseur is
begin
Code;
end Parseur;
end Parse;