DataMuseum.dk

top - metrics - download

    Length: 7170 (0x1c02)
    Types: TextFile
    Names: »B«

└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with String_Utilities;
with Text_Io;
package body Integer_Class is

    type Binary_Message is (Plus, Minus, Mul, Div, Less, Greater, Equal,
                            Less_Equal, Greater_Equal, Different);
    type Unary_Message is (Absolute, Cube, Entexte, Opposite, Square);

    function Create (Value : String) return Object.Reference is
        Obj : Object.Reference;
        Result : Boolean;
    begin
        String_Utilities.String_To_Number (Value, Obj.Identity, Result);
        return (Object.Tiny_Integer, Obj.Identity);
    end Create;
    function Translate_To_Tiny_Boolean
                (To_Object : Object.Reference;
                 The_Message : Binary_Message;
                 The_Argument : Object.Reference) return Object.Reference is
        Obj : Object.Reference;
    begin
        case The_Message is
            when Less =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity < The_Argument.Identity) then
                    Obj.Identity := 1;
                else
                    Obj.Identity := 0;
                    return (Obj);
                end if;
            when Greater =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity > The_Argument.Identity) then
                    Obj.Identity := 1;
                else  
                    Obj.Identity := 0;
                end if;
                return (Obj);
            when Equal =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity = The_Argument.Identity) then
                    Obj.Identity := 1;
                else  
                    Obj.Identity := 0;
                end if;
                return (Obj);
            when Less_Equal =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity <= The_Argument.Identity) then
                    Obj.Identity := 1;
                else  
                    Obj.Identity := 0;
                end if;
                return (Obj);
            when Greater_Equal =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity >= The_Argument.Identity) then
                    Obj.Identity := 1;
                else
                    Obj.Identity := 0;
                end if;
                return (Obj);
            when Different =>
                Obj.Class := Object.Tiny_Boolean;
                if (To_Object.Identity /= The_Argument.Identity) then
                    Obj.Identity := 1;
                else
                    Obj.Identity := 0;
                end if;
                return (Obj);
            when Plus | Minus | Mul | Div =>
                null;
        end case;


    end Translate_To_Tiny_Boolean;

    function Translate_To_Binary_Message
                (The_Message : Object.Message) return Binary_Message is

    begin
        if String_Utilities.Equal (The_Message, "=", True) then
            return (Equal);
        end if;
        if String_Utilities.Equal (The_Message, "<", True) then
            return (Less);
        end if;
        if String_Utilities.Equal (The_Message, ">", True) then
            return (Greater);
        end if;
        if String_Utilities.Equal (The_Message, "<=", True) then
            return (Less_Equal);
        end if;
        if String_Utilities.Equal (The_Message, ">=", True) then
            return (Greater_Equal);
        end if;
        if String_Utilities.Equal (The_Message, "<>", True) then
            return (Different);
        end if;
        if String_Utilities.Equal (The_Message, "+", True) then
            return (Plus);
        end if;
        if String_Utilities.Equal (The_Message, "-", True) then
            return (Minus);
        end if;
        if String_Utilities.Equal (The_Message, "*", True) then
            return (Mul);
        end if;
        if String_Utilities.Equal (The_Message, "/", True) then
            return (Div);
        end if;
    end Translate_To_Binary_Message;

    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return Object.Reference is
        Message : Unary_Message;
        Obj : Object.Reference;
    begin
        Message := Unary_Message'Value (The_Message);
        Obj := To_Object;
        case Message is
            when Absolute =>
                Obj.Identity := abs (To_Object.Identity);
                Obj.Class := Object.Tiny_Integer;
            when Cube =>
                Obj.Identity := To_Object.Identity ** 3;
                Obj.Class := Object.Tiny_Integer;
            when Entexte =>
                Text_Io.Put (String_Utilities.Number_To_String
                                (To_Object.Identity));
                Obj.Identity := To_Object.Identity;
                Obj.Class := To_Object.Class;
            when Opposite =>

                Obj.Identity := -1 * To_Object.Identity;
                Obj.Class := Object.Tiny_Integer;

            when Square =>
                Obj.Identity := To_Object.Identity ** 2;
                Obj.Class := Object.Tiny_Integer;

        end case;
        return Obj;
    exception
        when Constraint_Error =>  
            Text_Io.Put_Line ("message non compris");
            return To_Object;
    end Send;



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

    begin
        Message := Translate_To_Binary_Message (The_Message);
        case Message is
            when Plus =>
                Obj.Identity := To_Object.Identity + The_Argument.Identity;
                Obj.Class := Object.Tiny_Integer;
            when Minus =>
                Obj.Identity := To_Object.Identity - The_Argument.Identity;
                Obj.Class := Object.Tiny_Integer;
            when Mul =>
                Obj.Identity := To_Object.Identity * The_Argument.Identity;
                Obj.Class := Object.Tiny_Integer;
            when Div =>
                Obj.Identity := To_Object.Identity / The_Argument.Identity;
                Obj.Class := Object.Tiny_Integer;
            when Less =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
            when Greater =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
            when Equal =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
            when Less_Equal =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
            when Greater_Equal =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
            when Different =>
                Obj := Translate_To_Tiny_Boolean
                          (To_Object, Message, The_Argument);
        end case;
        return Obj;
    end Send;

end Integer_Class;