DataMuseum.dk

top - download

    Length: 7517 (0x1d5d)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with Bounded_String;
with String_Utilities;  
with Error_Broadcaster;
package body Bloc_Class is




-- iterateur de la classe bloc_class

    procedure Init (Iter : out Iterator; Coll : in Collection) is
    begin
        Iter := Iterator'First;
    end Init;

    procedure Next (Iter : in out Iterator) is
    begin
        Iter := Iter + 1;
    end Next;

    function Done (Iter : in Iterator) return Boolean is
    begin
        return (Iterator'Last = Iter);
    end Done;

    function Value (Iter : in Iterator) return Index is
    begin
        return Iter;  
    end Value;
    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return String is
    begin
        return ("Bloc Numero: " &
                String_Utilities.Number_To_String (To_Object.Identity, 10, 2) &
                " Mon Bloc englobant: " &
                String_Utilities.Number_To_String
                   ((Bloc_Collection.Table (To_Object.Identity).
                     Enclosing.Identity), 10, 2));
    end Send;
    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return Object.Reference is
        Bloc_Node : Bloc.Node;
        Obj, Enclosing_Bloc : Object.Reference;

    begin
        Bloc_Node := Bloc_Collection.Table (To_Object.Identity).Node;
        Enclosing_Bloc := Current_Bloc;
        Current_Bloc := To_Object;
        Obj := Bloc.Interpret (Bloc_Node, The_Message);
        Current_Bloc := Enclosing_Bloc;
        return Obj;
    end Send;

    function Send (To_Object : Object.Reference;  
                   The_Argument : Object.Parameters.List)
                  return Object.Reference is
        Local_Argument : Object.Parameters.List := The_Argument;
        Bloc_Node : Bloc.Node;
        Obj, Enclosing_Bloc, Iteration_Object : Object.Reference;  
        The_Message : Object.Message;
    begin
        Bounded_String.Copy (The_Message, "valeur");
        Bloc_Node := Bloc_Collection.Table (To_Object.Identity).Node;

        Enclosing_Bloc := Current_Bloc;
        Current_Bloc := To_Object;
        if (String_Utilities.Equal
               (Bounded_String.Image
                   (Object.Parameters.Selector (Local_Argument)),
                "tantQueVrai:", True)) then
            Object.Parameters.Get (Local_Argument, Iteration_Object);
            while (Object.Send (To_Object, The_Message).Identity = 1) loop
                Obj := (Object.Send (Iteration_Object, The_Message));
            end loop;
            return Obj;
        elsif (String_Utilities.Equal
                  (Bounded_String.Image
                      (Object.Parameters.Selector (Local_Argument)),
                   "tantQueFaux:", True)) then
            Object.Parameters.Get (Local_Argument, Iteration_Object);
            while (Object.Send (To_Object, The_Message).Identity = 0) loop
                Obj := (Object.Send (Iteration_Object, The_Message));
            end loop;
            return Obj;
        else

            Bloc.Interpret (Bloc_Node, Local_Argument, Obj);
        end if;

        Current_Bloc := Enclosing_Bloc;
        return Obj;
    end Send;


    function Create (Value : Object.Message) return Object.Reference is
    begin
        Next (Bloc_Collection.Iter);
        return (Object.Tiny_Bloc, Bloc_Collection.Iter);
    end Create;

    procedure Set (Address : Bloc.Node) is
    begin
        Symbol.Create (Bloc_Collection.Table (Bloc_Collection.Iter).Table);
        Bloc_Collection.Table (Bloc_Collection.Iter) :=
           (Address, Bloc_Collection.Table (Bloc_Collection.Iter).Table,
            Current_Bloc);
        Current_Bloc := (Object.Tiny_Bloc, Bloc_Collection.Iter);
    end Set;

    procedure Close is
    begin
        Current_Bloc := Bloc_Collection.Table (Current_Bloc.Identity).Enclosing;
    end Close;
    function Already_Exist
                (Identifier : Object.Message; Bloc : Object.Reference)
                return Boolean is
        Item : Object.Reference;
    begin
        Item := Bloc;
        while ((not Symbol.Already_Exist
                       (Bounded_String.Image (Identifier),
                        Bloc_Collection.Table (Item.Identity).Table)) and
               (Item.Identity /= Bloc_Collection.Table (Item.Identity).
                                    Enclosing.Identity)) loop
            Item := Bloc_Collection.Table (Item.Identity).Enclosing;
        end loop;
        return Symbol.Already_Exist
                  (Bounded_String.Image (Identifier),
                   Bloc_Collection.Table (Item.Identity).Table);
    end Already_Exist;



    procedure Local_Put (Identifier : Object.Message) is
        Obj : Object.Reference;
    begin
        Symbol.Put (Bounded_String.Image (Identifier),
                    Bloc_Collection.Table (Current_Bloc.Identity).Table, Obj);
    end Local_Put;


    procedure Put (Identifier : Object.Message) is
        Obj : Object.Reference := (Object.Tiny_Void, 0);
    begin  
        if not Already_Exist (Identifier, Current_Bloc) then
            Symbol.Put
               (Bounded_String.Image (Identifier),
                Bloc_Collection.Table (Current_Bloc.Identity).Table, Obj);
        end if;  
    end Put;
    procedure Set (Identifier : Object.Message; Obj : Object.Reference) is
        Item : Object.Reference;

    begin
        Item := Current_Bloc;
        while (not Symbol.Already_Exist
                      (Bounded_String.Image (Identifier),
                       Bloc_Collection.Table (Item.Identity).Table)) and
              (Item.Identity /= Bloc_Collection.Table (Item.Identity).
                                   Enclosing.Identity) loop
            Item := Bloc_Collection.Table (Item.Identity).Enclosing;
        end loop;
        Symbol.Put (Bounded_String.Image (Identifier),
                    Bloc_Collection.Table (Item.Identity).Table, Obj);
    end Set;

    function Get (Identifier : Object.Message) return Object.Reference is
        Item : Object.Reference;

    begin
        Item := Current_Bloc;
        if (Already_Exist (Identifier, Current_Bloc)) then
            while (not Symbol.Already_Exist
                          (Bounded_String.Image (Identifier),
                           Bloc_Collection.Table (Item.Identity).Table)) and
                  (Item.Identity /= Bloc_Collection.Table (Item.Identity).
                                       Enclosing.Identity) loop
                Item := Bloc_Collection.Table (Item.Identity).Enclosing;
            end loop;
            return (Symbol.Get (Bounded_String.Image (Identifier),
                                Bloc_Collection.Table (Item.Identity).Table));
        else  
            raise Error_Broadcaster.Unknown_Variable;
        end if;
    exception
        when Error_Broadcaster.Unknown_Variable =>
            Error_Broadcaster.Unknownvariable (Identifier);
            raise Error_Broadcaster.Unknown_Variable;
    end Get;
begin
    Symbol.Create (Bloc_Collection.Table (0).Table);
    Bloc_Collection.Table (Bloc_Collection.Iter).Node := Bloc.Empty_Node;
    Current_Bloc := (Object.Tiny_Bloc, 0);
    Bloc_Collection.Table (Bloc_Collection.Iter).Enclosing := Current_Bloc;
    Bounded_String.Copy (Predifined_Symbol, "tortue");
    Local_Put (Predifined_Symbol);
    Set (Predifined_Symbol, (Object.Tiny_Turtle, 0));
    Bounded_String.Copy (Predifined_Symbol, "stylo");
    Local_Put (Predifined_Symbol);
    Set (Predifined_Symbol, (Object.Tiny_Pen, 0));
end Bloc_Class;