15.4.134  src/app/tut/oop-crib/oop-crib.pkg

## oop-test.pkg

# Test via:
#     linux% my
#     eval: make "oop-crib.lib";
#     eval: obj = oop_test::new ( { int_field => 12, string_field => "abc" }, ());
#     eval: oop_test::get_int obj;

api Oop_Test {
    #
    Full__State(X);
    Self(X)  = object::Self( Full__State(X) );
    Myself   = Self( oop::Oop_Null );                   # Used only for the return type of 'make__object', everywhere else is Self(X).

    Object__Fields(X) = { string_field:  String,
                  int_field:     Int
                };

    Object__Methods(X) = { get_string: Self(X) -> String,
                   get_int:    Self(X) -> Int
                 };

    get_string:  Self(X)  -> String;
    get_int:     Self(X)  -> Int;

    repack_methods:  (Object__Methods(X) -> Object__Methods(X)) -> Self(X) -> Self(X);


    pack__object:    (Object__Fields(X), Void)  ->  X -> Self(X);
    unpack__object:   Self(X)            -> (X -> Self(X), X);
    make__object:    (Object__Fields(X), Void)  -> Myself;

};

package   oop_test
:         Oop_Test
{
    string_value = "string_value";
    int_value    =  31416;

    package super = object;

    Object__State(X)
        =
        OBJECT__STATE
          { object__methods: Object__Methods(X),
            object__fields:  Object__Fields(X)
          }
    withtype
        Full__State(X) = (Object__State(X), X)                  # Our state record plus those of our subclass chain, if any.
    also
        Self(X) = super::Self( Full__State(X) )
    also
        Object__Methods(X)
            =
            { get_string: Self(X) -> String,
              get_int:    Self(X) -> Int
            }
    also
        Object__Fields(X)
            =
            { string_field:  String,
              int_field:     Int
            }
    ;

    Myself = Self( oop::Oop_Null );

    fun get_string_method (self: Self(X))
        =
        {   my (recreate, (OBJECT__STATE { object__methods, object__fields }, substate)) = super::unpack__object self;
            object__fields.string_field;
        }

    also
    fun get_int_method    (self: Self(X))
        =
        {   my (recreate, (OBJECT__STATE { object__methods, object__fields }, substate)) = super::unpack__object self;
            object__fields.int_field;
        }

    also
    fun methods_vector ()
        =
        { get_string => get_string_method,
          get_int    => get_int_method
        }

    also
    fun get_string (self: Self(X))
        =
        {   my (_ /*recreate*/, (OBJECT__STATE { object__methods, object__fields => _ }, _ /*substate*/)) = super::unpack__object self;
            object__methods.get_string  self;
        }

    also
    fun get_int (self: Self(X))
        =
        {   my (recreate, (OBJECT__STATE { object__methods, object__fields }, substate)) = super::unpack__object self;
            object__methods.get_int     self;
        }

    also
    fun unpack__object  me
        =
        oop::unpack_object  (super::unpack__object me)

    also
    fun repack_methods  update_methods  me
        =
        oop::repack_object
            (\\ (OBJECT__STATE { object__methods, object__fields }) =  OBJECT__STATE { object__methods => (update_methods object__methods),   object__fields })
            (super::unpack__object me)

    also
    fun override_method_get_int  new_method  me
        =
        oop::repack_object
            (\\ (OBJECT__STATE { object__methods, object__fields }) =  OBJECT__STATE { object__methods => { get_string => object__methods.get_string, get_int => new_method },  object__fields })
            (super::unpack__object me)

    also
    fun repack_fields  update_fields  me
        =
        oop::repack_object
            (\\ (OBJECT__STATE { object__methods, object__fields }) =  OBJECT__STATE { object__fields  => (update_fields  object__fields ),   object__methods })
            (super::unpack__object me)

    also
    fun peq _ p q                               # Ignored arg is super::equal.
        =
        (get_int    p) == (get_int    q)    and
        (get_string p) == (get_string q)

    also
    fun pack__object (fields_1, fields_0) substate
        =
        {   result = super::pack__object fields_0 (OBJECT__STATE { object__methods => methods_vector (), object__fields => fields_1 }, substate);
            result = super::override_method_equal  peq  result;
            result;
        };

    fun make__object fields_tuple
        =
        pack__object fields_tuple oop::OOP_NULL;

    fun pack__object' (fields_1, fields_0) substate
        =
        (super::pack__object fields_0 (OBJECT__STATE { object__methods => methods_vector (), object__fields => fields_1 }, substate) );

};


## Copyright (c) 2010 by Jeffrey S Prothero,
## released per terms of SMLNJ-COPYRIGHT.