|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 81689 (0x13f19)
Types: TextFile
Notes: R1k Text-file segment
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦1a1353d5d⟧
└─⟦this⟧
with Text_Io, Lex, Error4, Moving_String, Group_identifier_Array;
with Complement5, Complement_Array5, Structure_Array5, Field_Identifier_Array;
with Objet, Detail, Attribute, View, View_List, Animate_List,
Order, Pre_Order_Instructions, Introduction_Instructions;
with Post_Order_Instructions, Order_List, Condition,
Expression, Affectation, Instruction_List;
with Enumeration_Array, Message_Array;
with Exclusive_Generic_List, Identifier, Cheat_Code;
use Text_Io, Moving_String;
package body Syn4 is
use Lex.Visible, Error4.Visible,expression.visible,condition.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 Message .. Introduction;
In_Progress : States := Message;
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
case Lex.Get_Token is
when Entier =>
structure_array5.Create_Number_Field(Structure_Name, Attribute_Index, Sem_Ok);
if not sem_Ok then
ok:=false;
error4.sem (Field_Exist,Field_Identifier_Array.Image (Attribute_Index));
end if;
Lex.Next;
when Chaine =>
structure_array5.Create_Sentence_Field
(Structure_Name, Attribute_Index, Sem_Ok);
if not Sem_Ok then
ok:=false;
error4.sem (Field_Exist,Field_Identifier_Array.Image (Attribute_Index));
end if;
Lex.Next;
when Id =>
if Enumeration_Array.Enumeration_Belong
(Lex.Get_Lower_Case_Value) then
Enumeration_Type := Enumeration_Array.Enum
(Lex.Get_Lower_Case_Value);
structure_array5.Create_Enumerate_Field
(Structure_Name, Attribute_Index, Sem_Ok);
if not Sem_Ok then
ok:=false;
error4.sem (Field_Exist, Field_Identifier_Array.Image
(Attribute_Index));
end if;
else
ok:=false;
error4.sem (Enumeration_Not_Exist,Lex.Get_Lower_Case_Value);
Enumeration_Type := 0;
end if;
Lex.Next;
when others =>
ok:=false;
Error4.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
case Lex.Get_Token is
when Anime | Lieu | Entite | Id =>
Structure_Type := Lex.Get_Lower_Case_Value;
if not structure_array5.Belong (Lex.Get_Lower_Case_Value) then
ok:=false;
error4.sem (Structure_Not_Exist, Lex.Get_Value);
end if;
Lex.Next;
when others =>
ok:=false;
Error4.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;
Error4.Syn (Wrong_Sentence,Follow_Liste_Messages_Erreur);
else
ok:=false;
Error4.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 : Identifier.Object;
Attribute_Index : 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_array5.Field_Put_Number(Structure_Name, Attribute_Index,
Integer'Value (Lex.Get_Lower_Case_Value), Sem_Ok);
if not Sem_Ok then
ok:=false;
error4.sem (Field_Not_A_Number,
Field_Identifier_Array.Image (Attribute_Index));
end if;
Lex.Next;
when Id =>
if Enumeration_Type /= 0 then
if Enumeration_Array.Literal_Belong
(Enumeration_Type, Lex.Get_Lower_Case_Value) then
Literal_Index := Enumeration_Array.Literal
(Enumeration_Type,Lex.Get_Lower_Case_Value);
structure_array5.Field_Put_Enumerate(Structure_Name, Attribute_Index,
Enumeration_Type, Literal_Index, Sem_Ok);
if not Sem_Ok then
ok:=false;
error4.sem (Field_Not_An_Enumerate,Field_Identifier_Array.Image
(Attribute_Index));
end if;
else
ok:=false;
error4.sem (Literal_Not_Belong,Lex.Get_Lower_Case_Value);
end if;
end if;
Lex.Next;
when Right_Sentence =>
Chaine (A_Sentence, Ok);
if ok then
structure_array5.Field_Put_Sentence
(Structure_Name, Attribute_Index, A_Sentence, Sem_Ok);
if not Sem_Ok then
ok:=false;
error4.sem (Field_Not_A_Sentence,Field_Identifier_Array.Image (Attribute_Index));
end if;
end if;
when others =>
ok:=false;
Error4.Syn (Valeur, Follow_Valeur);
end case;
end Valeur;
procedure Valeur (A_Complement : in out complement5.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 complement5.Field_Belong
(A_Complement, Attribute_Index) then
complement5.Field_Put_Number
(A_Complement, Attribute_Index,
Integer'Value (Lex.Get_Lower_Case_Value),Sem_Ok);
if not sem_ok then
ok:=false;
error4.sem (Field_Not_A_Number,Field_Identifier_Array.Image
(Attribute_Index));
end if;
else
ok:=false;
error4.sem (Field_Not_Belong,Field_Identifier_Array.Image
(Attribute_Index));
end if;
end if;
Lex.Next;
when Id =>
if Attribute_Index /= 0 then
if complement5.Field_Belong(A_Complement, Attribute_Index) then
if complement5.field_is_an_enumerate
(a_complement,attribute_index) then
Enumeration_Type :=complement5.Field_Enumeration
(A_Complement, Attribute_Index);
if Enumeration_Array.Literal_Belong(Enumeration_Type,
Lex.Get_Lower_Case_Value) then
Literal_Index := Enumeration_Array.Literal
(Enumeration_Type,Lex.Get_Lower_Case_Value);
complement5.Field_Put_Enumerate(A_Complement, Attribute_Index,
Enumeration_Type, Literal_Index, Sem_Ok);
else
ok:=false;
error4.sem (Literal_Not_Belong,Lex.Get_Lower_Case_Value);
end if;
else
ok:=false;
error4.sem (Field_Not_An_Enumerate,Field_Identifier_Array.Image
(Attribute_Index));
end if;
else
ok:=false;
error4.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 complement5.Field_Belong(A_Complement, Attribute_Index) then
complement5.Field_Put_Sentence(A_Complement, Attribute_Index,
A_Sentence, Sem_Ok);
if not sem_ok then
ok:=false;
error4.sem (Field_Not_A_Sentence,Field_Identifier_Array.Image
(Attribute_Index));
end if;
else
ok:=false;
error4.sem (Field_Not_Belong,Field_Identifier_Array.Image
(Attribute_Index));
end if;
end if;
when others =>
ok:=false;
Error4.Syn (Valeur, Follow_Valeur);
end case;
end Valeur;
procedure Objet (an_objet: out objet.object;Ok : in out Boolean) is
begin
case Lex.Get_Token is
when Id =>
if complement_array5.is_a_subject(lex.get_lower_case_value) then
objet.create_real(an_objet,complement_array5.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;
error4.sem (neither_a_complement_nor_a_group,lex.get_lower_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;
Error4.Syn (Single_Objet, Follow_Objet);
end case;
end 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;
error4.sem (Identifier_Belong_List,Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
else
ok:=false;
Error4.Syn (Id, Follow_Liste_Identificateurs);
end if;
end loop;
else
ok:=false;
Error4.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;
Error4.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;
error4.sem (Message, Identifier.Image (A_Sentence));
end if;
end if;
else
Ok := False;
if Lex.Get_Token = Wrong_Sentence then
ok:=false;
Error4.Syn (Wrong_Sentence,Follow_Liste_Messages_Erreur);
else
ok:=false;
Error4.Syn (Sentence, Follow_Liste_Messages_Erreur);
end if;
end if;
else
Ok := False;
Error4.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 Enumeration_Array.Enumeration_Belong
(Lex.Get_Lower_Case_Value) then
ok:=false;
error4.sem (Enumeration_Exist, Lex.Get_Value);
end if;
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (Id_List, Ok);
Put_Line ("enumere");
if Ok then
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
Enumeration_Array.Put_Literal(Enumeration_Identifier,
Identifier_List.Value (Iterator), Sem_Ok);
Identifier_List.Next (Iterator);
end loop;
end if;
else
ok:=false;
Error4.Syn (Colon, Follow_Liste_Enumeres);
end if;
else
ok:=false;
Error4.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 Enumeration_Array.Literal_Belong
(Enumeration_Array.Enum ("normal"),
Identifier.Image (Identifier_List.Value(Iterator))) then
Enumeration_Array.Put_Literal
(Special_Identifier,
Identifier_List.Value (Iterator), Sem_Ok);
else
Ok := False;
error4.sem (Special_In_Normal,
Identifier.Image(Identifier_List.Value(Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
ok:=false;
Error4.Syn (Colon, Follow_Lien_Special);
end if;
else
ok:=false;
Error4.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
Enumeration_Array.Put_Literal
(Normal_Identifier,
Identifier_List.Value (Iterator), Sem_Ok);
Identifier_List.Next (Iterator);
end loop;
end if;
Liens_Speciaux (Ok);
else
ok:=false;
Error4.Syn (Colon, Follow_Lien_Normal);
end if;
else
ok:=false;
Error4.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_array5.Put_Verb (Verb_Identifier,verb_identifier,sem_ok);
if not Sem_Ok then
ok:=false;
error4.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_array5.Put_Verb
(Identifier_List.Value (Iterator), verb_identifier,Sem_Ok);
if not Sem_Ok then
Ok := False;
error4.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;
else
ok:=false;
Error4.Syn (Id, Follow_Liste_Verbes);
end if;
Put_Line ("liste_verbes");
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);
Put_Line ("mots");
if Ok then
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
complement_array5.Put_Word(Identifier_List.Value (Iterator), Sem_Ok);
if not Sem_Ok then
ok:=false;
error4.sem (Word_Exist,Identifier.Image(Identifier_List.Value (Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
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;
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);
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);
Text_Io.Put_Line ("affectation");
end if;
else
ok:=false;
Error4.Syn (En, Follow_Attribut);
end if;
else
ok:=false;
Error4.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);
Text_Io.Put_Line ("attribut");
while Lex.Get_Token = Id loop
Attribut (Structure_Name, Ok);
Text_Io.Put_Line ("attribut");
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_array5.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;
Error4.Syn (Id, Follow_Liste_Structures);
end if;
else
ok:=false;
Error4.Syn (Colon, Follow_Liste_Structures);
end if;
end loop;
end Liste_Structures;
procedure Champs (A_Complement : in out complement5.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;
error4.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;
Error4.Syn (Equal, Follow_Champs);
end if;
end loop;
end Champs;
procedure Corps_Objet (A_Complement : in out complement5.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 : complement5.Object:=complement5.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_array5.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_array5.Put(A_Complement,
Identifier_List.Value (Iterator), Sem_Ok);
if not Sem_Ok then
ok := false;
error4.sem (Complement_Exist,Identifier.Image
(Identifier_List.Value (Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
ok:=false;
Error4.Syn (Colon, Follow_Liste_Objets);
end if;
end loop;
end Liste_Objets;
procedure Lieu (Place_Index, Direction_Index : out Natural;
Ok : in out Boolean) is
begin
Text_Io.Put_Line ("lieu start");
if Lex.Get_Token = Id then
if complement_array5.belong (Identifier.From_String
(Lex.Get_Lower_Case_Value)) then
if complement_array5.is_a_place (Identifier.From_String
(Lex.Get_Lower_Case_Value)) then
Place_Index := complement_array5.Index(Lex.Get_Lower_Case_Value);
else
ok:=false;
error4.sem (Complement_Not_a_place, Lex.Get_Lower_Case_Value);
end if;
else
ok:=false;
error4.sem (Complement_Not_exist, Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
if Lex.Get_Token = Id then
if complement_array5.belong (Identifier.From_String
(Lex.Get_Lower_Case_Value)) then
if complement_array5.is_a_word (Identifier.From_String
(Lex.Get_Lower_Case_Value)) then
Direction_Index := complement_array5.Index
(Lex.Get_Lower_Case_Value);
else
ok:=false;
error4.sem (Complement_Not_a_word, Lex.Get_Lower_Case_Value);
end if;
else
ok:=false;
error4.sem (Complement_Not_exist, Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
else
ok:=false;
Error4.Syn (Id, Follow_Lier_Lieux);
end if;
else
ok:=false;
Error4.Syn (Id, Follow_Lier_Lieux);
end if;
Text_Io.Put_Line ("lieu stop");
end Lieu;
procedure Moyen (Enumeration_Type, Literal_Index, Exit_Name_Index : out
Natural;
Ok : in out Boolean) is
Local_Type : Natural;
begin
Text_Io.Put_Line ("moyen start");
if Lex.Get_Token = Par then
Lex.Next;
Text_Io.Put_Line ("moyen 1 " & Lex.Get_Lower_Case_Value);
if Lex.Get_Token = Id then
if complement_array5.is_a_word (Identifier.From_String
(Lex.Get_Lower_Case_Value)) then
Exit_Name_Index := complement_array5.Index
(Lex.Get_Lower_Case_Value);
else
ok:=false;
error4.sem (Complement_Not_a_word, Lex.Get_Lower_Case_Value);
end if;
Lex.Next;
Text_Io.Put_Line ("moyen 2 " & Lex.Get_Lower_Case_Value);
if Lex.Get_Token = Id then
Local_Type := Enumeration_Array.Enum ("normal");
Text_Io.Put_Line ("moyen 3 : " & Integer'Image (Local_Type)& natural'Image (Literal_index));
if Enumeration_Array.Literal_Belong
(Local_Type, Lex.Get_Lower_Case_Value) then
Literal_Index :=
Enumeration_Array.Literal
(Local_Type, Lex.Get_Lower_Case_Value);
Text_Io.Put_Line ("moyen 4 " & natural'Image (Local_Type) & natural'Image (Literal_index));
else
Local_Type := Enumeration_Array.Enum ("special");
Text_Io.Put_Line ("moyen 5 : " & Integer'Image (Local_Type)& natural'Image (Literal_index));
if Enumeration_Array.Literal_Belong
(Local_Type, Lex.Get_Lower_Case_Value) then
Literal_Index :=
Enumeration_Array.Literal
(Local_Type, Lex.Get_Lower_Case_Value);
Text_Io.Put_Line ("moyen 6 " & natural'Image (Local_Type) & natural'Image (Literal_index));
else
Local_type := 0;
Literal_Index := 0;
ok:=false;
error4.sem (Literal_Not_Belong,Lex.Get_Lower_Case_Value);
end if;
end if;
lex.next;
else
ok:=false;
Error4.Syn (Id, Follow_Lier_Lieux);
end if;
else
ok:=false;
Error4.Syn (Id, Follow_Lier_Lieux);
end if;
else
ok:=false;
Error4.Syn (Par, Follow_Lier_Lieux);
end if;
Enumeration_Type := Local_Type;
Text_Io.Put_Line ("moyen stop " & natural'Image (Local_Type) & natural'Image (Literal_index));
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");
while Lex.Get_Token = Lie loop
Lex.Next;
Lieu (First_Place_Index, First_Direction_Index, Ok);
text_io.put_line("lier lieux 1");
Text_Io.Put_Line (complement_array5.Name (First_Place_Index));
Text_Io.Put_Line (complement_array5.Name (First_Direction_Index));
if Lex.Get_Token = A then
Lex.Next;
Lieu (Second_Place_Index, Second_Direction_Index,Ok);
text_io.put_line("lier lieux 2");
Text_Io.Put_Line (complement_array5.Name (Second_Place_Index));
Text_Io.Put_Line (complement_array5.Name
(Second_Direction_Index));
Moyen (Enumeration_Type, Literal_Index,
Exit_Name_Index, Ok);
Text_Io.Put_Line ("lier lieu 3");
Text_Io.Put_Line (complement_array5.Name (Exit_Name_Index));
Text_Io.Put_Line (natural'Image (Enumeration_Type));
Text_Io.Put_Line (natural'Image (Literal_Index));
if ok then
complement_array5.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 ("lier lieu 4 " & Boolean'Image (sem_Ok));
if Sem_Ok then
complement_array5.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 ("lier lieu 5 " & Boolean'Image (sem_Ok));
if Sem_Ok then
Field_Identifier_Array.Put(Identifier.From_String
(complement_array5.Name(First_Direction_Index)));
Field_Index := Field_Identifier_Array.Index
(complement_array5.Name(First_Direction_Index));
complement_array5.Create_Enumerate_Field
(First_Place_Index, Field_Index, Sem_Ok);
Text_Io.Put_Line ("lier lieu 6 " & Boolean'Image (Sem_Ok));
if Sem_Ok then
Field_Identifier_Array.Put(Identifier.From_String
(complement_array5.Name(Second_Direction_Index)));
Field_Index := Field_Identifier_Array.Index
(complement_array5.Name(Second_Direction_Index));
complement_array5.Create_Enumerate_Field
(Second_Place_Index, Field_Index, Sem_Ok);
Text_Io.Put_Line ("lier lieu 7 " & Boolean'Image (Sem_Ok));
if Sem_Ok then
complement_array5.Field_Put_Enumerate
(Second_Place_Index,Field_Index, Enumeration_Type,
Literal_Index, Sem_Ok);
Text_Io.Put_Line ("lier lieu 8 " & Boolean'Image (Sem_Ok));
else
Ok := False;
error4.sem (Field_Belong,
Field_Identifier_Array.Image(Field_Index));
end if;
else
Ok := False;
error4.sem (Field_Belong,Field_Identifier_Array.Image
(Field_Index));
end if;
else
Ok := False;
error4.sem (An_Exit, complement_array5.Name(Second_Place_Index));
end if;
else
Ok := False;
error4.sem (An_Exit, complement_array5.Name(First_Place_Index));
end if;
end if;
else
Ok := False;
Error4.Syn (A, Follow_Lier_Lieux);
end if;
end loop;
text_io.put_line("lier lieux stop");
end Lier_Lieux;
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);
if complement_array5.Belong (Identifier.From_String
(Lex.Get_Lower_Case_Value)) then
ok:=false;
error4.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");
identifier_list.show(id_list);
if Ok then
Identifier_List.Init (Iterator, Id_List);
while not Identifier_List.Done (Iterator) loop
if complement_array5.Belong
(Identifier_List.Value (Iterator)) then
complement_array5.put_group(Identifier_List.Value (Iterator),
group_identifier,sem_ok);
if not sem_ok then
ok:=false;
error4.sem(complement_has_a_group,
Identifier.Image(Identifier_List.Value(Iterator)));
end if;
else
Ok := False;
error4.sem (Complement_Not_Exist,
Identifier.Image(Identifier_List.Value(Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
ok:=false;
Error4.Syn (Colon, Follow_Liste_Groupes);
end if;
else
ok:=false;
Error4.Syn (Id, Follow_Liste_Groupes);
end if;
end loop;
text_io.put_line("liste groupe stop");
end Liste_Groupes;
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_array5.belong (Identifier.From_String
(Lex.Get_Lower_Case_Value)) then
if complement_array5.Is_A_Place
(Lex.Get_Lower_Case_Value) then
Place_Index := complement_array5.Index
(Lex.Get_Lower_Case_Value);
else
ok:=false;
error4.sem (Complement_Not_A_Place,lex.get_lower_case_value);
end if;
else
ok:=false;
error4.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;
error4.sem (Number_Of_Repeat_Null, "");
end if;
lex.next;
else
ok:=false;
Error4.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_array5.Put_Movement
(Identifier_List.Value (Iterator),Place_Index);
end loop;
end loop;
end if;
else
ok:=false;
Error4.Syn (Id, Follow_Mouvement);
end if;
text_io.put_line("mouvement stop");
end Mouvement;
procedure Mouvements (id_List : in Identifier_List.Object;
Ok : in out Boolean) is
begin
text_io.put_line("mouvements start");
Mouvement (id_List, Ok);
while Lex.Get_Token = Comma loop
Lex.Next;
Mouvement (id_List, Ok);
end loop;
text_io.put_line("mouvements stop");
end Mouvements;
procedure Liste_Itineraires (Ok : in out Boolean) is
id_List : Identifier_List.Object;
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.show(id_list);
while not Identifier_List.Done (Iterator) loop
if complement_array5.Is_An_Animate
(identifier.Image(Identifier_List.Value (Iterator))) then
animate_list.put
(complement_array5.index(Identifier_List.Value (Iterator)),sem_ok);
if not sem_ok then
ok := false;
error4.sem(animate_has_a_trip,identifier.Image(Identifier_List.Value (Iterator)));
end if;
else
Ok := False;
error4.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;
Error4.Syn (Colon, Follow_Liste_Itineraires);
end if;
end loop;
text_io.put_line("liste itineraire stop");
end Liste_Itineraires;
procedure complement_detail (a_detail : in detail.object;a_complement : in string;ok : in out boolean) is
begin
text_io.put_line("complement detail start");
if complement_array5.belong(a_complement) then
detail.create_real_complement(a_detail,
complement_array5.index(a_complement));
elsif group_array.belong(a_complement) then
detail.create_group_complement(a_detail,
order_list.complement_position(a_complement));.
else
ok:=false;
error4.sem (neither_a_complement_nor_a_group,a_complement);
end if;
text_io.put_line("complement detail stop");
end complement_detail;
procedure field_detail (a_detail : in detail.object;a_field:in string;ok : in out boolean) is
begin
text_io.put_line("field detail start");
if field_identifier_array.belong(a_field) then
detail.create_real_field(a_detail,
field_identifier_array.index(a_field));
elsif group_array.belong(a_field) then
detail.create_group_field(a_detail,
order_list.complement_position(a_field));
else
ok:=false;
error4.sem (neither_a_field_nor_a_group,a_field);
end if;
text_io.put_line("field detail stop");
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;
enumeration_type : in natural;Ok : in out Boolean);
procedure facteur (an_expression: in out expression.object;
enumeration_type : in natural;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");
case Lex.Get_Token is
when Opening_Bracket =>
Lex.Next;
une_Expression (an_expression,enumeration_type,ok);
text_io.put_line("facteur 1");
expression.show(an_expression);
if Lex.Get_Token = Closing_Bracket then
Lex.Next;
else
ok:=false;
Error4.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 );
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 enumeration.literal_belong(enumeration_type,
moving_string.image(an_identifier)) then
expression.create(an_expression,enumeration_type,
enumeration_array.literal(enumeration_type,
moving_string.image(an_identifier)));
else
ok:=false;
error4.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;
Error4.Syn (Facteur, Follow_Facteur);
end case;
text_io.put_line("facteur stop");
end Facteur;
procedure terme (an_expression: in out expression.object;
enumeration_type : in natural;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");
facteur(an_expression,ok);
text_io.put_line("terme 1");
expression.show(an_expression);
while First_Terme (Lex.Get_Token) loop
case Lex.Get_Token is
when Multiply =>
Lex.Next;
facteur(left_expression,ok);
expression.create(an_expression,multiply,an_expression,
left_expression,sem_ok);
text_io.put_line("terme 2");
expression.show(an_expression);
if not sem_ok then
ok:=false;
error4.sem(expression_not_same_type,"");
end if;
when Divide =>
Lex.Next;
facteur(left_expression,ok);
expression.create(an_expression,divide,an_expression,
left_expression,sem_ok);
text_io.put_line("terme 3");
expression.show(an_expression);
if not sem_ok then
ok:=false;
error4.sem(expression_not_same_type,"");
end if;
when others =>
null;
end case;
end loop;
text_io.put_line("terme stop");
end Terme;
procedure une_Expression (an_expression: in out expression.object;
enumeration_type : in natural;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");
Terme (an_expression,ok);
text_io.put_line("expression 1");
expression.show(an_expression);
while First_Expression (Lex.Get_Token) loop
case Lex.Get_Token is
when Add =>
Lex.Next;
Terme (left_expression,ok);
expression.create(an_expression,add,an_expression,
left_expression,sem_ok);
text_io.put_line("expression 2");
expression.show(an_expression);
if not sem_ok then
ok:=false;
error4.sem(expression_not_same_type,"");
end if;
when Substract =>
Lex.Next;
Terme (left_expression,ok);
expression.create(an_expression,substract,an_expression,
left_expression,sem_ok);
text_io.put_line("expression 3");
expression.show(an_expression);
if not sem_ok then
ok:=false;
error4.sem(expression_not_same_type,"");
end if;
when others =>
null;
end case;
end loop;
text_io.put_line("expression stop");
end Expression;
procedure tests (a_condition: out condition.object;an_attribute: in attribute.object;
enumeration_type:in natural;Ok : in out Boolean) is
an_expression : expression.object:=expression.null_object;
begin
text_io.put_line("tests start");
case Lex.Get_Token is
when Existe =>
Lex.Next;
if Lex.Get_Token = Pas then
condition.create_attribute_exist(a_condition,an_attribute,no);
Lex.Next;
else
condition.create_attribute_exist(a_condition,an_attribute,yes);
end if;
when Equal | Not_Equal =>
une_Expression (an_expression,enumeration_type,ok);
if ok then
condition.create_compare(a_condition,an_attribute,
compare_kind'value(token'image(lex.get_token)),
an_expression,sem_ok);
if not sem_ok then
ok:=false;
error4.sem(attribute_and_expression_not_same_type,"");
end if;
end if;
Lex.Next;
when Less | Greater | Greater_Equal | Less_Equal =>
une_Expression (an_expression,enumeration_type,ok);
if ok then
condition.create_compare(a_condition,an_attribute,
compare_kind'value(token'image(lex.get_token)),
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
error4.sem(wrong_compare_kind_for,token'image(lex.get_token));
else
error4.sem(attribute_and_expression_not_same_type,"");
end if;
end if;
Lex.Next;
when others =>
ok:=false;
Error4.Syn (Tests, Follow_Suite_Condition_Forte);
end case;
text_io.put_line("tests stop");
end Test;
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");
case Lex.Get_Token is
when De =>
Lex.Next;
field_detail (a_detail,
moving_string.image(an_identifier),ok);
Objet (an_objet,ok);
if ok then
attribute.put(an_attribute,an_objet,a_detail);
end if;
Tests(a_condition,an_attribute,
attribute.enumeration(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 := no;
Lex.Next;
else
a_binary_kind := yes
end if;
if Lex.Get_Token = A then
Lex.Next;
Objet (an_objet,ok);
if ok then
condition.create_belong(a_condition,an_objet,
a_detail,a_binary_kind));
end if;
else
ok:=false;
Error4.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 := no;
Lex.Next;
else
a_binary_kinf := yes;
end if;
if ok then
condition.create_subject_exist(a_condition,
a_detail,a_binary_kind);
end if;
when others =>
ok:=false;
Error4.Syn (Suite_Condition_Forte,
Follow_Suite_Condition_Forte);
end case;
text_io.put_line("suite condition forte stop");
end Suite_Condition_Forte;
procedure Condition_forte (a_condition: in out condition.object;
Ok : in out Boolean) is
an_identifier : identifier.object;
an_objet : objet.object;
a_number : integer;
begin
text_io.put_line("condition forte start");
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;
Error4.Syn (Id, Follow_Condition_Forte);
end if;
else
ok:=false;
Error4.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;
Error4.Syn (Id, Follow_Condition_Forte);
end if;
else
ok:=false;
Error4.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;
error4.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;
Error4.Syn (Passees, Follow_Condition_Forte);
end if;
else
ok:=false;
Error4.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;
Error4.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_array5.is_a_place(lex.get_lower_case_value) then
objet.create_real(an_objet,complement_array5.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;
error4.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;
end if;
if Lex.Get_Token = Existe then
Lex.Next;
if Lex.Get_Token = Pas then
Lex.Next;
conditon.create_exits_exist(a_conditon,
an_objet,no);
else
conditon.create_exits_exist(a_conditon,
an_objet,yes);
end if;
else
ok:=false;
Error4.Syn (Existe, Follow_Condition_Forte);
end if;
else
ok:=false;
Error4.Syn (Identifier_Place, Follow_Condition_Forte);
end if;
else
ok:=false;
Error4.Syn (De, Follow_Condition_Forte);
end if;
when others =>
ok:=false;
Error4.Syn (Condition_Forte, Follow_Condition_Forte);
end case;
text_io.put_line("condition forte stop");
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");
Condition_Forte (a_condition,ok);
text_io.put_line("condition faible 1");
condition.show(a_condition);
while First_Condition_Faible (Lex.Get_Token) loop
case Lex.Get_Token is
when Et =>
Lex.Next;
Condition_Forte (left_condition,ok);
text_io.put_line("condition faible 2");
condition.show(a_condition);
if ok then
Condition.create (a_condition,et,a_condition,left_condition);
end if;
when others =>
null;
end case;
end loop;
text_io.put_line("condition faible stop");
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");
Condition_Faible (a_condition,ok);
text_io.put_line("condition 1");
condition.show(a_condition);
while First_Condition (Lex.Get_Token) loop
case Lex.Get_Token is
when Ou =>
Lex.Next;
Condition_Faible (left_condition,ok);
text_io.put_line("condition 2");
condition.show(a_condition);
if ok then
Condition.create (a_condition,ou,a_condition,left_condition);
end if;
when others =>
null;
end case;
end loop;
text_io.put_line("condition stop");
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");
une_Condition (a_condition,ok);
text_io.put_line("si 1");
condition.show(a_condition);
if Lex.Get_Token = Alors then
Lex.Next;
Put_Line ("alors detecte");
Instructions_Simples (right_list,ok);
text_io.put_line("si 2");
instruction_list.show(right_list);
text_io.Put_Line ("sinon possible");
if Lex.Get_Token = Sinon then
Put_Line ("sinon detecte");
Lex.Next;
Instructions_Simples (wrong_list,ok);
text_io.put_line("si 3");
instruction_list.show(wrong_list);
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;
Error4.Syn (Si, Follow_Instruction_Simple);
end if;
else
ok:=false;
Error4.Syn (Fin, Follow_Instruction_Simple);
end if;
else
ok:=false;
Error4.Syn (Alors, Follow_Instruction_Simple);
end if;
text_io.put_line("si stop");
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;
begin
text_io.put_line("change start");
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;
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,
attribute.enumeration(an_attribute),ok);
if ok then
affectation.create_attribute(an_affectation,
an_attribute,an_expression);
instruction_list.insert_change(ins_list,an_affectation);
end if;
else
ok:=false;
Error4.Syn (En, Follow_Instruction_Simple);
end if;
else
ok:=false;
Error4.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;
Error4.Syn (Id, Follow_Instruction_Simple);
end if;
else
ok:=false;
Error4.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;
Error4.Syn (Id, Follow_Instruction_Simple);
end if;
else
ok:=false;
Error4.Syn (En, Follow_Instruction_Simple);
end if;
when others =>
ok:=false;
Error4.Syn (Change, Follow_Instruction_Simple);
end case;
text_io.put_line("change stop");
end Change;
procedure Quoi_Afficher (a_view:out view.object;Ok : in out Boolean) is
an_objet : objet.object;
a_detail : detail.object;
begin
text_io.put_line("quoi afficher start");
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;
Error4.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;
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;
Error4.Syn (de, Follow_Quoi_Afficher);
end if;
when Nom =>
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
objet(an_objet,ok);
if ok then
view.create_name(a_view,an_objet);
end if;
else
ok:=false;
Error4.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;
Error4.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;
Objet (an_objet,ok);
if ok then
view.create_contents(a_view,an_objet);
end if;
else
ok:=false;
Error4.Syn (De, Follow_Quoi_Afficher);
end if;
when others =>
ok:=false;
Error4.Syn (Quoi_Afficher, Follow_Quoi_Afficher);
end case;
text_io.put_line("quoi afficher stop");
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");
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");
end Liste_Affiche;
procedure Ligne (ins_list: in out instruction_list.object;Ok : in out Boolean) is
begin
text_io.put_line("ligne start");
if Lex.Get_Token = Suivante then
Lex.Next;
instruction_list.insert_next_line(ins_list);
else
ok:=false;
Error4.Syn (Suivante, Follow_Instruction_Simple);
end if;
text_io.put_line("ligne stop");
end Ligne;
procedure Bouge (ins_list: in out instruction_list.object;Ok : in out Boolean) is
begin
text_io.put_line("bouge start");
if Lex.Get_Token = Anime then
Lex.Next;
instruction_list.insert_move(ins_list);
else
ok:=false;
Error4.Syn (Anime, Follow_Instruction_Simple);
end if;
text_io.put_line("bouge stop");
end Bouge;
procedure Positionne (ins_list: in out instruction_list.object;Ok : in out Boolean) is
an_objet : objet.object;
a_detail : detail.object;
begin
text_io.put_line("positionne start");
if lex.get_token = id then
complement_detail (a_detail,
lex.get_lower_case_value,ok );
lex.next;
if Lex.Get_Token = A then
Lex.Next;
objet (an_objet,ok);
if ok then
instruction_list.insert_put(ins_list,a_detail,an_objet);
end if;
else
ok:=false;
Error4.Syn (a, Follow_Instruction_Simple);
end if;
else
ok:=false;
Error4.Syn (id, Follow_Instruction_Simple);
end if;
text_io.put_line("positionne stop");
end Positionne;
procedure Retire (ins_list: in out instruction_list.object;Ok : in out Boolean) is
a_detail : detail.object;
begin
text_io.put_line("retire start");
if lex.get_token = id then
complement_detail (a_detail,
lex.get_lower_case_value,ok );
Lex.Next;
if ok then
instruction_list.insert_put(ins_list,a_detail,objet.null_object);
end if;
else
ok:=false;
Error4.Syn (id, Follow_Instruction_Simple);
end if;
text_io.put_line("retire stop");
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");
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;
Error4.Syn (Id, Follow_Instruction_Simple);
end if;
else
ok:=false;
Error4.Syn (Vers, Follow_Instruction_Simple);
end if;
text_io.put_line("va stop");
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");
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;
Error4.Syn (instruction, Follow_Instruction_Simple);
end case;
text_io.put_line("instruction simple start");
end Instructions_Simples;
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");
instruction_simple(ins_list,ok);
while First_Instructions_Simples (Lex.Get_Token) loop
instruction_simple(ins_list,ok);
end loop;
text_io.put_line("instructions simples stop");
end Instructions_Simples;
procedure complement_existe(a_complement: in string;ok :in out boolean) is
begin
text_io.put_line("complement existe start");
if not (complement_array5.belong(a_complement)
or group_array.belong(a_complement)) then
ok:=false;
error4.sem (neither_a_complement_nor_a_group,a_complement);
end if;
text_io.put_line("complement existe stop");
end complement_existe;
procedure Description_Ordre (an_order : out order.object;Ok : in out Boolean) is
begin
text_io.put_line("description ordre start");
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;
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;
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;
end if;
text_io.put_line("description ordre 1");
order.show(an_order);
if Lex.Get_Token = Id then
ok:=false;
Error4.Syn (Too_Many_Complements, Follow_Ordre);
end if;
else
ok:=false;
Error4.Syn (Id, Follow_Ordre);
end if;
text_io.put_line("description ordre stop");
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");
order_list.free;
Description_Ordre (an_order,ok);
if ok then
order_list.put(an_order,sem_ok);
if not sem_ok then
ok:=false;
error4.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);
if not sem_ok then
ok:=false;
error4.sem (order_exist,order.image(an_order));
end if;
end if;
end loop;
text_io.put_line("liste description ordre stop");
end Liste_Description_Ordre;
procedure fill_coded_order_array(ins_list : in instruction_list.object;
a_place : in moving_string.object) is
an_order : order.object;
sem_ok : boolean;
begin
text_io.put_line("fill coded order start");
order_list.make_redirection;
text_io.put_line("fill coded order 1");
order_list.show;
order_list.init;
while not order_list.done loop
an_order := order_list.value;
order_array.put_place(a_place);
coded_order.put(an_order,ins_list,sem_ok);
if sem_ok then
ok:=false;
error4.sem(order_exist,order.image(an_order));
end if;
order_list.next;
end loop;
text_io.put_line("fill coded order stop");
end;
procedure Ordre (Ok : in out Boolean) is
ins_list : instruction.object:=instruction_list.null_object;
A_Place : Moving_String.Object;
begin
text_io.put_line("ordre start");
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_array5.is_a_place(lex.get_lower_case_value) then
A_Place := Lex.Get_Lower_Case_Value;
else
ok:=false;
error4.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");
instruction_list.show(ins_list);
if ok then
fill_order_array(ins_list,a_place);
end if;
else
ok:=false;
Error4.Syn (Id, Follow_Ordre);
end if;
text_io.put_line("pour stop");
end loop;
if Lex.Get_Token = Global then
text_io.put_line("global start");
Lex.Next;
ins_list:=instruction_list.null_object;
Instructions_Simples (ins_list,ok);
text_io.put_line("global 1");
instruction_list.show(ins_list);
if ok then
fill_order_array(ins_list,moving_string.from_string("global"));
end if;
text_io.put_line("global stop");
end if;
else
ok:=false;
Error4.Syn (Colon, Follow_Ordre);
end if;
text_io.put_line("ordre stop");
end Ordre;
procedure Fin_Quand (Ok : in out Boolean) is
begin
text_io.put_line("fin quand start");
if Lex.Get_Token = Fin then
Lex.Next;
if Lex.Get_Token = Quand then
Lex.Next;
else
ok:=false;
Error4.Syn (Quand, Follow_Quand_Ordre);
end if;
else
ok:=false;
Error4.Syn (Fin, Follow_Quand_Ordre);
end if;
text_io.put_line("ordre stop");
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");
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 (Ok);
while Lex.Get_Token = Substract loop
Lex.Next;
Ordre (Ok);
end loop;
Fin_Quand (Ok);
else
ok:=false;
Error4.Syn (Substract, Follow_Ordre);
end if;
else
ok:=false;
Error4.Syn (Vaut, Follow_Quand_Ordre);
end if;
else
ok:=false;
Error4.Syn (Ordre, Follow_Quand_Ordre);
end if;
else
ok:=false;
Error4.Syn (Quand, Follow_Quand_Ordre);
end if;
text_io.put_line("quand ordre stop");
end Quand_Ordre;
procedure Creation_Monde (Ok : in out Boolean) is
begin
text_io.put_line("creation monde start");
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 start");
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");
if Lex.Get_Token = Introduction then
Lex.Next;
Put_Line ("Lecture de la zone d'introduction ...");
Instructions_Simples (ins_list,ok);
instruction_list.show(ins_list);
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);
text_io.put_line("scenario 1");
instruction_list.show(ins_list);
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);
text_io.put_line("scenario 2");
instruction_list.show(ins_list);
if ok then
post_order_instructions.put(ins_list);
end if;
end if;
text_io.put_line("scenario stop");
end Scenario;
procedure Jeu_Aventure (Ok : in out Boolean) is
begin
text_io.put_line("jeu aventure start");
loop
Creation_Monde (Ok);
--Scenario (ok);
if not Lex.Is_At_End then
ok:=false;
Error4.Syn (Jeu_Aventure, Follow_Jeu_Aventure);
else
exit;
end if;
Put_Line ("redemarrage");
end loop;
text_io.put_line("jeu aventure stop");
end Jeu_Aventure;
procedure Start 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");
Message_Array.Show;
Enumeration_Array.Show;
complement_array5.Show;
structure_array5.Show;
Field_Identifier_Array.Show;
Group_identifier_Array.Show;
end Start;
end Syn4;