|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 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;