DataMuseum.dk

top - metrics - download

    Length: 6476 (0x194c)
    Types: TextFile
    Names: »B«

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

TextFile

with Class_Integer, Class_Boolean, Class_String, Class_Block;
with Bounded_String;

package body Object is

    function Create (Class : E_Class; Object : Index) return Reference is
    begin
        return Reference'(Id_Class => Class, Id_Object => Object);
    end Create;

    function Get (From : Reference) return E_Class is
    begin
        return From.Id_Class;
    end Get;

    function Get (From : Reference) return Index is
    begin
        return From.Id_Object;
    end Get;

    procedure Put (This : E_Class; Into : out Reference) is
    begin
        Into.Id_Class := This;
    end Put;

    procedure Put (This : Index; Into : out Reference) is
    begin
        Into.Id_Object := This;
    end Put;

    procedure Init (This : in out Keyword) is
    begin
        Message_Name.Init (This.Iter_Name, This.Name);
        Message_Argument.Init (This.Iter_Arg, This.Argument);

    end Init;

    function Create return Keyword is
        Mess : Keyword;
    begin
        Init (Mess);
        return Mess;
    end Create;

    function Get (From : Keyword) return Tiny_String is
    begin
        return Message_Name.Value (From.Iter_Name);
    end Get;

    function Get (From : Keyword) return Reference is
    begin
        return Message_Argument.Value (From.Iter_Arg);
    end Get;

    procedure Put (This : Tiny_String;
                   And_This : Reference;
                   Into : in out Keyword) is
    begin
        Into.Name := Message_Name.Make (This, Into.Name);
        Into.Argument := Message_Argument.Make (And_This, Into.Argument);
        Init (Into);
    end Put;

    procedure Put (This : Tiny_String; Into : in out Keyword) is
    begin
        Into.Name := Message_Name.Make (This, Into.Name);
        Message_Name.Init (Into.Iter_Name, Into.Name);
    end Put;

    procedure Put (This : Reference; Into : in out Keyword) is
    begin  
        Into.Argument := Message_Argument.Make (This, Into.Argument);
        Message_Argument.Init (Into.Iter_Arg, Into.Argument);
    end Put;

    procedure Next (From : in out Keyword) is
    begin
        Message_Name.Next (From.Iter_Name);
        Message_Argument.Next (From.Iter_Arg);
    end Next;

    function Is_Done (This : Keyword) return Boolean is
    begin
        return Message_Name.Done (This.Iter_Name) or
                  Message_Argument.Done (This.Iter_Arg);
    end Is_Done;

    function Is_Done_Name (This : Keyword) return Boolean is
    begin
        return Message_Name.Done (This.Iter_Name);
    end Is_Done_Name;

    function Is_Done_Argument (This : Keyword) return Boolean is
    begin
        return Message_Argument.Done (This.Iter_Arg);
    end Is_Done_Argument;

    procedure Free (This : in out Keyword) is
    begin
        Message_Name.Free (This.Name);
        Message_Argument.Free (This.Argument);
    end Free;

    function Create return Binary is
        Mess : Binary;
    begin
        return Mess;
    end Create;

    function Get (From : Binary) return Tiny_String is
    begin
        return From.Name;
    end Get;

    function Get (From : Binary) return Reference is
    begin
        return From.Argument;
    end Get;

    procedure Put (This : Tiny_String; Into : out Binary) is
    begin
        Into.Name := This;
    end Put;

    procedure Put (This : Reference; Into : out Binary) is
    begin
        Into.Argument := This;
    end Put;

    procedure Init (This : in out Unary) is
    begin
        Message_Name.Init (This.Iter, This.Name);
    end Init;

    function Create return Unary is
        Message : Unary;
    begin
        Message_Name.Init (Message.Iter, Message.Name);
        return Message;
    end Create;

    procedure Put (This : Tiny_String; Into : in out Unary) is
    begin
        Into.Name := Message_Name.Make (This, Into.Name);
        Message_Name.Init (Into.Iter, Into.Name);
    end Put;

    function Get (From : Object.Unary) return Object.Tiny_String is
    begin  
        return Message_Name.Value (From.Iter);
    end Get;

    procedure Next (From : in out Unary) is
    begin
        Message_Name.Next (From.Iter);
    end Next;

    function Is_Done (This : Unary) return Boolean is
    begin
        return Message_Name.Done (This.Iter);
    end Is_Done;

    procedure Free (This : in out Unary) is
    begin
        Message_Name.Free (This.Name);
    end Free;

    function Send (This_Message : Keyword; To : Reference) return Reference is
        package Name renames Object.Message_Name;
        package Argument renames Object.Message_Argument;
    begin
        case To.Id_Class is
            when Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when String_Class =>
                return Class_String.Send (This_Message, To);
            when Turtle_Class =>
                null;
            when Pen_Class =>
                null;
            when Block_Class =>
                null;
            when Void_Class =>
                return To;
        end case;
    end Send;

    function Send (This_Message : Binary; To : Reference) return Reference is
    begin
        case To.Id_Class is
            when Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when String_Class =>
                return Class_String.Send (This_Message, To);
            when Turtle_Class =>
                null;
            when Pen_Class =>
                null;
            when Block_Class =>
                null;
            when Void_Class =>
                return To;
        end case;
    end Send;

    function Send (This_Message : Unary; To : Reference) return Reference is
    begin
        case To.Id_Class is
            when Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when String_Class =>
                return Class_String.Send (This_Message, To);
            when Turtle_Class =>
                null;
            when Pen_Class =>
                null;
            when Block_Class =>
                return Class_Block.Send (This_Message, To);
            when Void_Class =>
                return To;
        end case;
    end Send;
end Object;