⟦7b0f1c5e2⟧

TextFile

with Class_Integer;
with Class_Boolean;
with Class_String;
with Class_Block;
with Class_Pen;
with Class_Turtle;
with Class_Window;

package body Message is

    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 (Name_From : Keyword) return Object.Tiny_String is
    begin
        return Message_Name.Value (Name_From.Iter_Name);
    end Get;

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

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

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

    procedure Put (This_Argument : Object.Reference; Into : in out Keyword) is
    begin  
        Into.Argument := Message_Argument.Make (This_Argument, 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 (Name_From : Binary) return Object.Tiny_String is
    begin
        return Name_From.Name;
    end Get;

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

    procedure Put (This_Argument : Object.Reference;
                   Named : Object.Tiny_String;
                   Into : in out Binary) is
    begin
        Into.Name := Named;
        Into.Argument := This_Argument;
    end Put;

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

    procedure Put (This_Argument : Object.Reference; Into : out Binary) is
    begin
        Into.Argument := This_Argument;
    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_Name : Object.Tiny_String; Into : in out Unary) is
    begin
        Into.Name := Message_Name.Make (This_Name, Into.Name);
        Message_Name.Init (Into.Iter, Into.Name);
    end Put;

    function Get (Name_From : Unary) return Object.Tiny_String is
    begin  
        return Message_Name.Value (Name_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 : Object.Reference)
                  return Object.Reference is
    begin
        case Object.Get (Class_From => To) is
            when Object.Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Object.Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when Object.String_Class =>
                return Class_String.Send (This_Message, To);
            when Object.Turtle_Class =>
                return Class_Turtle.Send (This_Message, To);
            when Object.Pen_Class =>
                return Class_Pen.Send (This_Message, To);
            when Object.Block_Class =>
                return Class_Block.Send (This_Message, To);
            when Object.Window_Class =>
                return Class_Window.Send (This_Message, To);
            when Object.Void_Class =>
                return To;
        end case;
    end Send;

    function Send (This_Message : Binary; To : Object.Reference)
                  return Object.Reference is
    begin
        case Object.Get (Class_From => To) is
            when Object.Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Object.Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when Object.String_Class =>
                return Class_String.Send (This_Message, To);
            when Object.Turtle_Class =>
                return Class_String.Send (This_Message, To);
            when Object.Pen_Class =>
                return Class_Pen.Send (This_Message, To);
            when Object.Block_Class =>
                return Class_Block.Send (This_Message, To);
            when Object.Window_Class =>
                return Class_Window.Send (This_Message, To);
            when Object.Void_Class =>
                return To;
        end case;
    end Send;

    function Send (This_Message : Unary; To : Object.Reference)
                  return Object.Reference is
    begin
        case Object.Get (Class_From => To) is
            when Object.Integer_Class =>
                return Class_Integer.Send (This_Message, To);
            when Object.Boolean_Class =>
                return Class_Boolean.Send (This_Message, To);
            when Object.String_Class =>
                return Class_String.Send (This_Message, To);
            when Object.Turtle_Class =>
                return Class_Turtle.Send (This_Message, To);
            when Object.Pen_Class =>
                return Class_Pen.Send (This_Message, To);
            when Object.Block_Class =>
                return Class_Block.Send (This_Message, To);
            when Object.Window_Class =>
                return Class_Window.Send (This_Message, To);
            when Object.Void_Class =>
                return To;
        end case;
    end Send;
end Message;
DataMuseum.dk

Rational R1000/400 Tapes

⟦7b0f1c5e2⟧ TextFile

Derivation

TextFile
