Include Paulo Moura's Logtalk OO LP system

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@53 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

Logtalk/examples/roots/NOTES

@@ -0,0 +1,20 @@
+=================================================================
+Logtalk - Object oriented extension to Prolog
+Release 2.8.4
+
+Copyright (c) 1998-2001 Paulo Moura.  All Rights Reserved.
+=================================================================
+
+
+To load all objects in this example consult the roots.loader utility
+file (note that the *.loader files are Prolog files).
+
+You will need to consult the following files in the library directory: 
+events.loader, types.loader, and hierarchies.loader.
+
+This folder contains rewritten versions of some of the objects provided 
+with previous, 1.x versions, of the Logtalk system. They are intended to 
+help the conversion of applications from Logtalk 1.x to 2.x and to
+support most of the other examples provided with the current Logtalk
+package.
+

Logtalk/examples/roots/SCRIPT

@@ -0,0 +1,32 @@
+=================================================================
+Logtalk - Object oriented extension to Prolog
+Release 2.8.4
+
+Copyright (c) 1998-2001 Paulo Moura.  All Rights Reserved.
+=================================================================
+
+
+% some queries dealing with instance/class hierarchies:
+
+
+| ?- object::ancestors(Ancestors).
+
+Ancestors = [class, abstract_class, object] 
+
+Yes
+
+
+| ?- class::instances(Instances).
+
+Instances = [object, abstract_class, class] 
+
+Yes
+
+
+| ?- class::superclass(Super).
+
+Super = abstract_class ;
+
+Super = object ;
+
+No

Logtalk/examples/roots/abstract_class.lgt

