DataMuseum.dk

top - download

    Length: 7046 (0x1b86)
    Types: TextFile
    Names: »B«

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

TextFile

with Boolean_Class;
with Integer_Class;
with Bloc_Class;
with Bounded_String;
with Pen_Class;
with Turtle_Class;
with String_Class;
with Error_Broadcaster;
package body Object is

    package body Parameters is

        procedure Add (Keyword : Message;
                       Obj : Reference;
                       To_List : in out List) is  
        begin
            Bounded_String.Insert (To_List.Selector, 1, Keyword);
            To_List.Param := Make (Obj, To_List.Param);
        end Add;

        procedure Get (From_List : in out List; Head : out Reference) is
        begin
            Head := First (From_List.Param);
            From_List.Param := Rest (From_List.Param);
        end Get;

        function Selector (From_List : List) return Message is
        begin
            return (From_List.Selector);
        end Selector;
    end Parameters;

    function Create (Token : Lex.Token; Value : Lex.Lex_String)
                    return Reference is
    begin
        case Token is
            when Lex.Integer =>
                return (Integer_Class.Create (Value));
            when Lex.Tiny_String =>
                return (String_Class.Create (Value));
            when Lex.Identifier =>  
                null;
            when Lex.Open_Bracket =>
                return (Bloc_Class.Create (Value));
            when Lex.Avec | Lex.Binary_Message | Lex.Key_Word | Lex.L_End |
                 Lex.Ok | Lex.Pour | Lex.Prendre | Lex.Renvoyer |
                 Lex.Special | Lex.Unknown | Lex.Dot | Lex.Close_Bracket |
                 Lex.Open_Parenthesis | Lex.Close_Parenthesis =>
                null;
        end case;
        null;
    end Create;

    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return Object.Reference is
    begin
        case To_Object.Class is
            when Tiny_Bloc =>
                return Bloc_Class.Send (To_Object, The_Message);
            when Tiny_Boolean =>
                return Boolean_Class.Send (To_Object, The_Message);
            when Tiny_Integer =>
                return Integer_Class.Send (To_Object, The_Message);
            when Tiny_Turtle =>
                return Turtle_Class.Send (To_Object, The_Message);
            when Tiny_String =>
                return String_Class.Send (To_Object, The_Message);
            when Tiny_Pen =>
                return Pen_Class.Send (To_Object, The_Message);
            when Tiny_Void =>
                return (Tiny_Void, 0);
        end case;  
    exception
        when Error_Broadcaster.Unknown_Unary_Message =>
            Error_Broadcaster.Unknown_Unarymessage (To_Object, The_Message);
            raise Error_Broadcaster.Unknown_Unary_Message;
    end Send;

    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return String is
    begin
        case To_Object.Class is
            when Tiny_Bloc =>
                return Bloc_Class.Send (To_Object, The_Message);
            when Tiny_Boolean =>
                return Boolean_Class.Send (To_Object, The_Message);
            when Tiny_Integer =>
                return Integer_Class.Send (To_Object, The_Message);
            when Tiny_Turtle =>
                return Turtle_Class.Send (To_Object, The_Message);
            when Tiny_String =>
                return String_Class.Send (To_Object, The_Message);
            when Tiny_Pen =>
                return Pen_Class.Send (To_Object, The_Message);
            when Tiny_Void =>
                return ("vide");
        end case;
    end Send;

    function Send (To_Object : Object.Reference;
                   The_Message : Object.Message;
                   The_Argument : Object.Reference) return Object.Reference is

    begin
        case To_Object.Class is
            when Tiny_Bloc =>
                raise Error_Broadcaster.Bloc_Bad_Type;
            when Tiny_Boolean =>
                return (Boolean_Class.Send
                           (To_Object, The_Message, The_Argument));
            when Tiny_Turtle =>
                raise Error_Broadcaster.Turtle_Bad_Type;
            when Tiny_Integer =>
                return (Integer_Class.Send
                           (To_Object, The_Message, The_Argument));  
            when Tiny_String =>
                return (String_Class.Send
                           (To_Object, The_Message, The_Argument));
            when Tiny_Pen =>
                raise Error_Broadcaster.Pen_Bad_Type;
            when Tiny_Void =>
                return (Tiny_Void, 0);
        end case;
    exception
        when Error_Broadcaster.Pen_Bad_Type =>
            Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
            raise Error_Broadcaster.Pen_Bad_Type;
        when Error_Broadcaster.Turtle_Bad_Type =>
            Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
            raise Error_Broadcaster.Turtle_Bad_Type;
        when Error_Broadcaster.Integer_Bad_Type =>
            Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
            raise Error_Broadcaster.Integer_Bad_Type;
        when Error_Broadcaster.Boolean_Bad_Type =>
            Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
            raise Error_Broadcaster.Boolean_Bad_Type;
        when Error_Broadcaster.Bloc_Bad_Type =>
            Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
            raise Error_Broadcaster.Bloc_Bad_Type;
        when Error_Broadcaster.String_Bad_Type =>
            Error_Broadcaster.Unknown_Binarymessage (To_Object, The_Message);
            raise Error_Broadcaster.String_Bad_Type;  
        when Error_Broadcaster.Tiny_String_Overflow =>
            Error_Broadcaster.Tiny_Stringoverflow (To_Object, The_Message);
            raise Error_Broadcaster.Tiny_String_Overflow;
    end Send;


    function Send (To_Object : Object.Reference;
                   The_Argument : Object.Parameters.List)
                  return Object.Reference is

    begin
        case To_Object.Class is
            when Tiny_Bloc =>
                return (Bloc_Class.Send (To_Object, The_Argument));
            when Tiny_Boolean =>
                return (Boolean_Class.Send (To_Object, The_Argument));
            when Tiny_Integer =>
                return (Integer_Class.Send (To_Object, The_Argument));
            when Tiny_Turtle =>
                return (Turtle_Class.Send (To_Object, The_Argument));
            when Tiny_String =>
                raise Error_Broadcaster.Unknown_Keyword_Message;
            when Tiny_Pen =>
                return (Pen_Class.Send (To_Object, The_Argument));
            when Tiny_Void =>
                return (Tiny_Void, 0);
        end case;
    exception
        when Error_Broadcaster.Unknown_Keyword_Message =>
            Error_Broadcaster.Unknown_Keywordmessage
               (To_Object, Object.Parameters.Selector (The_Argument));
            raise Error_Broadcaster.Unknown_Keyword_Message;
    end Send;

end Object;