|
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 - download
Length: 70656 (0x11400)
Types: Ada Source
Notes: 03_class, FILE, Long Ada Source, R1k_Segment, e3_tag, package body Syn, seg_044e15
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦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;
nblk1=44
nid=3e
hdr6=6a
[0x00] rec0=19 rec1=00 rec2=01 rec3=04a
[0x01] rec0=1a rec1=00 rec2=20 rec3=062
[0x02] rec0=1c rec1=00 rec2=3f rec3=01e
[0x03] rec0=1b rec1=00 rec2=33 rec3=012
[0x04] rec0=1b rec1=00 rec2=0b rec3=040
[0x05] rec0=09 rec1=00 rec2=12 rec3=000
[0x06] rec0=19 rec1=00 rec2=02 rec3=018
[0x07] rec0=1b rec1=00 rec2=13 rec3=018
[0x08] rec0=17 rec1=00 rec2=1f rec3=034
[0x09] rec0=13 rec1=00 rec2=2e rec3=044
[0x0a] rec0=1c rec1=00 rec2=3d rec3=032
[0x0b] rec0=1a rec1=00 rec2=15 rec3=014
[0x0c] rec0=1e rec1=00 rec2=32 rec3=01c
[0x0d] rec0=1a rec1=00 rec2=0d rec3=00c
[0x0e] rec0=18 rec1=00 rec2=1a rec3=01c
[0x0f] rec0=21 rec1=00 rec2=24 rec3=042
[0x10] rec0=22 rec1=00 rec2=37 rec3=02e
[0x11] rec0=20 rec1=00 rec2=0f rec3=00c
[0x12] rec0=14 rec1=00 rec2=28 rec3=00a
[0x13] rec0=1b rec1=00 rec2=27 rec3=04c
[0x14] rec0=16 rec1=00 rec2=08 rec3=030
[0x15] rec0=22 rec1=00 rec2=0e rec3=024
[0x16] rec0=21 rec1=00 rec2=3b rec3=044
[0x17] rec0=16 rec1=00 rec2=39 rec3=036
[0x18] rec0=17 rec1=00 rec2=26 rec3=046
[0x19] rec0=02 rec1=00 rec2=2b rec3=016
[0x1a] rec0=22 rec1=00 rec2=14 rec3=014
[0x1b] rec0=1f rec1=00 rec2=38 rec3=02e
[0x1c] rec0=13 rec1=00 rec2=36 rec3=054
[0x1d] rec0=23 rec1=00 rec2=03 rec3=032
[0x1e] rec0=20 rec1=00 rec2=1e rec3=01c
[0x1f] rec0=1d rec1=00 rec2=04 rec3=06e
[0x20] rec0=1b rec1=00 rec2=11 rec3=036
[0x21] rec0=18 rec1=00 rec2=1c rec3=036
[0x22] rec0=22 rec1=00 rec2=18 rec3=01c
[0x23] rec0=0e rec1=00 rec2=2f rec3=02a
[0x24] rec0=1d rec1=00 rec2=06 rec3=032
[0x25] rec0=16 rec1=00 rec2=41 rec3=032
[0x26] rec0=1e rec1=00 rec2=30 rec3=004
[0x27] rec0=1d rec1=00 rec2=1b rec3=038
[0x28] rec0=1f rec1=00 rec2=07 rec3=02e
[0x29] rec0=27 rec1=00 rec2=0c rec3=018
[0x2a] rec0=21 rec1=00 rec2=16 rec3=01a
[0x2b] rec0=1d rec1=00 rec2=21 rec3=01e
[0x2c] rec0=25 rec1=00 rec2=09 rec3=006
[0x2d] rec0=1d rec1=00 rec2=35 rec3=00e
[0x2e] rec0=11 rec1=00 rec2=3c rec3=050
[0x2f] rec0=1d rec1=00 rec2=2c rec3=02e
[0x30] rec0=1d rec1=00 rec2=31 rec3=060
[0x31] rec0=1e rec1=00 rec2=10 rec3=00e
[0x32] rec0=02 rec1=00 rec2=34 rec3=00c
[0x33] rec0=21 rec1=00 rec2=2a rec3=00c
[0x34] rec0=21 rec1=00 rec2=1d rec3=000
[0x35] rec0=00 rec1=00 rec2=00 rec3=000
[0x36] rec0=00 rec1=00 rec2=00 rec3=000
[0x37] rec0=00 rec1=00 rec2=00 rec3=000
[0x38] rec0=00 rec1=00 rec2=00 rec3=000
[0x39] rec0=00 rec1=00 rec2=00 rec3=000
[0x3a] rec0=00 rec1=01 rec2=00 rec3=000
[0x3b] rec0=00 rec1=04 rec2=00 rec3=000
[0x3c] rec0=00 rec1=40 rec2=03 rec3=391
[0x3d] rec0=fc rec1=00 rec2=00 rec3=000
[0x3e] rec0=32 rec1=00 rec2=00 rec3=000
[0x3f] rec0=00 rec1=00 rec2=00 rec3=000
[0x40] rec0=00 rec1=00 rec2=00 rec3=000
[0x41] rec0=00 rec1=00 rec2=00 rec3=000
[0x42] rec0=00 rec1=00 rec2=00 rec3=000
[0x43] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x215410610864656d6a1b9 0x42a00088462060003
Free Block Chain:
0x3e: 0000 00 0a 00 04 80 01 67 01 20 20 20 20 20 41 74 74 ┆ g Att┆
0xa: 0000 00 2d 00 29 80 1b 28 6c 65 78 2e 67 65 74 5f 6c ┆ - ) (lex.get_l┆
0x2d: 0000 00 40 02 2a 80 04 64 20 3d 3e 04 00 54 20 20 20 ┆ @ * d => T ┆
0x40: 0000 00 05 00 0c 80 09 20 20 20 20 20 20 20 20 20 09 ┆ ┆
0x5: 0000 00 19 00 09 80 06 6f 6c 6c 6f 77 5f 06 65 08 00 ┆ ollow_ e ┆
0x19: 0000 00 3a 00 0c 80 09 20 20 20 20 20 20 20 65 6e 09 ┆ : en ┆
0x3a: 0000 00 22 00 10 80 0d 20 20 20 20 20 20 20 20 20 20 ┆ " ┆
0x22: 0000 00 29 00 5d 80 26 20 20 20 20 20 20 20 20 50 75 ┆ ) ] & Pu┆
0x29: 0000 00 23 00 0c 80 09 6e 20 49 64 65 6e 74 69 66 09 ┆ # n Identif ┆
0x23: 0000 00 42 03 fc 80 02 73 65 02 00 1d 20 20 20 20 20 ┆ B se ┆
0x42: 0000 00 25 00 11 80 0e 20 20 20 20 20 20 20 20 20 20 ┆ % ┆
0x25: 0000 00 43 03 fc 80 14 20 20 20 20 20 20 20 20 4f 6b ┆ C Ok┆
0x43: 0000 00 17 00 11 80 03 20 3d 3e 03 00 08 20 20 20 20 ┆ => ┆
0x17: 0000 00 44 03 fc 80 0d 68 65 6e 20 6f 74 68 65 72 73 ┆ D hen others┆
0x44: 0000 00 00 00 10 00 0d 20 20 20 20 20 20 20 20 20 20 ┆ ┆