yap-6.3/Logtalk/examples/relations/relation.lgt

:- 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.