|
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: 109568 (0x1ac00)
Types: Ada Source
Notes: 03_class, FILE, Long Ada Source, R1k_Segment, e3_tag, package body Syn, seg_049a22
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Text_Io, Lex, Error, Moving_String, Group_Identifier_Array;
with Complement, Complement_Array, Structure_Array, Field_Identifier_Array;
with Objet, Detail, Attribute, View, View_List, Order,
Pre_Order_Instructions, Introduction_Instructions;
with Post_Order_Instructions, Order_List, Condition,
Coded_Order_Array, Expression, Affectation, Instruction_List;
with Enumerate_Array, Message_Array;
with Exclusive_Generic_List, Identifier, Cheat_Code;
use Text_Io, Moving_String;
package body Syn is
Number1 : Natural := 1;
Number2 : Natural := 1;
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 Token range Aide .. Introduction;
In_Progress : States := Aide;
procedure Type_Base (Structure_Name : in Identifier.Object;
Attribute_Index : in Positive;
Enumeration_Type : out Natural;
Ok : in out Boolean) is
Sem_Ok : Boolean;
begin
Enumeration_Type := 0;
case Lex.Get_Token is
when Entier =>
Structure_Array.Create_Number_Field
(Structure_Name, Attribute_Index, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Field_Exist,
Field_Identifier_Array.Image (Attribute_Index));
end if;
Lex.Next;
when Chaine =>
Structure_Array.Create_Sentence_Field
(Structure_Name, Attribute_Index, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Field_Exist,
Field_Identifier_Array.Image (Attribute_Index));
end if;
Lex.Next;
when Id =>
if Enumerate_Array.Enumeration_Belong
(Lex.Get_Lower_Case_Value) then
Enumeration_Type := Enumerate_Array.Enumeration_Index
(Lex.Get_Lower_Case_Value);
Structure_Array.Create_Enumerate_Field
(Structure_Name, Attribute_Index, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Field_Exist, Field_Identifier_Array.Image
(Attribute_Index));
end if;
else
Ok := False;
Error.Sem (Enumeration_Not_Exist, Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
when others =>
Ok := False;
Error.Syn (Type_Base, Follow_Type_Base);
end case;
end Type_Base;
procedure Type_Structure (Structure_Type : out Moving_String.Object;
Ok : in out Boolean) is
Sem_Ok : Boolean;
begin
Structure_Type := Moving_String.Null_Object;
case Lex.Get_Token is
when Anime | Lieu | Entite | Id =>
Structure_Type := Lex.Get_Lower_Case_Value;
if not Structure_Array.Belong (Lex.Get_Lower_Case_Value) then
Ok := False;
Error.Sem (Structure_Not_Exist, Lex.Get_Value);
end if;
Lex.Next;
when others =>
Ok := False;
Error.Syn (Type_Structure, Follow_Type_Structure);
end case;
end Type_Structure;
procedure Chaine (A_Sentence : out Identifier.Object;
Ok : in out Boolean) is
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
Value := Value & Lex.Get_Value;
Lex.Next;
else
Ok := False;
if Lex.Get_Token = Wrong_Sentence then
Ok := False;
Error.Syn (Wrong_Sentence, Follow_Liste_Messages_Erreur);
else
Ok := False;
Error.Syn (Sentence, Follow_Liste_Messages_Erreur);
end if;
end if;
end loop;
A_Sentence := Identifier.From_String (Moving_String.Image (Value));
end Chaine;
procedure Valeur (Structure_Name : in Identifier.Object;
Attribute_Index : in Positive;
Enumeration_Type : in Natural;
Ok : in out Boolean) is
A_Sentence : Identifier.Object;
Literal_Index : Natural;
Sem_Ok : Boolean;
begin
case Lex.Get_Token is
when Number =>
Structure_Array.Field_Put_Number
(Structure_Name, Attribute_Index,
Integer'Value (Lex.Get_Lower_Case_Value), Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Field_Not_A_Number,
Field_Identifier_Array.Image (Attribute_Index));
end if;
Lex.Next;
when Id =>
if Enumeration_Type /= 0 then
if Enumerate_Array.Literal_Belong
(Lex.Get_Lower_Case_Value) then
Literal_Index := Enumerate_Array.Literal_Index
(Lex.Get_Lower_Case_Value);
Structure_Array.Field_Put_Enumerate
(Structure_Name, Attribute_Index,
Enumeration_Type, Literal_Index, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Field_Not_An_Enumerate,
Field_Identifier_Array.Image
(Attribute_Index));
end if;
else
Ok := False;
Error.Sem (Literal_Not_Exist, Lex.Get_Lower_Case_Value);
end if;
end if;
Lex.Next;
when Right_Sentence =>
Chaine (A_Sentence, Ok);
if Ok then
Structure_Array.Field_Put_Sentence
(Structure_Name, Attribute_Index, A_Sentence, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Field_Not_A_Sentence,
Field_Identifier_Array.Image
(Attribute_Index));
end if;
end if;
when others =>
Ok := False;
Error.Syn (Valeur, Follow_Valeur);
end case;
end Valeur;
procedure Valeur (A_Complement : in out Complement.Object;
Attribute_Index : in Natural;
Ok : in out Boolean) is
Sem_Ok : Boolean;
A_Sentence : Identifier.Object;
Enumeration_Type : Natural;
Literal_Index : Natural;
begin
case Lex.Get_Token is
when Number =>
if Attribute_Index /= 0 then
if Complement.Field_Belong
(A_Complement, Attribute_Index) then
Complement.Field_Put_Number
(A_Complement, Attribute_Index,
Integer'Value (Lex.Get_Lower_Case_Value), Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Field_Not_A_Number,
Field_Identifier_Array.Image
(Attribute_Index));
end if;
else
Ok := False;
Error.Sem (Field_Not_Belong,
Field_Identifier_Array.Image
(Attribute_Index));
end if;
end if;
Lex.Next;
when Id =>
if Attribute_Index /= 0 then
if Complement.Field_Belong
(A_Complement, Attribute_Index) then
if Complement.Field_Is_An_Enumerate
(A_Complement, Attribute_Index) then
Enumeration_Type :=
Complement.Field_Enumeration
(A_Complement, Attribute_Index);
if Enumerate_Array.Literal_Belong
(Lex.Get_Lower_Case_Value) then
Literal_Index := Enumerate_Array.Literal_Index
(Lex.Get_Lower_Case_Value);
Complement.Field_Put_Enumerate
(A_Complement, Attribute_Index,
Enumeration_Type, Literal_Index, Sem_Ok);
else
Ok := False;
Error.Sem (Literal_Not_Exist,
Lex.Get_Lower_Case_Value);
end if;
else
Ok := False;
Error.Sem (Field_Not_An_Enumerate,
Field_Identifier_Array.Image
(Attribute_Index));
end if;
else
Ok := False;
Error.Sem (Field_Not_Belong,
Field_Identifier_Array.Image
(Attribute_Index));
end if;
end if;
Lex.Next;
when Right_Sentence =>
Chaine (A_Sentence, Ok);
if Ok and Attribute_Index /= 0 then
if Complement.Field_Belong
(A_Complement, Attribute_Index) then
Complement.Field_Put_Sentence
(A_Complement, Attribute_Index, A_Sentence, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Field_Not_A_Sentence,
Field_Identifier_Array.Image
(Attribute_Index));
end if;
else
Ok := False;
Error.Sem (Field_Not_Belong,
Field_Identifier_Array.Image
(Attribute_Index));
end if;
end if;
when others =>
Ok := False;
Error.Syn (Valeur, Follow_Valeur);
end case;
end Valeur;
procedure Un_Objet (An_Objet : out Objet.Object; Ok : in out Boolean) is
begin
Text_Io.Put_Line ("objetstart with a lexeme =>" & Lex.Get_Value);
An_Objet := Objet.Null_Object;
case Lex.Get_Token is
when Id =>
if Complement_Array.Is_A_Subject (Lex.Get_Lower_Case_Value) then
Objet.Create_Real (An_Objet, Complement_Array.Index
(Lex.Get_Lower_Case_Value));
elsif Group_Identifier_Array.Belong
(Lex.Get_Lower_Case_Value) then
Objet.Create_Group (An_Objet,
Order_List.Complement_Position
(Lex.Get_Lower_Case_Value));
Text_Io.Put_Line ("objet5");
else
Ok := False;
Error.Sem (Neither_A_Subject_Nor_A_Group,
Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
when Heros =>
Objet.Create_Hero (An_Objet);
Lex.Next;
when Lieu =>
Objet.Create_Place (An_Objet);
Lex.Next;
when others =>
Ok := False;
Error.Syn (Single_Objet, Follow_Objet);
end case;
Text_Io.Put_Line ("objet stop with OK =>" & Boolean'Image (Ok));
end Un_Objet;
procedure Liste_Identificateurs (Id_List : in out Identifier_List.Object;
Ok : in out Boolean) is
Sem_Ok : Boolean;
begin
Identifier_List.Free (Id_List);
if Lex.Get_Token = Id then
Identifier_List.Put
(Id_List, Identifier.From_String (Lex.Get_Lower_Case_Value),
Sem_Ok);
Lex.Next;
while Lex.Get_Token = Comma loop
Lex.Next;
if Lex.Get_Token = Id then
Identifier_List.Put
(Id_List,
Identifier.From_String (Lex.Get_Lower_Case_Value),
Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Identifier_Belong_List,
Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
else
Ok := False;
Error.Syn (Id, Follow_Liste_Identificateurs);
end if;
end loop;
else
Ok := False;
Error.Syn (Id, Follow_Liste_Identificateurs);
end if;
end Liste_Identificateurs;
procedure Aide (Ok : in out Boolean) is
begin
Lex.Next;
if Lex.Get_Token = Id then
Cheat_Code.Put (Lex.Get_Lower_Case_Value);
Lex.Next;
else
Ok := False;
Error.Syn (Id, Follow_Aide);
end if;
end Aide;
procedure Liste_Messages_Erreur (Ok : in out Boolean) is
A_Sentence : Identifier.Object;
Sem_Ok : Boolean;
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 (A_Sentence, Ok);
if Ok then
Message_Array.Put (A_Sentence, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Message, Identifier.Image (A_Sentence));
else
Text_Io.Put_Line ("message");
end if;
end if;
else
Ok := False;
if Lex.Get_Token = Wrong_Sentence then
Ok := False;
Error.Syn (Wrong_Sentence,
Follow_Liste_Messages_Erreur);
else
Ok := False;
Error.Syn (Sentence, Follow_Liste_Messages_Erreur);
end if;
end if;
else
Ok := False;
Error.Syn (Erreur, Follow_Liste_Messages_Erreur);
end if;
end loop;
end Liste_Messages_Erreur;
procedure Liste_Enumeres (Ok : in out Boolean) is
Enumeration_Identifier : Identifier.Object;
Id_List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
Sem_Ok : Boolean;
begin
while Lex.Get_Token = Enumere loop
Lex.Next;
if Lex.Get_Token = Id then
Enumeration_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
if Enumerate_Array.Enumeration_Belong
(Lex.Get_Lower_Case_Value) then
Ok := False;
Error.Sem (Enumeration_Exist, Lex.Get_Value);
end if;
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (Id_List, Ok);
if Ok then
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
Enumerate_Array.Put
(Enumeration_Identifier,
Identifier_List.Value (Iterator), Sem_Ok);
Identifier_List.Next (Iterator);
end loop;
if not Sem_Ok then
Put_Line ("enumere");
end if;
end if;
else
Ok := False;
Error.Syn (Colon, Follow_Liste_Enumeres);
end if;
else
Ok := False;
Error.Syn (Id, Follow_Liste_Enumeres);
end if;
end loop;
end Liste_Enumeres;
procedure Liens_Speciaux (Ok : in out Boolean) is
Id_List : Identifier_List.Object;
Special_Identifier : Identifier.Object;
Iterator : Identifier_List.Iterator;
Sem_Ok : Boolean;
begin
if Lex.Get_Token = Lien then
Lex.Next;
if Lex.Get_Token = Special then
Special_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (Id_List, Ok);
if Ok then
Put_Line ("etats liens speciaux");
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
if not (Enumerate_Array.Literal_Belong
(Identifier.Image (Identifier_List.Value
(Iterator)))) then
Enumerate_Array.Put
(Special_Identifier,
Identifier_List.Value (Iterator), Sem_Ok);
else
Ok := False;
Error.Sem (Special_In_Normal,
Identifier.Image
(Identifier_List.Value
(Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
Ok := False;
Error.Syn (Colon, Follow_Lien_Special);
end if;
else
Ok := False;
Error.Syn (Special, Follow_Lien_Special);
end if;
end if;
end Liens_Speciaux;
procedure Etats_Liens (Ok : in out Boolean) is
Normal_Identifier : Identifier.Object;
Id_List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
Sem_Ok : Boolean;
begin
if Lex.Get_Token = Lien then
Lex.Next;
if Lex.Get_Token = Normal then
Normal_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (Id_List, Ok);
if Ok then
Put_Line ("etats liens normaux");
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
Enumerate_Array.Put
(Normal_Identifier,
Identifier_List.Value (Iterator), Sem_Ok);
Identifier_List.Next (Iterator);
end loop;
end if;
Liens_Speciaux (Ok);
else
Ok := False;
Error.Syn (Colon, Follow_Lien_Normal);
end if;
else
Ok := False;
Error.Syn (Normal, Follow_Lien_Normal);
end if;
end if;
end Etats_Liens;
procedure Synonymes (Id_List : in out Identifier_List.Object;
Ok : in out Boolean) is
Sem_Ok : Boolean;
begin
if Lex.Get_Token = Ou then
Lex.Next;
Liste_Identificateurs (Id_List, Ok);
end if;
end Synonymes;
procedure Verbe (Ok : in out Boolean) is
Id_List : Identifier_List.Object;
Verb_Identifier : Identifier.Object;
Sem_Ok : Boolean;
Iterator : Identifier_List.Iterator;
begin
Verb_Identifier := Identifier.From_String (Lex.Get_Lower_Case_Value);
Complement_Array.Put_Verb (Verb_Identifier, Verb_Identifier, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Verb_Exist, Lex.Get_Value);
end if;
Lex.Next;
Synonymes (Id_List, Ok);
if Ok then
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
Complement_Array.Put_Verb
(Identifier_List.Value (Iterator), Verb_Identifier, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Verb_Exist,
Identifier.Image
(Identifier_List.Value (Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
end Verbe;
procedure Liste_Verbes (Ok : in out Boolean) is
Sem_Ok : Boolean;
begin
if Lex.Get_Token = Verbes then
Lex.Next;
if Lex.Get_Token = Id then
Verbe (Ok);
while Lex.Get_Token = Id loop
Verbe (Ok);
end loop;
if Ok then
Put_Line ("liste_verbes");
end if;
else
Ok := False;
Error.Syn (Id, Follow_Liste_Verbes);
end if;
end if;
end Liste_Verbes;
procedure Liste_Mots (Ok : in out Boolean) is
Id_List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
Sem_Ok : Boolean;
begin
if Lex.Get_Token = Mots then
Lex.Next;
Liste_Identificateurs (Id_List, Ok);
if Ok then
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
Complement_Array.Put_Word
(Identifier_List.Value (Iterator), Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Word_Exist,
Identifier.Image
(Identifier_List.Value (Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
if Ok then
Put_Line ("mots");
end if;
end if;
end if;
end Liste_Mots;
procedure Attribut (Structure_Name : in Identifier.Object;
Ok : in out Boolean) is
Attribute_Index : Positive;
Enumeration_Type : Natural;
Sem_Ok : Boolean;
begin
if Lex.Get_Token = Id then
Field_Identifier_Array.Put (Identifier.From_String
(Lex.Get_Lower_Case_Value));
Attribute_Index := Field_Identifier_Array.Index
(Lex.Get_Lower_Case_Value);
Complement_Array.Put_Word (Identifier.From_String
(Lex.Get_Lower_Case_Value), Sem_Ok);
Lex.Next;
if Lex.Get_Token = En then
Lex.Next;
Type_Base (Structure_Name, Attribute_Index,
Enumeration_Type, Ok);
if Lex.Get_Token = Equal then
Lex.Next;
Valeur (Structure_Name, Attribute_Index,
Enumeration_Type, Ok);
else
if Enumeration_Type /= 0 then
Structure_Array.Field_Put_Enumerate
(Structure_Name, Attribute_Index,
Enumeration_Type, 1, Sem_Ok);
end if;
end if;
else
Ok := False;
Error.Syn (En, Follow_Attribut);
end if;
else
Ok := False;
Error.Syn (Id, Follow_Attribut);
end if;
end Attribut;
procedure Corps_Structure
(Structure_Name : in Identifier.Object; Ok : in out Boolean) is
begin
if Lex.Get_Token = Attributs then
Lex.Next;
Attribut (Structure_Name, Ok);
while Lex.Get_Token = Id loop
Attribut (Structure_Name, Ok);
end loop;
end if;
end Corps_Structure;
procedure Liste_Structures (Ok : in out Boolean) is
Structure_Type : Moving_String.Object;
Structure_Name : Identifier.Object;
Sem_Ok : Boolean;
begin
while Lex.Get_Token = Structure loop
Lex.Next;
Type_Structure (Structure_Type, Ok);
if Lex.Get_Token = Colon then
Lex.Next;
if Lex.Get_Token = Id then
if Ok then
Structure_Name := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Structure_Array.Put
(Moving_String.Image (Structure_Type),
Structure_Name, Sem_Ok);
end if;
Lex.Next;
Corps_Structure (Structure_Name, Ok);
Put_Line ("structure");
else
Ok := False;
Error.Syn (Id, Follow_Liste_Structures);
end if;
else
Ok := False;
Error.Syn (Colon, Follow_Liste_Structures);
end if;
end loop;
end Liste_Structures;
procedure Champs (A_Complement : in out Complement.Object;
Ok : in out Boolean) is
Value : Moving_String.Object;
Attribute_Index : Natural;
begin
while Lex.Get_Token = Id loop
Attribute_Index := Field_Identifier_Array.Index
(Lex.Get_Lower_Case_Value);
if Attribute_Index = 0 then
Ok := False;
Error.Sem (Field_Not_Exist, Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
if Lex.Get_Token = Equal then
Lex.Next;
Valeur (A_Complement, Attribute_Index, Ok);
else
Ok := False;
Error.Syn (Equal, Follow_Champs);
end if;
end loop;
end Champs;
procedure Corps_Objet (A_Complement : in out Complement.Object;
Ok : in out Boolean) is
begin
if Lex.Get_Token = Attributs then
Lex.Next;
Champs (A_Complement, Ok);
end if;
end Corps_Objet;
procedure Liste_Objets (Ok : in out Boolean) is
Id_List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
Structure_Type : Moving_String.Object;
A_Complement : Complement.Object := Complement.Null_Object;
Sem_Ok : Boolean := True;
begin
while Lex.Get_Token = Cree loop
Lex.Next;
Type_Structure (Structure_Type, Ok);
if Ok then
A_Complement := Structure_Array.Subject
(Moving_String.Image (Structure_Type));
end if;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (Id_List, Ok);
Corps_Objet (A_Complement, Ok);
Put_Line ("objet");
if Ok then
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
Complement_Array.Put
(A_Complement,
Identifier_List.Value (Iterator), Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Complement_Exist,
Identifier.Image
(Identifier_List.Value (Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
Ok := False;
Error.Syn (Colon, Follow_Liste_Objets);
end if;
if Ok then
Text_Io.Put_Line ("objet");
end if;
end loop;
end Liste_Objets;
procedure Lieu (Place_Index, Direction_Index : out Natural;
Ok : in out Boolean) is
begin
Place_Index := 0;
Direction_Index := 0;
Text_Io.Put_Line ("lieu start with OK => " & Boolean'Image (Ok));
Place_Index := 0;
Direction_Index := 0;
if Lex.Get_Token = Id then
if Complement_Array.Belong (Lex.Get_Lower_Case_Value) then
if Complement_Array.Is_A_Place (Lex.Get_Lower_Case_Value) then
Place_Index := Complement_Array.Index
(Lex.Get_Lower_Case_Value);
else
Ok := False;
Error.Sem (Complement_Not_A_Place,
Lex.Get_Lower_Case_Value);
end if;
else
Ok := False;
Error.Sem (Complement_Not_Exist, Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
if Lex.Get_Token = Id then
if Complement_Array.Belong (Lex.Get_Lower_Case_Value) then
if Complement_Array.Is_A_Word
((Lex.Get_Lower_Case_Value)) then
Direction_Index := Complement_Array.Index
(Lex.Get_Lower_Case_Value);
else
Ok := False;
Error.Sem (Complement_Not_A_Word,
Lex.Get_Lower_Case_Value);
end if;
else
Ok := False;
Error.Sem (Complement_Not_Exist, Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
else
Ok := False;
Error.Syn (Id, Follow_Lier_Lieux);
end if;
else
Ok := False;
Error.Syn (Id, Follow_Lier_Lieux);
end if;
Text_Io.Put_Line ("lieu stop with OK => " & Boolean'Image (Ok));
end Lieu;
procedure Moyen (Enumeration_Type, Literal_Index, Exit_Name_Index : out
Natural;
Ok : in out Boolean) is
Local_Type : Natural := 0;
begin
Enumeration_Type := 0;
Literal_Index := 0;
Exit_Name_Index := 0;
Text_Io.Put_Line ("moyen start with OK => " & Boolean'Image (Ok));
Enumeration_Type := 0;
Literal_Index := 0;
Exit_Name_Index := 0;
if Lex.Get_Token = Par then
Lex.Next;
Text_Io.Put_Line ("name of the link is " &
Lex.Get_Lower_Case_Value);
if Lex.Get_Token = Id then
if Complement_Array.Is_A_Word (Lex.Get_Lower_Case_Value) then
Exit_Name_Index := Complement_Array.Index
(Lex.Get_Lower_Case_Value);
else
Ok := False;
Error.Sem (Complement_Not_A_Word, Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
Text_Io.Put_Line ("and its state is " &
Lex.Get_Lower_Case_Value);
if Lex.Get_Token = Id then
Text_Io.Put_Line ("type link_state index is " &
Integer'Image (Local_Type));
Local_Type := Enumerate_Array.Enumeration_From_Literal_Index
(Lex.Get_Lower_Case_Value);
if Local_Type =
Enumerate_Array.Enumeration_Index ("normal") or
Local_Type = Enumerate_Array.Enumeration_Index
("special") then
Literal_Index := Enumerate_Array.Literal_Index
(Lex.Get_Lower_Case_Value);
Enumeration_Type := Local_Type;
Text_Io.Put_Line ("local type is " &
Natural'Image (Local_Type));
else
Ok := False;
Error.Sem (Literal_Not_Exist, Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
else
Ok := False;
Error.Syn (Id, Follow_Lier_Lieux);
end if;
else
Ok := False;
Error.Syn (Id, Follow_Lier_Lieux);
end if;
else
Ok := False;
Error.Syn (Par, Follow_Lier_Lieux);
end if;
Text_Io.Put_Line ("moyen stop with enum_type => " &
Natural'Image (Local_Type));
end Moyen;
procedure Lier_Lieux (Ok : in out Boolean) is
First_Place_Index, First_Direction_Index,
Second_Place_Index, Second_Direction_Index, Exit_Name_Index,
Enumeration_Type, Literal_Index, Field_Index : Natural;
Sem_Ok : Boolean;
begin
Text_Io.Put_Line ("lier lieux start with OK => " & Boolean'Image (Ok));
while Lex.Get_Token = Lie loop
Lex.Next;
Lieu (First_Place_Index, First_Direction_Index, Ok);
Text_Io.Put_Line ("first place :");
Text_Io.Put_Line (Complement_Array.Name (First_Place_Index));
Text_Io.Put_Line (Complement_Array.Name (First_Direction_Index));
if Lex.Get_Token = A then
Lex.Next;
Lieu (Second_Place_Index, Second_Direction_Index, Ok);
Text_Io.Put_Line ("second place :");
Text_Io.Put_Line (Complement_Array.Name (Second_Place_Index));
Text_Io.Put_Line (Complement_Array.Name
(Second_Direction_Index));
Moyen (Enumeration_Type, Literal_Index, Exit_Name_Index, Ok);
Text_Io.Put_Line ("with mean of :");
Text_Io.Put_Line (Complement_Array.Name (Exit_Name_Index));
Text_Io.Put_Line (Natural'Image (Enumeration_Type));
Text_Io.Put_Line (Natural'Image (Literal_Index));
if Ok then
Complement_Array.Put_Exit
(First_Place_Index, Exit_Name_Index,
First_Place_Index, First_Direction_Index,
Second_Place_Index, Second_Direction_Index, Sem_Ok);
Text_Io.Put_Line ("stockage 1ere issue est " &
Boolean'Image (Sem_Ok));
if Sem_Ok then
Complement_Array.Put_Exit
(Second_Place_Index, Exit_Name_Index,
Second_Place_Index, Second_Direction_Index,
First_Place_Index, First_Direction_Index, Sem_Ok);
Text_Io.Put_Line ("stockage 2eme issue est " &
Boolean'Image (Sem_Ok));
if Sem_Ok then
Field_Identifier_Array.Put
(Identifier.From_String
(Complement_Array.Name
(First_Direction_Index)));
Field_Index := Field_Identifier_Array.Index
(Complement_Array.Name
(First_Direction_Index));
Complement_Array.Create_Enumerate_Field
(First_Place_Index, Field_Index, Sem_Ok);
Text_Io.Put_Line
("creation of field for 1st place is " &
Boolean'Image (Sem_Ok));
if Sem_Ok then
Field_Identifier_Array.Put
(Identifier.From_String
(Complement_Array.Name
(Second_Direction_Index)));
Field_Index := Field_Identifier_Array.Index
(Complement_Array.Name
(Second_Direction_Index));
Complement_Array.Create_Enumerate_Field
(Second_Place_Index, Field_Index, Sem_Ok);
Text_Io.Put_Line
("creation of field for 2nd place is " &
Boolean'Image (Sem_Ok));
if Sem_Ok then
Complement_Array.Field_Put_Enumerate
(Second_Place_Index,
Field_Index, Enumeration_Type,
Literal_Index, Sem_Ok);
Text_Io.Put_Line ("last operation is " &
Boolean'Image (Sem_Ok));
else
Ok := False;
Error.Sem (Field_Belong,
Field_Identifier_Array.Image
(Field_Index));
end if;
else
Ok := False;
Error.Sem (Field_Belong,
Field_Identifier_Array.Image
(Field_Index));
end if;
else
Ok := False;
Error.Sem (An_Exit, Complement_Array.Name
(Second_Place_Index));
end if;
else
Ok := False;
Error.Sem (An_Exit, Complement_Array.Name
(First_Place_Index));
end if;
end if;
else
Ok := False;
Error.Syn (A, Follow_Lier_Lieux);
end if;
end loop;
Text_Io.Put_Line ("lier lieux stop with OK => " & Boolean'Image (Ok));
end Lier_Lieux;
procedure Mouvement (Id_List : in Identifier_List.Object;
Ok : in out Boolean) is
Iterator : Identifier_List.Iterator;
Place_Index, Number_Of_Repeat : Natural;
begin
Text_Io.Put_Line ("mouvement start " & Lex.Get_Lower_Case_Value);
if Lex.Get_Token = Id then
if Complement_Array.Belong (Lex.Get_Lower_Case_Value) then
if Complement_Array.Is_A_Place (Lex.Get_Lower_Case_Value) then
Place_Index := Complement_Array.Index
(Lex.Get_Lower_Case_Value);
else
Ok := False;
Error.Sem (Complement_Not_A_Place,
Lex.Get_Lower_Case_Value);
end if;
else
Ok := False;
Error.Sem (Complement_Not_Exist, Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Text_Io.Put_Line ("mouvement 1 " & Lex.Get_Lower_Case_Value);
if Lex.Get_Token = Number then
Number_Of_Repeat := Natural'Value
(Lex.Get_Lower_Case_Value);
Text_Io.Put_Line ("mouvement 2 " &
Natural'Image (Number_Of_Repeat));
if Number_Of_Repeat = 0 then
Ok := False;
Error.Sem (Number_Of_Repeat_Null, "");
end if;
Lex.Next;
else
Ok := False;
Error.Syn (Number, Follow_Mouvement);
end if;
else
Number_Of_Repeat := 1;
end if;
if Ok then
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
for I in 1 .. Number_Of_Repeat loop
Complement_Array.Put_Movement
(Identifier_List.Value (Iterator), Place_Index);
end loop;
Identifier_List.Next (Iterator);
end loop;
end if;
else
Ok := False;
Error.Syn (Id, Follow_Mouvement);
end if;
Text_Io.Put_Line ("mouvement stop with OK => " & Boolean'Image (Ok));
end Mouvement;
procedure Mouvements (Id_List : in Identifier_List.Object;
Ok : in out Boolean) is
begin
Text_Io.Put_Line ("mouvements start with OK => " & Boolean'Image (Ok));
Mouvement (Id_List, Ok);
while Lex.Get_Token = Comma loop
Lex.Next;
Mouvement (Id_List, Ok);
end loop;
Text_Io.Put_Line ("mouvements stop with OK => " & Boolean'Image (Ok));
end Mouvements;
procedure Liste_Itineraires (Ok : in out Boolean) is
Id_List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
Sem_Ok : Boolean;
begin
Text_Io.Put_Line ("liste itineraire start");
while Lex.Get_Token = Itineraire loop
Lex.Next;
Liste_Identificateurs (Id_List, Ok);
Text_Io.Put_Line ("Liste Itineraire 1");
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
if not Complement_Array.Is_An_Animate
(Identifier.Image
(Identifier_List.Value (Iterator))) then
Ok := False;
Error.Sem (Complement_Not_An_Animate,
Identifier.Image
(Identifier_List.Value (Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
if Lex.Get_Token = Colon then
Lex.Next;
Mouvements (Id_List, Ok);
else
Ok := False;
Error.Syn (Colon, Follow_Liste_Itineraires);
end if;
end loop;
Text_Io.Put_Line ("liste itineraire stop with OK => " &
Boolean'Image (Ok));
end Liste_Itineraires;
procedure Liste_Groupes (Ok : in out Boolean) is
Id_List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
Complement_Index : Natural;
Group_Identifier : Identifier.Object;
Sem_Ok : Boolean;
begin
Text_Io.Put_Line ("liste groupe start");
while Lex.Get_Token = Groupe loop
Lex.Next;
if Lex.Get_Token = Id then
Group_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Group_Identifier_Array.Put (Group_Identifier, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Group_Exist, Lex.Get_Value);
end if;
if Complement_Array.Belong (Lex.Get_Lower_Case_Value) then
Ok := False;
Error.Sem (Group_Is_Complement, Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (Id_List, Ok);
Put_Line ("liste groupe 1");
if Ok then
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
if Complement_Array.Belong
(Identifier.Image
(Identifier_List.Value (Iterator))) then
Complement_Array.Put_Group
(Identifier_List.Value (Iterator),
Group_Identifier, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Complement_Has_A_Group,
Identifier.Image
(Identifier_List.Value
(Iterator)));
end if;
else
Ok := False;
Error.Sem (Complement_Not_Exist,
Identifier.Image
(Identifier_List.Value
(Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
Ok := False;
Error.Syn (Colon, Follow_Liste_Groupes);
end if;
else
Ok := False;
Error.Syn (Id, Follow_Liste_Groupes);
end if;
end loop;
Text_Io.Put_Line ("liste groupe stop with OK => " & Boolean'Image (Ok));
end Liste_Groupes;
procedure Complement_Detail (A_Detail : in out Detail.Object;
A_Complement : in String;
Ok : in out Boolean) is
begin
Text_Io.Put_Line ("complement detail start with OK =>" &
Boolean'Image (Ok));
A_Detail := Detail.Null_Object;
if Complement_Array.Belong (A_Complement) then
Detail.Create_Real_Complement
(A_Detail, Complement_Array.Index (A_Complement));
elsif Group_Identifier_Array.Belong (A_Complement) then
Detail.Create_Complement_Group
(A_Detail, Order_List.Complement_Position (A_Complement));
else
Ok := False;
Error.Sem (Neither_A_Complement_Nor_A_Group, A_Complement);
end if;
Text_Io.Put_Line ("complement detail stop with OK => " &
Boolean'Image (Ok));
end Complement_Detail;
procedure Field_Detail (A_Detail : in out Detail.Object;
A_Field : in String;
Ok : in out Boolean) is
begin
Text_Io.Put_Line ("field detail start with OK => " &
Boolean'Image (Ok));
A_Detail := Detail.Null_Object;
if Field_Identifier_Array.Belong (A_Field) then
Detail.Create_Real_Field (A_Detail,
Field_Identifier_Array.Index (A_Field));
elsif Group_Identifier_Array.Belong (A_Field) then
Detail.Create_Field_Group
(A_Detail, Order_List.Complement_Position (A_Field));
else
Ok := False;
Error.Sem (Neither_A_Field_Nor_A_Group, A_Field);
end if;
Text_Io.Put_Line ("field detail stop wit OK => " & Boolean'Image (Ok));
end Field_Detail;
procedure Instructions_Simples (Ins_List : in out Instruction_List.Object;
Ok : in out Boolean);
procedure Une_Expression (An_Expression : in out Expression.Object;
Ok : in out Boolean);
procedure Facteur (An_Expression : in out Expression.Object;
Ok : in out Boolean) is
An_Identifier : Moving_String.Object;
An_Attribute : Attribute.Object;
An_Objet : Objet.Object;
A_Detail : Detail.Object;
begin
Text_Io.Put_Line ("facteur start with OK => " & Boolean'Image (Ok));
case Lex.Get_Token is
when Opening_Bracket =>
Lex.Next;
Une_Expression (An_Expression, Ok);
if Lex.Get_Token = Closing_Bracket then
Lex.Next;
else
Ok := False;
Error.Syn (Closing_Bracket, Follow_Facteur);
end if;
when Id =>
An_Identifier := Lex.Get_Lower_Case_Value;
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
Field_Detail (A_Detail,
Moving_String.Image (An_Identifier), Ok);
Un_Objet (An_Objet, Ok);
if Ok then
Attribute.Put (An_Attribute, An_Objet, A_Detail);
Expression.Create (An_Expression, An_Attribute);
end if;
else
if Enumerate_Array.Literal_Belong
(Moving_String.Image (An_Identifier)) then
Expression.Create
(An_Expression, Enumerate_Array.
Enumeration_From_Literal_Index
(Moving_String.Image
(An_Identifier)),
Enumerate_Array.Literal_Index
(Moving_String.Image (An_Identifier)));
Text_Io.Put_Line ("facteur ------ expression");
Expression.Show (An_Expression);
else
Ok := False;
Error.Sem (Literal_Not_Exist,
Moving_String.Image (An_Identifier));
end if;
end if;
when Number =>
Expression.Create (An_Expression,
Integer'Value (Lex.Get_Lower_Case_Value));
Lex.Next;
when others =>
Ok := False;
Error.Syn (Facteur, Follow_Facteur);
end case;
Text_Io.Put_Line ("facteur stop with OK => " & Boolean'Image (Ok));
end Facteur;
procedure Terme (An_Expression : in out Expression.Object;
Ok : in out Boolean) is
First_Terme : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Multiply .. Divide => True, others => False);
Left_Expression : Expression.Object;
Sem_Ok : Boolean;
begin
Text_Io.Put_Line ("terme start with OK => " & Boolean'Image (Ok));
Facteur (An_Expression, Ok);
while First_Terme (Lex.Get_Token) loop
case Lex.Get_Token is
when Multiply =>
Lex.Next;
Facteur (Left_Expression, Ok);
Expression.Create (An_Expression, Expression.Multiply,
An_Expression, Left_Expression, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Expression_Not_Same_Type, "");
end if;
when Divide =>
Lex.Next;
Facteur (Left_Expression, Ok);
Expression.Create (An_Expression, Expression.Divide,
An_Expression, Left_Expression, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Expression_Not_Same_Type, "");
end if;
when others =>
null;
end case;
end loop;
Text_Io.Put_Line ("terme stop with OK => " & Boolean'Image (Ok));
end Terme;
procedure Une_Expression (An_Expression : in out Expression.Object;
Ok : in out Boolean) is
First_Expression : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Substract .. Add => True, others => False);
Left_Expression : Expression.Object;
Sem_Ok : Boolean;
begin
Text_Io.Put_Line ("expression start with OK => " & Boolean'Image (Ok));
Terme (An_Expression, Ok);
while First_Expression (Lex.Get_Token) loop
case Lex.Get_Token is
when Add =>
Lex.Next;
Terme (Left_Expression, Ok);
Expression.Create (An_Expression, Expression.Add,
An_Expression, Left_Expression, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Expression_Not_Same_Type, "");
end if;
when Substract =>
Lex.Next;
Terme (Left_Expression, Ok);
Expression.Create (An_Expression, Expression.Substract,
An_Expression, Left_Expression, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Expression_Not_Same_Type, "");
end if;
when others =>
null;
end case;
end loop;
Text_Io.Put_Line ("expression stop with OK => " & Boolean'Image (Ok));
end Une_Expression;
procedure Tests (A_Condition : out Condition.Object;
An_Attribute : in Attribute.Object;
Ok : in out Boolean) is
An_Expression : Expression.Object := Expression.Null_Object;
Operator : Token;
Sem_Ok : Boolean;
begin
Text_Io.Put_Line ("tests start " & Lex.Get_Value);
case Lex.Get_Token is
when Existe =>
Lex.Next;
if Lex.Get_Token = Pas then
Condition.Create_Attribute_Exist
(A_Condition, An_Attribute, Condition.No);
Lex.Next;
else
Condition.Create_Attribute_Exist
(A_Condition, An_Attribute, Condition.Yes);
end if;
when Equal | Not_Equal =>
Operator := Lex.Get_Token;
Lex.Next;
Text_Io.Put_Line ("equal 1");
Une_Expression (An_Expression, Ok);
Text_Io.Put_Line ("equal 2");
if Ok then
Text_Io.Put_Line ("equal 3");
Condition.Create_Compare
(A_Condition, An_Attribute,
Condition.Compare_Kind'Value (Token'Image (Operator)),
An_Expression, Sem_Ok);
Text_Io.Put_Line ("equal 4");
--if not Sem_Ok then
-- Ok := False;
-- Error.Sem (Attribute_And_Expression_Not_Same_Type, "");
--end if; end if;
Text_Io.Put_Line ("equal 5");
when Less | Greater | Greater_Equal | Less_Equal =>
Operator := Lex.Get_Token;
Lex.Next;
Une_Expression (An_Expression, Ok);
if Ok then
Condition.Create_Compare
(A_Condition, An_Attribute,
Condition.Compare_Kind'Value (Token'Image (Operator)),
An_Expression, Sem_Ok);
--if not Sem_Ok then
-- Ok := False;
-- if Attribute.Is_An_Enumerate (An_Attribute) and
-- Expression.Is_An_Enumerate (An_Expression) then
-- Error.Sem (Wrong_Compare_Kind,
-- Token'Image (Operator));
-- else
-- Error.Sem
-- (Attribute_And_Expression_Not_Same_Type, "");
-- end if;
-- end if;
end if;
when others =>
Ok := False;
Error.Syn (Tests, Follow_Suite_Condition_Forte);
end case;
Text_Io.Put_Line ("tests stop with OK => " & Boolean'Image (Ok));
end Tests;
procedure Suite_Condition_Forte (A_Condition : in out Condition.Object;
An_Identifier : in Moving_String.Object;
Ok : in out Boolean) is
An_Attribute : Attribute.Object;
An_Objet : Objet.Object;
A_Detail : Detail.Object;
A_Binary_Kind : Condition.Binary_Kind;
begin
Text_Io.Put_Line ("suite condition forte start with OK => " &
Boolean'Image (Ok));
case Lex.Get_Token is
when De =>
Lex.Next;
Field_Detail (A_Detail,
Moving_String.Image (An_Identifier), Ok);
Un_Objet (An_Objet, Ok);
if Ok then
Attribute.Put (An_Attribute, An_Objet, A_Detail);
end if;
Tests (A_Condition, An_Attribute, Ok);
when Appartient =>
Lex.Next;
Complement_Detail (A_Detail,
Moving_String.Image (An_Identifier), Ok);
if Lex.Get_Token = Pas then
A_Binary_Kind := Condition.No;
Lex.Next;
else
A_Binary_Kind := Condition.Yes;
end if;
if Lex.Get_Token = A then
Lex.Next;
Un_Objet (An_Objet, Ok);
if Ok then
Condition.Create_Belong (A_Condition, An_Objet,
A_Detail, A_Binary_Kind);
end if;
else
Ok := False;
Error.Syn (A, Follow_Suite_Condition_Forte);
end if;
when Existe =>
Lex.Next;
Complement_Detail (A_Detail,
Moving_String.Image (An_Identifier), Ok);
if Lex.Get_Token = Pas then
A_Binary_Kind := Condition.No;
Lex.Next;
else
A_Binary_Kind := Condition.Yes;
end if;
if Ok then
Condition.Create_Subject_Exist
(A_Condition, A_Detail, A_Binary_Kind);
end if;
when others =>
Ok := False;
Error.Syn (Suite_Condition_Forte, Follow_Suite_Condition_Forte);
end case;
Text_Io.Put_Line ("suite condition forte stop with OK => " &
Boolean'Image (Ok));
end Suite_Condition_Forte;
procedure Condition_Forte
(A_Condition : in out Condition.Object; Ok : in out Boolean) is
An_Identifier : Moving_String.Object;
An_Objet : Objet.Object;
A_Detail : Detail.Object;
A_Number : Integer;
begin
Text_Io.Put_Line ("condition forte start with OK => " &
Boolean'Image (Ok));
case Lex.Get_Token is
when Id =>
An_Identifier := Lex.Get_Lower_Case_Value;
Lex.Next;
Suite_Condition_Forte (A_Condition, An_Identifier, Ok);
when Heros =>
Lex.Next;
if Lex.Get_Token = Equal then
Lex.Next;
if Lex.Get_Token = Id then
Complement_Detail (A_Detail,
Lex.Get_Lower_Case_Value, Ok); if Ok then
Condition.Create_Hero (A_Condition, A_Detail);
end if;
Lex.Next;
else
Ok := False;
Error.Syn (Id, Follow_Condition_Forte);
end if;
else
Ok := False;
Error.Syn (Equal, Follow_Condition_Forte);
end if;
when Lieu =>
Lex.Next;
if Lex.Get_Token = Equal then
Lex.Next;
if Lex.Get_Token = Id then
Complement_Detail (A_Detail,
Lex.Get_Lower_Case_Value, Ok);
if Ok then
Condition.Create_Place (A_Condition, A_Detail);
end if;
Lex.Next;
else
Ok := False;
Error.Syn (Id, Follow_Condition_Forte);
end if;
else
Ok := False;
Error.Syn (Equal, Follow_Condition_Forte);
end if;
when Number =>
A_Number := Integer'Value (Lex.Get_Lower_Case_Value);
if A_Number = 0 then
Ok := False;
Error.Sem (Number_Of_Actions_Null, "");
end if;
Lex.Next;
if Lex.Get_Token = Actions then
Lex.Next;
if Lex.Get_Token = Passees then
Lex.Next;
if Ok then
Condition.Create_Actions (A_Condition, A_Number);
end if;
else
Ok := False;
Error.Syn (Passees, Follow_Condition_Forte);
end if;
else
Ok := False;
Error.Syn (Actions, Follow_Condition_Forte);
end if;
when Rencontre =>
Lex.Next;
if Lex.Get_Token = Id then
Complement_Detail (A_Detail, Lex.Get_Lower_Case_Value, Ok);
if Ok then
Condition.Create_Meet (A_Condition, A_Detail);
end if;
Lex.Next;
else
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
if Complement_Array.Is_A_Place
(Lex.Get_Lower_Case_Value) then Objet.Create_Real (An_Objet,
Complement_Array.Index
(Lex.Get_Lower_Case_Value));
elsif Group_Identifier_Array.Belong
(Lex.Get_Lower_Case_Value) then
Objet.Create_Group (An_Objet,
Order_List.Complement_Position
(Lex.Get_Lower_Case_Value));
else
Ok := False;
Error.Sem (Neither_A_Place_Nor_A_Group,
Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
elsif Lex.Get_Token = Lieu then
Objet.Create_Place (An_Objet);
Lex.Next;
else
Ok := False;
Error.Syn (Identifier_Place, Follow_Condition_Forte);
end if;
if Lex.Get_Token = Existe then
Lex.Next;
if Lex.Get_Token = Pas then
Lex.Next;
Condition.Create_Exits_Exist
(A_Condition, An_Objet, Condition.No);
else
Condition.Create_Exits_Exist
(A_Condition, An_Objet, Condition.Yes);
end if;
else
Ok := False;
Error.Syn (Existe, Follow_Condition_Forte);
end if;
else
Ok := False;
Error.Syn (De, Follow_Condition_Forte);
end if;
when others =>
Ok := False;
Error.Syn (Condition_Forte, Follow_Condition_Forte);
end case;
Text_Io.Put_Line ("condition forte stop with OK => " &
Boolean'Image (Ok));
end Condition_Forte;
procedure Condition_Faible
(A_Condition : in out Condition.Object; Ok : in out Boolean) is
First_Condition_Faible : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Et => True, others => False);
Left_Condition : Condition.Object := Condition.Null_Object;
begin
Text_Io.Put_Line ("condition faible start with OK => " &
Boolean'Image (Ok));
Condition_Forte (A_Condition, Ok);
while First_Condition_Faible (Lex.Get_Token) loop
case Lex.Get_Token is
when Et =>
Lex.Next;
Condition_Forte (Left_Condition, Ok);
if Ok then
Condition.Create (A_Condition, Condition.Et,
A_Condition, Left_Condition);
end if;
when others =>
null;
end case;
end loop;
Text_Io.Put_Line ("condition faible stop with OK => " &
Boolean'Image (Ok));
end Condition_Faible;
procedure Une_Condition
(A_Condition : in out Condition.Object; Ok : in out Boolean) is
First_Condition : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Ou => True, others => False);
Left_Condition : Condition.Object := Condition.Null_Object;
begin
Text_Io.Put_Line ("condition start with OK => " & Boolean'Image (Ok));
Condition_Faible (A_Condition, Ok);
while First_Condition (Lex.Get_Token) loop
case Lex.Get_Token is
when Ou =>
Lex.Next;
Condition_Faible (Left_Condition, Ok);
if Ok then
Condition.Create (A_Condition, Condition.Ou,
A_Condition, Left_Condition);
end if;
when others =>
null;
end case;
end loop;
Text_Io.Put_Line ("condition stop with OK => " & Boolean'Image (Ok));
end Une_Condition;
procedure Si (Ins_List : in out Instruction_List.Object;
Ok : in out Boolean) is
Right_List : Instruction_List.Object := Instruction_List.Null_Object;
Wrong_List : Instruction_List.Object := Instruction_List.Null_Object;
A_Condition : Condition.Object := Condition.Null_Object;
begin
Text_Io.Put_Line ("si start with OK => " & Boolean'Image (Ok));
Une_Condition (A_Condition, Ok);
if Lex.Get_Token = Alors then
Lex.Next;
Put_Line ("alors detecte");
Instructions_Simples (Right_List, Ok);
if Lex.Get_Token = Sinon then
Put_Line ("sinon detecte");
Lex.Next;
Instructions_Simples (Wrong_List, Ok);
Put_Line ("fin de sinon");
end if;
Instruction_List.Insert_If
(Ins_List, A_Condition, Right_List, Wrong_List);
if Lex.Get_Token = Fin then
Lex.Next;
if Lex.Get_Token = Si then
Lex.Next;
else
Ok := False;
Error.Syn (Si, Follow_Instruction_Simple);
end if;
else
Ok := False;
Error.Syn (Fin, Follow_Instruction_Simple);
end if;
else
Ok := False;
Error.Syn (Alors, Follow_Instruction_Simple);
end if;
Text_Io.Put_Line ("si stop with OK => " & Boolean'Image (Ok));
end Si;
procedure Change (Ins_List : in out Instruction_List.Object;
Ok : in out Boolean) is
An_Affectation : Affectation.Object;
An_Expression : Expression.Object := Expression.Null_Object;
An_Objet : Objet.Object;
A_Detail : Detail.Object;
An_Attribute : Attribute.Object;
Sem_Ok : Boolean;
begin
Text_Io.Put_Line ("change start with OK => " & Boolean'Image (Ok));
case Lex.Get_Token is
when Id =>
Field_Detail (A_Detail, Lex.Get_Lower_Case_Value, Ok);
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
Un_Objet (An_Objet, Ok);
if Ok then
Attribute.Put (An_Attribute, An_Objet, A_Detail);
end if;
if Lex.Get_Token = En then
Lex.Next;
Une_Expression (An_Expression, Ok);
if Ok then
Affectation.Create_Attribute
(An_Affectation, An_Attribute, An_Expression);
-- if not Sem_Ok then
-- Ok := False;
-- Error.Sem
-- (Attribute_And_Expression_Not_Same_Type, "");
-- end if;
Instruction_List.Insert_Change
(Ins_List, An_Affectation);
end if;
else
Ok := False;
Error.Syn (En, Follow_Instruction_Simple);
end if;
else
Ok := False;
Error.Syn (De, Follow_Instruction_Simple);
end if;
when Heros =>
Lex.Next;
if Lex.Get_Token = En then
Lex.Next;
if Lex.Get_Token = Id then
Complement_Detail (A_Detail,
Lex.Get_Lower_Case_Value, Ok);
if Ok then
Affectation.Create_Hero (An_Affectation, A_Detail);
Instruction_List.Insert_Change
(Ins_List, An_Affectation);
end if;
Lex.Next;
else
Ok := False;
Error.Syn (Id, Follow_Instruction_Simple);
end if;
else
Ok := False;
Error.Syn (En, Follow_Instruction_Simple);
end if;
when Lieu =>
Lex.Next;
if Lex.Get_Token = En then
Lex.Next;
if Lex.Get_Token = Id then
Complement_Detail (A_Detail,
Lex.Get_Lower_Case_Value, Ok);
if Ok then
Affectation.Create_Place (An_Affectation, A_Detail);
Instruction_List.Insert_Change
(Ins_List, An_Affectation);
end if;
Lex.Next;
else
Ok := False;
Error.Syn (Id, Follow_Instruction_Simple);
end if;
else
Ok := False;
Error.Syn (En, Follow_Instruction_Simple);
end if;
when others =>
Ok := False;
Error.Syn (Change, Follow_Instruction_Simple);
end case;
Text_Io.Put_Line ("change stop with OK => " & Boolean'Image (Ok));
end Change;
procedure Quoi_Afficher (A_View : out View.Object; Ok : in out Boolean) is
An_Objet : Objet.Object;
A_Detail : Detail.Object;
An_Attribute : Attribute.Object;
begin
Text_Io.Put_Line ("quoi afficher start with OK => " &
Boolean'Image (Ok));
case Lex.Get_Token is
when Right_Sentence =>
View.Create_Sentence (A_View, Identifier.From_String
(Lex.Get_Lower_Case_Value));
Lex.Next;
when Wrong_Sentence =>
Ok := False;
Error.Syn (Wrong_Sentence, Follow_Quoi_Afficher);
when Number =>
View.Create_Number (A_View, Integer'Value
(Lex.Get_Lower_Case_Value));
Lex.Next;
when Id =>
Field_Detail (A_Detail, Lex.Get_Lower_Case_Value, Ok);
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
Un_Objet (An_Objet, Ok);
if Ok then
Attribute.Put (An_Attribute, An_Objet, A_Detail);
View.Create_Attribute (A_View, An_Attribute);
end if;
else
Ok := False;
Error.Syn (De, Follow_Quoi_Afficher);
end if;
when Nom =>
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
Un_Objet (An_Objet, Ok);
if Ok then
View.Create_Name (A_View, An_Objet);
end if;
else
Ok := False;
Error.Syn (De, Follow_Quoi_Afficher);
end if;
when Issue =>
Lex.Next;
if Lex.Get_Token = Id then
Complement_Detail (A_Detail, Lex.Get_Lower_Case_Value, Ok);
if Ok then
View.Create_Exit (A_View, A_Detail);
end if;
Lex.Next;
else
Ok := False;
Error.Syn (Id, Follow_Quoi_Afficher);
end if;
when Issues =>
View.Create_Exits (A_View);
Lex.Next;
when Contenu =>
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
Un_Objet (An_Objet, Ok);
if Ok then
View.Create_Contents (A_View, An_Objet);
end if;
else
Ok := False;
Error.Syn (De, Follow_Quoi_Afficher);
end if;
when others =>
Ok := False;
Error.Syn (Quoi_Afficher, Follow_Quoi_Afficher);
end case;
Text_Io.Put_Line ("quoi afficher stop with OK => " &
Boolean'Image (Ok));
end Quoi_Afficher;
procedure Liste_Affiche (Ins_List : in out Instruction_List.Object;
Ok : in out Boolean) is
First_Liste_Affiche : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Ampersand => True, others => False);
Display_List : View_List.Object;
A_View : View.Object;
begin
Text_Io.Put_Line ("liste quoi afficher start with OK => " &
Boolean'Image (Ok));
Quoi_Afficher (A_View, Ok);
if Ok then
View_List.Put (Display_List, A_View);
end if;
while (First_Liste_Affiche (Lex.Get_Token)) loop
case Lex.Get_Token is
when Ampersand =>
Lex.Next;
Quoi_Afficher (A_View, Ok);
if Ok then
View_List.Put (Display_List, A_View);
end if;
when others =>
null;
end case;
end loop;
if Ok then
Instruction_List.Insert_Display (Ins_List, Display_List);
end if;
Text_Io.Put_Line ("liste quoi afficher stop with OK => " &
Boolean'Image (Ok));
end Liste_Affiche;
procedure Ligne (Ins_List : in out Instruction_List.Object;
Ok : in out Boolean) is
begin
Text_Io.Put_Line ("ligne start with OK => " & Boolean'Image (Ok));
if Lex.Get_Token = Suivante then
Lex.Next;
Instruction_List.Insert_Next_Line (Ins_List);
else
Ok := False;
Error.Syn (Suivante, Follow_Instruction_Simple);
end if;
Text_Io.Put_Line ("ligne stop with OK => " & Boolean'Image (Ok));
end Ligne;
procedure Bouge (Ins_List : in out Instruction_List.Object;
Ok : in out Boolean) is
begin
Text_Io.Put_Line ("bouge start with OK => " & Boolean'Image (Ok));
if Lex.Get_Token = Anime then
Lex.Next;
Instruction_List.Insert_Move (Ins_List);
else
Ok := False;
Error.Syn (Anime, Follow_Instruction_Simple);
end if;
Text_Io.Put_Line ("bouge stop with OK => " & Boolean'Image (Ok));
end Bouge;
procedure Positionne (Ins_List : in out Instruction_List.Object;
Ok : in out Boolean) is
Id_List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
An_Objet : Objet.Object;
A_Detail : Detail.Object;
begin
Text_Io.Put_Line ("positionne start with OK => " & Boolean'Image (Ok));
Liste_Identificateurs (Id_List, Ok);
if Lex.Get_Token = A then
Lex.Next;
Un_Objet (An_Objet, Ok);
if Ok then
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
Complement_Detail
(A_Detail,
Identifier.Image (Identifier_List.Value (Iterator)),
Ok);
if Ok then
Instruction_List.Insert_Put
(Ins_List, A_Detail, An_Objet);
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
Ok := False;
Error.Syn (A, Follow_Instruction_Simple);
end if;
Text_Io.Put_Line ("positionne stop with OK => " & Boolean'Image (Ok));
end Positionne;
procedure Retire (Ins_List : in out Instruction_List.Object;
Ok : in out Boolean) is
Id_List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
A_Detail : Detail.Object;
begin
Text_Io.Put_Line ("retire start with OK => " & Boolean'Image (Ok));
Liste_Identificateurs (Id_List, Ok);
if Ok then
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
Complement_Detail
(A_Detail, Identifier.Image
(Identifier_List.Value (Iterator)), Ok);
if Ok then
Instruction_List.Insert_Put
(Ins_List, A_Detail, Objet.Null_Object);
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
Text_Io.Put_Line ("retire stop with OK => " & Boolean'Image (Ok));
end Retire;
procedure Va (Ins_List : in out Instruction_List.Object;
Ok : in out Boolean) is
A_Detail : Detail.Object;
begin
Text_Io.Put_Line ("va start with OK => " & Boolean'Image (Ok));
if Lex.Get_Token = Vers then
Lex.Next;
if Lex.Get_Token = Id then
Complement_Detail (A_Detail, Lex.Get_Lower_Case_Value, Ok);
if Ok then
Instruction_List.Insert_Go (Ins_List, A_Detail);
end if;
Lex.Next;
else
Ok := False;
Error.Syn (Id, Follow_Instruction_Simple);
end if;
else
Ok := False;
Error.Syn (Vers, Follow_Instruction_Simple);
end if;
Text_Io.Put_Line ("va stop with OK => " & Boolean'Image (Ok));
end Va;
procedure Instruction_Simple (Ins_List : in out Instruction_List.Object;
Ok : in out Boolean) is
begin
Text_Io.Put_Line ("instruction simple start with OK => " &
Boolean'Image (Ok) & "++++++++++++++++++++++++ " &
Natural'Image (Number2));
Number2 := Number2 + 1;
case Lex.Get_Token is
when Si =>
Lex.Next;
Si (Ins_List, Ok);
when Change =>
Lex.Next;
Change (Ins_List, Ok);
when Affiche =>
Lex.Next;
Liste_Affiche (Ins_List, Ok);
when Ligne =>
Lex.Next;
Ligne (Ins_List, Ok);
when Bouge =>
Lex.Next;
Bouge (Ins_List, Ok);
when Positionne =>
Lex.Next;
Positionne (Ins_List, Ok);
when Retire =>
Lex.Next;
Retire (Ins_List, Ok);
when Termine =>
Lex.Next;
Instruction_List.Insert_Stop (Ins_List);
when Va =>
Lex.Next;
Va (Ins_List, Ok);
when Efface =>
Lex.Next;
Instruction_List.Insert_Erase (Ins_List);
when others =>
Ok := False;
Error.Syn (Instruction, Follow_Instruction_Simple);
end case;
Text_Io.Put_Line ("instruction simple stop with OK => " &
Boolean'Image (Ok));
end Instruction_Simple;
procedure Instructions_Simples (Ins_List : in out Instruction_List.Object;
Ok : in out Boolean) is
First_Instructions_Simples : constant Token_To_Boolean_Array :=
Token_To_Boolean_Array'(Si .. Va => True, others => False);
begin
Text_Io.Put_Line ("instructions simples start with OK => " &
Boolean'Image (Ok));
while First_Instructions_Simples (Lex.Get_Token) loop
Instruction_Simple (Ins_List, Ok);
end loop;
Text_Io.Put_Line ("instructions simples stop with OK => " &
Boolean'Image (Ok));
end Instructions_Simples;
procedure Complement_Existe
(A_Complement : in String; Ok : in out Boolean) is
begin
Text_Io.Put_Line ("complement existe start with OK => " &
Boolean'Image (Ok));
if not (Complement_Array.Belong (A_Complement) or
Group_Identifier_Array.Belong (A_Complement)) then
Ok := False;
Error.Sem (Neither_A_Complement_Nor_A_Group, A_Complement);
end if;
Text_Io.Put_Line ("complement existe stop with OK => " &
Boolean'Image (Ok));
end Complement_Existe;
procedure Description_Ordre
(An_Order : in out Order.Object; Ok : in out Boolean) is
begin
Text_Io.Put_Line ("description ordre start with OK => " &
Boolean'Image (Ok));
if Lex.Get_Token = Id then
Complement_Existe (Lex.Get_Lower_Case_Value, Ok);
Order.Put_First_Complement (An_Order, Lex.Get_Lower_Case_Value);
Lex.Next;
if Lex.Get_Token = Id then
Complement_Existe (Lex.Get_Lower_Case_Value, Ok);
Order.Put_Second_Complement
(An_Order, Lex.Get_Lower_Case_Value);
Lex.Next;
else
Order.Put_Second_Complement (An_Order, "");
end if;
if Lex.Get_Token = Id then
Complement_Existe (Lex.Get_Lower_Case_Value, Ok);
Order.Put_Third_Complement (An_Order, Lex.Get_Lower_Case_Value);
Lex.Next;
else
Order.Put_Third_Complement (An_Order, "");
end if;
if Lex.Get_Token = Id then
Complement_Existe (Lex.Get_Lower_Case_Value, Ok);
Order.Put_Fourth_Complement
(An_Order, Lex.Get_Lower_Case_Value);
Lex.Next;
else
Order.Put_Fourth_Complement (An_Order, "");
end if;
if Lex.Get_Token = Id then
Ok := False;
Error.Syn (Too_Many_Complements, Follow_Ordre);
end if;
else
Ok := False;
Error.Syn (Id, Follow_Ordre);
end if;
Text_Io.Put_Line ("description ordre stop with OK => " &
Boolean'Image (Ok));
end Description_Ordre;
procedure Liste_Description_Ordre (Ok : in out Boolean) is
An_Order : Order.Object;
Sem_Ok : Boolean;
begin
Text_Io.Put_Line ("liste description ordre start with OK => " &
Boolean'Image (Ok) & "----------------------- " &
Natural'Image (Number1));
Number1 := Number1 + 1;
Order_List.Free;
Description_Ordre (An_Order, Ok);
if Ok then
Order_List.Put (An_Order, Sem_Ok);
Order_List.Show;
if not Sem_Ok then
Ok := False;
Error.Sem (Order_Exist, Order.Image (An_Order));
end if;
end if;
while Lex.Get_Token = Comma loop
Lex.Next;
Description_Ordre (An_Order, Ok);
if Ok then
Order_List.Put (An_Order, Sem_Ok);
Order_List.Show;
if not Sem_Ok then
Ok := False;
Error.Sem (Order_Exist, Order.Image (An_Order));
end if;
end if;
end loop;
Text_Io.Put_Line ("liste description ordre stop with OK => " &
Boolean'Image (Ok));
end Liste_Description_Ordre;
procedure Fill_Coded_Order_Array (Ins_List : in Instruction_List.Object;
A_Place : in String;
Ok : in out Boolean) is
First_Order, An_Order : Order.Object;
Sem_Ok : Boolean;
begin
Text_Io.Put_Line ("Fill order");
First_Order := Order_List.First_Order;
for Position in Order.Index'First + 1 .. Order.Index'Last loop
Order_List.Make_Redirection
(Order.Complement (First_Order, Position), Position, Sem_Ok);
end loop;
if not Sem_Ok then
Ok := False;
Error.Sem (Order_List_Group_Failure, "");
end if;
Order_List.Init;
while not Order_List.Done loop
An_Order := Order_List.Value;
Order.Put_Place (An_Order, A_Place);
Coded_Order_Array.Put (An_Order, Ins_List, Sem_Ok);
if not Sem_Ok then
Ok := False;
Error.Sem (Order_Exist, Order.Image (An_Order));
end if;
Order_List.Next;
end loop;
Text_Io.Put_Line ("fill coded order stop with OK => " &
Boolean'Image (Ok));
end Fill_Coded_Order_Array;
procedure Ordre (Ok : in out Boolean) is
Ins_List : Instruction_List.Object := Instruction_List.Null_Object;
A_Place : Moving_String.Object;
begin
Text_Io.Put_Line ("ordre start with OK => " & Boolean'Image (Ok));
Liste_Description_Ordre (Ok);
if Lex.Get_Token = Colon then
Lex.Next;
while Lex.Get_Token = Pour loop
Text_Io.Put_Line
("pour start --------------------------------------------------------");
Lex.Next;
if Lex.Get_Token = Id then
if Complement_Array.Is_A_Place
(Lex.Get_Lower_Case_Value) then
A_Place := Lex.Get_Lower_Case_Value;
else
Ok := False;
Error.Sem (Complement_Not_A_Place,
Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
Ins_List := Instruction_List.Null_Object;
Instructions_Simples (Ins_List, Ok);
Text_Io.Put_Line ("pour 1 is " & Boolean'Image (Ok));
if Ok then
Fill_Coded_Order_Array
(Ins_List, Moving_String.Image (A_Place), Ok);
end if;
else
Ok := False;
Error.Syn (Id, Follow_Ordre);
end if;
Text_Io.Put_Line
("pour stop => state " & Boolean'Image (Ok) &
"-------------------------------------------------");
end loop;
if Lex.Get_Token = Global then
Text_Io.Put_Line ("global debute avec OK => " &
Boolean'Image (Ok) &
" **************************************");
Lex.Next;
Ins_List := Instruction_List.Null_Object;
Instructions_Simples (Ins_List, Ok);
if Ok then
Text_Io.Put_Line ("stockage des ordres debute ...");
Fill_Coded_Order_Array (Ins_List, "global", Ok);
end if;
Text_Io.Put_Line
("global stop*************************************************");
--else
--Ok := False;
--Error.Syn (Global, Follow_Ordre);
end if;
else
Ok := False;
Error.Syn (Colon, Follow_Ordre);
end if;
Text_Io.Put_Line ("ordre stop with OK => " & Boolean'Image (Ok));
end Ordre;
procedure Fin_Quand (Ok : in out Boolean) is
begin
Text_Io.Put_Line ("fin quand start with OK => " & Boolean'Image (Ok));
if Lex.Get_Token = Fin then
Lex.Next;
if Lex.Get_Token = Quand then
Lex.Next;
else
Ok := False;
Error.Syn (Quand, Follow_Quand_Ordre);
end if;
else
Ok := False;
Error.Syn (Fin, Follow_Quand_Ordre);
end if;
Text_Io.Put_Line ("fin quand stop with OK => " & Boolean'Image (Ok));
end Fin_Quand;
procedure Quand_Ordre (Ok : in out Boolean) is
Ins_List : Instruction_List.Object := Instruction_List.Null_Object;
begin
Text_Io.Put_Line ("quand ordre start with OK => " & Boolean'Image (Ok));
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 = Diese then
Lex.Next;
Ordre (Ok);
while Lex.Get_Token = Diese loop
Lex.Next;
Ordre (Ok);
end loop;
Fin_Quand (Ok);
else
Ok := False;
Error.Syn (Substract, Follow_Ordre);
end if;
else
Ok := False;
Error.Syn (Vaut, Follow_Quand_Ordre);
end if;
else
Ok := False;
Error.Syn (Ordre, Follow_Quand_Ordre);
end if;
else
Ok := False;
Error.Syn (Quand, Follow_Quand_Ordre);
end if;
Text_Io.Put_Line ("quand ordre stop with OK => " & Boolean'Image (Ok));
end Quand_Ordre;
procedure Creation_Monde (Ok : in out Boolean) is
begin
Text_Io.Put_Line ("creation monde start with OK => " &
Boolean'Image (Ok));
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 Aide =>
Aide (Ok);
when Message =>
Liste_Messages_Erreur (Ok);
when Enumere =>
Liste_Enumeres (Ok);
when Lien =>
Etats_Liens (Ok);
when Verbes =>
Liste_Verbes (Ok);
when Mots =>
Liste_Mots (Ok);
when Structure =>
Liste_Structures (Ok);
when Cree =>
Liste_Objets (Ok);
when Lie =>
Lier_Lieux (Ok);
when Itineraire =>
Liste_Itineraires (Ok);
when Groupe =>
Liste_Groupes (Ok);
when others =>
exit;
end case;
while Lex.Get_Token in States and Lex.Get_Token > In_Progress loop
In_Progress := States'Succ (In_Progress);
end loop;
end loop;
if not Lex.Is_At_End then
Put_Line ("in_progress : " & Token'Image (In_Progress));
end if;
Text_Io.Put_Line ("creation monde stop with OK => " &
Boolean'Image (Ok));
end Creation_Monde;
procedure Scenario (Ok : in out Boolean) is
Ins_List : Instruction_List.Object := Instruction_List.Null_Object;
begin
Text_Io.Put_Line ("scenario start with OK => " & Boolean'Image (Ok));
if Lex.Get_Token = Introduction then
Lex.Next;
Put_Line ("Lecture de la zone d'introduction ...");
Instructions_Simples (Ins_List, Ok);
if Ok then
Introduction_Instructions.Put (Ins_List);
end if;
end if;
if Lex.Get_Token = Scenario then
Lex.Next;
Put_Line ("Lecture de la zone de scenario ...");
Ins_List := Instruction_List.Null_Object;
Instructions_Simples (Ins_List, Ok);
if Ok then
Pre_Order_Instructions.Put (Ins_List);
end if;
Quand_Ordre (Ok);
Ins_List := Instruction_List.Null_Object;
Instructions_Simples (Ins_List, Ok);
if Ok then
Post_Order_Instructions.Put (Ins_List);
end if;
end if;
Text_Io.Put_Line ("scenario stop with OK => " & Boolean'Image (Ok));
end Scenario;
procedure Jeu_Aventure (Ok : in out Boolean) is
begin
Text_Io.Put_Line ("jeu aventure start with OK => " &
Boolean'Image (Ok));
loop
Creation_Monde (Ok);
Text_Io.Put_Line
("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@");
Complement_Array.Show;
Text_Io.Put_Line
("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@");
Scenario (Ok);
if not Lex.Is_At_End then
Ok := False;
Error.Syn (Jeu_Aventure, Follow_Jeu_Aventure);
else
exit;
end if;
Put_Line ("redemarrage");
end loop;
Text_Io.Put_Line ("jeu aventure stop with OK => " & Boolean'Image (Ok));
end Jeu_Aventure;
procedure Evaluate_Syn (Ok : out Boolean) is
Parse_Ok : Boolean := True;
begin
Text_Io.Put_Line ("jeu aventure start");
Lex.Initialize;
Jeu_Aventure (Parse_Ok);
Lex.Close;
if Parse_Ok then
Put_Line ("Program is Ok");
else
Put_Line ("Program is Ko");
end if;
Text_Io.Put_Line ("jeu aventure stop");
Ok := Parse_Ok;
end Evaluate_Syn;
end Syn;
nblk1=6a
nid=24
hdr6=d0
[0x00] rec0=1a rec1=00 rec2=01 rec3=016
[0x01] rec0=19 rec1=00 rec2=68 rec3=03c
[0x02] rec0=14 rec1=00 rec2=67 rec3=070
[0x03] rec0=1c rec1=00 rec2=66 rec3=010
[0x04] rec0=1d rec1=00 rec2=65 rec3=032
[0x05] rec0=19 rec1=00 rec2=64 rec3=010
[0x06] rec0=14 rec1=00 rec2=63 rec3=024
[0x07] rec0=1b rec1=00 rec2=62 rec3=044
[0x08] rec0=15 rec1=00 rec2=61 rec3=026
[0x09] rec0=10 rec1=00 rec2=60 rec3=026
[0x0a] rec0=15 rec1=00 rec2=5f rec3=056
[0x0b] rec0=17 rec1=00 rec2=5e rec3=040
[0x0c] rec0=13 rec1=00 rec2=5d rec3=070
[0x0d] rec0=1d rec1=00 rec2=5c rec3=018
[0x0e] rec0=1c rec1=00 rec2=5b rec3=02a
[0x0f] rec0=1e rec1=00 rec2=5a rec3=010
[0x10] rec0=1b rec1=00 rec2=59 rec3=062
[0x11] rec0=14 rec1=00 rec2=58 rec3=01a
[0x12] rec0=1e rec1=00 rec2=57 rec3=02a
[0x13] rec0=11 rec1=00 rec2=56 rec3=00a
[0x14] rec0=1c rec1=00 rec2=55 rec3=06e
[0x15] rec0=16 rec1=00 rec2=54 rec3=06c
[0x16] rec0=21 rec1=00 rec2=53 rec3=042
[0x17] rec0=1c rec1=00 rec2=52 rec3=05c
[0x18] rec0=1c rec1=00 rec2=51 rec3=080
[0x19] rec0=1b rec1=00 rec2=50 rec3=024
[0x1a] rec0=1a rec1=00 rec2=4f rec3=066
[0x1b] rec0=1d rec1=00 rec2=4e rec3=03a
[0x1c] rec0=1c rec1=00 rec2=4d rec3=00a
[0x1d] rec0=1f rec1=00 rec2=4c rec3=014
[0x1e] rec0=17 rec1=00 rec2=4b rec3=05c
[0x1f] rec0=1d rec1=00 rec2=4a rec3=008
[0x20] rec0=14 rec1=00 rec2=49 rec3=030
[0x21] rec0=20 rec1=00 rec2=48 rec3=010
[0x22] rec0=19 rec1=00 rec2=47 rec3=04c
[0x23] rec0=13 rec1=00 rec2=46 rec3=030
[0x24] rec0=1f rec1=00 rec2=45 rec3=028
[0x25] rec0=14 rec1=00 rec2=44 rec3=080
[0x26] rec0=16 rec1=00 rec2=17 rec3=036
[0x27] rec0=11 rec1=00 rec2=43 rec3=08c
[0x28] rec0=12 rec1=00 rec2=25 rec3=02c
[0x29] rec0=14 rec1=00 rec2=42 rec3=01c
[0x2a] rec0=1c rec1=00 rec2=23 rec3=04a
[0x2b] rec0=19 rec1=00 rec2=29 rec3=02c
[0x2c] rec0=1c rec1=00 rec2=22 rec3=062
[0x2d] rec0=21 rec1=00 rec2=3a rec3=046
[0x2e] rec0=1a rec1=00 rec2=19 rec3=01a
[0x2f] rec0=19 rec1=00 rec2=05 rec3=00a
[0x30] rec0=13 rec1=00 rec2=40 rec3=06e
[0x31] rec0=18 rec1=00 rec2=20 rec3=00c
[0x32] rec0=16 rec1=00 rec2=3f rec3=074
[0x33] rec0=19 rec1=00 rec2=0a rec3=022
[0x34] rec0=1e rec1=00 rec2=3e rec3=05a
[0x35] rec0=14 rec1=00 rec2=28 rec3=074
[0x36] rec0=16 rec1=00 rec2=34 rec3=018
[0x37] rec0=1d rec1=00 rec2=1f rec3=01c
[0x38] rec0=1b rec1=00 rec2=0e rec3=014
[0x39] rec0=1c rec1=00 rec2=08 rec3=03c
[0x3a] rec0=1d rec1=00 rec2=36 rec3=024
[0x3b] rec0=16 rec1=00 rec2=0c rec3=002
[0x3c] rec0=14 rec1=00 rec2=41 rec3=07a
[0x3d] rec0=1d rec1=00 rec2=03 rec3=012
[0x3e] rec0=15 rec1=00 rec2=0b rec3=094
[0x3f] rec0=1a rec1=00 rec2=2e rec3=012
[0x40] rec0=1b rec1=00 rec2=1c rec3=002
[0x41] rec0=17 rec1=00 rec2=39 rec3=026
[0x42] rec0=18 rec1=00 rec2=2f rec3=056
[0x43] rec0=19 rec1=00 rec2=2a rec3=002
[0x44] rec0=11 rec1=00 rec2=2b rec3=032
[0x45] rec0=18 rec1=00 rec2=1a rec3=012
[0x46] rec0=1e rec1=00 rec2=10 rec3=024
[0x47] rec0=1d rec1=00 rec2=18 rec3=01c
[0x48] rec0=1d rec1=00 rec2=30 rec3=000
[0x49] rec0=20 rec1=00 rec2=11 rec3=028
[0x4a] rec0=1b rec1=00 rec2=0f rec3=092
[0x4b] rec0=15 rec1=00 rec2=09 rec3=00e
[0x4c] rec0=16 rec1=00 rec2=16 rec3=066
[0x4d] rec0=18 rec1=00 rec2=1e rec3=014
[0x4e] rec0=1b rec1=00 rec2=2d rec3=00c
[0x4f] rec0=18 rec1=00 rec2=33 rec3=010
[0x50] rec0=1a rec1=00 rec2=3b rec3=016
[0x51] rec0=1d rec1=00 rec2=27 rec3=022
[0x52] rec0=1d rec1=00 rec2=38 rec3=010
[0x53] rec0=1f rec1=00 rec2=21 rec3=006
[0x54] rec0=19 rec1=00 rec2=1d rec3=02e
[0x55] rec0=19 rec1=00 rec2=31 rec3=07e
[0x56] rec0=1f rec1=00 rec2=06 rec3=060
[0x57] rec0=1e rec1=00 rec2=35 rec3=030
[0x58] rec0=1c rec1=00 rec2=07 rec3=02c
[0x59] rec0=19 rec1=00 rec2=26 rec3=08a
[0x5a] rec0=1b rec1=00 rec2=3d rec3=00c
[0x5b] rec0=1a rec1=00 rec2=1b rec3=00a
[0x5c] rec0=1d rec1=00 rec2=14 rec3=03c
[0x5d] rec0=1d rec1=00 rec2=02 rec3=00e
[0x5e] rec0=1e rec1=00 rec2=32 rec3=016
[0x5f] rec0=18 rec1=00 rec2=0d rec3=044
[0x60] rec0=1a rec1=00 rec2=3c rec3=02e
[0x61] rec0=24 rec1=00 rec2=04 rec3=022
[0x62] rec0=1b rec1=00 rec2=13 rec3=00c
[0x63] rec0=1d rec1=00 rec2=69 rec3=03e
tail 0x2174e0ebe86607bdfc129 0x42a00088462060003
Free Block Chain:
0x24: 0000 00 6a 0d 80 1b 84 21 c0 01 50 b8 3c 00 58 0b 09 ┆ j ! P < X ┆
0x6a: 0000 00 00 0d 80 12 06 82 00 03 70 90 44 00 2a 00 89 ┆ p D * ┆