|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 45927 (0xb367)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦3903f22e3⟧
└─⟦this⟧
with Text_Io, Lex, Error, Moving_String, Group_Array,
Enumeration_Array, Message_Array, Complement_Identifier_Array,
Exclusive_Generic_List, Identifier;
use Text_Io, Moving_String;
package body Syn is
use Lex.Visible, Error.Visible;
package Identifier_List is new Exclusive_Generic_List
(Element => Identifier.Object,
Null_Element => Identifier.Null_Object,
Show_Element => Identifier.Show,
Get_Key => Identifier.Image);
subtype States is Lex.Visible.Token range Message .. Introduction;
In_Progress : States := Message;
procedure Type_Base (Structure_Name, Attribut_Name : in Identifier.Object;
Enumeration_Type : out Natural;
Ok : in out Boolean) is
Local_Ok : Boolean := True;
Index : Natural := Field_Identifier.Index
(Identifier.Image (Attribut_Name));
begin
case Lex.Get_Token is
when Entier =>
Structure_Array.Create_Number_Field
(Structure_Name, Index, Local_Ok);
Lex.Next;
when Chaine =>
Structure_Array.Create_Sentence_Field
(Structure_Name, Index, Local_Ok);
Lex.Next;
when Id =>
Enumeration_Type := Enumeration_Array.Enum
(Lex.Get_Lower_Case_Value);
Structure_Array.Create_Enumerate_Field
(Structure_Name, Index, Local_Ok);
Lex.Next;
when others =>
Local_Ok := False;
Error.Syn (Type_Base, Follow_Type_Base);
end case;
Ok := Ok and Local_Ok;
end Type_Base;
procedure Type_Structure (Structure_Type : out Moving_String.Object;
Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Anime | Lieu | Entite | Id =>
Structure_Type := Moving_String.From_String
(Lex.Get_Lower_Case_Value);
Lex.Next;
when others =>
Local_Ok := False;
Error.Syn (Type_Structure, Follow_Type_Structure);
end case;
Ok := Ok and Local_Ok;
end Type_Structure;
procedure Chaine (A_Sentence : out Identifier.Object;
Ok : in out Boolean) is
Local_Ok : Boolean := True;
Value : Moving_String.Object;
begin
Value := Moving_String.From_String (Lex.Get_Value);
Lex.Next;
while Lex.Get_Token = Ampersand loop
Lex.Next;
if Lex.Get_Token /= Right_Sentence then
Local_Ok := False;
Error.Syn (Chaine, Follow_Chaine);
else
Value := Value & Lex.Get_Value;
Lex.Next;
end if;
end loop;
Ok := Local_Ok;
A_Sentence := Identifier.From_String (Moving_String.Image (Value));
end Chaine;
procedure Valeur (Structure_Name, Attribut_Name : in Identifier.Object;
Enumeration_Type : Natural;
Ok : in out Boolean) is
Local_Ok : Boolean := True;
Index : Natural := Field_Identifier_Array
(Identifier.Image (Attribut_Name));
A_Sentence : Identifier.Object;
Literal_Index : Natural;
begin
case Lex.Get_Token is
when Number =>
Structure_Array.Field_Put_Number
(Structure_Name, Index,
Integer'Value (Lex.Get_Lower_Case_Value), Local_Ok);
Lex.Next;
when Id =>
Literal_Index := Enumeration_Array.Literal
(Enumeration_Type, Lex.
Get_Lower_Case_Value);
Structure_Array.Field_Put_Enumerate
(Structure_Name, Index, Enumeration_Type,
Literal_Index, Local_Ok);
Lex.Next;
when Right_Sentence =>
Chaine (A_Sentence, Local_Ok);
Structure_Array.Field_Put_Sentence
(Structure_Name, Index, A_Sentence, Local_Ok);
when others =>
Local_Ok := False;
Error.Syn (Valeur, Follow_Valeur);
end case;
Ok := Ok and Local_Ok;
end Valeur;
procedure Objet (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Id | Heros | Lieu =>
Lex.Next;
when others =>
Local_Ok := False;
Error.Syn (Objet, Follow_Objet);
end case;
Ok := Ok and Local_Ok;
end Objet;
procedure Liste_Identificateurs
(List : in out Identifier_List.Object; Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Id then
Identifier_List.Put
(List, Identifier.From_String (Lex.Get_Lower_Case_Value),
Local_Ok);
Lex.Next;
while Lex.Get_Token = Comma loop
Lex.Next;
if Lex.Get_Token = Id then
Identifier_List.Put
(List, Identifier.From_String (Lex.Get_Lower_Case_Value),
Local_Ok);
if not Local_Ok then
Error.Sem (Liste_Id, Lex.Get_Value);
end if;
Lex.Next;
else
Local_Ok := False;
Error.Syn (Id, Follow_Liste_Identificateurs);
end if;
end loop;
else
Local_Ok := False;
Error.Syn (Id, Follow_Liste_Identificateurs);
end if;
Ok := Ok and Local_Ok;
Identifier_List.Show (List);
end Liste_Identificateurs;
procedure Liste_Messages_Erreur (Ok : in out Boolean) is
A_Sentence : Identifier.Object;
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Message loop
Lex.Next;
if Lex.Get_Token = Erreur then
Lex.Next;
if Lex.Get_Token = Right_Sentence then
Chaine (Value, Local_Ok);
if Local_Ok then
Text_Io.Put_Line ("message");
Message_Array.Put (A_Sentence, Local_Ok);
if not Local_Ok then
Error.Sem (Message, Identifier.Image (A_Sentence));
end if;
end if;
else
Local_Ok := False;
if Lex.Get_Token = Wrong_Sentence then
Error.Syn (Wrong_Sentence,
Follow_Liste_Messages_Erreur);
else
Error.Syn (Sentence, Follow_Liste_Messages_Erreur);
end if;
end if;
else
Local_Ok := False;
Error.Syn (Erreur, Follow_Liste_Messages_Erreur);
end if;
end loop;
Ok := Ok and Local_Ok;
end Liste_Messages_Erreur;
procedure Liste_Enumeres (Ok : in out Boolean) is
Enumeration_Identifier : Identifier.Object;
List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Enumere loop
Identifier_List.Free (List);
Lex.Next;
if Lex.Get_Token = Id then
Enumeration_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (List, Local_Ok);
if Local_Ok then
Put_Line ("enumere");
Identifier_List.Init (Iterator, List);
while not Identifier_List.Done (Iterator) loop
Enumeration_Array.Put_Literal
(Enumeration_Identifier,
Identifier_List.Value (Iterator), Local_Ok);
if not Local_Ok then
Error.Sem (Enumere, Identifier.Image
(Identifier_List.Value
(Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Liste_Enumeres);
end if;
else
Local_Ok := False;
Error.Syn (Id, Follow_Liste_Enumeres);
end if;
end loop;
Ok := Ok and Local_Ok;
end Liste_Enumeres;
procedure Attribut (Structure_Name : in Identifier.Object;
Ok : in out Boolean) is
Value : Moving_String.Object;
Local_Ok : Boolean := True;
Attribut_Name : Identifier.Object;
Enumeration_Type : Natural;
begin
if Lex.Get_Token = Id then
Attribut_Name := Identifier.From_String (Lex.Get_Lower_Case_Value);
Field_Identifier_Array.Put (Attribut_Name);
Lex.Next;
if Lex.Get_Token = En then
Lex.Next;
Type_Base (Structure_Name, Attribut_Name,
Enumeration_Type, Local_Ok);
if Lex.Get_Token = Colon then
Lex.Next;
Valeur (Structure_Name, Attribut_Name,
Enumeration_Type, Local_Ok);
end if;
else
Local_Ok := False;
Error.Syn (En, Follow_Attribut);
end if;
else
Local_Ok := False;
Error.Syn (Id, Follow_Attribut);
end if;
Ok := Ok and Local_Ok;
end Attribut;
procedure Corps_Structure
(Structure_Name : in Identifier.Object; Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Attributs then
Lex.Next;
if Lex.Get_Token = Substract then
Lex.Next;
Attribut (Structure_Name, Local_Ok);
while Lex.Get_Token = Substract loop
Lex.Next;
Attribut (Structure_Name, Local_Ok);
end loop;
else
Local_Ok := False;
Error.Syn (Substract, Follow_Attribut);
end if;
end if;
Ok := Ok and Local_Ok;
end Corps_Structure;
procedure Liste_Structures (Ok : in out Boolean) is
Local_Ok : Boolean := True;
Structure_Type : Moving_String.Object;
Structure_Name : Identifier.Object;
begin
while Lex.Get_Token = Structure loop
Lex.Next;
Type_Structure (Structure_Type, Local_Ok);
if Lex.Get_Token = Colon then
Lex.Next;
if Lex.Get_Token = Id then
Structure_Name := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Structure_Array.Put
(Moving_String.Image (Structure_Type), Structure_Name);
Lex.Next;
Corps_Structure (Structure_Name, Local_Ok);
if Local_Ok then
Put_Line ("structure");
end if;
else
Local_Ok := False;
Error.Syn (Id, Follow_Liste_Structures);
end if;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Liste_Structures);
end if;
end loop;
Ok := Ok and Local_Ok;
end Liste_Structures;
procedure Champs (Ok : in out Boolean) is
Value : Moving_String.Object;
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Id loop
Lex.Next;
if Lex.Get_Token = Equal then
Lex.Next;
Valeur (Value, Local_Ok); -- a modifier cf attributs
else
Local_Ok := False;
Error.Syn (Equal, Follow_Champs);
end if;
end loop;
Ok := Ok and Local_Ok;
end Champs;
procedure Mouvement (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Id then
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
if Lex.Get_Token = Number then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Number, Follow_Mouvement);
end if;
end if;
else
Local_Ok := False;
Error.Syn (Id, Follow_Mouvement);
end if;
Ok := Ok and Local_Ok;
end Mouvement;
procedure Mouvements (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
Mouvement (Local_Ok);
while Lex.Get_Token = Comma loop
Lex.Next;
Mouvement (Local_Ok);
end loop;
Ok := Ok and Local_Ok;
end Mouvements;
procedure Itineraire (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Itineraire then
Lex.Next;
if Lex.Get_Token = Equal then
Lex.Next;
Mouvements (Local_Ok);
else
Local_Ok := False;
Error.Syn (Equal, Follow_Liste_Objets);
end if;
end if;
Ok := Ok and Local_Ok;
end Itineraire;
procedure Corps_Objet (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Attributs then
Lex.Next;
Champs (Local_Ok);
Itineraire (Local_Ok);
end if;
Ok := Ok and Local_Ok;
end Corps_Objet;
procedure Liste_Objets (Ok : in out Boolean) is
List : Identifier_List.Object;
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Cree loop
Lex.Next;
Type_Structure (Local_Ok);
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (List, Local_Ok);
Corps_Objet (Local_Ok);
if Local_Ok then
Put_Line ("objet");
end if;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Liste_Objets);
end if;
end loop;
Ok := Ok and Local_Ok;
end Liste_Objets;
procedure Liste_Mots (Ok : in out Boolean) is
List : Identifier_List.Object;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Mots then
Lex.Next;
Liste_Identificateurs (List, Local_Ok);
if Local_Ok then
Put_Line ("mots");
end if;
end if;
Ok := Ok and Local_Ok;
end Liste_Mots;
procedure Liens_Speciaux (Ok : in out Boolean) is
List : Identifier_List.Object;
An_Identifier : Identifier.Object;
Iterator : Identifier_List.Iterator;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Lien then
Lex.Next;
if Lex.Get_Token = Special then
An_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (List, Local_Ok);
if Local_Ok then
Put_Line ("etats liens speciaux");
Identifier_List.Init (Iterator, List);
while not Identifier_List.Done (Iterator) loop
Enumeration_Array.Put_Literal
(An_Identifier,
Identifier_List.Value (Iterator), Local_Ok);
if not Local_Ok then
Put_Line ("Erreur dans liste special");
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Etats_Liens);
end if;
else
Local_Ok := False;
Error.Syn (Special, Follow_Etats_Liens);
end if;
end if;
Ok := Ok and Local_Ok;
end Liens_Speciaux;
procedure Etats_Liens (Ok : in out Boolean) is
An_Identifier : Identifier.Object;
List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Lien then
Lex.Next;
if Lex.Get_Token = Normal then
An_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (List, Local_Ok);
if Local_Ok then
Put_Line ("etats liens normaux");
Identifier_List.Init (Iterator, List);
while not Identifier_List.Done (Iterator) loop
Enumeration_Array.Put_Literal
(An_Identifier,
Identifier_List.Value (Iterator), Local_Ok);
if not Local_Ok then
Put_Line ("Erreur dans liste normal");
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
Liens_Speciaux (Local_Ok);
else
Local_Ok := False;
Error.Syn (Colon, Follow_Etats_Liens);
end if;
else
Local_Ok := False;
Error.Syn (Normal, Follow_Etats_Liens);
end if;
end if;
Ok := Ok and Local_Ok;
end Etats_Liens;
procedure Lieu (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Id then
Lex.Next;
if Lex.Get_Token = Id then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Id, Follow_Lier_Lieux);
end if;
else
Local_Ok := False;
Error.Syn (Id, Follow_Lier_Lieux);
end if;
Ok := Ok and Local_Ok;
end Lieu;
procedure Moyen (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Par then
Lex.Next;
if Lex.Get_Token = Id then
Lex.Next;
if Lex.Get_Token = Id then
Lex.Next;
end if;
else
Local_Ok := False;
Error.Syn (Id, Follow_Lier_Lieux);
end if;
else
Local_Ok := False;
Error.Syn (Par, Follow_Lier_Lieux);
end if;
Ok := Ok and Local_Ok;
end Moyen;
procedure Lier_Lieux (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Lie loop
Lex.Next;
Lieu (Local_Ok);
if Lex.Get_Token = A then
Lex.Next;
Lieu (Local_Ok);
if Local_Ok then
Moyen (Local_Ok);
end if;
if Local_Ok then
Put_Line ("lien");
end if;
else
Local_Ok := False;
Error.Syn (A, Follow_Lier_Lieux);
end if;
end loop;
Ok := Ok and Local_Ok;
end Lier_Lieux;
procedure Liste_Groupes (Ok : in out Boolean) is
List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
Index : Natural;
Group_Identifier : Identifier.Object;
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Groupe loop
Lex.Next;
if Lex.Get_Token = Id then
Group_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (List, Local_Ok);
if Local_Ok then
Put_Line ("groupe");
Identifier_List.Init (Iterator, List);
while not Identifier_List.Done (Iterator) loop
Index := Complement_Identifier_Array.Index
(Identifier.Image
(Identifier_List.Value (Iterator)));
Group_Array.Put (Group_Identifier, Index, Local_Ok);
if not Local_Ok then
Error.Sem (Groupe, Identifier.Image
(Identifier_List.Value
(Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Liste_Groupes);
end if;
else
Local_Ok := False;
Error.Syn (Id, Follow_Liste_Groupes);
end if;
end loop;
Ok := Ok and Local_Ok;
end Liste_Groupes;
procedure Synonymes (List : in out Identifier_List.Object;
Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Ou then
Lex.Next;
Liste_Identificateurs (List, Local_Ok);
end if;
Ok := Ok and Local_Ok;
end Synonymes;
procedure Liste_Verbes (Ok : in out Boolean) is
List : Identifier_List.Object;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Verbes then
Lex.Next;
Put_Line ("liste_verbes");
while Lex.Get_Token = Id loop
Lex.Next;
Synonymes (List, Local_Ok);
--if local_ok then
--Put_Line ("verbe");
--end if;
end loop;
end if;
Ok := Ok and Local_Ok;
end Liste_Verbes;
procedure Instructions_Simples (Ok : in out Boolean);
procedure Expression (Ok : in out Boolean);
procedure Facteur (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Opening_Bracket =>
Lex.Next;
Expression (Local_Ok);
if Lex.Get_Token = Closing_Bracket then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Closing_Bracket, Follow_Facteur);
end if;
when Id =>
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
Objet (Local_Ok);
end if;
when Number =>
Lex.Next;
when others =>
Local_Ok := False;
Error.Syn (Facteur, Follow_Facteur);
end case;
Ok := Ok and Local_Ok;
end Facteur;
procedure Terme (Ok : in out Boolean) is
First_Terme : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Multiply .. Divide => True, others => False);
Local_Ok : Boolean := True;
begin
Facteur (Local_Ok);
while First_Terme (Lex.Get_Token) loop
case Lex.Get_Token is
when Multiply | Divide =>
Lex.Next;
Facteur (Local_Ok);
when others =>
null;
end case;
end loop;
Ok := Ok and Local_Ok;
end Terme;
procedure Expression (Ok : in out Boolean) is
First_Expression : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Substract .. Add => True, others => False);
Local_Ok : Boolean := True;
begin
Terme (Local_Ok);
while First_Expression (Lex.Get_Token) loop
case Lex.Get_Token is
when Add | Substract =>
Lex.Next;
Terme (Local_Ok);
when others =>
null;
end case;
end loop;
Ok := Ok and Local_Ok;
end Expression;
procedure Tests (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Existe =>
Lex.Next;
if Lex.Get_Token = Pas then
Lex.Next;
end if;
when Equal | Not_Equal | Less | Greater |
Greater_Equal | Less_Equal =>
Lex.Next;
Expression (Local_Ok);
when others =>
Local_Ok := False;
Error.Syn (Tests, Follow_Suite_Condition_Forte);
end case;
Ok := Ok and Local_Ok;
end Tests;
procedure Suite_Condition_Forte (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when De =>
Lex.Next;
Objet (Local_Ok);
Tests (Local_Ok);
when Appartient =>
Lex.Next;
if Lex.Get_Token = Pas then
Lex.Next;
end if;
if Lex.Get_Token = A then
Lex.Next;
Objet (Local_Ok);
else
Local_Ok := False;
Error.Syn (A, Follow_Suite_Condition_Forte);
end if;
when Existe =>
Lex.Next;
if Lex.Get_Token = Pas then
Lex.Next;
end if;
when others =>
Local_Ok := False;
Error.Syn (Suite_Condition_Forte, Follow_Suite_Condition_Forte);
end case;
Ok := Ok and Local_Ok;
end Suite_Condition_Forte;
procedure Condition_Forte (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Id =>
Lex.Next;
Suite_Condition_Forte (Local_Ok);
when Heros | Lieu =>
Lex.Next;
if Lex.Get_Token = Equal then
Lex.Next;
if Lex.Get_Token = Id then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Id, Follow_Condition_Forte);
end if;
else
Local_Ok := False;
Error.Syn (Equal, Follow_Condition_Forte);
end if;
when Number =>
Lex.Next;
if Lex.Get_Token = Actions then
Lex.Next;
if Lex.Get_Token = Passees then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Passees, Follow_Condition_Forte);
end if;
else
Local_Ok := False;
Error.Syn (Actions, Follow_Condition_Forte);
end if;
when Rencontre =>
Lex.Next;
if Lex.Get_Token = Id then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Id, Follow_Condition_Forte);
end if;
when Issues =>
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
if Lex.Get_Token = Id then
Lex.Next;
if Lex.Get_Token = Existe then
Lex.Next;
if Lex.Get_Token = Pas then
Lex.Next;
end if;
else
Local_Ok := False;
Error.Syn (De, Follow_Condition_Forte);
end if;
else
Local_Ok := False;
Error.Syn (Id, Follow_Condition_Forte);
end if;
else
Local_Ok := False;
Error.Syn (De, Follow_Condition_Forte);
end if;
when others =>
Local_Ok := False;
Error.Syn (Condition_Forte, Follow_Condition_Forte);
end case;
Ok := Ok and Local_Ok;
end Condition_Forte;
procedure Condition_Faible (Ok : in out Boolean) is
First_Condition_Faible : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Et => True, others => False);
Local_Ok : Boolean := True;
begin
Condition_Forte (Local_Ok);
while First_Condition_Faible (Lex.Get_Token) loop-- a simplifier
case Lex.Get_Token is
when Et =>
Lex.Next;
Condition_Forte (Local_Ok);
when others =>
null;
end case;
end loop;
Ok := Ok and Local_Ok;
end Condition_Faible;
procedure Condition (Ok : in out Boolean) is
First_Condition : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Ou => True, others => False);
Local_Ok : Boolean := True;
begin
Condition_Faible (Local_Ok);
while First_Condition (Lex.Get_Token) loop-- a simplifier
case Lex.Get_Token is
when Ou =>
Lex.Next;
Condition_Faible (Local_Ok);
when others =>
null;
end case;
end loop;
Ok := Ok and Local_Ok;
end Condition;
procedure Si (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
Condition (Local_Ok);
if Lex.Get_Token = Alors then
Lex.Next;
--Put_Line ("alors detecte");
Instructions_Simples (Local_Ok);
--Put_Line ("sinon possible");
if Lex.Get_Token = Sinon then
--Put_Line ("sinon detecte");
Lex.Next;
Instructions_Simples (Local_Ok);
end if;
--Put_Line ("fin de sinon");
if Lex.Get_Token = Fin then
Lex.Next;
if Lex.Get_Token = Si then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Si, Follow_Instruction_Simple);
end if;
else
Local_Ok := False;
Error.Syn (Fin, Follow_Instruction_Simple);
end if;
else
Local_Ok := False;
Error.Syn (Alors, Follow_Instruction_Simple);
end if;
Ok := Ok and Local_Ok;
end Si;
procedure Change (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Id =>
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
Objet (Local_Ok);
if Lex.Get_Token = En then
Lex.Next;
Expression (Local_Ok);
else
Local_Ok := False;
Error.Syn (En, Follow_Instruction_Simple);
end if;
else
Local_Ok := False;
Error.Syn (De, Follow_Instruction_Simple);
end if;
when Heros | Lieu =>
Lex.Next;
if Lex.Get_Token = En then
Lex.Next;
if Lex.Get_Token = Id then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Id, Follow_Instruction_Simple);
end if;
else
Local_Ok := False;
Error.Syn (En, Follow_Instruction_Simple);
end if;
when others =>
Local_Ok := False;
Error.Syn (Change, Follow_Instruction_Simple);
end case;
Ok := Ok and Local_Ok;
end Change;
procedure Quoi_Afficher (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Right_Sentence =>
Lex.Next;
when Wrong_Sentence =>
Local_Ok := False;
Error.Syn (Wrong_Sentence, Follow_Quoi_Afficher);
when Number =>
Lex.Next;
when Id =>
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
Objet (Local_Ok);
end if;
when Issue =>
Lex.Next;
if Lex.Get_Token = Id then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Id, Follow_Quoi_Afficher);
end if;
when Issues =>
Lex.Next;
when Contenu =>
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
Objet (Local_Ok);
else
Local_Ok := False;
Error.Syn (De, Follow_Quoi_Afficher);
end if;
when others =>
Local_Ok := False;
Error.Syn (Quoi_Afficher, Follow_Quoi_Afficher);
end case;
Ok := Ok and Local_Ok;
end Quoi_Afficher;
procedure Liste_Affiche (Ok : in out Boolean) is
First_Liste_Affiche : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Ampersand => True, others => False);
Local_Ok : Boolean := True;
begin
Quoi_Afficher (Local_Ok);
while (First_Liste_Affiche (Lex.Get_Token)) loop
case Lex.Get_Token is
when Ampersand =>
Lex.Next;
Quoi_Afficher (Local_Ok);
when others =>
null;
end case;
end loop;
Ok := Ok and Local_Ok;
end Liste_Affiche;
procedure Ligne (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Suivante then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Suivante, Follow_Instruction_Simple);
end if;
Ok := Ok and Local_Ok;
end Ligne;
procedure Bouge (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Anime then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Anime, Follow_Instruction_Simple);
end if;
Ok := Ok and Local_Ok;
end Bouge;
procedure Positionne (Ok : in out Boolean) is
List : Identifier_List.Object;
Local_Ok : Boolean := True;
begin
Liste_Identificateurs (List, Local_Ok);
if Lex.Get_Token = A then
Lex.Next;
Objet (Local_Ok);
else
Local_Ok := False;
Error.Syn (Dans, Follow_Instruction_Simple);
end if;
Ok := Ok and Local_Ok;
end Positionne;
procedure Va (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Vers then
Lex.Next;
if Lex.Get_Token = Id then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Id, Follow_Instruction_Simple);
end if;
else
Local_Ok := False;
Error.Syn (Vers, Follow_Instruction_Simple);
end if;
Ok := Ok and Local_Ok;
end Va;
procedure Instructions_Simples (Ok : in out Boolean) is
First_Instructions_Simples : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Si .. Va => True, others => False);
List : Identifier_List.Object;
Local_Ok : Boolean := True;
begin
while First_Instructions_Simples (Lex.Get_Token) loop
case Lex.Get_Token is
when Si =>
Lex.Next;
Si (Local_Ok);
when Change =>
Lex.Next;
Change (Local_Ok);
when Affiche =>
Lex.Next;
Liste_Affiche (Local_Ok);
when Ligne =>
Lex.Next;
Ligne (Local_Ok);
when Bouge =>
Lex.Next;
Bouge (Local_Ok);
when Positionne =>
Lex.Next;
Positionne (Local_Ok);
when Retire =>
Lex.Next;
Liste_Identificateurs (List, Local_Ok);
when Termine =>
Lex.Next;
when Va =>
Lex.Next;
Va (Local_Ok);
when Efface =>
Lex.Next;
when others =>
null;
Put_Line ("fin instructions simples");
end case;
end loop;
Ok := Ok and Local_Ok;
end Instructions_Simples;
procedure Description_Ordre (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Id then
Lex.Next;
while Lex.Get_Token = Id loop
Lex.Next;
end loop;
else
Local_Ok := False;
Error.Syn (Id, Follow_Ordre);
end if;
Ok := Ok and Local_Ok;
end Description_Ordre;
procedure Ordre (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
Description_Ordre (Local_Ok);
while Lex.Get_Token = Comma loop
Lex.Next;
Description_Ordre (Local_Ok);
end loop;
if Lex.Get_Token = Colon then
Lex.Next;
Instructions_Simples (Local_Ok);
while Lex.Get_Token = Pour or Lex.Get_Token = Ailleurs loop
if Lex.Get_Token = Pour then
Lex.Next;
if Lex.Get_Token = Id then
Lex.Next;
Instructions_Simples (Local_Ok);
else
Local_Ok := False;
Error.Syn (Id, Follow_Ordre);
end if;
else
Lex.Next;
Instructions_Simples (Local_Ok);
exit;
end if;
end loop;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Ordre);
end if;
if Local_Ok then
Put_Line ("ordre");
end if;
Ok := Ok and Local_Ok;
end Ordre;
procedure Fin_Quand (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Fin then
Lex.Next;
if Lex.Get_Token = Quand then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Quand, Follow_Quand_Ordre);
end if;
else
Local_Ok := False;
Error.Syn (Fin, Follow_Quand_Ordre);
end if;
Ok := Ok and Local_Ok;
end Fin_Quand;
procedure Quand_Ordre (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Quand then
Lex.Next;
if Lex.Get_Token = Ordre then
Lex.Next;
if Lex.Get_Token = Vaut then
Lex.Next;
if Lex.Get_Token = Substract then
Lex.Next;
Ordre (Local_Ok);
while Lex.Get_Token = Substract loop
Lex.Next;
Ordre (Local_Ok);
end loop;
Fin_Quand (Local_Ok);
if Local_Ok then
Put_Line ("quand_ordre correct");
end if;
else
Local_Ok := False;
Error.Syn (Substract, Follow_Ordre);
end if;
else
Local_Ok := False;
Error.Syn (Vaut, Follow_Quand_Ordre);
end if;
else
Local_Ok := False;
Error.Syn (Ordre, Follow_Quand_Ordre);
end if;
else
Local_Ok := False;
Error.Syn (Quand, Follow_Quand_Ordre);
end if;
Ok := Ok and Local_Ok;
end Quand_Ordre;
procedure Creation_Monde (Ok : in out Boolean) is
Local_Ok : Boolean := True;
[declaration]
begin
Put_Line ("Lecture de la zone de creation ...");
while Lex.Get_Token in States and Lex.Get_Token >= In_Progress loop
case In_Progress is
when Message =>
Liste_Messages_Erreur (Local_Ok);
when Enumere =>
Liste_Enumeres (Local_Ok);
when Structure =>
Liste_Structures (Local_Ok);
when Cree =>
Liste_Objets (Local_Ok);
when Mots =>
Liste_Mots (Local_Ok);
when Lien =>
Etats_Liens (Local_Ok);
when Lie =>
Lier_Lieux (Local_Ok);
when Groupe =>
Liste_Groupes (Local_Ok);
when Verbes =>
Liste_Verbes (Local_Ok);
when others =>
exit;
end case;
In_Progress := States'Succ (In_Progress);
end loop;
if not Lex.Is_At_End then
Put_Line ("in_progress : " & Token'Image (In_Progress));
end if;
Ok := Ok and Local_Ok;
end Creation_Monde;
procedure Scenario (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Introduction then
Lex.Next;
Put_Line ("Lecture de la zone d'introduction ...");
Instructions_Simples (Local_Ok);
end if;
if Lex.Get_Token = Scenario then
Lex.Next;
Put_Line ("Lecture de la zone de scenario ...");
Instructions_Simples (Local_Ok);
Quand_Ordre (Local_Ok);
Instructions_Simples (Local_Ok);
end if;
Ok := Ok and Local_Ok;
end Scenario;
procedure Jeu_Aventure (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
loop
Creation_Monde (Local_Ok);
Scenario (Local_Ok);
if not Lex.Is_At_End then
Local_Ok := False;
-- Put_Line ("not at end");
Error.Syn (Jeu_Aventure, Follow_Jeu_Aventure);
else
exit;
end if;
Put_Line ("redemarrage");
end loop;
Ok := Ok and Local_Ok;
end Jeu_Aventure;
procedure Start is
Local_Ok : Boolean := True;
begin
Lex.Initialize;
Jeu_Aventure (Local_Ok);
if Local_Ok then
Put_Line ("Program is Ok");
else
Put_Line ("Program is false");
end if;
Enumeration_Array.Show;
Message_Array.Show;
Group_Array.Show;
end Start;
begin
Complement_Identifier_Array.Put ("e1");
Complement_Identifier_Array.Put ("e2");
Complement_Identifier_Array.Put ("e3");
Complement_Identifier_Array.Put ("e4");
Complement_Identifier_Array.Put ("e5");
Complement_Identifier_Array.Put ("e6");
Complement_Identifier_Array.Put ("e7");
Complement_Identifier_Array.Put ("e8");
end Syn