⟦4787a1dec⟧

TextFile

with Text_Io;
with Bounded_Strings;
with Error;
package body Reduct is

    package Int_Io is new Text_Io.Integer_Io (Integer);

    Maxaddress : constant := 99;   -- limitations liees au format des trames
    Maxvalue : constant := 9999;   -- Bitbus

    Currenttime : Integer := 0;
    Reduct_Ok : Boolean := True;  -- Vrai si pas d'erreur pendant la reduction
    -- passe a Faux sinon pour empecher Production

    -- construction des noeuds de l'arbre reduit avec les 4 actions predef
    function Mkreductact (Periph, Actor : Integer) return Preductnode is
        Ptrnode : Preductnode;
    begin
        Ptrnode := new Reductnode (Act);
        Ptrnode.Thetype := Act;
        Ptrnode.Act_Periph := Periph;
        Ptrnode.Act_Actor := Actor;
        Ptrnode.Thetime := Currenttime;
        return Ptrnode;
    end Mkreductact;

    function Mkreductdes (Periph, Actor : Integer) return Preductnode is
        Ptrnode : Preductnode;
    begin
        Ptrnode := new Reductnode (Des);
        Ptrnode.Thetype := Des;
        Ptrnode.Des_Periph := Periph;
        Ptrnode.Des_Actor := Actor;
        Ptrnode.Thetime := Currenttime;
        return Ptrnode;
    end Mkreductdes;

    function Mkreductmod (Periph, Actor, Nbre : Integer) return Preductnode is
        Ptrnode : Preductnode;
    begin
        Ptrnode := new Reductnode (Modi);
        Ptrnode.Thetype := Modi;
        Ptrnode.Mod_Periph := Periph;
        Ptrnode.Mod_Actor := Actor;
        Ptrnode.Mod_Nbre := Nbre;
        Ptrnode.Thetime := Currenttime;
        return Ptrnode;
    end Mkreductmod;

    function Mkreductevo (Periph, Actor, Nbre1, Nbre2 : Integer)
                         return Preductnode is
        Ptrnode : Preductnode;
    begin
        Ptrnode := new Reductnode (Evo);
        Ptrnode.Thetype := Evo;
        Ptrnode.Evo_Periph := Periph;
        Ptrnode.Evo_Actor := Actor;
        Ptrnode.Evo_Nbre1 := Nbre1;
        Ptrnode.Evo_Nbre2 := Nbre2;
        Ptrnode.Thetime := Currenttime;
        return Ptrnode;
    end Mkreductevo;

    -- evaluation d'une expression
    -- declaration incomplete, prototype
    function Exprgetvalue (Aexprnode : Nodes.Pnode) return Integer;

    function Idgetvalue (Aidnode : Nodes.Pnode) return Integer is
    begin
        return Symbol.Get_Value (Aidnode.Id_Val);
    end Idgetvalue;

    function Idactorgetvalue (Periph : Lexical.Lexeme; Aidnode : Nodes.Pnode)
                             return Integer is
    begin
        return Symbol.Get_Actor_Number (Periph, Aidnode.Id_Val);
    end Idactorgetvalue;

    function Factgetvalue (Afactnode : Nodes.Pnode) return Integer is
        use Nodes;
    begin
        case Afactnode.Fac_Node.Thetype is
            when Expression =>
                return Exprgetvalue (Afactnode.Fac_Node);
            when Id =>
                return Idgetvalue (Afactnode.Fac_Node);
            when Nombre =>
                return Nodes.Nbgetvalue (Afactnode.Fac_Node);
            when others =>
                null;
        end case;
    end Factgetvalue;

    procedure Termprimegetvalue (Result_Factl : in out Integer;
                                 Atermprimenode : Nodes.Pnode) is
        use Nodes;
        use Error;
        Result_Factr : Integer;
    begin
        Result_Factr := Factgetvalue (Atermprimenode.Terp_Fact);
        case Atermprimenode.Terp_Op is
            when Mul =>
                Result_Factl := Result_Factl * Result_Factr;
            when Div =>
                if Result_Factr = 0 then
                    Reduct_Ok := False;
                    Result_Factl := 0;
                    Error.Handle (Divide_By_Zero);
                else
                    Result_Factl := Result_Factl / Result_Factr;
                end if;
            when Modulo =>
                Result_Factl := Result_Factl mod Result_Factr;
            when others =>
                null;
        end case;
        -- si il y a d'autres TermePrime a calculer on recursive
        if Atermprimenode.Terp_Termprime /= null then
            Termprimegetvalue (Result_Factl, Atermprimenode.Terp_Termprime);
        end if;
    end Termprimegetvalue;

    function Termgetvalue (Atermnode : Nodes.Pnode) return Integer is
        use Nodes;
        Result_Factl, Result_Factr : Integer;
    begin
        if Atermnode.Thetype = Terme then
            if Atermnode.Ter_Fact /= null then
                Result_Factl := Factgetvalue (Atermnode.Ter_Fact);
            end if;
            if Atermnode.Ter_Termprime /= null then
                Termprimegetvalue (Result_Factl, Atermnode.Ter_Termprime);
            end if;
            return Result_Factl;
        else
            return 0;     -- erreur du programme
        end if;
    end Termgetvalue;

    procedure Exprprimegetvalue (Result_Terml : in out Integer;
                                 Aexprprimenode : Nodes.Pnode) is
        Result_Termr : Integer;
        use Nodes;
    begin
        Result_Termr := Termgetvalue (Aexprprimenode.Expp_Term);
        case Aexprprimenode.Expp_Op is
            when Add =>
                Result_Terml := Result_Terml + Result_Termr;
            when Sub =>
                Result_Terml := Result_Terml - Result_Termr;
            when others =>
                null;
        end case;
        -- si il y a d'autres ExpressionPrime a calculer on recursive
        if Aexprprimenode.Expp_Exprprime /= null then
            Exprprimegetvalue (Result_Terml, Aexprprimenode.Expp_Exprprime);
        end if;
    end Exprprimegetvalue;

    function Exprgetvalue (Aexprnode : Nodes.Pnode) return Integer is
        use Nodes;
        use Error;
        Result_Terml, Result_Termr : Integer;
    begin
        if Aexprnode.Thetype = Expression then
            if Aexprnode.Exp_Term /= null then
                Result_Terml := Termgetvalue (Aexprnode.Exp_Term);
            end if;
            if Aexprnode.Exp_Exprprime /= null then
                Exprprimegetvalue (Result_Terml, Aexprnode.Exp_Exprprime);
            end if;
            return Result_Terml;
        else
            return 0;  -- erreur du programme
        end if;
    end Exprgetvalue;

    -- affichage d'une expression telle qu'elle est construite sous forme d'arbre

    procedure Printidactor (Periph : Lexical.Lexeme; Ptr : Nodes.Pnode) is
    begin
        Text_Io.Put (Bounded_Strings.Image (Ptr.Id_Val));
        Text_Io.Put (' ');
        Int_Io.Put (Symbol.Get_Actor_Number
                       (Periph, Ptr.Id_Val));  -- pour table globale seulement
    end Printidactor;

    procedure Printid (Ptr : Nodes.Pnode) is
        use Nodes;
    begin
        if Ptr /= null then
            Text_Io.Put (Bounded_Strings.Image (Ptr.Id_Val));
            Text_Io.Put (' ');
            Int_Io.Put (Symbol.Get_Value (Ptr.Id_Val));
        end if;
    end Printid;

    -- prototype
    procedure Printexpr (Aexprnode : Nodes.Pnode);

    procedure Printfact (Afactnode : Nodes.Pnode) is
        use Nodes;
    begin
        case Afactnode.Fac_Node.Thetype is
            when Expression =>
                Printexpr (Afactnode.Fac_Node);
            when Id =>
                Printid (Afactnode.Fac_Node);
            when Nombre =>
                Int_Io.Put (Nodes.Nbgetvalue (Afactnode.Fac_Node));
            when others =>
                null;
        end case;
    end Printfact;

    procedure Printtermprime (Atermprimenode : Nodes.Pnode) is
        use Nodes;
    begin
        case Atermprimenode.Terp_Op is
            when Mul =>
                Text_Io.Put ("*");
            when Div =>
                Text_Io.Put ("/");
            when Modulo =>
                Text_Io.Put ("mod");
            when others =>
                null;
        end case;
        Printfact (Atermprimenode.Terp_Fact);
        -- si il y a d'autres TermPrime a calculer on recursive
        if Atermprimenode.Terp_Termprime /= null then
            Printtermprime (Atermprimenode.Terp_Termprime);
        end if;
    end Printtermprime;

    procedure Printterm (Atermnode : Nodes.Pnode) is
        use Nodes;
    begin
        if Atermnode.Thetype = Terme then
            if Atermnode.Ter_Fact /= null then
                Printfact (Atermnode.Ter_Fact);
            end if;
            if Atermnode.Ter_Termprime /= null then
                Printtermprime (Atermnode.Ter_Termprime);
            end if;
        end if;
    end Printterm;

    procedure Printexprprime (Aexprprimenode : Nodes.Pnode) is
        use Nodes;
    begin
        case Aexprprimenode.Expp_Op is
            when Add =>
                Text_Io.Put ("+");
            when Sub =>
                Text_Io.Put ("-");
            when others =>
                null;
        end case;
        Printterm (Aexprprimenode.Expp_Term);
        -- si il y a d'autres ExpressionPrime a calculer on recursive
        if Aexprprimenode.Expp_Exprprime /= null then
            Printexprprime (Aexprprimenode.Expp_Exprprime);
        end if;
    end Printexprprime;

    procedure Printexpr (Aexprnode : Nodes.Pnode) is
        use Nodes;
    begin
        if Aexprnode.Thetype = Expression then
            if Aexprnode.Exp_Term /= null then
                Printterm (Aexprnode.Exp_Term);
            end if;
            if Aexprnode.Exp_Exprprime /= null then
                Printexprprime (Aexprnode.Exp_Exprprime);
            end if;
        end if;
    end Printexpr;

    -- affichage du contenu de l'arbre

    procedure Printexprvalue (Aexprnode : Nodes.Pnode) is
    begin
        Int_Io.Put (Exprgetvalue (Aexprnode));
        Text_Io.Put (' ');
    end Printexprvalue;

    procedure Printaffect (Ptr : Nodes.Pnode) is
    begin
        Printid (Ptr.Aff_Id);
        Text_Io.Put (" := ");
        Printexpr (Ptr.Aff_Expr);
        Text_Io.New_Line;
    end Printaffect;

    procedure Printfaire (Ptr : Nodes.Pnode) is
        use Nodes;
    begin
        Text_Io.Put ("-> Faire ");
        Printid (Ptr.Fai_Id1);
        Printid (Ptr.Fai_Id2);
        Text_Io.New_Line;
    end Printfaire;

    procedure Printactiver (Ptr : Nodes.Pnode) is
    begin
        Text_Io.Put (" -> Activer ");
        Printid (Ptr.Act_Id1);
        Printidactor (Ptr.Act_Id1.Id_Val, Ptr.Act_Id2);
        Text_Io.New_Line;
    end Printactiver;

    procedure Printdesactiver (Ptr : Nodes.Pnode) is
    begin
        Text_Io.Put (" -> Desactiver ");
        Printid (Ptr.Des_Id1);
        Printidactor (Ptr.Des_Id1.Id_Val, Ptr.Des_Id2);
        Text_Io.New_Line;
    end Printdesactiver;

    procedure Printmodifier (Ptr : Nodes.Pnode) is
    begin
        Text_Io.Put (" -> Modifier ");
        Printid (Ptr.Mod_Id1);
        Printidactor (Ptr.Mod_Id1.Id_Val, Ptr.Mod_Id2);
        Printexprvalue (Ptr.Mod_Expr);
        Text_Io.New_Line;
    end Printmodifier;

    procedure Printevoluer (Ptr : Nodes.Pnode) is
    begin
        Text_Io.Put (" -> Evoluer ");
        Printid (Ptr.Evo_Id1);
        Printidactor (Ptr.Evo_Id1.Id_Val, Ptr.Evo_Id2);
        Printexprvalue (Ptr.Evo_Expr1);
        Printexprvalue (Ptr.Evo_Expr2);
        Text_Io.New_Line;
    end Printevoluer;

    procedure Printrepeter (Ptr : Nodes.Pnode) is
    begin
        Text_Io.Put (" -------> Repeter ");
        Printexprvalue (Ptr.Rep_Expr);
        Text_Io.New_Line;
        Printtree (Ptr.Rep_Instr);
        Text_Io.New_Line;
        Text_Io.Put_Line (" -------> fin Repeter ");
    end Printrepeter;

    procedure Printsinon (Ptr : Nodes.Pnode) is
    begin
        Text_Io.Put ("--------> Sinon ");
        Printtree (Ptr.Sin_Instr);
        Text_Io.New_Line;
    end Printsinon;

    procedure Printcond (Ptr : Nodes.Pnode) is
    begin
        Text_Io.Put (Boolean'Image (Ptr.Con_Val));
    end Printcond;

    procedure Printsi (Ptr : Nodes.Pnode) is
        use Nodes;
    begin
        Text_Io.Put ("--------> Si ");
        Printcond (Ptr.Si_Cond);
        Text_Io.Put (" alors ");
        Text_Io.New_Line;
        Printtree (Ptr.Si_Instr);
        if Ptr.Si_Sinon /= null then
            Printsinon (Ptr.Si_Sinon);
        end if;
        Text_Io.Put_Line ("-------> fin Si ");
    end Printsi;

    procedure Printautemps (Ptr : Nodes.Pnode) is
    begin
        Text_Io.Put ("--------> Autemps ");
        Printexprvalue (Ptr.Aut_Expr);
        Text_Io.New_Line;
        Printtree (Ptr.Aut_Instr);
        Text_Io.New_Line;
        Text_Io.Put_Line ("-------> fin Autemps ");
    end Printautemps;

    procedure Printattendre (Ptr : Nodes.Pnode) is
        use Nodes;
    begin
        Text_Io.Put ("--------> Attendre ");
        Printexprvalue (Ptr.Att_Expr);
        Text_Io.New_Line;
    end Printattendre;

    procedure Printtree (Atreenode : Nodes.Pnode) is
        use Nodes;
        Ptr : Nodes.Pnode;
    begin
        Ptr := Atreenode;
        while Ptr /= null loop
            case Ptr.Thetype is
                when Affect =>
                    Printaffect (Ptr);
                when Faire =>
                    Printfaire (Ptr);
                when Activer =>
                    Printactiver (Ptr);
                when Desactiver =>
                    Printdesactiver (Ptr);
                when Modifier =>
                    Printmodifier (Ptr);
                when Evoluer =>
                    Printevoluer (Ptr);
                when Repeter =>
                    Printrepeter (Ptr);
                when Si =>
                    Printsi (Ptr);
                when Autemps =>
                    Printautemps (Ptr);
                when Attendre =>
                    Printattendre (Ptr);
                when others =>
                    null;
            end case;
            Ptr := Ptr.Next;
        end loop;
    end Printtree;


    -- evaluation d'une condition
    function Conditionistrue (Acondnode : Nodes.Pnode) return Boolean is
        use Nodes;
        Nbre1, Nbre2 : Integer := 0;
    begin
        if Acondnode.Con_Expr1 /= null then
            Nbre1 := Exprgetvalue (Acondnode.Con_Expr1);
            if Acondnode.Con_Expr2 /= null then
                Nbre2 := Exprgetvalue (Acondnode.Con_Expr2);
            end if;
            case Acondnode.Con_Op is
                when Inf =>
                    return Nbre1 < Nbre2;
                when Sup =>
                    return Nbre1 > Nbre2;
                when Eq =>
                    return Nbre1 = Nbre2;
                when Inf_Eq =>
                    return Nbre1 <= Nbre2;
                when Sup_Eq =>
                    return Nbre1 >= Nbre2;
                when Diff =>
                    return Nbre1 /= Nbre2;
                when None =>
                    return True;
            end case;
        else
            return True;  -- une Expression est toujours vraie
        end if;
    end Conditionistrue;

    function Isvalid (Number1, Number2 : Integer; Max : Integer)
                     return Boolean is
        use Error;
    begin
        if Number1 > Max or Number2 > Max then    -- Cas Nombre > Max
            Reduct_Ok := False;
            Error.Handle (Bitbus_Error);
        end if;
        if Number1 < 0 or Number2 < 0 then        -- Cas Nombre < 0
            Reduct_Ok := False;
            Error.Handle (Negativ_Number);
        end if;
        if Reduct_Ok then                     -- Ok
            return True;
        else
            return False;                      -- Not Ok
        end if;
    end Isvalid;

    procedure Reductactiver (Ptr : Nodes.Pnode;
                             Phead : in out Preductnode;
                             Pqueue : out Preductnode) is
        Periph, Actor, Time : Integer;
    begin
        Periph := Idgetvalue (Ptr.Act_Id1);
        Actor := Idactorgetvalue (Ptr.Act_Id1.Id_Val, Ptr.Act_Id2);
        if Isvalid (Periph, Actor, Maxaddress) then
            Phead := Mkreductact (Periph, Actor);
        end if;
        Pqueue := Phead;
    end Reductactiver;

    procedure Reductdesactiver (Ptr : Nodes.Pnode;
                                Phead : in out Preductnode;
                                Pqueue : out Preductnode) is
        Periph, Actor : Integer;
    begin
        Periph := Idgetvalue (Ptr.Des_Id1);
        Actor := Idactorgetvalue (Ptr.Des_Id1.Id_Val, Ptr.Des_Id2);
        if Isvalid (Periph, Actor, Maxaddress) then
            Phead := Mkreductdes (Periph, Actor);
        end if;
        Pqueue := Phead;
    end Reductdesactiver;

    procedure Reductmodifier (Ptr : Nodes.Pnode;
                              Phead : in out Preductnode;
                              Pqueue : out Preductnode) is
        Periph, Actor, Value1 : Integer;
    begin
        Periph := Idgetvalue (Ptr.Mod_Id1);
        Actor := Idactorgetvalue (Ptr.Mod_Id1.Id_Val, Ptr.Mod_Id2);
        Value1 := Exprgetvalue (Ptr.Mod_Expr);
        if Isvalid (Value1, 0, Maxvalue) then
            if Isvalid (Periph, Actor, Maxaddress) then
                Phead := Mkreductmod (Periph, Actor, Value1);
            end if;
        end if;
        Pqueue := Phead;
    end Reductmodifier;

    procedure Reductevoluer (Ptr : Nodes.Pnode;
                             Phead : in out Preductnode;
                             Pqueue : out Preductnode) is
        Periph, Actor, Value1, Value2 : Integer;
    begin
        Periph := Idgetvalue (Ptr.Evo_Id1);
        Actor := Idactorgetvalue (Ptr.Evo_Id1.Id_Val, Ptr.Evo_Id2);
        Value1 := Exprgetvalue (Ptr.Evo_Expr1);
        Value2 := Exprgetvalue (Ptr.Evo_Expr2);
        if Isvalid (Value1, Value2, Maxvalue) then
            if Isvalid (Periph, Actor, Maxaddress) then
                Phead := Mkreductevo (Periph, Actor, Value1, Value2);
            end if;
        end if;
        Pqueue := Phead;
    end Reductevoluer;

    -- prototype
    procedure Reductbodytree (Ptraabstracttree : Nodes.Pnode;
                              Phead : in out Preductnode;
                              Pqueue : in out Preductnode);

    procedure Reductaffect (Ptr : Nodes.Pnode;
                            Phead : in out Preductnode;
                            Pqueue : in out Preductnode) is
        use Nodes;
        use Symbol;
        Avariable : Lexical.Lexeme;
        Valeur : Integer := 0;
    begin
        Avariable := Nodes.Idgetlex (Ptr.Aff_Id);
        Valeur := Exprgetvalue (Ptr.Aff_Expr);
        Symbol.Set_Value (Avariable, Valeur);
        Pqueue := Phead;
    end Reductaffect;

    procedure Reductfaire (Ptr : Nodes.Pnode;
                           Phead : in out Preductnode;
                           Pqueue : in out Preductnode) is
        use Nodes;
        use Symbol;
        Numero : Integer := 1;
        Ssprogname, Argid, Arg_Effectiv_Id : Lexical.Lexeme;
        Ptrarg, Pcode : Nodes.Pnode;
    begin
        Ssprogname := Nodes.Idgetlex (Ptr.Fai_Id1);
        Pcode := Symbol.Get_Code (Ssprogname);
        Symbol.Set_Current_Table (Ssprogname);
        -- recuperer les params
        Ptrarg := Ptr.Fai_Id2;
        while Ptrarg /= null loop
            Argid := Nodes.Idgetlex (Ptrarg);
            Arg_Effectiv_Id := Symbol.Get_Effectfiv_Arg_Name (Argid);
            Symbol.Set_Arg_Value (Arg_Effectiv_Id, Numero);
            Ptrarg := Ptrarg.Next;
            Numero := Numero + 1;
        end loop;
        Reductbodytree (Pcode, Phead, Pqueue);
        Phead := Pqueue;
        Symbol.
           Reset_Current_Table;   -- pour se repositionner sur la table precedente
    end Reductfaire;

    procedure Reductrepeter (Ptr : Nodes.Pnode;
                             Phead : in out Preductnode;
                             Pqueue : in out Preductnode) is
        use Nodes;
        Times : Integer;
    begin
        Times := Exprgetvalue (Ptr.Rep_Expr);
        if Isvalid (Times, 0, Integer'Last) then
            for I in 1 .. Times loop
                Reductbodytree (Ptr.Rep_Instr, Phead, Pqueue);
                Phead := Pqueue;
            end loop;
        else
            Pqueue := Phead;
        end if;
    end Reductrepeter;

    procedure Reductsinon (Ptr : Nodes.Pnode;
                           Phead : in out Preductnode;
                           Pqueue : in out Preductnode) is
    begin
        Reductbodytree (Ptr.Sin_Instr, Phead, Pqueue);
    end Reductsinon;

    procedure Reductsi (Ptr : Nodes.Pnode;
                        Phead : in out Preductnode;
                        Pqueue : in out Preductnode) is
        use Nodes;
    begin
        if Conditionistrue (Ptr.Si_Cond) then
            Reductbodytree (Ptr.Si_Instr, Phead, Pqueue);
        else
            if Ptr.Si_Sinon /= null then
                Reductsinon (Ptr.Si_Sinon, Phead, Pqueue);
            end if;
        end if;
    end Reductsi;

    procedure Reductautemps (Ptr : Nodes.Pnode;
                             Phead : in out Preductnode;
                             Pqueue : in out Preductnode) is
    begin
        Currenttime := Exprgetvalue (Ptr.Aut_Expr);
        if Isvalid (Currenttime, 0, Integer'Last) then
            Reductbodytree (Ptr.Aut_Instr, Phead, Pqueue);
        else
            Pqueue := Phead;
        end if;
    end Reductautemps;

    procedure Reductattendre (Ptr : Nodes.Pnode;
                              Phead : in out Preductnode;
                              Pqueue : in out Preductnode) is
    begin
        Currenttime := Currenttime + Exprgetvalue (Ptr.Att_Expr);
        -- possibilite de faire Attendre ( <temps negatif> )
        if Currenttime < 0 then
            Currenttime := 0;
        end if;
        Pqueue := Phead;  -- pas de noeud cree ici
    end Reductattendre;

    procedure Reductbodytree (Ptraabstracttree : Nodes.Pnode;
                              Phead : in out Preductnode;
                              Pqueue : in out Preductnode) is
        use Nodes;
        Ptr : Nodes.Pnode;
        Localphead : Preductnode;
    begin
        Ptr := Ptraabstracttree;
        Localphead := Phead;
        while Ptr /= null loop

            case Ptr.Thetype is
                when Activer =>
                    Reductactiver (Ptr, Localphead.Next, Pqueue);
                when Desactiver =>
                    Reductdesactiver (Ptr, Localphead.Next, Pqueue);
                when Modifier =>
                    Reductmodifier (Ptr, Localphead.Next, Pqueue);
                when Evoluer =>
                    Reductevoluer (Ptr, Localphead.Next, Pqueue);
                when Affect =>
                    Reductaffect (Ptr, Localphead, Pqueue);
                when Faire =>
                    Reductfaire (Ptr, Localphead, Pqueue);
                when Repeter =>
                    Reductrepeter (Ptr, Localphead, Pqueue);
                when Si =>
                    Reductsi (Ptr, Localphead, Pqueue);
                when Autemps =>
                    Reductautemps (Ptr, Localphead, Pqueue);
                when Attendre =>
                    Reductattendre (Ptr, Localphead, Pqueue);
                when others =>
                    null;
            end case;
            if (Ptr.Thetype /= None) or (Ptr.Thetype /= Faire) then
                Localphead := Pqueue;
            end if;
            Ptr := Ptr.Next;
        end loop;
    end Reductbodytree;

    function Reducttree return Preductnode is
        use Nodes;
        Ptraabstracttree : Nodes.Pnode; -- Debut de l'arbre abstrait.
        Pstarttree :
           Preductnode;                 -- Debut arbre reduit a transmettre a PRODUCT.
        Pbidon :
           Preductnode;                 -- Pbidon n'est pas utilisee , lie au codage
                                        -- correspond a un pointeur sur la fin de l'arbre
                                        -- reduit final.
        Start_Symbol : Lexical.Lexeme;
    begin
        Pstarttree := new Reductnode (None);    -- ancre pour depart
        Symbol.Init_Tables_Stack;
        Bounded_Strings.Set (Start_Symbol, "#START");
        Ptraabstracttree := Symbol.Get_Code (Start_Symbol);
        if Ptraabstracttree /= null then
            Reductbodytree (Ptraabstracttree, Pstarttree, Pbidon);
        else
            Reduct_Ok := False;
        end if;
        if Reduct_Ok then
            return Pstarttree.Next;
            -- debut de l'arbre reduit
            -- mission terminee, on passe la main a PRODUCT
        else
            return null;
            -- pas de Production de code dans ce cas
        end if;
    end Reducttree;

end Reduct;
DataMuseum.dk

Rational R1000/400 Tapes

⟦4787a1dec⟧ TextFile

Derivation

TextFile
