|
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: 73175 (0x11dd7)
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«
└─⟦b6336e208⟧
└─⟦this⟧
with Text_Io, Lex, Error, Moving_String, Group_Array,complement,complement_array,
structure_array,
-- objet,detail,attribute,view,view_list,animate_list,order,pre_order_instruction_list,post_order_instruction_list,
-- order_list,condition,expression,affectation,instruction_list,introduction_order_instruction_list,
-- order_array,coded_order_array;
Enumeration_Array, Message_Array,
Exclusive_Generic_List, Identifier;
use Text_Io, Moving_String;
package body Syn3 is
use Lex.Visible, Error.Visible;
package Identifier_List is new Exclusive_Generic_List
(Element => Identifier.Object,
Null_Element => Identifier.Null_Object,
Show_Element => Identifier.Show,
Get_Key => Identifier.Image);
subtype States is Token range Message .. Introduction;
In_Progress : States := Message;
procedure Type_Base (Structure_Name, Attribute_index : in positive;
Enumeration_Type : out Natural;
Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Entier =>
Structure_Array.Create_Number_Field
(Structure_Name, attribute_Index, Local_Ok);
if not local_ok then
error.sem(field_exist,identifier.image(attribute_name));
end if;
Lex.Next;
when Chaine =>
Structure_Array.Create_Sentence_Field
(Structure_Name, attribute_Index, Local_Ok);
if not local_ok then
error.sem(field_exist,identifier.image(attribute_name);
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_Array.Create_Enumerate_Field
(Structure_Name, attribute_Index, Local_Ok);
if not local_ok then
error.sem(field_exist,identifierer.image(attribute_name);
end if;
else
local_ok:=fasle;
error.sem(enumeration_not_exist,lex.get_lower_case_value);
end if;
Lex.Next;
when others =>
Local_Ok := False;
Error.Syn (Type_Base, Follow_Type_Base);
end case;
Ok := Ok and Local_Ok;
end Type_Base;
procedure Type_Structure (Structure_Type : out Moving_String.Object;
Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Anime | Lieu | Entite | Id =>
Structure_Type := Lex.Get_Lower_Case_Value;
Lex.Next;
when others =>
Local_Ok := False;
Error.Syn (Type_Structure, Follow_Type_Structure);
end case;
Ok := Ok and Local_Ok;
end Type_Structure;
procedure Chaine (A_Sentence : out Identifier.Object;
Ok : in out Boolean) is
Local_Ok : Boolean := True;
Value : Moving_String.Object;
begin
value := lex.get_value; --moving pas lower case;
Lex.Next;
while Lex.Get_Token = Ampersand loop
Lex.Next;
if Lex.Get_Token /= Right_Sentence then
Local_Ok := False;
Error.Syn (Chaine, Follow_Chaine);
else
Value := Value & Lex.Get_Value;
Lex.Next;
end if;
end loop;
Ok := Local_Ok;
A_Sentence := Identifier.From_String (Moving_String.Image (Value));
end Chaine;
procedure Valeur (Structure_Name, Attribute_index : positive
Enumeration_Type :in Natural;
Ok : in out Boolean) is
A_Sentence : Identifier.Object;
Literal_Index : Natural;
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Number =>
structure_Array.Field_Put_Number
(Structure_Name, attribute_Index,
Integer'Value (Lex.Get_Lower_Case_Value), Local_Ok);
if not local_ok then
error.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_Array.Field_Put_Enumerate
(Structure_Name, attribute_Index, Enumeration_Type,
Literal_Index, Local_Ok);
if not local_ok then
error.sem (field_not_an_enumerate,field_identifier_array.image(attribute_index));
end if;
else
local_ok:=fasle;
error.sem (literal_not_belong,lex.get_lower_case_value);
end if;
end if;
Lex.Next;
when Right_Sentence =>
Chaine (A_Sentence, Local_Ok);
Structure_Array.Field_Put_Sentence
(Structure_Name, attribute_Index, A_Sentence, Local_Ok);
if not local_ok then
error.sem (field_not_a_sentence,field_identifier_array.image(attribute_index));
end if;
when others =>
Local_Ok := False;
Error.Syn (Valeur, Follow_Valeur);
end case;
Ok := Ok and Local_Ok;
end Valeur;
procedure Valeur (a_complement:in out complement.object; Attribute_index : in natural;
Ok : in out Boolean) is
Local_Ok : Boolean := True;
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
if complement.field_is_a_number(a_complement,attribute_index) then
complement.field_put_number
(a_complement, attribut_Index,
Integer'Value (Lex.Get_Lower_Case_Value), Local_Ok);
else
local_ok:=false;
error.sem (field_not_a_number,field_identifier_array.image(attribute_index);
end if;
else
local_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 enumeration_array.literal_belong(enumeration_type,lex.get_lower_case_value) then
Literal_Index := Enumeration_Array.Literal
(Enumeration_Type, Lex.
Get_Lower_Case_Value);
complement.field_put_enumerate
(a_complement, attribut_Index, Enumeration_Type,
Literal_Index, Local_Ok);
else
local_ok:=fasle;
error.sem (literal_not_belong,lex.get_lower_case_value);
end if;
else
local_ok:=false;
error.sem (field_not_an_enumerate,field_identifier_array.image(attribute_index);
end if;
else
local_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, Local_Ok);
if attribute_index \= 0 then
if complement.field_belong(a_complement,attribute_index) then
if complement.field_is_a_sentence(a_complement,attribute_index) then
complement.field_put_sentence
(a_complement, attribut_Index,
A_Sentence, Local_Ok);
else
local_ok:=false;
error.sem (field_not_a_sentence,field_identifier_array.image(attribute_index));
end if;
else
local_ok:=false;
error.sem (field_not_belong,field_identifier_array.image(attribute_index);
end if;
end if;
when others =>
Local_Ok := False;
Error.Syn (Valeur, Follow_Valeur);
end case;
Ok := Ok and Local_Ok;
end Valeur;
-- procedure Objet (an_objet: out objet.object;Ok : in out Boolean) is
procedure Objet (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
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_array.belong(lex.get_lower_case_value) then
---objet.create_group(an_objet,order_list.complement_position(lex.get_lower_case_value));.
--else
-- local_ok := false;
--error.sem (neither_a_complement_or_a_group,lex.get_lower_value);
--end if;
lex.next;
when Heros =>
--create_hero(an_object);
lex.next;
when Lieu =>
--objet.create_place(an_object);
Lex.Next;
when others =>
Local_Ok := False;
Error.Syn (Objet, Follow_Objet);
end case;
Ok := Ok and Local_Ok;
end Objet;
procedure Liste_Identificateurs
(id_List : in out Identifier_List.Object; Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Id then
Identifier_List.Put
(id_list, Identifier.From_String (Lex.Get_Lower_Case_Value),
Local_Ok);
Lex.Next;
while Lex.Get_Token = Comma loop
Lex.Next;
if Lex.Get_Token = Id then
Identifier_List.Put
(id_list, Identifier.From_String (Lex.Get_Lower_Case_Value),
Local_Ok);
if not Local_Ok then
error.sem (identifier_belong_List, Lex.Get_Lower_case_Value);
end if;
Lex.Next;
else
Local_Ok := False;
Error.Syn (Identifier, Follow_Liste_Identificateurs);
end if;
end loop;
else
Local_Ok := False;
Error.Syn (Identifier, Follow_Liste_Identificateurs);
end if;
Ok := Ok and Local_Ok;
-------------------------------
Identifier_List.Show (id_List);
-------------------------------
end Liste_Identificateurs;
procedure Liste_Messages_Erreur (Ok : in out Boolean) is
A_Sentence : Identifier.Object;
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Message loop
Lex.Next;
if Lex.Get_Token = Erreur then
Lex.Next;
if Lex.Get_Token = Right_Sentence then
Chaine (Value, Local_Ok);
if Local_Ok then
Text_Io.Put_Line ("message");
Message_Array.Put (A_Sentence, Local_Ok);
if not Local_Ok then
Local_ok:=false;
error.sem (Message, Identifier.Image (A_Sentence));
end if;
end if;
else
Local_Ok := False;
if Lex.Get_Token = Wrong_Sentence then
Error.Syn (Wrong_Sentence,
Follow_Liste_Messages_Erreur);
else
Error.Syn (Sentence, Follow_Liste_Messages_Erreur);
end if;
end if;
else
Local_Ok := False;
Error.Syn (Erreur, Follow_Liste_Messages_Erreur);
end if;
end loop;
Ok := Ok and Local_Ok;
---------------
message_array.show;
---------------------
end Liste_Messages_Erreur;
procedure Liste_Enumeres (Ok : in out Boolean) is
Enumeration_Identifier : Identifier.Object;
List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Enumere loop
Lex.Next;
Identifier_List.Free (id_list);
if Lex.Get_Token = Id then
Enumeration_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
if enumeration_array.enumeration_belong(identifier.image(enumeration_identifier)) then
local_ok:=false;
error.sem(enumeration_exist,identifier.image(enumeration_identifier));
end if;
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (id_list, Local_Ok);
if Local_Ok then
Put_Line ("enumere");
Identifier_List.Init (Iterator, List);
while not Identifier_List.Done (Iterator) loop
Enumeration_Array.Put_Literal
(Enumeration_Identifier,
Identifier_List.Value (Iterator), Local_Ok);
--if not local_ok then
-- Local_ok:=false;error.sem (literal_exist, Identifier.Image
-- (identifier_list.value(iterator))); -- est ce bien utile
--end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Liste_Enumeres);
end if;
else
Local_Ok := False;
Error.Syn (Identifier, Follow_Liste_Enumeres);
end if;
end loop;
Ok := Ok and Local_Ok;
end Liste_Enumeres;
procedure Attribut (Structure_Name : in Identifier.Object;
Ok : in out Boolean) is
Attribute_index : positive;
Enumeration_Type : Natural;
Local_Ok : Boolean := True;
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, Local_Ok);
if Lex.Get_Token = Colon then
Lex.Next;
-- pb si type base a dit que le field existait deja, valeur pourrait modifier celui qui existe deja !! ca fait rien ---puisque ca ne marchera pas !! attention a ce que valeur ne repete les memes erreurs !!
-- il peut tester le ok qu'il recoit !!
Valeur (Structure_Name, Attribute_index
Enumeration_Type, Local_Ok);
end if;
else
Local_Ok := False;
Error.Syn (En, Follow_Attribut);
end if;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Attribut);
end if;
Ok := Ok and Local_Ok;
end Attribut;
procedure Corps_Structure
(Structure_Name : in Identifier.Object; Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Attributs then
Lex.Next;
if Lex.Get_Token = Substract then
Lex.Next;
Attribut (Structure_Name, Local_Ok);
while Lex.Get_Token = Substract loop
Lex.Next;
Attribut (Structure_Name, Local_Ok);
end loop;
else
Local_Ok := False;
Error.Syn (Substract, Follow_Attribut);
end if;
end if;
Ok := Ok and Local_Ok;
end Corps_Structure;
procedure Liste_Structures (Ok : in out Boolean) is
Local_Ok : Boolean := True;
Structure_Type : Moving_String.Object;
Structure_Name : Identifier.Object;
begin
while Lex.Get_Token = Structure loop
Lex.Next;
Type_Structure (Structure_Type, Local_Ok);
if Lex.Get_Token = Colon then
Lex.Next;
if Lex.Get_Token = Id then
if local_ok then
Structure_Name := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Structure_Array.Put
(Moving_String.Image (Structure_Type), Structure_Name,local_ok);
-- si local_ok faux et struc renvoie true !!!!
end if;
Lex.Next;
Corps_Structure (Structure_Name, Local_Ok);
if Local_Ok then
Put_Line ("structure");
end if;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Liste_Structures);
end if;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Liste_Structures);
end if;
end loop;
Ok := Ok and Local_Ok;
end Liste_Structures;
procedure Champs (a_complement:in out complement.object;Ok : in out Boolean) is
Value : Moving_String.Object;
attribute_index : natural;
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Id loop
Attribute_index := field_Identifier_array.index (Lex.Get_Lower_Case_Value);
if attribute_index = 0 then
local_ok:=false;
error.sem (field_not_exist,lex.get_lower_case);
endif;
Lex.Next;
if Lex.Get_Token = Equal then
Lex.Next;
Valeur (a_complement, Attribute_index, Local_Ok);
else
Local_Ok := False;
Error.Syn (Equal, Follow_Champs);
end if;
end loop;
Ok := Ok and Local_Ok;
end Champs;
procedure Corps_Objet (a_complement: in out complement.object;Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Attributs then
Lex.Next;
Champs (a_complement,Local_Ok);
end if;
Ok := Ok and Local_Ok;
end Corps_Objet;
procedure Liste_Objets (Ok : in out Boolean) is
List : Identifier_List.Object;
iterator : identifier_list.iterator;
structure_type : moving_string.object;
a_complement : complement.object;
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Cree loop
Lex.Next;
Type_Structure (structure_type,Local_Ok);
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (id_list, Local_Ok);
Corps_Objet (a_complement,Local_Ok);
if Local_Ok then
identifier_list.init(iterator,list);
while not identifier_list.done(iterator) loop
complement_array.put(a_complement,identifier_list.value(iterator),local_ok);
--------------
-- attention si local_ok faux et put done true il ya un bug !!!!!!!!!!!
-----------------------
if not local_ok then
error.sem (complement_exist,identifier.image(identifier_list.value(iterator));
end if;
identifier_list.next(iterator);
end loop;
Put_Line ("objet");
end if;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Liste_Objets);
end if;
end loop;
Ok := Ok and Local_Ok;
end Liste_Objets;
procedure Liste_Mots (Ok : in out Boolean) is
List : Identifier_List.Object;
iterator : identifier_list.iterator;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Mots then
Lex.Next;
Liste_Identificateurs (id_list, Local_Ok);
if Local_Ok then
Put_Line ("mots");
Identifier_List.Init (Iterator, List);
while not Identifier_List.Done (Iterator) loop
complement_Array.Put_word
(Identifier_List.Value (Iterator), Local_Ok);
if not local_ok then
error.sem (word_exist, Identifier.Image
(identifier_list.value(iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
end if;
Ok := Ok and Local_Ok;
end Liste_Mots;
procedure Liens_Speciaux (Ok : in out Boolean) is
List : Identifier_List.Object;
Special_Identifier : Identifier.Object;
Iterator : Identifier_List.Iterator;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Lien then
Lex.Next;
if Lex.Get_Token = Special then
Special_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (id_list, Local_Ok);
if Local_Ok then
Put_Line ("etats liens speciaux");
Identifier_List.Init (Iterator, List);
while not Identifier_List.Done (Iterator) loop
Enumeration_Array.Put_Literal
(Special_Identifier,
Identifier_List.Value (Iterator), Local_Ok);
-- if not Local_Ok then
-- Local_ok:=false;error.sem (literal_exist, Identifier.Image
-- (identifier_list.value(iterator)));
-- end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Etats_Liens);
end if;
else
Local_Ok := False;
Error.Syn (Special, Follow_Etats_Liens);
end if;
end if;
Ok := Ok and Local_Ok;
end Liens_Speciaux;
procedure Etats_Liens (Ok : in out Boolean) is
Normal_Identifier : Identifier.Object;
List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Lien then
Lex.Next;
if Lex.Get_Token = Normal then
An_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
Lex.Next;
if Lex.Get_Token = Colon then
Lex.Next;
Liste_Identificateurs (id_list, Local_Ok);
if Local_Ok then
Put_Line ("etats liens normaux");
Identifier_List.Init (Iterator, List);
while not Identifier_List.Done (Iterator) loop
Enumeration_Array.Put_Literal
(normal_Identifier,
Identifier_List.Value (Iterator), Local_Ok);
-- if not Local_Ok then
-- Local_ok:=false;error.sem (literal_exist, Identifier.Image
-- (identifier_list.value(iterator)));
-- end if;
Identifier_List.Next (Iterator);
end loop;
end if;
Liens_Speciaux (Local_Ok);
else
Local_Ok := False;
Error.Syn (Colon, Follow_Etats_Liens);
end if;
else
Local_Ok := False;
Error.Syn (Normal, Follow_Etats_Liens);
end if;
end if;
Ok := Ok and Local_Ok;
end Etats_Liens;
procedure Synonymes (id_list : in out Identifier_List.Object;
Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Ou then
Lex.Next;
Liste_Identificateurs (id_list, Local_Ok);
end if;
Ok := Ok and Local_Ok;
end Synonymes;
procedure Liste_Verbes (Ok : in out Boolean) is
List : Identifier_List.Object;
verb_identifier : identifier.object;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Verbes then
Lex.Next;
Put_Line ("liste_verbes");
while Lex.Get_Token = Id loop
verb_identifier:=identifier.from_string(lex.get_lower_case_value);
Lex.Next;
identifier_list.free(id_list);
Synonymes (id_list, Local_Ok);
if local_ok then
Put_Line ("verbe");
Identifier_List.Init (Iterator, List);
while not Identifier_List.Done (Iterator) loop
complement_Array.Put_verb (identifier_list.value(iterator),verb_identifier, Local_Ok);
if not Local_Ok then
error.sem (verb_exist, Identifier.Image
(Identifier_List.Value
(Iterator)));
end if;
Identifier_List.Next (Iterator);
end loop;
end if;
end loop;
end if;
Ok := Ok and Local_Ok;
end Liste_Verbes;
procedure Lieu (place_index,direction_index : out natural;Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Id then
if complement_array.belong(lex.get_lower_case_value) then
place_index := complement_array.index(lex.get_lower_case_value);
else
local_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
direction_index := complement_array.index(lex.get_lower_case_value);
else
local_ok := false;
error.sem(complement_not_exist,lex.get_lower_case_value);
end if;
Lex.Next;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Lier_Lieux);
end if;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Lier_Lieux);
end if;
Ok := Ok and Local_Ok;
end Lieu;
procedure Moyen (enumeration_type,literal_index,exit_name_index:out natural;Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
enumeration_type:=enumeration_array.enumeration("normal");
literal_index:=0;
if Lex.Get_Token = Par then
Lex.Next;
if Lex.Get_Token = Id then
if complement_array.belong(lex.get_lower_case_value) then
exit_name_index := complement_array.index(lex.get_lower_case_value);
else
local_ok := false;
error.sem(complement_not_exist,lex.get_lower_case_value);
end if;
Lex.Next;
if Lex.Get_Token = Id then
if enumeration_array.literal_belong(enumeration_type,lex.get_lower_case_value);
literal_index := enumeration_array.literal(enumeration_type,lex.get_lower_case_value);
else if
enumeration_type:=enumeration_array.enumeration("special");
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);
else
local_ok:=false;
error.sem (literal_not_belong,lex.get_lower_case_value);
end if;
Lex.Next;
end if;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Lier_Lieux);
end if;
else
Local_Ok := False;
Error.Syn (Par, Follow_Lier_Lieux);
end if;
Ok := Ok and Local_Ok;
end Moyen;
procedure Lier_Lieux (Ok : in out Boolean) is
first_place_index,first_direction_index,second_place_index,second_direction_index,
exit_name_index,enumeration_type,literal_index,field_index: natural;
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Lie loop
Lex.Next;
Lieu (first_place_index,first_direction_index,Local_Ok);
if Lex.Get_Token = A then
Lex.Next;
Lieu (second_place_index,second_direction_index,Local_Ok);
Moyen (enumeration_type,literal_index,exit_name_index,Local_Ok);
if Local_Ok then
Put_Line ("lien");
-- faire les verifications d'usage \= 0 !!
complement_array.put_exit(first_place_index,exit_name_index,first_place_index,first_direction_index,
second_place_index,second_direction_index,local_ok);
if local_ok then
complement_array.put_exit(second_place_index,exit_name_index,second_place_index,
second_direction_index,first_place_index,first_direction_index,local_ok);
if local_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,local_ok);
if local_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,local_ok);
if local_ok then
complement_array.field_put_enumerate(second_place_index,field_index,enumeration_type,
literal_index,local_ok);
else
local_ok:=false;
error.sem(field_belong,field_identifier_array.image(field_index);
end if;
else
local_ok:=false;
error.sem(field_belong,field_identifier_array.image(field_index);
end if;
else
local_ok:=false;
error.sem(exit,complement_array.name(second_place_index));
end if;
else
local_ok:=false;
error.sem(exit,complement_array.name(fisrt_place_index));
end if;
end if;
else
Local_Ok := False;
Error.Syn (A, Follow_Lier_Lieux);
end if;
end loop;
Ok := Ok and Local_Ok;
end Lier_Lieux;
procedure Liste_Groupes (Ok : in out Boolean) is
List : Identifier_List.Object;
Iterator : Identifier_List.Iterator;
complement_Index : Natural;
Group_Identifier : Identifier.Object;
Local_Ok : Boolean := True;
begin
while Lex.Get_Token = Groupe loop
Lex.Next;
if Lex.Get_Token = Id then
Group_Identifier := Identifier.From_String
(Lex.Get_Lower_Case_Value);
if complement_array.belong(lex.get_lower_case_value) then
local_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, Local_Ok);
if Local_Ok then
Put_Line ("groupe");
Identifier_List.Init (Iterator, List);
while not Identifier_List.Done (Iterator) loop
if complement_array.belong(identifier.image(identifier_list.value(iterator))) then
complement_Index := Complement_Array.Index
(Identifier.Image
(Identifier_List.Value (Iterator)));
Group_Array.Put (Group_Identifier, complement_Index, Local_Ok);
else
local_ok:=false;
error.sem(complement_not_exist,identifier.image(identifier_list.value(iterator)));
end if;
-- tester si meme type ou si ce sont tous des sujets !!
--if not Local_Ok then
-- Local_ok:=false;error.sem (Subject_exist_in_group, Identifier.Image -- est ce bien --utile ?
-- (Identifier_List.Value
-- (Iterator)));
-- end if;
Identifier_List.Next (Iterator);
end loop;
end if;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Liste_Groupes);
end if;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Liste_Groupes);
end if;
end loop;
Ok := Ok and Local_Ok;
end Liste_Groupes;
procedure Mouvement (animate_index:in natural;Ok : in out Boolean) is
Local_Ok : Boolean := True;
place_index,number_of_repeat : natural;
begin
if Lex.Get_Token = Id then
if complement_array.belong(lex.get_lower_case_value) then
place_index := complement_array.index(lex.get_lower_case_value);
if not complement_array.is_a_place(place_index) then
local_ok:=false;
error.sem (complement_not_a_place,complement_array.name(place_index);
end if;
else
local_ok:=false;
error.sem (complement_not_exist,lex.get_lower_case_value);
end if;
Lex.next;
if Lex.Get_Token = Colon then
Lex.Next;
if Lex.Get_Token = Number then
number_of_repeat := natural'image(lex.get_lower_case_value);
Lex.Next;
if number_of_repeat \=0 then
if complement_array.is_an_animate(animate_index) and complement_array.is_a_place(place_index) then
for i in 1 .. number_of _repeat loop
complement_array.put_movement(animate_index,place_index);
end loop;
end if;
else
local_ok:=false;
error.sem(number_of_repeat_null,"");
end if;
end if;
end if;
end if;
else
Local_Ok := False;
Error.Syn (Number, Follow_Mouvement);
end if;
end if;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Mouvement);
end if;
Ok := Ok and Local_Ok;
end Mouvement;
procedure Mouvements (animate_index: in natural;Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
Mouvement (animate_index,Local_Ok);
while Lex.Get_Token = Comma loop
Lex.Next;
Mouvement (animate_index,Local_Ok);
end loop;
Ok := Ok and Local_Ok;
end Mouvements;
procedure Liste_Itineraire (Ok : in out Boolean) is
animate_index : natural;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Itineraire then
Lex.Next;
if lex.get_token = id then
if complement_array.belong(lex.get_lower_case_value) then
animate_index := complement_array.index(lex.get_lower_case_value);
if not complement_array.is_an_animate(animate_index) then
local_ok:=false;
error.sem (complement_not_an_animate,complement_array.image(animate_index));
end if;
else
local_ok:=false;
error.sem(complement_not_exist,lex.get_lower_case_value);
end if;
lex.next;
if Lex.Get_Token = Equal then
Lex.Next;
Mouvements (animate_index,Local_Ok);
else
Local_Ok := False;
Error.Syn (Equal, Follow_Liste_Objets);
else
local := false;
Error.Syn (identifier, Follow_Liste_objets);
end if;
end if;
Ok := Ok and Local_Ok;
end Itineraire;
--procedure complement_detail (a_detail : in detail.object;a_complement : in string;ok : out boolean) is
--local_ok : boolean := true;
--begin
--if complement_array.belong(a_complement) then
--detail.create_real_complement(a_detail,complement_array.index(a_complement));
--elsif group_array.belong(a_complement) then
--detail.create_group_complement(a_detail,order_list.complement_position(a_complement));.
--else
--local_ok := false;
--error.sem (neither_a_complement_nor_a_group,a_complement);
--end if;
--ok :=Ok and Local_Ok;
--end detail;
--procedure field_detail (a_detail : in detail.object;a_field:in string;ok : out boolean) is
--local_ok : boolean := true;
--begin
--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
--local_ok := false;
--error.sem (neither_a_field_nor_a_group,a_field);
--end if;
--ok := local_ok &
--end;
procedure Instructions_Simples (Ok : in out Boolean);
--procedure Instructions_Simples (ins_list : in out instruction_list.object;Ok : in out Boolean);
procedure Expression (Ok : in out Boolean);
--procedure Expression (an_expression: in out expression.object;
--enumeration_type : in natural;Ok : in out Boolean);
procedure Facteur (Ok : in out Boolean) is
--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;
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Opening_Bracket =>
Lex.Next;
Expression (Local_Ok);
--Expression (an_expression,enumeration_type,Local_Ok);
if Lex.Get_Token = Closing_Bracket then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Closing_Bracket, Follow_Facteur);
end if;
when Id =>
--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),local_ok );
Objet (Local_Ok);
--Objet (an_objet,Local_Ok);
--if local_ok then
--attribute.put(an_attribute,an_objet,a_detail);
--expression.create(an_expression,an_attribute);
--end if;
--else
--if enumeration.literal_belong(enumaration_type,
--moving_string(an_identifier)) then
--expression.create(an_expression,enumeration_type,
--enumeration_array.literal(enumeration_type,
--moving_string(an_identifier));
--else
--error.sem (literal_not_exist,moving_string(an_identifier));
--end if;
--probleme
end if;
when Number =>
--expression.create(an_expression,integer'value(lex.get_lower_case_value);
Lex.Next;
when others =>
Local_Ok := False;
Error.Syn (Facteur, Follow_Facteur);
end case;
Ok := Ok and Local_Ok;
end Facteur;
procedure Terme (Ok : in out Boolean) is
--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;
Local_Ok : Boolean := True;
begin
Facteur (Local_Ok);
--facteur(an_expression,Local_Ok);
while First_Terme (Lex.Get_Token) loop
case Lex.Get_Token is
when Multiply =>
Lex.Next;
Facteur (Local_Ok);
--facteur(left_expression,Local_Ok);
--expression.create(an_expression,'*',an_expression,left_expression,local_ok);
--if not local_ok then
--error.sem(expression_not_same_type,"");
-- end if;
when Divide =>
Lex.Next;
Facteur (Local_Ok);
--facteur(left_expression,Local_Ok);
--expression.create(an_expression,'/',an_expression,left_expression,local_ok);
--if not local_ok then
--error.sem(expression_not_same_type,"");
--end if;
when others =>
null;
end case;
end loop;
Ok := Ok and Local_Ok;
end Terme;
procedure Expression (Ok : in out Boolean) is
--procedure 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;
Local_Ok : Boolean := True;
begin
Terme (Local_Ok);
--Terme (an_expression,Local_Ok);
while First_Expression (Lex.Get_Token) loop
case Lex.Get_Token is
when Add=>
Lex.Next;
Terme (Local_Ok);
--Terme (left_expression,Local_Ok);
--expression.create(an_expression,'+',an_expression,left_expression,local_ok);
--if not local_ok then
--error.sem(expression_not_same_type,"");
--end if;
when Substract =>
Lex.Next;
Terme (Local_Ok);
--Terme (left_expression,Local_Ok);
--expression.create(an_expression,'-',an_expression,left_expression,local_ok);
--if not local_ok then
--error.sem(expression_not_same_type,"");
--end if;
when others =>
null;
end case;
end loop;
Ok := Ok and Local_Ok;
end Expression;
procedure Tests (Ok : in out Boolean) is
--procedure tests (a_condition: out condition.object;an_attribute: in attribute.object;
--enumeration_type;Ok : in out Boolean) is
--an_expression : expression.object;
Local_Ok : Boolean := True;
begin
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);
null;
end if;
when equal|not_equal =>
Expression (Local_Ok);
--Expression (an_expression,enumeration_type,Local_Ok);
--if local_ok then
--condition.create_compare(a_condition,an_attribute,
--compare_kind'value(token'image(lex.get_token)),an_expression,local_ok);
-- tenir compte du local_ok
--end if;
lex.next;
when Less|Greater |Greater_Equal |Less_Equal =>
Expression (Local_Ok);
--Expression (an_expression,enumeration_type,Local_Ok);
--if local_ok then
--condition.create_compare(a_condition,an_attribute,
--compare_kind'value(token'image(lex.get_token)),an_expression,local_ok);
-- tenir compte du local_ok
--end if;
lex.next;
when others =>
Local_Ok := False;
Error.Syn (Tests, Follow_Suite_Condition_Forte);
end case;
Ok := Ok and Local_Ok;
end Tests;
procedure Suite_Condition_Forte (Ok : in out Boolean) is
--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
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when De =>
--procedure field_detail (a_detail,moving_string.image(an_identifier),local_ok );
Lex.Next;
Objet (Local_Ok);
--Objet (an_objet,Local_Ok);
--if local_ok then
--attribute.put(an_attribute,an_objet,a_detail);
--end if;
--Tests(a_condition,an_attribute,
--attribute.enumeration(an_attribute),Local_Ok);
Tests (local_ok);
when Appartient =>
Lex.Next;
--complement_detail (a_detail,moving_string.image(an_identifier),local_ok );
if Lex.Get_Token = Pas then
--a_binary_kind := no;
lex.next;
else
--a_binary_kind := yes
null;
end if;
if Lex.Get_Token = A then
Lex.Next;
Objet (Local_Ok);
--Objet (an_objet,Local_Ok);
--if local_ok then
--condition.create_belong(a_condition,an_objet,a_detail,a_binary_kind));
--end if;
else
Local_Ok := False;
Error.Syn (A, Follow_Suite_Condition_Forte);
end if;
when Existe =>
Lex.Next;
--complement_detail (a_detail,moving_string.image(an_identifier),local_ok );
if Lex.Get_Token = Pas then
--a_binary_kind := no;
lex.next;
else
null;
--a_binary_kinf := yes;
end if;
--if local_ok then
--condition.create_subject_exist(a_condition,a_detail,a_binary_kind);
--end if;
when others =>
Local_Ok := False;
Error.Syn (Suite_Condition_Forte, Follow_Suite_Condition_Forte);
end case;
Ok := Ok and Local_Ok;
end Suite_Condition_Forte;
procedure Condition_Forte (Ok : in out Boolean) is
--procedure Condition_forte (a_condition: in out condition.object;Ok : in out Boolean) is
--an_objet : objet.object;
--a_number : integer;
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Id =>
Lex.Next;
Suite_Condition_Forte (Local_Ok);
--Suite_Condition_Forte (a_condition,lex.get_lower_case_value,Local_Ok);
when Heros =>
Lex.Next;
if Lex.Get_Token = Equal then
Lex.Next;
if Lex.Get_Token = Id then
--procedure complement_detail (a_detail,lex.get_lower_case_value,local_ok );
--if local_ok then
-- condition.create_hero(a_condition,a_detail);
--end if;
Lex.Next;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Condition_Forte);
end if;
else
Local_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
--procedure complement_detail (a_detail,lex.get_lower_case_value,local_ok );
--if local_ok then
--condition.create_place(a_condition,a_detail);
--end if;
Lex.Next;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Condition_Forte);
end if;
else
Local_Ok := False;
Error.Syn (Equal, Follow_Condition_Forte);
end if;
when Number =>
--a_number:= integer'value(lex.get_lower_case_value);
--if number = 0 then
--error.sem (number_of_actions_null,"");
--else
--condition.create_actions(a_condition,a_number);
--end if;
Lex.Next;
if Lex.Get_Token = Actions then
Lex.Next;
if Lex.Get_Token = Passees then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Passees, Follow_Condition_Forte);
end if;
else
Local_Ok := False;
Error.Syn (Actions, Follow_Condition_Forte);
end if;
when Rencontre =>
Lex.Next;
if Lex.Get_Token = Id then
--procedure complement_detail (a_detail,lex.get_lower_case_value,local_ok );
--if local_ok then
-- condition.create_meet(a_condition,a_detail);
--end if;
Lex.Next;
else
Local_Ok := False;
Error.Syn (identifier, 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_array.belong(lex.get_lower_case_value) then
--objet.create_group(an_objet,order_list.complement_position(lex.get_lower_case_value));
--else
--local_ok := false;
--error.sem (neither_a_place_nor_a_group,lex.get_lower_case_value);
--end if;
Lex.Next;
elsif Lex.Get_Token = lieu the
--objet.create_place(an_objet);
Lex.Next;
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);
null;
end if;
else
Local_Ok := False;
Error.Syn (Existe, Follow_Condition_Forte);
end if;
else
Local_Ok := False;
Error.Syn (identifier_place, Follow_Condition_Forte);
end if;
else
Local_Ok := False;
Error.Syn (De, Follow_Condition_Forte);
end if;
when others =>
Local_Ok := False;
Error.Syn (Condition_Forte, Follow_Condition_Forte);
end case;
Ok := Ok and Local_Ok;
end Condition_Forte;
procedure Condition_Faible (Ok : in out Boolean) is
--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;
Local_Ok : Boolean := True;
begin
Condition_Forte (Local_Ok);
--Condition_Fort (a_condition,Local_Ok);
while First_Condition_Faible (Lex.Get_Token) loop -- a simplifier
case Lex.Get_Token is
when Et =>
Lex.Next;
Condition_Forte (Local_Ok);
--Condition_Forte (left_condition,Local_Ok);
--Condition.create (a_condition,et,a_condition,left_condition);
when others =>
null;
end case;
end loop;
Ok := Ok and Local_Ok;
end Condition_Faible;
procedure Condition (Ok : in out Boolean) is
--procedure 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);
-- ou ou bien et ?????
--left_condition : condition.object;
Local_Ok : Boolean := True;
begin
Condition_Faible (Local_Ok);
--Condition_Faible (a_condition,Local_Ok);
while First_Condition (Lex.Get_Token) loop -- a simplifier
case Lex.Get_Token is
when Ou =>
Lex.Next;
Condition_Faible (Local_Ok);
--Condition_Faible (left_condition,Local_Ok);
--Condition.create (a_condition,ou,a_condition,left_condition);
when others =>
null;
end case;
end loop;
Ok := Ok and Local_Ok
end Condition;
procedure Si (Ok : in out Boolean) is
--procedure Si (ins_list: in out instruction_list.object;Ok : in out Boolean) is
--right_list,wrong_list : instruction_list_list;object;
-- peut etre mettre un := null_object;
--a_condition : condition.object;
Local_Ok : Boolean := True;
begin
Condition (Local_Ok);
--Condition (a_condition,Local_Ok);
if Lex.Get_Token = Alors then
Lex.Next;
--Put_Line ("alors detecte");
Instructions_Simples (Local_Ok);
--Instructions_Simples (right_list,Local_Ok);
--Put_Line ("sinon possible");
if Lex.Get_Token = Sinon then
--Put_Line ("sinon detecte");
Lex.Next;
--Instructions_Simples (wrong_list,Local_Ok);
Instructions_Simples (Local_Ok);
end if;
--instruction_list.insert_if(ins_list,a_condition,right_list,wrong_list);
--Put_Line ("fin de sinon");
if Lex.Get_Token = Fin then
Lex.Next;
if Lex.Get_Token = Si then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Si, Follow_Instruction_Simple);
end if;
else
Local_Ok := False;
Error.Syn (Fin, Follow_Instruction_Simple);
end if;
else
Local_Ok := False;
Error.Syn (Alors, Follow_Instruction_Simple);
end if;
Ok := Ok and Local_Ok;
end Si;
procedure Change (Ok : in out Boolean) is
--procedure Change (ins_list: in out instruction_list.object;Ok : in out Boolean) is
--an_affectation : affectation.object;
--an_expression : expression.object;
--an_objet : objet.object;
--a_detail : detail.object;
Local_Ok : Boolean := True;
begin
case Lex.Get_Token is
when Id =>
--procedure field_detail (a_detail ,lex.get_lower_case_value,local_ok );
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
Objet (Local_Ok);
--objet (an_objet,Local_Ok);
-- if local_ok then
--attribute.put(an_attribute,an_objet,a_detail);
--end if;
if Lex.Get_Token = En then
Lex.Next;
Expression (Local_Ok);
--Expression (an_expression,
--attribute.enumeration(an_attribute),Local_Ok);
--if local_ok then
--affectation.create_attribute(an_affectation,an_attribute,an_expression);
--instruction_list.insert_change(ins_list,an_affectation);
--end if;
else
Local_Ok := False;
Error.Syn (En, Follow_Instruction_Simple);
end if;
else
Local_Ok := False;
Error.Syn (De, Follow_Instruction_Simple);
end if;
when heros =>
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,local_ok );
--if local_ok then
--affectation.create_hero(an_affectation,a_detail);
--instruction_list.insert_change(ins_list,an_affectation);
--end if;
Lex.Next;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Instruction_Simple);
end if;
else
Local_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
--procedure complement_detail (a_detail,lex.get_lower_case_value,local_ok );
--if local_ok then
--affectation.create_place(an_affectation,a_detail);
--instruction_list.insert_change(ins_list,an_affectation);
--end if;
Lex.Next;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Instruction_Simple);
end if;
else
Local_Ok := False;
Error.Syn (En, Follow_Instruction_Simple);
end if;
when others =>
Local_Ok := False;
Error.Syn (Change, Follow_Instruction_Simple);
end case;
Ok := Ok and Local_Ok;
end Change;
procedure Quoi_Afficher (Ok : in out Boolean) is
--procedure Quoi_Afficher (a_view:out view.object;Ok : in out Boolean) is
--an_objet : objet.object;
--a_detail : detail.object;
Local_Ok : Boolean := True;
begin
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 =>
Local_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,local_ok );
Lex.Next;
if Lex.Get_Token = De then
Lex.Next;
Objet (Local_Ok);
--Objet (an_objet,Local_Ok);
--if local_ok then
--attribute.put(an_attribute,an_objet,a_detail);
--view.create_attribute(a_view,an_attribute);
--end if;
end if;
when nom =>
lex.next
if Lex.Get_Token = de then
Lex.Next;
objet(local_ok);
--objet(an_objet,local_ok);
--if local_ok then
--view.create_name(a_view,an_objet);
--end if;
else
Local_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,local_ok );
--if local_ok then
--view.create_exit(a_view,a_detail);
--end if;
Lex.Next;
else
Local_Ok := False;
Error.Syn (identifier, 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 (Local_Ok);
--Objet (an_objet,Local_Ok);
--if local_ok then
--view.create_contents(a_view,an_objet);
-- end if;
else
Local_Ok := False;
Error.Syn (De, Follow_Quoi_Afficher);
end if;
when others =>
Local_Ok := False;
Error.Syn (Quoi_Afficher, Follow_Quoi_Afficher);
end case;
Ok := Ok and Local_Ok;
end Quoi_Afficher;
procedure Liste_Affiche (Ok : in out Boolean) is
--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;
Local_Ok : Boolean := True;
begin
Quoi_Afficher (Local_Ok);
--Quoi_Afficher (a_view,Local_Ok);
--if local_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 (Local_Ok);
--quoi_Afficher (a_view,Local_Ok);
--if local_ok then
--view_list.put(display_list,a_view);
--end if;
when others =>
null;
end case;
end loop;
Ok := Ok and Local_Ok;
end Liste_Affiche;
procedure Ligne (Ok : in out Boolean) is
--procedure Ligne (ins_list: in out instruction_list.object;Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Suivante then
Lex.Next;
--instruction_list.insert_next_line(ins_list);
else
Local_Ok := False;
Error.Syn (Suivante, Follow_Instruction_Simple);
end if;
Ok := Ok and Local_Ok;
end Ligne;
procedure Bouge (Ok : in out Boolean) is
--procedure Bouge (ins_list: in out instruction_list.object;Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Anime then
Lex.Next;
--instruction_list.insert_move(ins_list);
else
Local_Ok := False;
Error.Syn (Anime, Follow_Instruction_Simple);
end if;
Ok := Ok and Local_Ok;
end Bouge;
--procedure instruction_put(ins_list: in out instruction_list.object;
--id_list:in identifier_list.object;an_objet : objet.object;ok : out boolean) is
--an_iterator: identifier_list.iterator;
--ind_list: index_list.object;
--local_ok : boolean := true;
--begin
--identifier.init(an_iterator,id_list);
--while not identifier_list.done(an_iterator) loop
--if complement_array.belong(identifier.image(identifier_list.value(an_iterator))) then
--if complement_array.is_an_entity(identifier.image(identifier_list.value(an_iterator)))
--or complement_array.is_an_animate(identifier.image(identifier_list.value(an_iterator))) then
--index_list.put(ind_list,complement_array.index(identifier.image(identifier_list.value(an_iterator));
--else
--local_ok := false;
--error.sem (complement_not_entity_or_animate,identifier.image(identifier_list.value(an_iterator)));
--end if;
--else
--local_ok := false;
--error.sem (complement_not_exist,identifier.image(identifier_list.value(an_iterator)));
--end if;
--identifier_list.next(an_iterator);
--end loop;
--instruction_list.insert_put(ins_list,ind_list,an_objet);
ok := ok and local_ok;
--end;
procedure Positionne (Ok : in out Boolean) is
--procedure Positionne (ins_list: in out instruction_list.object;Ok : in out Boolean) is
id_List : Identifier_List.Object;
an_iterator: identifier_list.iterator;
--ind_list: index_list.object;
--an_objet : objet.object;
Local_Ok : Boolean := True;
begin
Liste_Identificateurs (id_List, Local_Ok);
if Lex.Get_Token = A then
Lex.Next;
Objet (Local_Ok);
--objet (an_objet,local_ok);
-- if local_ok then
--instruction_put(ins_list,id_list,an_objet);
--end if;
else
Local_Ok := False;
Error.Syn (Dans, Follow_Instruction_Simple);
end if;
Ok := Ok and Local_Ok;
end Positionne;
procedure va (Ok : in out Boolean) is
--procedure va (ins_list : in out instruction_list.object;Ok : in out Boolean) is
--a_detail: detail.object;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Vers then
Lex.Next;
if Lex.Get_Token = Id then
--complement_detail (a_detail,lex.get_lower_case_value,local_ok);
--if local_ok then
--instruction_list.insert_go(ins_list,a_detail);
--end if;
Lex.Next;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Instruction_Simple);
end if;
else
Local_Ok := False;
Error.Syn (Vers, Follow_Instruction_Simple);
end if;
Ok := Ok and Local_Ok;
end Va;
procedure Instructions_Simples (Ok : in out Boolean) is
--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);
id_list: Identifier_List.Object;
display_list : view_list.object;
Local_Ok : Boolean := True;
--instructions simples peut etre vide !!!!!!!
begin
while First_Instructions_Simples (Lex.Get_Token) loop
case Lex.Get_Token is
when Si =>
Lex.Next;
Si (Local_Ok);
--si(ins_list,local_ok);
when Change =>
Lex.Next;
Change (Local_Ok);
--change(ins_list,local_ok);
when Affiche =>
Lex.Next;
Liste_Affiche (Local_Ok);
--liste_affiche(ins_list,local_ok);
when Ligne =>
Lex.Next;
Ligne (Local_Ok);
--Ligne (ins_list,Local_Ok);
when Bouge =>
Lex.Next;
Bouge (Local_Ok);
--Bouge (ins_list,Local_Ok);
when Positionne =>
Lex.Next;
Positionne (Local_Ok);
--Positionne (ins_list,Local_Ok);
when Retire =>
Lex.Next;
Liste_Identificateurs (id_List, Local_Ok);
--instruction_put(ins_list,id_list,objet.null_object);
when Termine =>
Lex.Next;
--instruction_list.insert_stop(ins_list);
when Va =>
Lex.Next;
va (local_ok);
--Va (ins_list,Local_Ok);
when Efface =>
Lex.Next;
--instruction_list.insert_erase(ins_list);
when others =>
null;
Put_Line ("fin instructions simples");
end case;
end loop;
Ok := Ok and Local_Ok;
end Instructions_Simples;
procedure Description_Ordre (Ok : in out Boolean) is
--procedure Description_Ordre (an_order : out order.object;Ok : in out Boolean) is
-- peut etre in out ?????
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Id then
--order.put_first_complement(an_order,lex.get_lower_case_value);
Lex.Next;
if Lex.Get_Token = Id then
--order.put_second_complement(an_order,lex.get_lower_case_value);
Lex.Next;
end if;
if Lex.Get_Token = Id then
--order.put_third_complement(an_order,lex.get_lower_case_value);
Lex.Next;
end if;
if Lex.Get_Token = Id then
--order.put_fourth_complement(an_order,lex.get_lower_case_value);
Lex.Next;
end if;
if Lex.Get_Token = Id then
Local_Ok := False;
Error.Syn (too_many_complements, Follow_Ordre);
end if;
else
Local_Ok := False;
Error.Syn (identifier, Follow_Ordre);
end if;
Ok := Ok and Local_Ok;
end Description_Ordre;
procedure liste_description_ordre(ok: out boolean) is
--an_order : order.object;
local_ok : boolean := true;
begin
--order_list.free;
Description_Ordre (Local_Ok);
--Description_Ordre (an_order,Local_Ok);
--order_list.put(an_order,local_ok);
--if not local_ok then
--error.sem (order_exist,order.image(an_order));
--end if;
while Lex.Get_Token = Comma loop
Lex.Next;
Description_Ordre (Local_Ok);
--Description_Ordre (an_order,Local_Ok);
--order_list.put (an_order,local_ok);
--if not local_ok then
--error.sem (order_exist,order.image(an_order));
--end if;
end loop;
ok := ok and local_ok;
end;
--procedure fill_coded_order_array(ins_list : in instruction_list.object;
--a_place : in string) is
--an_order : order.object;
--begin
--order_list.init;
--while not order_list.done loop
--an_order := order_list.value;
--order_array.put_place(a_place);
--order_array.put_first_complement(order.complement
--(an_order,1));
--order_array.put_second_complement(order.complement
--(an_order,2));
--order_array.put_third_complement(order.complement
--(an_order,3));
--order_array.put_fourth_complement(order.complement
--(an_order,4));
--order_array.init;
--while not order_array.done loop
--an_order := (order_array.value);
--order.put_instruction(an_order,ins_list);
--order_array.put(an_order);
--order_array.next;
--end loop;
--order_list.next;
--end loop;
--end;
procedure Ordre (Ok : in out Boolean) is
--procedure Ordre (Ok : in out Boolean) is
--ins_list,common_ins_list : instruction.object;
a_place : moving_string.object;
Local_Ok : Boolean := True;
begin
liste_description_ordre(local_ok);
if Lex.Get_Token = Colon then
Lex.Next;
--Instructions_Simples (comon_ins_list,Local_Ok);
Instructions_Simples (Local_Ok);
if lex.get_token = pour then
Lex.Next;
if Lex.Get_Token = Id then
a_place := lex.get_lower_case_value;
Lex.Next;
Instructions_Simples (Local_Ok);
--copy(common_ins_list,ins_list);
--Instructions_Simples (ins_list,Local_Ok);
--fill_order_array(ins_list,moving_string.image(a_place));
else
Local_Ok := False;
Error.Syn (identifier, Follow_Ordre);
end if;
while Lex.Get_Token = Pour loop
Lex.Next;
if Lex.Get_Token = Id then
a_place := lex.get_lower_case_value;
Lex.Next;
Instructions_Simples (Local_Ok);
--copy(common_ins_list,ins_list);
--Instructions_Simples (ins_list,Local_Ok);
--fill_order_array(ins_list,moving_string.image(a_place));
else
Local_Ok := False;
Error.Syn (identifier, Follow_Ordre);
end if;
end loop;
if lex.get_token = ailleurs then
Lex.Next;
Instructions_Simples (Local_Ok);
--copy (common_ins_list,ins_list);
--Instructions_Simples (ins_list,Local_Ok);
--fill_order_array(ins_list,"ailleurs");
end if;
else
Instructions_Simples (Local_Ok);
--copy(common_ins_list,ins_list);
--Instructions_Simples (ins_list,Local_Ok);
--fill_order_array(ins_list,ailleurs));
end if;
else
Local_Ok := False;
Error.Syn (Colon, Follow_Ordre);
end if;
if Local_Ok then
Put_Line ("ordre");
end if;
Ok := Ok and Local_Ok;
end Ordre;
procedure Fin_Quand (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Fin then
Lex.Next;
if Lex.Get_Token = Quand then
Lex.Next;
else
Local_Ok := False;
Error.Syn (Quand, Follow_Quand_Ordre);
end if;
else
Local_Ok := False;
Error.Syn (Fin, Follow_Quand_Ordre);
end if;
Ok := Ok and Local_Ok;
end Fin_Quand;
procedure Quand_Ordre (Ok : in out Boolean) is
--ins_list : instruction_list.object;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Quand then
Lex.Next;
if Lex.Get_Token = Ordre then
Lex.Next;
if Lex.Get_Token = Vaut then
Lex.Next;
if Lex.Get_Token = Substract then
Lex.Next;
Ordre (Local_Ok);
while Lex.Get_Token = Substract loop
Lex.Next;
Ordre (Local_Ok);
end loop;
Fin_Quand (Local_Ok);
if Local_Ok then
Put_Line ("quand_ordre correct");
end if;
else
Local_Ok := False;
Error.Syn (Substract, Follow_Ordre);
end if;
else
Local_Ok := False;
Error.Syn (Vaut, Follow_Quand_Ordre);
end if;
else
Local_Ok := False;
Error.Syn (Ordre, Follow_Quand_Ordre);
end if;
else
Local_Ok := False;
Error.Syn (Quand, Follow_Quand_Ordre);
end if;
Ok := Ok and Local_Ok;
end Quand_Ordre;
procedure Creation_Monde (Ok : in out Boolean) is
Local_Ok : Boolean := True;
--[declaration]
begin
Put_Line ("Lecture de la zone de creation ...");
while Lex.Get_Token in States and Lex.Get_Token >= In_Progress loop
case In_Progress is
when Message =>
Liste_Messages_Erreur (Local_Ok);
when Enumere =>
Liste_Enumeres (Local_Ok);
when Lien =>
Etats_Liens (Local_Ok);
when Verbes =>
Liste_Verbes (Local_Ok);
when Mots =>
Liste_Mots (Local_Ok);
when Structure =>
Liste_Structures (Local_Ok);
when Cree =>
Liste_Objets (Local_Ok);
when Lie =>
Lier_Lieux (Local_Ok);
when Liste_itineraire =>
liste_itineraires(local_ok);
when Groupe =>
Liste_Groupes (Local_Ok);
when others =>
exit;
end case;
In_Progress := States'Succ (In_Progress);
end loop;
if not Lex.Is_At_End then
Put_Line ("in_progress : " & Token'Image (In_Progress));
end if;
Ok := Ok and Local_Ok;
end Creation_Monde;
procedure Scenario (Ok : in out Boolean) is
--ins_list : instruction_list.object;
Local_Ok : Boolean := True;
begin
if Lex.Get_Token = Introduction then
Lex.Next;
Put_Line ("Lecture de la zone d'introduction ...");
Instructions_Simples (Local_Ok);
--Instructions_Simples (ins_list,Local_Ok);
--introduction_instructions.put(ins_list);
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,Local_Ok);
--pre_order_instructions.put(ins_list);
Instructions_Simples (Local_Ok);
Quand_Ordre (Local_Ok);
--ins_list := instruction_list.null_object;
--Instructions_Simples (ins_list,Local_Ok);
--post_order_instructions.put(ins_list);
Instructions_Simples (Local_Ok);
end if;
Ok := Ok and Local_Ok;
end Scenario;
procedure Jeu_Aventure (Ok : in out Boolean) is
Local_Ok : Boolean := True;
begin
loop
Creation_Monde (Local_Ok);
Scenario (Local_Ok);
if not Lex.Is_At_End then
Local_Ok := False;
-- Put_Line ("not at end");
Error.Syn (Jeu_Aventure, Follow_Jeu_Aventure);
else
exit;
end if;
Put_Line ("redemarrage");
end loop;
Ok := Ok and Local_Ok;
end Jeu_Aventure;
procedure Start is
Local_Ok : Boolean := True;
begin
Lex.Initialize;
Jeu_Aventure (Local_Ok);
if Local_Ok then
Put_Line ("Program is Ok");
else
Put_Line ("Program is false");
end if;
Message_Array.Show;
Enumeration_Array.Show;
complement_array.show;
field_identifier_array.show;
Group_Array.Show;
end Start;
end Syn;