|
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 - metrics - downloadIndex: B T
Length: 15364 (0x3c04)
Types: TextFile
Names: »B«
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─⟦d65440be7⟧ »DATA«
└─⟦this⟧
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_Fin, Lu, "pas de definition du materiel");
null;
Def_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;