This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/Logtalk/examples/roots/classes.lgt

282 lines
6.3 KiB
Plaintext
Raw Normal View History

:- protocol(abstract_classp).
:- info([
version is 1.0,
author is 'Paulo Moura',
date is 2000/7/24,
comment is 'Default protocol for all abstract classes.']).
:- public(metaclass/0).
:- mode(metaclass, zero_or_one).
:- info(metaclass/0, [
comment is 'True if the object is a metaclass.']).
:- public(abstract_class/0).
:- mode(abstract_class, zero_or_one).
:- info(metaclass/0, [
comment is 'True if the object is an abstract class.']).
:- end_protocol.
:- object(abstract_class,
implements(abstract_classp),
instantiates(class),
specializes(object)).
:- info([
version is 2,
author is 'Paulo Moura',
date is 2000/7/24,
comment is 'Default metaclass for all abstract classes.']).
metaclass :-
self(Self),
instantiates_class(Class, Self),
this(This),
Class::ancestor(This).
abstract_class :-
self(Self),
Self \= abstract_class.
strict_instance :-
fail.
:- end_object.
:- protocol(classp).
:- info([
version is 1.0,
author is 'Paulo Moura',
date is 2000/7/24,
comment is 'Default protocol for all instantiable classes.']).
:- public(new/1).
:- mode(new(?object), zero_or_one).
:- info(new/1, [
comment is 'Creates a new instance.',
argnames is ['Instance']]).
:- public(new/2).
:- mode(new(?object, +list), zero_or_one).
:- info(new/2, [
comment is 'Creates a new instance using a list of initialization options.',
argnames is ['Instance', 'Options']]).
:- public(clone/2).
:- mode(clone(+object, ?object), zero_or_one).
:- info(clone/2, [
comment is 'Clones an instance.',
argnames is ['Instance', 'Clone']]).
:- public(instance_base_name/1).
:- mode(instance_base_name(-atom), one).
:- info(instance_base_name/1, [
comment is 'Base name to generated new instance names.',
argnames is ['Name']]).
:- public(delete/1).
:- mode(delete(+object), zero_or_one).
:- info(delete/1, [
comment is 'Deletes a dynamic instance.',
argnames is ['Instance']]).
:- public(delete/2).
:- mode(delete(+object, +list), zero_or_one).
:- info(delete/2, [
comment is 'Deletes a dynamic instance using a list of deleting options.',
argnames is ['Instance', 'Options']]).
:- public(delete_all/0).
:- mode(delete_all, zero_or_one).
:- info(delete_all/0, [
comment is 'Deletes all dynamic instances. Fails if some dynamic instance can not be deleted.']).
:- public(delete_all/1).
:- mode(delete_all(+list), zero_or_one).
:- info(delete_all/1, [
comment is 'Deletes all dynamic instances using a list of deleting options. Fails if some dynamic instance can not be deleted.',
argnames is ['Options']]).
:- public(equals/2).
:- mode(equals(+object, +object), zero_or_one).
:- info(equals/2, [
comment is 'The two instances represents the same object for some definition of equality.',
argnames is ['Instance1', 'Instance2']]).
:- end_protocol.
:- object(class,
implements(classp),
instantiates(class),
specializes(abstract_class)).
:- info([
version is 1.1,
author is 'Paulo Moura',
date is 2005/3/12,
comment is 'Default metaclass for all classes.']).
:- private(instance_counter_/1).
:- dynamic(instance_counter_/1).
:- mode(instance_counter_(?integer), zero_or_one).
:- info(instance_counter_/1, [
comment is 'Stores a counter of created instances.',
argnames is ['Counter']]).
new(Object) :-
::new(Object, []).
new(Object, Options) :-
valid_new_identifier(Object),
self(Self),
create_object(Object, [instantiates(Self)], [], []),
Object::init(Options).
clone(Object, Clone) :-
self(Self),
sender(Sender),
throw(error(subclass_responsability, Self::clone(Object, Clone), Sender)).
delete(Object) :-
::delete(Object, []).
delete(Object, Options) :-
::instance(Object),
Object::free(Options),
abolish_object(Object).
delete_all :-
::delete_all([]).
delete_all(Options) :-
::instance(Instance),
object_property(Instance, (dynamic)),
::delete(Instance, Options),
fail.
delete_all(_) :-
\+ (::instance(Instance),
object_property(Instance, (dynamic))).
instance_base_name(i).
instance_counter_(0).
valid_new_identifier(Identifier) :-
var(Identifier), !,
retract(instance_counter_(Last)),
::instance_base_name(Base),
functor(Base, Functor, Arity),
number_codes(Arity, Codes),
atom_codes(Atom, Codes),
repeat,
next_integer(Last, Next),
number_codes(Next, Codes2),
atom_codes(Atom2, Codes2),
atom_concat(Functor, Atom2, Identifier),
atom_concat(Identifier, Atom, Prefix),
\+ {current_predicate(Prefix/_)},
asserta(instance_counter_(Next)),
!.
valid_new_identifier(Identifier) :-
once((atom(Identifier); compound(Identifier))),
functor(Identifier, Functor, Arity),
number_codes(Arity, Codes),
atom_codes(Atom, Codes),
atom_concat(Functor, Atom, Prefix),
\+ {current_predicate(Prefix/_)}.
next_integer(N, N1) :-
N1 is N + 1.
next_integer(N, N2) :-
N1 is N + 1,
next_integer(N1, N2).
equals(Instance1, Instance2) :-
self(Self),
sender(Sender),
throw(error(subclass_responsability, Self::equals(Instance1, Instance2), Sender)).
abstract_class :-
fail.
:- end_object.
:- protocol(objectp).
:- info([
version is 1.0,
author is 'Paulo Moura',
date is 2000/7/24,
comment is 'Default protocol for all objects.']).
:- public(strict_instance/0).
:- mode(strict_instance, zero_or_one).
:- info(strict_instance/0, [
comment is 'True if the object is strictly an instance.']).
:- public(print/0).
:- mode(print, one).
:- info(print/0, [
comment is 'Pretty prints an object description.']).
:- public(nil/0).
:- mode(nil, zero_or_one).
:- info(nil/0, [
comment is 'True if the object represents a void reference.']).
:- end_protocol.
:- object(object,
implements(objectp, event_handlersp),
imports(initialization, class_hierarchy),
instantiates(class)).
:- info([
version is 1.0,
date is 2000/7/24,
author is 'Paulo Moura',
comment is 'Minimal predicates for all objects. Default root of the inheritance graph.']).
:- uses(event_registry).
strict_instance.
default_free_option(del_monitors).
process_free_option(del_monitors) :-
self(Self),
event_registry::del_monitors(Self, _, _, _),
event_registry::del_monitors(_, _, Self, _),
event_registry::del_monitors(_, _, _, Self).
nil :-
fail.
print :-
self(Self),
writeq(Self), nl, nl,
forall(
::current_predicate(Predicate),
(writeq(Predicate), nl)),
nl.
before(_, _, _).
after(_, _, _).
:- end_object.