## object.pkg
# Compiled by:
# src/lib/std/standard.lib# Object / object are adapted from
# Bernard Berthomieu's "OOP Programming Styles in ML"
# Appendix 2.3.2 where they are called EQOBJ/Eqobj:
#
package object: Object { # Object is from src/lib/src/object.api exception EQUAL;
class__ super = root_object;
Object__State(X) = OBJECT__STATE Object__Methods(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) = Self(X) -> Self(X) -> Bool # Our sole method compares objects for equality.
;
Myself = Self( oop::Oop_Null );
fun equal p q
=
{ my (_, (OBJECT__STATE eq, _)) = super::unpack__object p;
eq p q;
};
fun get__substate me
=
{ my (state, substate) = super::get__substate me;
substate;
};
fun unpack__object me
=
oop::unpack_object (super::unpack__object me);
fun override__equal new_method me
=
oop::repack_object
(\\ (OBJECT__STATE old_method) = OBJECT__STATE (new_method old_method))
(super::unpack__object me);
fun repack_methods update_methods me
=
oop::repack_object
(\\ (OBJECT__STATE object__methods) = OBJECT__STATE (update_methods object__methods))
(super::unpack__object me);
# Here we define a default object-equality
# comparison function to be overridden by subclasses.
#
# Since we don't know any state variables at this point
# we cannot do any interesting equality comparison,
# so we just raise the EQUAL exception if we actually
# get called:
#
fun default_equal
(p: Self(X))
(q: Self(X))
: Bool
=
raise exception EQUAL;
fun pack__object () substate
=
super::pack__object () (OBJECT__STATE default_equal, substate);
fun make__object ()
=
pack__object () oop::OOP_NULL;
};