@@ -0,0 +1,31 @@
+
+:- object(abstract_class,
+	implements(abstract_classp),
+	instantiates(class),
+	specializes(object)).
+
+
+	:- info([
+		version is 2,
+		authors 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.

Logtalk/examples/roots/abstract_classp.lgt

@@ -0,0 +1,28 @@
+
+:- protocol(abstract_classp).
+
+
+	:- info([
+		version is 1.0,
+		authors 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.

Logtalk/examples/roots/class.lgt

@@ -0,0 +1,117 @@
+
+:- object(class,
+	implements(classp),
+	instantiates(class),
+	specializes(abstract_class)).
+
+
+	:- info([
+		version is 1.0,
+		authors is 'Paulo Moura',
+		date is 2000/7/24,
+		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.

Logtalk/examples/roots/classp.lgt

@@ -0,0 +1,92 @@
+
+:- protocol(classp).
+
+
+	:- info([
+		version is 1.0,
+		authors 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.

Logtalk/examples/roots/initialization.lgt

@@ -0,0 +1,232 @@
+
+:- category(initialization).
+
+
+	:- info([
+		version is 1.1,
+		authors is 'Paulo Moura',
+		date is 2000/11/5,
+		comment is 'Object initialization protocol.']).
+
+
+	:- uses(list).
+
+
+	:- public(init/1).
+
+	:- mode(init(+list), zero_or_one).
+
+	:- info(init/1,
+		[comment is 'Intialize an object with the given list of options.',
+		 argnames is ['Options']]).
+
+
+	:- public(valid_init_option/1).
+
+	:- mode(valid_init_option(+nonvar), zero_or_one).
+
+	:- info(valid_init_option/1,
+		[comment is 'True if the argument is a valid initialization option.',
+		 argnames is ['Option']]).
+
+
+	:- public(valid_init_options/1).
+
+	:- mode(valid_init_options(+list), zero_or_one).
+
+	:- info(valid_init_options/1,
+		[comment is 'True if the argument is list of valid initialization options.',
+		 argnames is ['Options']]).
+
+
+	:- public(default_init_options/1).
+
+	:- mode(default_init_options(+list), one).
+
+	:- info(default_init_options/1,
+		[comment is 'List of default initilization options.',
+		 argnames is ['Options']]).
+
+
+	:- public(default_init_option/1).
+
+	:- mode(default_init_option(?nonvar), zero_or_more).
+
+	:- info(default_init_option/1,
+		[comment is 'Default initilization option.',
+		 argnames is ['Option']]).
+
+
+	:- protected(process_init_option/1).
+
+	:- mode(process_init_option(?nonvar), zero_or_one).
+
+	:- info(process_init_option/1,
+		[comment is 'Process initilization option.',
+		 argnames is ['Option']]).
+
+
+	:- private(process_init_options/1).
+
+	:- mode(process_init_options(+list), zero_or_one).
+
+	:- info(process_init_options/1,
+		[comment is 'Process a list of initilization options.',
+		 argnames is ['Options']]).
+
+
+	:- public(free/1).
+
+	:- mode(free(+list), zero_or_one).
+
+	:- info(free/1,
+		[comment is 'Release an object with the given list of options.',
+		 argnames is ['Options']]).
+
+
+	:- public(valid_free_option/1).
+
+	:- mode(valid_free_option(+nonvar), zero_or_one).
+
+	:- info(valid_init_option/1,
+		[comment is 'True if the argument is a valid delete option.',
+		 argnames is ['Option']]).
+
+
+	:- public(valid_free_options/1).
+
+	:- mode(valid_free_options(+list), zero_or_one).
+
+	:- info(valid_free_options/1,
+		[comment is 'True if the argument is list of valid delete options.',
+		 argnames is ['Options']]).
+
+
+	:- public(default_free_options/1).
+
+	:- mode(default_free_options(+list), one).
+
+	:- info(default_free_options/1,
+		[comment is 'List of default delete options.',
+		 argnames is ['Options']]).
+
+
+	:- public(default_free_option/1).
+
+	:- mode(default_free_option(?nonvar), zero_or_more).
+
+	:- info(default_free_option/1,
+		[comment is 'Default delete option.',
+		 argnames is ['Option']]).
+
+
+	:- protected(process_free_option/1).
+
+	:- mode(process_free_option(?nonvar), zero_or_one).
+
+	:- info(process_free_option/1,
+		[comment is 'Process delete option.',
+		 argnames is ['Option']]).
+
+
+	:- private(process_free_options/1).
+
+	:- mode(process_free_options(+list), zero_or_one).
+
+	:- info(process_free_options/1,
+		[comment is 'Process a list of delete options.',
+		 argnames is ['Options']]).
+
+
+	:- private(merge_options/3).
+
+	:- mode(merge_options(+list, +list, -list), one).
+
+	:- info(merge_options/3,
+		[comment is 'Constructs a complete list of options complementing the explicit options with the default ones.',
+		 argnames is ['Options', 'Defaults', 'Result']]).
+
+
+	init(Options) :-
+		::valid_init_options(Options),
+		::default_init_options(Defaults),
+		::merge_options(Options, Defaults, Options2),
+		::process_init_options(Options2).
+
+
+	default_init_options(Defaults) :-
+		findall(Default, ::default_init_option(Default), Defaults).
+
+
+	valid_init_options([]).
+
+	valid_init_options([Option| Options]) :-
+		::valid_init_option(Option),
+		valid_init_options(Options).
+
+
+	valid_init_option(_).
+
+
+	process_init_options([]).
+
+	process_init_options([Option| Options]) :-
+		once(::process_init_option(Option)),
+		process_init_options(Options).
+
+
+	process_init_option(Option) :-
+		self(Self),
+		sender(Sender),
+		throw(error(existence_error(predicate_definition), Self::process_init_option(Option), Sender)).
+
+
+
+	free(Options) :-
+		::valid_free_options(Options),
+		::default_free_options(Defaults),
+		::merge_options(Options, Defaults, Options2),
+		::process_free_options(Options2).
+
+
+	default_free_options(Defaults) :-
+		findall(Default, ::default_free_option(Default), Defaults).
+
+
+	valid_free_options([]).
+
+	valid_free_options([Option| Options]) :-
+		::valid_free_option(Option),
+		valid_free_options(Options).
+
+
+	valid_free_option(_).
+
+
+	process_free_options([]).
+
+	process_free_options([Option| Options]) :-
+		once(::process_free_option(Option)),
+		process_free_options(Options).
+
+
+	process_free_option(Option) :-
+		self(Self),
+		sender(Sender),
+		throw(error(existence_error(predicate_definition), Self::process_free_option(Option), Sender)).
+
+
+	merge_options([], Defaults, Defaults).
+	
+	merge_options([Option-Value| Options], Defaults, [Option-Value| Options2]) :-
+		!,
+		(list::select(Option-_, Defaults, Defaults2) ->
+			merge_options(Options, Defaults2, Options2)
+			;
+			merge_options(Options, Defaults, Options2)).
+
+	merge_options([Option| Options], Defaults, [Option| Options2]) :-
+		merge_options(Options, Defaults, Options2).
+
+
+:- end_category.

Logtalk/examples/roots/nil.lgt

@@ -0,0 +1,16 @@
+
+:- object(nil,
+	instantiates(object)).
+
+
+	:- info([
+		version is 1.0,
+		date is 2000/7/24,
+		authors is 'Paulo Moura',
+		comment is 'Used to represent a void reference.']).
+
+
+	nil.
+
+
+:- end_object.

Logtalk/examples/roots/object.lgt

@@ -0,0 +1,50 @@
+
+:- object(object,
+	implements(objectp, event_handlersp),
+	imports(initialization, class_hierarchy),
+	instantiates(class)).
+
+
+	:- info([
+		version is 1.0,
+		date is 2000/7/24,
+		authors 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.

Logtalk/examples/roots/objectp.lgt

@@ -0,0 +1,36 @@
+
+:- protocol(objectp).
+
+
+	:- info([
+		version is 1.0,
+		authors 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.

Logtalk/examples/roots/proto.lgt

@@ -0,0 +1,48 @@
+
+:- object(proto,
+	implements(protop, event_handlersp),
+	imports(initialization, proto_hierarchy)).
+
+
+	:- info([
+		version is 1.0,
+		date is 2000/7/24,
+		authors is 'Paulo Moura',
+		comment is 'Minimal predicates for all prototypes. Default root of the extension graph.']).
+
+
+	:- uses(event_registry).
+
+
+	clone(Clone) :-
+		self(Self),
+		sender(Sender),
+		throw(error(descendant_responsability, Self::clone(Clone), Sender)).
+
+
+	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).
+
+
+	print :-
+		self(Self),
+		writeq(Self), nl, nl,
+		forall(
+			::current_predicate(Predicate),
+			(writeq(Predicate), nl)),
+		nl.
+
+
+	before(_, _, _).
+
+
+	after(_, _, _).
+
+
+:- end_object.

Logtalk/examples/roots/protop.lgt

@@ -0,0 +1,29 @@
+
+:- protocol(protop).
+
+
+	:- info([
+		version is 1.0,
+		date is 2000/7/24,
+		authors is 'Paulo Moura',
+		comment is 'Default protocol for all prototypes.']).
+
+
+	:- public(clone/1).
+
+	:- mode(clone(?object), zero_or_one).
+
+	:- info(clone/1, [
+		comment is 'Clones a prototype.',
+		argnames is ['Clone']]).
+
+
+	:- public(print/0).
+
+	:- mode(print, one).
+
+	:- info(print/0, [
+		comment is 'Pretty prints an object description.']).
+
+
+:- end_protocol.

Logtalk/examples/roots/roots.loader

@@ -0,0 +1,8 @@
+
+:- initialization(
+	logtalk_load([
+		initialization,
+		objectp, object,
+		abstract_classp, abstract_class,
+		classp, class,
+		nil])).