|
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: 45927 (0xb367) 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« └─⟦3903f22e3⟧ └─⟦this⟧
with Text_Io, Lex, Error, Moving_String, Group_Array, Enumeration_Array, Message_Array, Complement_Identifier_Array, Exclusive_Generic_List, Identifier; use Text_Io, Moving_String; package body Syn is use Lex.Visible, Error.Visible; package Identifier_List is new Exclusive_Generic_List (Element => Identifier.Object, Null_Element => Identifier.Null_Object, Show_Element => Identifier.Show, Get_Key => Identifier.Image); subtype States is Lex.Visible.Token range Message .. Introduction; In_Progress : States := Message; procedure Type_Base (Structure_Name, Attribut_Name : in Identifier.Object; Enumeration_Type : out Natural; Ok : in out Boolean) is Local_Ok : Boolean := True; Index : Natural := Field_Identifier.Index (Identifier.Image (Attribut_Name)); begin case Lex.Get_Token is when Entier => Structure_Array.Create_Number_Field (Structure_Name, Index, Local_Ok); Lex.Next; when Chaine => Structure_Array.Create_Sentence_Field (Structure_Name, Index, Local_Ok); Lex.Next; when Id => Enumeration_Type := Enumeration_Array.Enum (Lex.Get_Lower_Case_Value); Structure_Array.Create_Enumerate_Field (Structure_Name, Index, Local_Ok); Lex.Next; when others => Local_Ok := False; Error.Syn (Type_Base, Follow_Type_Base); end case; Ok := Ok and Local_Ok; end Type_Base; procedure Type_Structure (Structure_Type : out Moving_String.Object; Ok : in out Boolean) is Local_Ok : Boolean := True; begin case Lex.Get_Token is when Anime | Lieu | Entite | Id => Structure_Type := Moving_String.From_String (Lex.Get_Lower_Case_Value); Lex.Next; when others => Local_Ok := False; Error.Syn (Type_Structure, Follow_Type_Structure); end case; Ok := Ok and Local_Ok; end Type_Structure; procedure Chaine (A_Sentence : out Identifier.Object; Ok : in out Boolean) is Local_Ok : Boolean := True; Value : Moving_String.Object; begin Value := Moving_String.From_String (Lex.Get_Value); Lex.Next; while Lex.Get_Token = Ampersand loop Lex.Next; if Lex.Get_Token /= Right_Sentence then Local_Ok := False; Error.Syn (Chaine, Follow_Chaine); else Value := Value & Lex.Get_Value; Lex.Next; end if; end loop; Ok := Local_Ok; A_Sentence := Identifier.From_String (Moving_String.Image (Value)); end Chaine; procedure Valeur (Structure_Name, Attribut_Name : in Identifier.Object; Enumeration_Type : Natural; Ok : in out Boolean) is Local_Ok : Boolean := True; Index : Natural := Field_Identifier_Array (Identifier.Image (Attribut_Name)); A_Sentence : Identifier.Object; Literal_Index : Natural; begin case Lex.Get_Token is when Number => Structure_Array.Field_Put_Number (Structure_Name, Index, Integer'Value (Lex.Get_Lower_Case_Value), Local_Ok); Lex.Next; when Id => Literal_Index := Enumeration_Array.Literal (Enumeration_Type, Lex. Get_Lower_Case_Value); Structure_Array.Field_Put_Enumerate (Structure_Name, Index, Enumeration_Type, Literal_Index, Local_Ok); Lex.Next; when Right_Sentence => Chaine (A_Sentence, Local_Ok); Structure_Array.Field_Put_Sentence (Structure_Name, Index, A_Sentence, Local_Ok); when others => Local_Ok := False; Error.Syn (Valeur, Follow_Valeur); end case; Ok := Ok and Local_Ok; end Valeur; procedure Objet (Ok : in out Boolean) is Local_Ok : Boolean := True; begin case Lex.Get_Token is when Id | Heros | Lieu => Lex.Next; when others => Local_Ok := False; Error.Syn (Objet, Follow_Objet); end case; Ok := Ok and Local_Ok; end Objet; procedure Liste_Identificateurs (List : in out Identifier_List.Object; Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Id then Identifier_List.Put (List, Identifier.From_String (Lex.Get_Lower_Case_Value), Local_Ok); Lex.Next; while Lex.Get_Token = Comma loop Lex.Next; if Lex.Get_Token = Id then Identifier_List.Put (List, Identifier.From_String (Lex.Get_Lower_Case_Value), Local_Ok); if not Local_Ok then Error.Sem (Liste_Id, Lex.Get_Value); end if; Lex.Next; else Local_Ok := False; Error.Syn (Id, Follow_Liste_Identificateurs); end if; end loop; else Local_Ok := False; Error.Syn (Id, Follow_Liste_Identificateurs); end if; Ok := Ok and Local_Ok; Identifier_List.Show (List); end Liste_Identificateurs; procedure Liste_Messages_Erreur (Ok : in out Boolean) is A_Sentence : Identifier.Object; Local_Ok : Boolean := True; begin while Lex.Get_Token = Message loop Lex.Next; if Lex.Get_Token = Erreur then Lex.Next; if Lex.Get_Token = Right_Sentence then Chaine (Value, Local_Ok); if Local_Ok then Text_Io.Put_Line ("message"); Message_Array.Put (A_Sentence, Local_Ok); if not Local_Ok then Error.Sem (Message, Identifier.Image (A_Sentence)); end if; end if; else Local_Ok := False; if Lex.Get_Token = Wrong_Sentence then Error.Syn (Wrong_Sentence, Follow_Liste_Messages_Erreur); else Error.Syn (Sentence, Follow_Liste_Messages_Erreur); end if; end if; else Local_Ok := False; Error.Syn (Erreur, Follow_Liste_Messages_Erreur); end if; end loop; Ok := Ok and Local_Ok; end Liste_Messages_Erreur; procedure Liste_Enumeres (Ok : in out Boolean) is Enumeration_Identifier : Identifier.Object; List : Identifier_List.Object; Iterator : Identifier_List.Iterator; Local_Ok : Boolean := True; begin while Lex.Get_Token = Enumere loop Identifier_List.Free (List); Lex.Next; if Lex.Get_Token = Id then Enumeration_Identifier := Identifier.From_String (Lex.Get_Lower_Case_Value); Lex.Next; if Lex.Get_Token = Colon then Lex.Next; Liste_Identificateurs (List, Local_Ok); if Local_Ok then Put_Line ("enumere"); Identifier_List.Init (Iterator, List); while not Identifier_List.Done (Iterator) loop Enumeration_Array.Put_Literal (Enumeration_Identifier, Identifier_List.Value (Iterator), Local_Ok); if not Local_Ok then Error.Sem (Enumere, Identifier.Image (Identifier_List.Value (Iterator))); end if; Identifier_List.Next (Iterator); end loop; end if; else Local_Ok := False; Error.Syn (Colon, Follow_Liste_Enumeres); end if; else Local_Ok := False; Error.Syn (Id, Follow_Liste_Enumeres); end if; end loop; Ok := Ok and Local_Ok; end Liste_Enumeres; procedure Attribut (Structure_Name : in Identifier.Object; Ok : in out Boolean) is Value : Moving_String.Object; Local_Ok : Boolean := True; Attribut_Name : Identifier.Object; Enumeration_Type : Natural; begin if Lex.Get_Token = Id then Attribut_Name := Identifier.From_String (Lex.Get_Lower_Case_Value); Field_Identifier_Array.Put (Attribut_Name); Lex.Next; if Lex.Get_Token = En then Lex.Next; Type_Base (Structure_Name, Attribut_Name, Enumeration_Type, Local_Ok); if Lex.Get_Token = Colon then Lex.Next; Valeur (Structure_Name, Attribut_Name, Enumeration_Type, Local_Ok); end if; else Local_Ok := False; Error.Syn (En, Follow_Attribut); end if; else Local_Ok := False; Error.Syn (Id, Follow_Attribut); end if; Ok := Ok and Local_Ok; end Attribut; procedure Corps_Structure (Structure_Name : in Identifier.Object; Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Attributs then Lex.Next; if Lex.Get_Token = Substract then Lex.Next; Attribut (Structure_Name, Local_Ok); while Lex.Get_Token = Substract loop Lex.Next; Attribut (Structure_Name, Local_Ok); end loop; else Local_Ok := False; Error.Syn (Substract, Follow_Attribut); end if; end if; Ok := Ok and Local_Ok; end Corps_Structure; procedure Liste_Structures (Ok : in out Boolean) is Local_Ok : Boolean := True; Structure_Type : Moving_String.Object; Structure_Name : Identifier.Object; begin while Lex.Get_Token = Structure loop Lex.Next; Type_Structure (Structure_Type, Local_Ok); if Lex.Get_Token = Colon then Lex.Next; if Lex.Get_Token = Id then Structure_Name := Identifier.From_String (Lex.Get_Lower_Case_Value); Structure_Array.Put (Moving_String.Image (Structure_Type), Structure_Name); Lex.Next; Corps_Structure (Structure_Name, Local_Ok); if Local_Ok then Put_Line ("structure"); end if; else Local_Ok := False; Error.Syn (Id, Follow_Liste_Structures); end if; else Local_Ok := False; Error.Syn (Colon, Follow_Liste_Structures); end if; end loop; Ok := Ok and Local_Ok; end Liste_Structures; procedure Champs (Ok : in out Boolean) is Value : Moving_String.Object; Local_Ok : Boolean := True; begin while Lex.Get_Token = Id loop Lex.Next; if Lex.Get_Token = Equal then Lex.Next; Valeur (Value, Local_Ok); -- a modifier cf attributs else Local_Ok := False; Error.Syn (Equal, Follow_Champs); end if; end loop; Ok := Ok and Local_Ok; end Champs; procedure Mouvement (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Id then Lex.Next; if Lex.Get_Token = Colon then Lex.Next; if Lex.Get_Token = Number then Lex.Next; else Local_Ok := False; Error.Syn (Number, Follow_Mouvement); end if; end if; else Local_Ok := False; Error.Syn (Id, Follow_Mouvement); end if; Ok := Ok and Local_Ok; end Mouvement; procedure Mouvements (Ok : in out Boolean) is Local_Ok : Boolean := True; begin Mouvement (Local_Ok); while Lex.Get_Token = Comma loop Lex.Next; Mouvement (Local_Ok); end loop; Ok := Ok and Local_Ok; end Mouvements; procedure Itineraire (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Itineraire then Lex.Next; if Lex.Get_Token = Equal then Lex.Next; Mouvements (Local_Ok); else Local_Ok := False; Error.Syn (Equal, Follow_Liste_Objets); end if; end if; Ok := Ok and Local_Ok; end Itineraire; procedure Corps_Objet (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Attributs then Lex.Next; Champs (Local_Ok); Itineraire (Local_Ok); end if; Ok := Ok and Local_Ok; end Corps_Objet; procedure Liste_Objets (Ok : in out Boolean) is List : Identifier_List.Object; Local_Ok : Boolean := True; begin while Lex.Get_Token = Cree loop Lex.Next; Type_Structure (Local_Ok); if Lex.Get_Token = Colon then Lex.Next; Liste_Identificateurs (List, Local_Ok); Corps_Objet (Local_Ok); if Local_Ok then Put_Line ("objet"); end if; else Local_Ok := False; Error.Syn (Colon, Follow_Liste_Objets); end if; end loop; Ok := Ok and Local_Ok; end Liste_Objets; procedure Liste_Mots (Ok : in out Boolean) is List : Identifier_List.Object; Local_Ok : Boolean := True; begin if Lex.Get_Token = Mots then Lex.Next; Liste_Identificateurs (List, Local_Ok); if Local_Ok then Put_Line ("mots"); end if; end if; Ok := Ok and Local_Ok; end Liste_Mots; procedure Liens_Speciaux (Ok : in out Boolean) is List : Identifier_List.Object; An_Identifier : Identifier.Object; Iterator : Identifier_List.Iterator; Local_Ok : Boolean := True; begin if Lex.Get_Token = Lien then Lex.Next; if Lex.Get_Token = Special then An_Identifier := Identifier.From_String (Lex.Get_Lower_Case_Value); Lex.Next; if Lex.Get_Token = Colon then Lex.Next; Liste_Identificateurs (List, Local_Ok); if Local_Ok then Put_Line ("etats liens speciaux"); Identifier_List.Init (Iterator, List); while not Identifier_List.Done (Iterator) loop Enumeration_Array.Put_Literal (An_Identifier, Identifier_List.Value (Iterator), Local_Ok); if not Local_Ok then Put_Line ("Erreur dans liste special"); end if; Identifier_List.Next (Iterator); end loop; end if; else Local_Ok := False; Error.Syn (Colon, Follow_Etats_Liens); end if; else Local_Ok := False; Error.Syn (Special, Follow_Etats_Liens); end if; end if; Ok := Ok and Local_Ok; end Liens_Speciaux; procedure Etats_Liens (Ok : in out Boolean) is An_Identifier : Identifier.Object; List : Identifier_List.Object; Iterator : Identifier_List.Iterator; Local_Ok : Boolean := True; begin if Lex.Get_Token = Lien then Lex.Next; if Lex.Get_Token = Normal then An_Identifier := Identifier.From_String (Lex.Get_Lower_Case_Value); Lex.Next; if Lex.Get_Token = Colon then Lex.Next; Liste_Identificateurs (List, Local_Ok); if Local_Ok then Put_Line ("etats liens normaux"); Identifier_List.Init (Iterator, List); while not Identifier_List.Done (Iterator) loop Enumeration_Array.Put_Literal (An_Identifier, Identifier_List.Value (Iterator), Local_Ok); if not Local_Ok then Put_Line ("Erreur dans liste normal"); end if; Identifier_List.Next (Iterator); end loop; end if; Liens_Speciaux (Local_Ok); else Local_Ok := False; Error.Syn (Colon, Follow_Etats_Liens); end if; else Local_Ok := False; Error.Syn (Normal, Follow_Etats_Liens); end if; end if; Ok := Ok and Local_Ok; end Etats_Liens; procedure Lieu (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Id then Lex.Next; if Lex.Get_Token = Id then Lex.Next; else Local_Ok := False; Error.Syn (Id, Follow_Lier_Lieux); end if; else Local_Ok := False; Error.Syn (Id, Follow_Lier_Lieux); end if; Ok := Ok and Local_Ok; end Lieu; procedure Moyen (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Par then Lex.Next; if Lex.Get_Token = Id then Lex.Next; if Lex.Get_Token = Id then Lex.Next; end if; else Local_Ok := False; Error.Syn (Id, Follow_Lier_Lieux); end if; else Local_Ok := False; Error.Syn (Par, Follow_Lier_Lieux); end if; Ok := Ok and Local_Ok; end Moyen; procedure Lier_Lieux (Ok : in out Boolean) is Local_Ok : Boolean := True; begin while Lex.Get_Token = Lie loop Lex.Next; Lieu (Local_Ok); if Lex.Get_Token = A then Lex.Next; Lieu (Local_Ok); if Local_Ok then Moyen (Local_Ok); end if; if Local_Ok then Put_Line ("lien"); end if; else Local_Ok := False; Error.Syn (A, Follow_Lier_Lieux); end if; end loop; Ok := Ok and Local_Ok; end Lier_Lieux; procedure Liste_Groupes (Ok : in out Boolean) is List : Identifier_List.Object; Iterator : Identifier_List.Iterator; Index : Natural; Group_Identifier : Identifier.Object; Local_Ok : Boolean := True; begin while Lex.Get_Token = Groupe loop Lex.Next; if Lex.Get_Token = Id then Group_Identifier := Identifier.From_String (Lex.Get_Lower_Case_Value); Lex.Next; if Lex.Get_Token = Colon then Lex.Next; Liste_Identificateurs (List, Local_Ok); if Local_Ok then Put_Line ("groupe"); Identifier_List.Init (Iterator, List); while not Identifier_List.Done (Iterator) loop Index := Complement_Identifier_Array.Index (Identifier.Image (Identifier_List.Value (Iterator))); Group_Array.Put (Group_Identifier, Index, Local_Ok); if not Local_Ok then Error.Sem (Groupe, Identifier.Image (Identifier_List.Value (Iterator))); end if; Identifier_List.Next (Iterator); end loop; end if; else Local_Ok := False; Error.Syn (Colon, Follow_Liste_Groupes); end if; else Local_Ok := False; Error.Syn (Id, Follow_Liste_Groupes); end if; end loop; Ok := Ok and Local_Ok; end Liste_Groupes; procedure Synonymes (List : in out Identifier_List.Object; Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Ou then Lex.Next; Liste_Identificateurs (List, Local_Ok); end if; Ok := Ok and Local_Ok; end Synonymes; procedure Liste_Verbes (Ok : in out Boolean) is List : Identifier_List.Object; Local_Ok : Boolean := True; begin if Lex.Get_Token = Verbes then Lex.Next; Put_Line ("liste_verbes"); while Lex.Get_Token = Id loop Lex.Next; Synonymes (List, Local_Ok); --if local_ok then --Put_Line ("verbe"); --end if; end loop; end if; Ok := Ok and Local_Ok; end Liste_Verbes; procedure Instructions_Simples (Ok : in out Boolean); procedure Expression (Ok : in out Boolean); procedure Facteur (Ok : in out Boolean) is Local_Ok : Boolean := True; begin case Lex.Get_Token is when Opening_Bracket => Lex.Next; Expression (Local_Ok); if Lex.Get_Token = Closing_Bracket then Lex.Next; else Local_Ok := False; Error.Syn (Closing_Bracket, Follow_Facteur); end if; when Id => Lex.Next; if Lex.Get_Token = De then Lex.Next; Objet (Local_Ok); end if; when Number => Lex.Next; when others => Local_Ok := False; Error.Syn (Facteur, Follow_Facteur); end case; Ok := Ok and Local_Ok; end Facteur; procedure Terme (Ok : in out Boolean) is First_Terme : constant Token_To_Boolean_Array := Token_To_Boolean_Array'(Multiply .. Divide => True, others => False); Local_Ok : Boolean := True; begin Facteur (Local_Ok); while First_Terme (Lex.Get_Token) loop case Lex.Get_Token is when Multiply | Divide => Lex.Next; Facteur (Local_Ok); when others => null; end case; end loop; Ok := Ok and Local_Ok; end Terme; procedure Expression (Ok : in out Boolean) is First_Expression : constant Token_To_Boolean_Array := Token_To_Boolean_Array'(Substract .. Add => True, others => False); Local_Ok : Boolean := True; begin Terme (Local_Ok); while First_Expression (Lex.Get_Token) loop case Lex.Get_Token is when Add | Substract => Lex.Next; Terme (Local_Ok); when others => null; end case; end loop; Ok := Ok and Local_Ok; end Expression; procedure Tests (Ok : in out Boolean) is Local_Ok : Boolean := True; begin case Lex.Get_Token is when Existe => Lex.Next; if Lex.Get_Token = Pas then Lex.Next; end if; when Equal | Not_Equal | Less | Greater | Greater_Equal | Less_Equal => Lex.Next; Expression (Local_Ok); when others => Local_Ok := False; Error.Syn (Tests, Follow_Suite_Condition_Forte); end case; Ok := Ok and Local_Ok; end Tests; procedure Suite_Condition_Forte (Ok : in out Boolean) is Local_Ok : Boolean := True; begin case Lex.Get_Token is when De => Lex.Next; Objet (Local_Ok); Tests (Local_Ok); when Appartient => Lex.Next; if Lex.Get_Token = Pas then Lex.Next; end if; if Lex.Get_Token = A then Lex.Next; Objet (Local_Ok); else Local_Ok := False; Error.Syn (A, Follow_Suite_Condition_Forte); end if; when Existe => Lex.Next; if Lex.Get_Token = Pas then Lex.Next; end if; when others => Local_Ok := False; Error.Syn (Suite_Condition_Forte, Follow_Suite_Condition_Forte); end case; Ok := Ok and Local_Ok; end Suite_Condition_Forte; procedure Condition_Forte (Ok : in out Boolean) is Local_Ok : Boolean := True; begin case Lex.Get_Token is when Id => Lex.Next; Suite_Condition_Forte (Local_Ok); when Heros | Lieu => Lex.Next; if Lex.Get_Token = Equal then Lex.Next; if Lex.Get_Token = Id then Lex.Next; else Local_Ok := False; Error.Syn (Id, Follow_Condition_Forte); end if; else Local_Ok := False; Error.Syn (Equal, Follow_Condition_Forte); end if; when Number => Lex.Next; if Lex.Get_Token = Actions then Lex.Next; if Lex.Get_Token = Passees then Lex.Next; else Local_Ok := False; Error.Syn (Passees, Follow_Condition_Forte); end if; else Local_Ok := False; Error.Syn (Actions, Follow_Condition_Forte); end if; when Rencontre => Lex.Next; if Lex.Get_Token = Id then Lex.Next; else Local_Ok := False; Error.Syn (Id, Follow_Condition_Forte); end if; when Issues => Lex.Next; if Lex.Get_Token = De then Lex.Next; if Lex.Get_Token = Id then Lex.Next; if Lex.Get_Token = Existe then Lex.Next; if Lex.Get_Token = Pas then Lex.Next; end if; else Local_Ok := False; Error.Syn (De, Follow_Condition_Forte); end if; else Local_Ok := False; Error.Syn (Id, Follow_Condition_Forte); end if; else Local_Ok := False; Error.Syn (De, Follow_Condition_Forte); end if; when others => Local_Ok := False; Error.Syn (Condition_Forte, Follow_Condition_Forte); end case; Ok := Ok and Local_Ok; end Condition_Forte; procedure Condition_Faible (Ok : in out Boolean) is First_Condition_Faible : constant Token_To_Boolean_Array := Token_To_Boolean_Array'(Et => True, others => False); Local_Ok : Boolean := True; begin Condition_Forte (Local_Ok); while First_Condition_Faible (Lex.Get_Token) loop-- a simplifier case Lex.Get_Token is when Et => Lex.Next; Condition_Forte (Local_Ok); when others => null; end case; end loop; Ok := Ok and Local_Ok; end Condition_Faible; procedure Condition (Ok : in out Boolean) is First_Condition : constant Token_To_Boolean_Array := Token_To_Boolean_Array'(Ou => True, others => False); Local_Ok : Boolean := True; begin Condition_Faible (Local_Ok); while First_Condition (Lex.Get_Token) loop-- a simplifier case Lex.Get_Token is when Ou => Lex.Next; Condition_Faible (Local_Ok); when others => null; end case; end loop; Ok := Ok and Local_Ok; end Condition; procedure Si (Ok : in out Boolean) is Local_Ok : Boolean := True; begin Condition (Local_Ok); if Lex.Get_Token = Alors then Lex.Next; --Put_Line ("alors detecte"); Instructions_Simples (Local_Ok); --Put_Line ("sinon possible"); if Lex.Get_Token = Sinon then --Put_Line ("sinon detecte"); Lex.Next; Instructions_Simples (Local_Ok); end if; --Put_Line ("fin de sinon"); if Lex.Get_Token = Fin then Lex.Next; if Lex.Get_Token = Si then Lex.Next; else Local_Ok := False; Error.Syn (Si, Follow_Instruction_Simple); end if; else Local_Ok := False; Error.Syn (Fin, Follow_Instruction_Simple); end if; else Local_Ok := False; Error.Syn (Alors, Follow_Instruction_Simple); end if; Ok := Ok and Local_Ok; end Si; procedure Change (Ok : in out Boolean) is Local_Ok : Boolean := True; begin case Lex.Get_Token is when Id => Lex.Next; if Lex.Get_Token = De then Lex.Next; Objet (Local_Ok); if Lex.Get_Token = En then Lex.Next; Expression (Local_Ok); else Local_Ok := False; Error.Syn (En, Follow_Instruction_Simple); end if; else Local_Ok := False; Error.Syn (De, Follow_Instruction_Simple); end if; when Heros | Lieu => Lex.Next; if Lex.Get_Token = En then Lex.Next; if Lex.Get_Token = Id then Lex.Next; else Local_Ok := False; Error.Syn (Id, Follow_Instruction_Simple); end if; else Local_Ok := False; Error.Syn (En, Follow_Instruction_Simple); end if; when others => Local_Ok := False; Error.Syn (Change, Follow_Instruction_Simple); end case; Ok := Ok and Local_Ok; end Change; procedure Quoi_Afficher (Ok : in out Boolean) is Local_Ok : Boolean := True; begin case Lex.Get_Token is when Right_Sentence => Lex.Next; when Wrong_Sentence => Local_Ok := False; Error.Syn (Wrong_Sentence, Follow_Quoi_Afficher); when Number => Lex.Next; when Id => Lex.Next; if Lex.Get_Token = De then Lex.Next; Objet (Local_Ok); end if; when Issue => Lex.Next; if Lex.Get_Token = Id then Lex.Next; else Local_Ok := False; Error.Syn (Id, Follow_Quoi_Afficher); end if; when Issues => Lex.Next; when Contenu => Lex.Next; if Lex.Get_Token = De then Lex.Next; Objet (Local_Ok); else Local_Ok := False; Error.Syn (De, Follow_Quoi_Afficher); end if; when others => Local_Ok := False; Error.Syn (Quoi_Afficher, Follow_Quoi_Afficher); end case; Ok := Ok and Local_Ok; end Quoi_Afficher; procedure Liste_Affiche (Ok : in out Boolean) is First_Liste_Affiche : constant Token_To_Boolean_Array := Token_To_Boolean_Array'(Ampersand => True, others => False); Local_Ok : Boolean := True; begin Quoi_Afficher (Local_Ok); while (First_Liste_Affiche (Lex.Get_Token)) loop case Lex.Get_Token is when Ampersand => Lex.Next; Quoi_Afficher (Local_Ok); when others => null; end case; end loop; Ok := Ok and Local_Ok; end Liste_Affiche; procedure Ligne (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Suivante then Lex.Next; else Local_Ok := False; Error.Syn (Suivante, Follow_Instruction_Simple); end if; Ok := Ok and Local_Ok; end Ligne; procedure Bouge (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Anime then Lex.Next; else Local_Ok := False; Error.Syn (Anime, Follow_Instruction_Simple); end if; Ok := Ok and Local_Ok; end Bouge; procedure Positionne (Ok : in out Boolean) is List : Identifier_List.Object; Local_Ok : Boolean := True; begin Liste_Identificateurs (List, Local_Ok); if Lex.Get_Token = A then Lex.Next; Objet (Local_Ok); else Local_Ok := False; Error.Syn (Dans, Follow_Instruction_Simple); end if; Ok := Ok and Local_Ok; end Positionne; procedure Va (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Vers then Lex.Next; if Lex.Get_Token = Id then Lex.Next; else Local_Ok := False; Error.Syn (Id, Follow_Instruction_Simple); end if; else Local_Ok := False; Error.Syn (Vers, Follow_Instruction_Simple); end if; Ok := Ok and Local_Ok; end Va; procedure Instructions_Simples (Ok : in out Boolean) is First_Instructions_Simples : constant Token_To_Boolean_Array := Token_To_Boolean_Array'(Si .. Va => True, others => False); List : Identifier_List.Object; Local_Ok : Boolean := True; begin while First_Instructions_Simples (Lex.Get_Token) loop case Lex.Get_Token is when Si => Lex.Next; Si (Local_Ok); when Change => Lex.Next; Change (Local_Ok); when Affiche => Lex.Next; Liste_Affiche (Local_Ok); when Ligne => Lex.Next; Ligne (Local_Ok); when Bouge => Lex.Next; Bouge (Local_Ok); when Positionne => Lex.Next; Positionne (Local_Ok); when Retire => Lex.Next; Liste_Identificateurs (List, Local_Ok); when Termine => Lex.Next; when Va => Lex.Next; Va (Local_Ok); when Efface => Lex.Next; when others => null; Put_Line ("fin instructions simples"); end case; end loop; Ok := Ok and Local_Ok; end Instructions_Simples; procedure Description_Ordre (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Id then Lex.Next; while Lex.Get_Token = Id loop Lex.Next; end loop; else Local_Ok := False; Error.Syn (Id, Follow_Ordre); end if; Ok := Ok and Local_Ok; end Description_Ordre; procedure Ordre (Ok : in out Boolean) is Local_Ok : Boolean := True; begin Description_Ordre (Local_Ok); while Lex.Get_Token = Comma loop Lex.Next; Description_Ordre (Local_Ok); end loop; if Lex.Get_Token = Colon then Lex.Next; Instructions_Simples (Local_Ok); while Lex.Get_Token = Pour or Lex.Get_Token = Ailleurs loop if Lex.Get_Token = Pour then Lex.Next; if Lex.Get_Token = Id then Lex.Next; Instructions_Simples (Local_Ok); else Local_Ok := False; Error.Syn (Id, Follow_Ordre); end if; else Lex.Next; Instructions_Simples (Local_Ok); exit; end if; end loop; else Local_Ok := False; Error.Syn (Colon, Follow_Ordre); end if; if Local_Ok then Put_Line ("ordre"); end if; Ok := Ok and Local_Ok; end Ordre; procedure Fin_Quand (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Fin then Lex.Next; if Lex.Get_Token = Quand then Lex.Next; else Local_Ok := False; Error.Syn (Quand, Follow_Quand_Ordre); end if; else Local_Ok := False; Error.Syn (Fin, Follow_Quand_Ordre); end if; Ok := Ok and Local_Ok; end Fin_Quand; procedure Quand_Ordre (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Quand then Lex.Next; if Lex.Get_Token = Ordre then Lex.Next; if Lex.Get_Token = Vaut then Lex.Next; if Lex.Get_Token = Substract then Lex.Next; Ordre (Local_Ok); while Lex.Get_Token = Substract loop Lex.Next; Ordre (Local_Ok); end loop; Fin_Quand (Local_Ok); if Local_Ok then Put_Line ("quand_ordre correct"); end if; else Local_Ok := False; Error.Syn (Substract, Follow_Ordre); end if; else Local_Ok := False; Error.Syn (Vaut, Follow_Quand_Ordre); end if; else Local_Ok := False; Error.Syn (Ordre, Follow_Quand_Ordre); end if; else Local_Ok := False; Error.Syn (Quand, Follow_Quand_Ordre); end if; Ok := Ok and Local_Ok; end Quand_Ordre; procedure Creation_Monde (Ok : in out Boolean) is Local_Ok : Boolean := True; [declaration] begin Put_Line ("Lecture de la zone de creation ..."); while Lex.Get_Token in States and Lex.Get_Token >= In_Progress loop case In_Progress is when Message => Liste_Messages_Erreur (Local_Ok); when Enumere => Liste_Enumeres (Local_Ok); when Structure => Liste_Structures (Local_Ok); when Cree => Liste_Objets (Local_Ok); when Mots => Liste_Mots (Local_Ok); when Lien => Etats_Liens (Local_Ok); when Lie => Lier_Lieux (Local_Ok); when Groupe => Liste_Groupes (Local_Ok); when Verbes => Liste_Verbes (Local_Ok); when others => exit; end case; In_Progress := States'Succ (In_Progress); end loop; if not Lex.Is_At_End then Put_Line ("in_progress : " & Token'Image (In_Progress)); end if; Ok := Ok and Local_Ok; end Creation_Monde; procedure Scenario (Ok : in out Boolean) is Local_Ok : Boolean := True; begin if Lex.Get_Token = Introduction then Lex.Next; Put_Line ("Lecture de la zone d'introduction ..."); Instructions_Simples (Local_Ok); end if; if Lex.Get_Token = Scenario then Lex.Next; Put_Line ("Lecture de la zone de scenario ..."); Instructions_Simples (Local_Ok); Quand_Ordre (Local_Ok); Instructions_Simples (Local_Ok); end if; Ok := Ok and Local_Ok; end Scenario; procedure Jeu_Aventure (Ok : in out Boolean) is Local_Ok : Boolean := True; begin loop Creation_Monde (Local_Ok); Scenario (Local_Ok); if not Lex.Is_At_End then Local_Ok := False; -- Put_Line ("not at end"); Error.Syn (Jeu_Aventure, Follow_Jeu_Aventure); else exit; end if; Put_Line ("redemarrage"); end loop; Ok := Ok and Local_Ok; end Jeu_Aventure; procedure Start is Local_Ok : Boolean := True; begin Lex.Initialize; Jeu_Aventure (Local_Ok); if Local_Ok then Put_Line ("Program is Ok"); else Put_Line ("Program is false"); end if; Enumeration_Array.Show; Message_Array.Show; Group_Array.Show; end Start; begin Complement_Identifier_Array.Put ("e1"); Complement_Identifier_Array.Put ("e2"); Complement_Identifier_Array.Put ("e3"); Complement_Identifier_Array.Put ("e4"); Complement_Identifier_Array.Put ("e5"); Complement_Identifier_Array.Put ("e6"); Complement_Identifier_Array.Put ("e7"); Complement_Identifier_Array.Put ("e8"); end Syn