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/relations/relation.lgt
pmoura 75392e54c7 Logtalk 2.15.0 release files.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@757 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
2003-02-05 00:15:28 +00:00

472 lines
10 KiB
Plaintext

:- object(relation,
implements(relationp),
instantiates(class),
specializes(object)).
:- info([
version is 1.0,
date is 2000/7/24,
author is 'Esteban Zimanyi, Paulo Moura',
comment is 'Enables the representation of relations between independent objects.']).
:- uses(before_event_registry).
:- uses(after_event_registry).
:- uses(list).
tuple(Tuple) :-
::tuple_(Tuple).
tuples(Tuples) :-
findall(Tuple, ::tuple_(Tuple), Tuples).
add_tuple(Tuple) :-
\+ ::descriptor(_),
self(Self),
sender(Sender),
throw(error(descriptor_not_defined, Self::add_tuple(Tuple), Sender)).
add_tuple(Tuple) :-
::descriptor(Descriptor),
\+ list::same_length(Tuple, Descriptor),
self(Self),
sender(Sender),
throw(error(invalid_length, Self::add_tuple(Tuple), Sender)).
add_tuple(Tuple) :-
::descriptor(Descriptor),
::key(Key),
make_tuple_template(Tuple, Descriptor, Key, Template),
::tuple(Template),
self(Self),
sender(Sender),
throw(error(breaks_key(Key), Self::add_tuple(Tuple), Sender)).
add_tuple(Tuple) :-
::descriptor(Descriptor),
list::nth(Position, Tuple, Object),
list::nth(Position, Descriptor, Role),
::cardinality(Role, _, Maximum),
::plays_role_n_times(Object, Role, Number),
Maximum = Number,
self(Self),
sender(Sender),
throw(error(breaks_max_cardinality(Object, Role, Maximum), Self::add_tuple(Tuple), Sender)).
add_tuple(Tuple) :-
::descriptor(Descriptor),
list::nth(Position, Tuple, Object),
list::nth(Position, Descriptor, Role),
::domain(Role, Domain),
(Domain::strict_instance ->
\+ Domain::valid(Object)
;
\+ Object::ancestor(Domain)),
self(Self),
sender(Sender),
throw(error(breaks_domain(Object, Role, Domain), Self::add_tuple(Tuple), Sender)).
add_tuple(Tuple) :-
::assertz(tuple_(Tuple)),
::set_monitors(Tuple).
make_tuple_template([], [], _, []).
make_tuple_template([Object| Objects], [Role| Roles], Key, [Var| Rest]) :-
(list::member(Role, Key) ->
Var = Object
;
true),
make_tuple_template(Objects, Roles, Key, Rest).
remove_tuple(Tuple) :-
\+ ::descriptor(_),
self(Self),
sender(Sender),
throw(error(descriptor_not_defined, Self::remove_tuple(Tuple), Sender)).
remove_tuple(Tuple) :-
::descriptor(Descriptor),
list::nth(Position, Tuple, Object),
list::nth(Position, Descriptor, Role),
::cardinality(Role, Minimum, _),
::plays_role_n_times(Object, Role, Number),
Minimum = Number,
self(Self),
sender(Sender),
throw(error(breaks_min_cardinality(Object, Role, Minimum), Self::remove_tuple(Tuple), Sender)).
remove_tuple(Tuple) :-
::retract(tuple_(Tuple)),
::del_monitors(Tuple).
remove_all_tuples :-
::retractall(tuple_(_)),
::del_all_monitors.
number_of_tuples(Number) :-
findall(1, ::tuple_(_), List),
list::length(List, Number).
plays_roles(Object, Roles) :-
::descriptor(Descriptor),
setof(Role,
Tuple^Position^ (::tuple(Tuple),
list::member(Object, Tuple),
list::nth(Position, Tuple, Object),
once(list::nth(Position, Descriptor, Role))),
Roles).
plays_role_in_tuple(Object, Role, Tuple) :-
::descriptor(Descriptor),
::tuple(Tuple),
list::nth(Position, Tuple, Object),
list::nth(Position, Descriptor, Role).
plays_role_n_times(Object, Role, Number) :-
::descriptor(Descriptor),
list::nth(Position, Descriptor, Role),
setof(Tuple,
(::tuple(Tuple),
list::nth(Position, Tuple, Object)),
Tuples),
list::length(Tuples, Number).
domains(Domains) :-
::descriptor(Descriptor),
domains(Descriptor, Domains).
domains([], []).
domains([Role| Roles], [Domain| Domains]) :-
::domain_(Role, Domain),
domains(Roles, Domains).
domain(Role, Domain) :-
::domain_(Role, Domain).
set_domains(Domains) :-
\+ ::descriptor(_),
self(Self),
sender(Sender),
throw(error(descriptor_not_defined, Self::set_domains(Domains), Sender)).
set_domains(Domains) :-
::tuple(_),
self(Self),
sender(Sender),
throw(error(non_empty_relation, Self::set_domains(Domains), Sender)).
set_domains(Domains) :-
::descriptor(Descriptor),
set_domains(Domains, Descriptor).
set_domains([], []).
set_domains([Role| Roles], [Domain| Domains]) :-
::retractall(domain_(Role, _)),
::assertz(domain_(Role, Domain)),
set_domains(Roles, Domains).
descriptor(Descriptor) :-
::descriptor_(Descriptor).
degree(Degree) :-
::descriptor_(Descriptor),
list::length(Descriptor, Degree).
set_descriptor(Descriptor) :-
\+ ::tuple(_),
::assertz(descriptor_(Descriptor)),
::set_keys([Descriptor]),
set_role_defaults(Descriptor).
set_role_defaults([]).
set_role_defaults([Role| Roles]) :-
::set_domain(Role, object),
::set_cardinality(Role, 0, n),
::set_delete_option(Role, cascade),
set_role_defaults(Roles).
key(Key) :-
::key_(Key).
keys(Keys) :-
findall(Key, ::key_(Key), Keys).
set_keys(Keys) :-
\+ ::descriptor(_),
self(Self),
sender(Sender),
throw(error(descriptor_not_defined, Self::set_keys(Keys), Sender)).
set_keys(Keys) :-
::tuple(_),
self(Self),
sender(Sender),
throw(error(non_empty_relation, Self::set_keys(Keys), Sender)).
set_keys(Keys) :-
\+ valid_keys(Keys),
self(Self),
sender(Sender),
throw(error(invalid_key, Self::set_keys(Keys), Sender)).
set_keys(Keys) :-
::retractall(key_(_)),
set_keys2(Keys).
set_keys2([]).
set_keys2([Key| Keys]) :-
::assertz(key_(Key)),
set_keys2(Keys).
valid_keys(Keys) :-
::descriptor(Descriptor),
valid_keys(Keys, Descriptor).
valid_keys([], _).
valid_keys([Key| Keys], Descriptor) :-
forall(
list::member(Role, Key),
list::memberchk(Role, Descriptor)),
valid_keys(Keys, Descriptor).
delete_options(Options) :-
::descriptor(Descriptor),
delete_options(Descriptor, Options).
delete_options([], []).
delete_options([Role| Roles], [Option| Options]) :-
::delete_option_(Role, Option),
delete_options(Roles, Options).
delete_option(Role, Option) :-
::delete_option_(Role, Option).
set_delete_options(Options) :-
\+ ::descriptor(_),
self(Self),
sender(Sender),
throw(error(descriptor_not_defined, Self::set_delete_options(Options), Sender)).
set_delete_options(Options) :-
::tuple(_),
self(Self),
sender(Sender),
throw(error(non_empty_relation, Self::set_delete_options(Options), Sender)).
set_delete_options(Options) :-
::descriptor(Descriptor),
\+ list::same_length(Options, Descriptor),
self(Self),
sender(Sender),
throw(error(invalid_length, Self::set_delete_options(Options), Sender)).
set_delete_options(Options) :-
\+ valid_delete_options(Options),
self(Self),
sender(Sender),
throw(error(invalid_delete_option, Self::set_delete_options(Options), Sender)).
set_delete_options(Options) :-
::descriptor(Descriptor),
set_delete_options(Descriptor, Options).
set_delete_options([], []).
set_delete_options([Role| Roles], [Option| Options]) :-
::retractall(delete_option_(Role, _)),
::assertz(delete_option_(Role, Option)),
set_delete_options(Roles, Options).
valid_delete_options([]).
valid_delete_options([Option| Options]) :-
once((Option = restrict; Option = cascade)),
valid_delete_options(Options).
cardinalities(Cardinalities) :-
::descriptor(Descriptor),
cardinalities(Descriptor, Cardinalities).
cardinalities([], []).
cardinalities([Role| Roles], [(Min, Max)| Cardinalities]) :-
::cardinality_(Role, Min, Max),
cardinalities(Roles, Cardinalities).
cardinality(Role, Min, Max) :-
::cardinality_(Role, Min, Max).
set_cardinalities(Cardinalities) :-
\+ ::descriptor(_),
self(Self),
sender(Sender),
throw(error(descriptor_not_defined, Self::set_cardinalities(Cardinalities), Sender)).
set_cardinalities(Cardinalities) :-
::tuple(_),
self(Self),
sender(Sender),
throw(error(non_empty_relation, Self::set_cardinalities(Cardinalities), Sender)).
set_cardinalities(Cardinalities) :-
\+ valid_cardinalities(Cardinalities),
self(Self),
sender(Sender),
throw(error(invalid_cardinality, Self::set_cardinalities(Cardinalities), Sender)).
set_cardinalities(Cardinalities) :-
::descriptor(Descriptor),
set_cardinalities(Cardinalities, Descriptor).
set_cardinalities([], []).
set_cardinalities([(Min, Max)| Cardinalities], [Role| Roles]) :-
::retractall(cardinality_(Role, _, _)),
::assertz(cardinality_(Role, Min, Max)),
set_cardinalities(Cardinalities, Roles).
valid_cardinalities([]).
valid_cardinalities([Cardinality| Cardinalities]) :-
nonvar(Cardinality),
Cardinality = (Min, Max),
lower_cardinality(Min, Max),
valid_cardinalities(Cardinalities).
lower_cardinality(I, n) :-
integer(I), !.
lower_cardinality(I, J) :-
integer(I),
integer(J),
I < J.
free(Options) :-
::remove_all_tuples,
^^free(Options).
set_monitors([]).
set_monitors([Object| Objects]) :-
(instantiates_class(Object, Class) ->
self(Self),
before_event_registry::set_monitor(Class, delete(Object, _), _, Self)
;
true),
set_monitors(Objects).
del_monitors([]).
del_monitors([Object| Objects]) :-
((instantiates_class(Object, Class),
\+ (::tuple(Other), list::member(Object, Other))) ->
self(Self),
before_event_registry::del_monitors(Class, delete(Object, _), _, Self)
;
true),
del_monitors(Objects).
del_all_monitors :-
self(Self),
before_event_registry::del_monitors(_, _, _, Self),
after_event_registry::del_monitors(_, _, _, Self).
before(_, delete(Object, Options), _) :-
!,
((::delete_option(Role, restrict),
::plays_role_in_tuple(Object, Role, Tuple)) ->
self(Self),
sender(Sender),
throw(error(can_not_be_deleted(Tuple, Object, Role), Self::delete(Object, Options), Sender))
;
forall(
::plays_role_in_tuple(Object, Role, Tuple),
::remove_tuple(Tuple))).
before(_, _, _).
after(_, _, _).
restore_monitors :-
self(Self),
before_event_registry::del_monitors(_, _, _, Self),
after_event_registry::del_monitors(_, _, _, Self),
forall(::tuple(Tuple), ::set_monitors(Tuple)).
print :-
::descriptor(Descriptor),
write('descriptor:'), nl, write(' '), writeq(Descriptor), nl,
::domains(Domains),
write('domains:'), nl, write(' '), writeq(Domains), nl,
::cardinalities(Cardinalities),
write('cardinalities:'), nl, write(' '), writeq(Cardinalities), nl,
::delete_options(Options),
write('delete options:'), nl, write(' '), writeq(Options), nl,
write('keys:'), nl,
forall(::key(Key), (write(' '), writeq(Key), nl)),
write('tuples:'), nl,
forall(::tuple(Tuple), (write(' '), writeq(Tuple), nl)).
:- end_object.