|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 44568 (0xae18)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Text_Io;
with Nodes;
with Lexical;
use Lexical;
with Symbol;
use Symbol;
with Bounded_Strings;
with Error;
use Error;
package body Parser is
procedure Parse_Corps_Scene (Parse : in out Boolean;
Ptr_Scene : out Nodes.Pnode);
--prototype,declaration incomplete
procedure Parse_Prog_Principal (Parse : in out Boolean;
Ptr_Prog_Principal : out Nodes.Pnode) is
Ptr_Scene_S : Nodes.Pnode;
begin
if Lexical.Get = L_Debut then
Lexical.Next;
Parse_Corps_Scene (Parse, Ptr_Scene_S);
if Parse then
if Lexical.Get = L_Fin then
Lexical.Next;
Ptr_Prog_Principal := Ptr_Scene_S;
else
Parse := False;
end if;
end if;
else
Parse := False;
end if;
end Parse_Prog_Principal;
procedure Parse_Terme (Parse : in out Boolean;
Ptr_Term : in out Nodes.Pnode);
--prototype,declaration incomplete
procedure Parse_Facteur (Parse : in out Boolean;
Ptr_Fact : in out Nodes.Pnode);
--prototype,declaration incomplete
procedure Parse_Expression (Parse : in out Boolean;
Ptr_Expr : in out Nodes.Pnode) is
use Nodes;
Parse_Ter : Boolean := True;
Ptr_Terml_S, Ptr_Termr_S, Paux : Nodes.Pnode;
begin
Parse_Terme (Parse, Ptr_Terml_S);
if Parse then
Ptr_Expr := Nodes.Mkexprnode (Ptr_Terml_S, null);
Paux := Ptr_Expr;
if Lexical.Get = L_Plus or else Lexical.Get = L_Minus then
while Lexical.Get = L_Plus or else Lexical.Get = L_Minus loop
case Lexical.Get is
when L_Plus =>
Lexical.Next;
Parse_Terme (Parse_Ter, Ptr_Termr_S);
if Parse_Ter then
if Paux.Thetype = Expression then
Paux.Exp_Exprprime :=
Nodes.Mkexprprimenode
(Ptr_Termr_S, null, Add);
else
Paux.Expp_Exprprime :=
Nodes.Mkexprprimenode
(Ptr_Termr_S, null, Add);
end if;
end if;
when L_Minus =>
Lexical.Next;
Parse_Terme (Parse_Ter, Ptr_Termr_S);
if Parse_Ter then
if Paux.Thetype = Expression then
Paux.Exp_Exprprime :=
Nodes.Mkexprprimenode
(Ptr_Termr_S, null, Sub);
else
Paux.Expp_Exprprime :=
Nodes.Mkexprprimenode
(Ptr_Termr_S, null, Sub);
end if;
end if;
when others =>
Parse := False;
end case;
if Paux.Thetype = Expression then
Paux :=
Paux.
Exp_Exprprime; -- pour chainage des operations
else
Paux := Paux.Expp_Exprprime;
end if;
exit when not Parse_Ter;
end loop;
end if;
Parse := Parse_Ter;
end if;
end Parse_Expression;
procedure Parse_Terme (Parse : in out Boolean;
Ptr_Term : in out Nodes.Pnode) is
use Nodes;
Parse_Term : Boolean := True;
Ptr_Factl_S, Ptr_Factr_S, Paux : Nodes.Pnode;
begin
Parse_Facteur (Parse, Ptr_Factl_S);
if Parse then
Ptr_Term := Nodes.Mktermnode (Ptr_Factl_S, null);
Paux := Ptr_Term;
if Lexical.Get = L_Star or else
Lexical.Get = L_Slash or else Lexical.Get = L_Mod then
while Lexical.Get = L_Star or else
Lexical.Get = L_Slash or else Lexical.Get = L_Mod loop
case Lexical.Get is
when L_Star =>
Lexical.Next;
Parse_Facteur (Parse_Term, Ptr_Factr_S);
if Parse_Term then
if Paux.Thetype = Terme then
Paux.Ter_Termprime :=
Nodes.Mktermprimenode
(Ptr_Factr_S, null, Mul);
else
Paux.Terp_Termprime :=
Nodes.Mktermprimenode
(Ptr_Factr_S, null, Mul);
end if;
end if;
when L_Slash =>
Lexical.Next;
Parse_Facteur (Parse_Term, Ptr_Factr_S);
if Parse_Term then
if Paux.Thetype = Terme then
Paux.Ter_Termprime :=
Nodes.Mktermprimenode
(Ptr_Factr_S, null, Div);
else
Paux.Terp_Termprime :=
Nodes.Mktermprimenode
(Ptr_Factr_S, null, Div);
end if;
end if;
when L_Mod =>
Lexical.Next;
Parse_Facteur (Parse_Term, Ptr_Factr_S);
if Parse_Term then
if Paux.Thetype = Terme then
Paux.Ter_Termprime :=
Nodes.Mktermprimenode
(Ptr_Factr_S, null, Modulo);
else
Paux.Terp_Termprime :=
Nodes.Mktermprimenode
(Ptr_Factr_S, null, Modulo);
end if;
end if;
when others =>
Parse_Term := False;
end case;
if Paux.Thetype = Terme then
Paux := Paux.Ter_Termprime;
else
Paux := Paux.Terp_Termprime;
end if;
exit when not Parse_Term;
end loop;
end if;
Parse := Parse_Term;
end if;
end Parse_Terme;
procedure Parse_Facteur (Parse : in out Boolean;
Ptr_Fact : in out Nodes.Pnode) is
use Nodes;
Ptr_Fact_S : Nodes.Pnode;
begin
case Lexical.Get is
when L_Open =>
Lexical.Next;
Parse_Expression (Parse, Ptr_Fact_S);
if Parse then
if Lexical.Get = L_Close then
Ptr_Fact := Mkfactnode (Ptr_Fact_S);
Lexical.Next;
Parse := True;
else
Parse := False;
end if;
end if;
when L_Id =>
Ptr_Fact := Mkfactnode (Nodes.Mkidnode (Lexical.Value));
Lexical.Next;
Parse := True;
when L_Nbr =>
Ptr_Fact := Mkfactnode (Nodes.Mknbnode (Lexical.Number));
Lexical.Next;
Parse := True;
when others =>
Parse := False;
end case;
end Parse_Facteur;
procedure Parse_Evoluer (Parse : in out Boolean;
Ptr_Id1, Ptr_Id2 : out Nodes.Pnode;
Ptr_Expr1, Ptr_Expr2 : out Nodes.Pnode) is
Id1, Id2 : Lexical.Lexeme;
Ptr_Expr1_S, Ptr_Expr2_S : Nodes.Pnode;
begin
if Lexical.Get = L_Id then
Id1 := Lexical.Value;
Lexical.Next;
if Lexical.Get = L_Point then
Lexical.Next;
if Lexical.Get = L_Id then
Id2 := Lexical.Value;
Lexical.Next;
if Lexical.Get = L_Jusqua then
Lexical.Next;
Parse_Expression (Parse, Ptr_Expr1_S);
if Parse then
if Lexical.Get = L_En then
Lexical.Next;
Parse_Expression (Parse, Ptr_Expr2_S);
if Parse then
Ptr_Id1 := Nodes.Mkidnode (Id1);
Ptr_Id2 := Nodes.Mkidnode (Id2);
Ptr_Expr1 := Ptr_Expr1_S;
Ptr_Expr2 := Ptr_Expr2_S;
end if;
else
Parse := False;
end if;
end if;
else
Parse := False;
end if;
else
Parse := False;
end if;
else
Parse := False;
end if;
else
Parse := False;
end if;
end Parse_Evoluer;
procedure Parse_Modifier (Parse : in out Boolean;
Ptr_Id1, Ptr_Id2 : out Nodes.Pnode;
Ptr_Expr : out Nodes.Pnode) is
Id1, Id2 : Lexical.Lexeme;
Ptr_Expr_S : Nodes.Pnode;
begin
if Lexical.Get = L_Id then
Id1 := Lexical.Value;
Lexical.Next;
if Lexical.Get = L_Point then
Lexical.Next;
if Lexical.Get = L_Id then
Id2 := Lexical.Value;
Lexical.Next;
if Lexical.Get = L_Avec then
Lexical.Next;
Parse_Expression (Parse, Ptr_Expr_S);
if Parse then
Ptr_Id1 := Nodes.Mkidnode (Id1);
Ptr_Id2 := Nodes.Mkidnode (Id2);
Ptr_Expr := Ptr_Expr_S;
end if;
else
Parse := False;
end if;
else
Parse := False;
end if;
else
Parse := False;
end if;
else
Parse := False;
end if;
end Parse_Modifier;
procedure Parse_Desactiver (Parse : in out Boolean;
Ptr_Id1, Ptr_Id2 : out Nodes.Pnode) is
Id1, Id2 : Lexical.Lexeme;
begin
if Lexical.Get = L_Id then
Id1 := Lexical.Value;
Lexical.Next;
if Lexical.Get = L_Point then
Lexical.Next;
if Lexical.Get = L_Id then
Id2 := Lexical.Value;
Lexical.Next;
Parse := True;
Ptr_Id1 := Nodes.Mkidnode (Id1);
Ptr_Id2 := Nodes.Mkidnode (Id2);
else
Parse := False;
end if;
else
Parse := False;
end if;
else
Parse := False;
end if;
end Parse_Desactiver;
procedure Parse_Activer (Parse : in out Boolean;
Ptr_Id1, Ptr_Id2 : out Nodes.Pnode) is
Id1, Id2 : Lexical.Lexeme;
begin
if Lexical.Get = L_Id then
Id1 := Lexical.Value;
Lexical.Next;
if Lexical.Get = L_Point then
Lexical.Next;
if Lexical.Get = L_Id then
Id2 := Lexical.Value;
Lexical.Next;
Parse := True;
Ptr_Id1 := Nodes.Mkidnode (Id1);
Ptr_Id2 := Nodes.Mkidnode (Id2);
else
Parse := False;
end if;
else
Parse := False;
end if;
else
Parse := False;
end if;
end Parse_Activer;
procedure Parse_Action_Predef (Parse : in out Boolean;
Ptr_Action_Predef : in out Nodes.Pnode) is
Ptr_Id1_S : Nodes.Pnode;
Ptr_Id2_S : Nodes.Pnode;
Ptr_Expr1_S, Ptr_Expr2_S : Nodes.Pnode;
begin
case Lexical.Get is
when L_Activer =>
Lexical.Next;
Parse_Activer (Parse, Ptr_Id1_S, Ptr_Id2_S);
if Parse then
Ptr_Action_Predef := Nodes.Mkactivernode
(Ptr_Id1_S, Ptr_Id2_S);
end if;
when L_Desactiver =>
Lexical.Next;
Parse_Desactiver (Parse, Ptr_Id1_S, Ptr_Id2_S);
if Parse then
Ptr_Action_Predef := Nodes.Mkdesactivernode
(Ptr_Id1_S, Ptr_Id2_S);
end if;
when L_Modifier =>
Lexical.Next;
Parse_Modifier (Parse, Ptr_Id1_S, Ptr_Id2_S, Ptr_Expr1_S);
if Parse then
Ptr_Action_Predef := Nodes.Mkmodifiernode
(Ptr_Id1_S, Ptr_Id2_S, Ptr_Expr1_S);
end if;
when L_Evoluer =>
Lexical.Next;
Parse_Evoluer (Parse, Ptr_Id1_S, Ptr_Id2_S,
Ptr_Expr1_S, Ptr_Expr2_S);
if Parse then
Ptr_Action_Predef := Nodes.Mkevoluernode
(Ptr_Id1_S, Ptr_Id2_S,
Ptr_Expr1_S, Ptr_Expr2_S);
end if;
when others =>
Parse := False;
end case;
end Parse_Action_Predef;
procedure Parse_Faire (Parse : in out Boolean;
Ptr_Id1 : out Nodes.Pnode;
Ptr_Id2 : in out Nodes.Pnode);
-- prototype, declaration incomplete
procedure Parse_Corps_Effet (Parse : in out Boolean;
Ptr_Effet : out Nodes.Pnode) is
use Nodes;
Parse_Corps_Effet : Boolean := False;
Ptr_Action_Predef_S : Nodes.Pnode;
Ptr_Id1_S, Ptr_Id2_S : Nodes.Pnode;
Ptr_Deb_Code_Effet : Nodes.Pnode := new Node (None);
Ptr_Code_Effet : Nodes.Pnode;
begin
Ptr_Code_Effet := Ptr_Deb_Code_Effet;
while Lexical.Get = L_Activer or else Lexical.Get = L_Desactiver or else
Lexical.Get = L_Modifier or else
Lexical.Get = L_Evoluer or else Lexical.Get = L_Faire loop
case Lexical.Get is
when L_Activer | L_Desactiver | L_Modifier | L_Evoluer =>
Parse_Action_Predef (Parse_Corps_Effet,
Ptr_Action_Predef_S);
if Parse_Corps_Effet then
Ptr_Code_Effet.Next := Ptr_Action_Predef_S;
Ptr_Code_Effet := Ptr_Code_Effet.Next;
else
exit;
end if;
when L_Faire =>
Lexical.Next;
if Lexical.Get = L_Id and then
Symbol.Get_Type (Lexical.Value) = Symbol.T_Effect then
Parse_Faire (Parse_Corps_Effet, Ptr_Id1_S, Ptr_Id2_S);
if Parse_Corps_Effet then
Ptr_Code_Effet.Next := Nodes.Mkfairenode
(Ptr_Id1_S, Ptr_Id2_S);
Ptr_Code_Effet := Ptr_Code_Effet.Next;
end if;
end if;
when others =>
Parse := False;
end case;
end loop;
Parse := Parse_Corps_Effet;
if Parse then
Ptr_Effet := Ptr_Deb_Code_Effet.Next;
end if;
end Parse_Corps_Effet;
procedure Parse_Liste_Param (Parse : in out Boolean) is
Parse_Liste_Param : Boolean := True;
begin
if Lexical.Get = L_Id then
Symbol.Add (Lexical.Value, Argument);
Lexical.Next;
while Lexical.Get = L_Comma loop
Lexical.Next;
if Lexical.Get = L_Id then
Symbol.Add (Lexical.Value, Argument);
Lexical.Next;
Parse_Liste_Param := True;
else
Parse_Liste_Param := False;
exit;
end if;
end loop;
Parse := Parse_Liste_Param;
else
Parse := False;
end if;
end Parse_Liste_Param;
procedure Parse_Bloc_Param (Parse : in out Boolean) is
begin
if Lexical.Get = L_Open then
Lexical.Next;
Parse_Liste_Param (Parse);
if Parse then
if Lexical.Get = L_Close then
Lexical.Next;
else
Parse := False;
end if;
end if;
else
Parse := True; -- autorise aucun "param" declare
end if;
end Parse_Bloc_Param;
procedure Parse_Effet (Parse : in out Boolean) is
Ptr_Effet_S : Nodes.Pnode;
Id : Lexical.Lexeme;
begin
if Lexical.Get = L_Id then
Id := Lexical.Value;
Symbol.Add (Id, Effect);
Symbol.New_Table (Local_Table_Size);
Lexical.Next;
Parse_Bloc_Param (Parse);
if Parse then
if Lexical.Get = L_Est then
Lexical.Next;
Parse_Corps_Effet (Parse, Ptr_Effet_S);
if Parse then
if Lexical.Get = L_Fin then
Lexical.Next;
if Lexical.Get = L_Effet then
Lexical.Next;
Symbol.Set_Code (Id, Ptr_Effet_S);
else
Parse := False;
end if;
else
Parse := False;
end if;
end if;
else
Parse := False;
end if;
end if;
Symbol.Release_Table;
else
Parse := False;
end if;
end Parse_Effet;
procedure Parse_Liste_Arg (Parse : in out Boolean;
Ptr_Liste_Arg : in out Nodes.Pnode) is
use Nodes;
Parse_Liste_Arg : Boolean := True;
Ptr_Aux : Nodes.Pnode;
begin
if Lexical.Get = L_Id then
Ptr_Aux := Nodes.Mkidnode (Lexical.Value);
Ptr_Liste_Arg := Ptr_Aux;
Lexical.Next;
while Lexical.Get = L_Comma loop
Lexical.Next;
if Lexical.Get = L_Id then
Ptr_Aux.Next := Nodes.Mkidnode (Lexical.Value);
Lexical.Next;
Parse_Liste_Arg := True;
Ptr_Aux := Ptr_Aux.Next;
else
Parse_Liste_Arg := False;
exit;
end if;
end loop;
Parse := Parse_Liste_Arg;
else
Parse := False;
end if;
end Parse_Liste_Arg;
procedure Parse_Bloc_Arg (Parse : in out Boolean;
Ptr_Liste_Arg : in out Nodes.Pnode) is
use Nodes;
begin
if Lexical.Get = L_Open then
Lexical.Next;
Parse_Liste_Arg (Parse, Ptr_Liste_Arg);
if Parse then
if Lexical.Get = L_Close then
Lexical.Next;
else
Parse := False;
end if;
end if;
else
Parse := True; -- autorise aucun "arg" declare
end if;
end Parse_Bloc_Arg;
procedure Parse_Faire (Parse : in out Boolean;
Ptr_Id1 : out Nodes.Pnode;
Ptr_Id2 : in out Nodes.Pnode) is
use Nodes;
Id1 : Lexical.Lexeme;
begin
if Lexical.Get = L_Id then
Id1 := Lexical.Value;
Lexical.Next;
Parse_Bloc_Arg (Parse, Ptr_Id2);
if Parse then
Ptr_Id1 := Nodes.Mkidnode (Id1);
end if;
else
Parse := False;
end if;
end Parse_Faire;
procedure Parse_Repeter (Parse : in out Boolean;
Ptr_Expr : out Nodes.Pnode;
Ptr_Scene : out Nodes.Pnode) is
Ptr_Expr_S : Nodes.Pnode;
Ptr_Scene_S : Nodes.Pnode;
begin
Parse_Expression (Parse, Ptr_Expr_S);
if Parse then
if Lexical.Get = L_Fois then
Lexical.Next;
Parse_Corps_Scene (Parse, Ptr_Scene_S);
if Parse then
if Lexical.Get = L_Fin then
Lexical.Next;
if Lexical.Get = L_Repeter then
Lexical.Next;
Ptr_Expr := Ptr_Expr_S;
Ptr_Scene := Ptr_Scene_S;
else
Parse := False;
end if;
else
Parse := False;
end if;
end if;
else
Parse := False;
end if;
end if;
end Parse_Repeter;
procedure Parse_Sinon (Parse : in out Boolean;
Ptr_Sinon : out Nodes.Pnode) is
Ptr_Scene_S : Nodes.Pnode;
begin
if Lexical.Get = L_Sinon then
Lexical.Next;
if Lexical.Get = L_Faire then
Lexical.Next;
Parse_Corps_Scene (Parse, Ptr_Scene_S);
if Parse then
Ptr_Sinon := Nodes.Mksinonnode (Ptr_Scene_S);
end if;
else
Parse := False;
end if;
end if;
end Parse_Sinon;
procedure Parse_Suite_Condition (Parse : in out Boolean;
Ptr_Expr : in out Nodes.Pnode;
Op : out Nodes.Op_Rel) is
use Nodes;
begin
case Lexical.Get is
when L_Equ =>
Lexical.Next;
Parse_Expression (Parse, Ptr_Expr);
Op := Eq;
when L_Neq =>
Lexical.Next;
Parse_Expression (Parse, Ptr_Expr);
Op := Diff;
when L_Gt =>
Lexical.Next;
Parse_Expression (Parse, Ptr_Expr);
Op := Sup;
when L_Lt =>
Lexical.Next;
Parse_Expression (Parse, Ptr_Expr);
Op := Inf;
when L_Geq =>
Lexical.Next;
Parse_Expression (Parse, Ptr_Expr);
Op := Sup_Eq;
when L_Leq =>
Lexical.Next;
Parse_Expression (Parse, Ptr_Expr);
Op := Inf_Eq;
when L_Alors =>
Op := Op_Rel'(None);
when others =>
Parse := False;
end case;
end Parse_Suite_Condition;
procedure Parse_Condition (Parse : in out Boolean;
Ptr_Cond : out Nodes.Pnode) is
Ptr_Expr1_S : Nodes.Pnode;
Ptr_Expr2_S : Nodes.Pnode;
Op_S : Nodes.Op_Rel;
begin
Parse_Expression (Parse, Ptr_Expr1_S);
if Parse then
Parse_Suite_Condition (Parse, Ptr_Expr2_S, Op_S);
if Parse then
Ptr_Cond := Nodes.Mkcondnode (Ptr_Expr1_S, Ptr_Expr2_S, Op_S);
end if;
else
Parse := False;
end if;
end Parse_Condition;
procedure Parse_Si (Parse : in out Boolean;
Ptr_Cond : out Nodes.Pnode;
Ptr_Scene : out Nodes.Pnode;
Ptr_Sinon : in out Nodes.Pnode) is
begin
Parse_Condition (Parse, Ptr_Cond);
if Parse then
if Lexical.Get = L_Alors then
Lexical.Next;
if Lexical.Get = L_Faire then
Lexical.Next;
Parse_Corps_Scene (Parse, Ptr_Scene);
if Parse then
Parse_Sinon (Parse, Ptr_Sinon);
if Parse then
if Lexical.Get = L_Fin then
Lexical.Next;
if Lexical.Get = L_Si then
Lexical.Next;
else
Parse := False;
end if;
else
Parse := False;
end if;
end if;
end if;
else
Parse := False;
end if;
else
Parse := False;
end if;
end if;
end Parse_Si;
procedure Parse_Autemps (Parse : in out Boolean;
Ptr_Expr : out Nodes.Pnode;
Ptr_Scene : out Nodes.Pnode) is
Ptr_Expr_S : Nodes.Pnode;
Ptr_Scene_S : Nodes.Pnode;
begin
Parse_Expression (Parse, Ptr_Expr_S);
if Parse then
if Lexical.Get = L_Faire then
Lexical.Next;
Parse_Corps_Scene (Parse, Ptr_Scene_S);
if Parse then
if Lexical.Get = L_Fin then
Lexical.Next;
if Lexical.Get = L_Autemps then
Lexical.Next;
Ptr_Expr := Ptr_Expr_S;
Ptr_Scene := Ptr_Scene_S;
else
Parse := False;
end if;
else
Parse := False;
end if;
end if;
else
Parse := False;
end if;
end if;
end Parse_Autemps;
procedure Parse_Attendre (Parse : in out Boolean;
Ptr_Expr : out Nodes.Pnode) is
Ptr_Expr_S : Nodes.Pnode;
begin
Parse_Expression (Parse, Ptr_Expr_S);
if Parse then
Ptr_Expr := Ptr_Expr_S;
end if;
end Parse_Attendre;
procedure Parse_Affect (Parse : in out Boolean;
Ptr_Expr : out Nodes.Pnode) is
Ptr_Expr_S : Nodes.Pnode;
begin
if Lexical.Get = L_Affect then
Lexical.Next;
Parse_Expression (Parse, Ptr_Expr_S);
if Parse then
Ptr_Expr := Ptr_Expr_S;
end if;
else
Parse := False;
end if;
end Parse_Affect;
procedure Parse_Corps_Scene (Parse : in out Boolean;
Ptr_Scene : out Nodes.Pnode) is
use Nodes;
Parse_Corps_Scene : Boolean := False;
Ptr_Action_Predef_S : Nodes.Pnode;
Id1 : Lexical.Lexeme;
Ptr_Id1_S, Ptr_Id2_S : Nodes.Pnode;
Ptr_Expr1_S, Expr2_S : Nodes.Pnode;
Ptr_Cond_S, Ptr_Sinon_S : Nodes.Pnode;
Ptr_Scene_S : Nodes.Pnode;
Ptr_Deb_Code_Scene : Nodes.Pnode := new Node (None);
Ptr_Code_Scene : Nodes.Pnode;
begin
Ptr_Code_Scene := Ptr_Deb_Code_Scene;
while Lexical.Get = L_Activer or else Lexical.Get = L_Desactiver or else
Lexical.Get = L_Modifier or else Lexical.Get = L_Faire or else
Lexical.Get = L_Evoluer or else Lexical.Get = L_Id or else
Lexical.Get = L_Repeter or else Lexical.Get = L_Si or else
Lexical.Get = L_Autemps or else Lexical.Get = L_Attendre loop
case Lexical.Get is
when L_Activer | L_Desactiver | L_Modifier | L_Evoluer =>
Parse_Action_Predef (Parse_Corps_Scene,
Ptr_Action_Predef_S);
if Parse_Corps_Scene then
Ptr_Code_Scene.Next := Ptr_Action_Predef_S;
Ptr_Code_Scene := Ptr_Code_Scene.Next;
end if;
when L_Id =>
Id1 := Lexical.Value;
Symbol.Add (Id1, Variable);
Lexical.Next;
Parse_Affect (Parse_Corps_Scene, Ptr_Expr1_S);
if Parse_Corps_Scene then
Ptr_Id1_S := Nodes.Mkidnode (Id1);
Ptr_Code_Scene.Next := Nodes.Mkaffectnode
(Ptr_Id1_S, Ptr_Expr1_S);
Ptr_Code_Scene := Ptr_Code_Scene.Next;
end if;
when L_Faire =>
Lexical.Next;
Parse_Faire (Parse_Corps_Scene, Ptr_Id1_S, Ptr_Id2_S);
if Parse_Corps_Scene then
Ptr_Code_Scene.Next := Nodes.Mkfairenode
(Ptr_Id1_S, Ptr_Id2_S);
Ptr_Code_Scene := Ptr_Code_Scene.Next;
end if;
when L_Repeter =>
Lexical.Next;
Parse_Repeter (Parse_Corps_Scene, Ptr_Expr1_S, Ptr_Scene_S);
if Parse_Corps_Scene then
Ptr_Code_Scene.Next := Nodes.Mkrepeternode
(Ptr_Expr1_S, Ptr_Scene_S);
Ptr_Code_Scene := Ptr_Code_Scene.Next;
end if;
when L_Si =>
Lexical.Next;
Parse_Si (Parse_Corps_Scene, Ptr_Cond_S,
Ptr_Scene_S, Ptr_Sinon_S);
if Parse_Corps_Scene then
Ptr_Code_Scene.Next :=
Nodes.Mksinode
(Ptr_Cond_S, Ptr_Scene_S, Ptr_Sinon_S);
Ptr_Code_Scene := Ptr_Code_Scene.Next;
end if;
when L_Autemps =>
Lexical.Next;
Parse_Autemps (Parse_Corps_Scene, Ptr_Expr1_S, Ptr_Scene_S);
if Parse_Corps_Scene then
Ptr_Code_Scene.Next := Nodes.Mkautempsnode
(Ptr_Expr1_S, Ptr_Scene_S);
Ptr_Code_Scene := Ptr_Code_Scene.Next;
end if;
when L_Attendre =>
Lexical.Next;
Parse_Attendre (Parse_Corps_Scene, Ptr_Expr1_S);
if Parse_Corps_Scene then
Ptr_Code_Scene.Next :=
Nodes.Mkattendrenode (Ptr_Expr1_S);
Ptr_Code_Scene := Ptr_Code_Scene.Next;
end if;
when others =>
Parse_Corps_Scene := False;
end case;
exit when not Parse_Corps_Scene;
end loop;
Parse := Parse_Corps_Scene;
if Parse then
Ptr_Scene := Ptr_Deb_Code_Scene.Next;
end if;
end Parse_Corps_Scene;
procedure Parse_Scene (Parse : in out Boolean) is
Ptr_Scene_S : Nodes.Pnode;
Id : Lexical.Lexeme;
begin
if Lexical.Get = L_Id then
Id := Lexical.Value;
Symbol.Add (Id, Scene);
Symbol.New_Table (Local_Table_Size);
Lexical.Next;
Parse_Bloc_Param (Parse);
if Parse then
if Lexical.Get = L_Est then
Lexical.Next;
Parse_Corps_Scene (Parse, Ptr_Scene_S);
if Parse then
if Lexical.Get = L_Fin then
Lexical.Next;
if Lexical.Get = L_Scene then
Lexical.Next;
Symbol.Set_Code (Id, Ptr_Scene_S);
else
Parse := False;
end if;
else
Parse := False;
end if;
end if;
else
Parse := False;
end if;
end if;
Symbol.Release_Table;
else
Parse := False;
end if;
end Parse_Scene;
procedure Parse_Corps_Experience (Parse : in out Boolean) is
use Nodes;
Parse_Corps_Experience : Boolean := False;
begin
while Lexical.Get = L_Effet or else Lexical.Get = L_Scene loop
case Lexical.Get is
when L_Effet =>
Lexical.Next;
Parse_Effet (Parse_Corps_Experience);
when L_Scene =>
Lexical.Next;
Parse_Scene (Parse_Corps_Experience);
when others =>
Parse_Corps_Experience := False;
end case;
exit when not Parse_Corps_Experience;
end loop;
Parse := Parse_Corps_Experience;
end Parse_Corps_Experience;
procedure Parse_Bloc_Experience (Parse : in out Boolean) is
begin
if Lexical.Get = L_Experience then
Lexical.Next;
if Lexical.Get = L_Est then
Lexical.Next;
Parse_Corps_Experience (Parse);
if Parse then
if Lexical.Get = L_Fin then
Lexical.Next;
if Lexical.Get = L_Experience then
Lexical.Next;
else
Parse := False;
end if;
else
Parse := False;
end if;
end if;
else
Parse := False;
end if;
end if;
end Parse_Bloc_Experience;
procedure Parse_Corps_Implantation (Parse : in out Boolean) is
Parse_Corps_Implantation : Boolean := False;
Id1 : Lexical.Lexeme;
begin
while Lexical.Get = L_Id loop
Id1 := Lexical.Value;
Symbol.Add (Id1, Station);
Lexical.Next;
if Lexical.Get = L_Est then
Lexical.Next;
if Lexical.Get = L_Id then
Symbol.Set_Type (Id1, Lexical.Value);
Lexical.Next;
if Lexical.Get = L_En then
Lexical.Next;
if Lexical.Get = L_Nbr then
Symbol.Set_Value (Id1, Lexical.Number);
Lexical.Next;
Parse_Corps_Implantation := True;
else
Parse_Corps_Implantation := False;
exit;
end if;
else
Parse_Corps_Implantation := False;
exit;
end if;
else
Parse_Corps_Implantation := False;
exit;
end if;
else
Parse_Corps_Implantation := False;
exit;
end if;
end loop;
Parse := Parse_Corps_Implantation;
end Parse_Corps_Implantation;
procedure Parse_Bloc_Implantation (Parse : in out Boolean) is
begin
if Lexical.Get = L_Implantation then
Lexical.Next;
if Lexical.Get = L_Est then
Lexical.Next;
Parse_Corps_Implantation (Parse);
if Parse then
if Lexical.Get = L_Fin then
Lexical.Next;
if Lexical.Get = L_Implantation then
Lexical.Next;
else
Parse := False;
end if;
else
Parse := False;
end if;
end if;
else
Parse := False;
end if;
else
Parse := False;
end if;
end Parse_Bloc_Implantation;
procedure Parse_Type (Parse : in out Boolean) is
begin
case Lexical.Get is
when L_Binaire =>
Lexical.Next;
Parse := True;
when L_Temporel =>
Lexical.Next;
Parse := True;
when L_Fugitif =>
Lexical.Next;
Parse := True;
when L_Discret =>
Lexical.Next;
Parse := True;
when others =>
Parse := False;
end case;
end Parse_Type;
procedure Parse_Liste_D_Acteurs_Types (Parse : in out Boolean) is
Parse_Liste_D_Acteurs_Types : Boolean := False;
begin
Symbol.New_Table (Actor_Table_Size);
while Lexical.Get = L_Id loop
Symbol.Add (Lexical.Value, Actor);
Lexical.Next;
Parse_Type (Parse_Liste_D_Acteurs_Types);
if not Parse_Liste_D_Acteurs_Types then
exit;
end if;
end loop;
Symbol.Release_Table;
Parse := Parse_Liste_D_Acteurs_Types;
end Parse_Liste_D_Acteurs_Types;
procedure Parse_Corps_Materiel (Parse : in out Boolean) is
Parse_Corps_Materiel : Boolean := False;
begin
while Lexical.Get = L_Categorie loop
Lexical.Next;
if Lexical.Get = L_Id then
Symbol.Add (Lexical.Value, Category);
Lexical.Next;
if Lexical.Get = L_Est then
Lexical.Next;
Parse_Liste_D_Acteurs_Types (Parse_Corps_Materiel);
if Parse_Corps_Materiel then
if Lexical.Get = L_Fin then
Lexical.Next;
if Lexical.Get = L_Categorie then
Lexical.Next;
Parse_Corps_Materiel := True;
else
Error.Handle (" [Categorie] attendu",
Corps_Materiel);
exit;
end if;
else
Error.Handle (" [Fin] attendu", Corps_Materiel);
exit;
end if;
else
exit;
end if;
else
Error.Handle (" [Est] attendu", Corps_Materiel);
exit;
end if;
else
Error.Handle (" [Identificateur] attendu", Corps_Materiel);
exit;
end if;
end loop;
if Parse_Corps_Materiel then
Parse := Parse_Corps_Materiel;
else
Error.Handle (" [Categorie] attendu", Corps_Materiel);
end if;
end Parse_Corps_Materiel;
procedure Parse_Bloc_Materiel (Parse : in out Boolean) is
begin
if Lexical.Get = L_Materiel then
Lexical.Next;
if Lexical.Get = L_Est then
Lexical.Next;
Parse_Corps_Materiel (Parse);
if Parse then
if Lexical.Get = L_Fin then
Lexical.Next;
if Lexical.Get = L_Materiel then
Lexical.Next;
else
Error.Handle (" [Materiel] attendu", Bloc_Materiel);
end if;
else
Error.Handle (" [Fin] attendu", Bloc_Materiel);
end if;
end if;
else
Error.Handle (" [Est] attendu", Bloc_Materiel);
end if;
else
Error.Handle (" [Materiel] attendu", Bloc_Materiel);
end if;
end Parse_Bloc_Materiel;
procedure Parse_Corps_Spectacle (Parse : in out Boolean;
Ptr_Corps_Spectacle : out Nodes.Pnode) is
Ptr_Prog_Principal_S : Nodes.Pnode;
begin
Parse_Bloc_Materiel (Parse);
if Parse then
Parse_Bloc_Implantation (Parse);
if Parse then
Parse_Bloc_Experience (Parse);
if Parse then
Parse_Prog_Principal (Parse, Ptr_Prog_Principal_S);
if Parse then
Ptr_Corps_Spectacle := Ptr_Prog_Principal_S;
end if;
end if;
end if;
end if;
end Parse_Corps_Spectacle;
procedure Parse_Show (Parse : in out Boolean; Ptr_Show : out Nodes.Pnode) is
Ptr_Spectacle_S : Nodes.Pnode;
begin
if Lexical.Get = L_Spectacle then
Lexical.Next;
if Lexical.Get = L_Est then
Lexical.Next;
Symbol.New_Table (Global_Table_Size);
Parse_Corps_Spectacle (Parse, Ptr_Spectacle_S);
if Parse then
if Lexical.Get = L_Fin then
Lexical.Next;
if Lexical.Get = L_Spectacle then
Lexical.Next;
Parse := Lexical.Get = L_Eof;
if Parse then
Ptr_Show := Ptr_Spectacle_S;
end if;
else
Error.Handle (" [Spectacle] attendu", Show);
end if;
else
Error.Handle (" [Fin] attendu", Show);
end if;
end if;
Symbol.Release_Table;
else
Error.Handle (" [Est] attendu", Show);
end if;
else
Error.Handle (" [Spectacle] attendu", Show);
end if;
end Parse_Show;
procedure Parse_File (File_Name : in String) is
use Nodes;
Parse_File : Boolean := True;
Start_Symbol : Lexical.Lexeme;
Ptr_Start_S : Nodes.Pnode := new Node (None);
begin
Lexical.Open (File_Name);
Lexical.Next;
Parse_Show (Parse_File, Ptr_Start_S.Next);
Lexical.Close;
if Parse_File then
Bounded_Strings.Set (Start_Symbol, "#START");
Symbol.Add (Start_Symbol, Symbol.Begining);
Symbol.Set_Code (Start_Symbol, Ptr_Start_S.Next);
else
Error.Handle ("en ", Error.External);
Bounded_Strings.Set (Start_Symbol, "#START");
Symbol.Add (Start_Symbol, Symbol.Begining);
Symbol.Set_Code (Start_Symbol, null);
end if;
end Parse_File;
end Parser;