Logtalk 2.26.2 files.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1487 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
9f1b358c04
commit
3455276aa2
320
Logtalk/examples/birds/birds.lgt
Normal file
320
Logtalk/examples/birds/birds.lgt
Normal file
@ -0,0 +1,320 @@
|
|||||||
|
|
||||||
|
:- object(order,
|
||||||
|
imports(descriptors, proto_hierarchy)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(falconiforms,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(order)).
|
||||||
|
|
||||||
|
order(falconiforms).
|
||||||
|
eats(meat).
|
||||||
|
feet(curved_talons).
|
||||||
|
bill(sharp_hooked).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(falcon,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(falconiforms)).
|
||||||
|
|
||||||
|
family(falcon).
|
||||||
|
wings(long_pointed).
|
||||||
|
head(large).
|
||||||
|
tail(narrow_at_tip).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(peregrine_falcon,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(falcon)).
|
||||||
|
|
||||||
|
eats(birds).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(sparrow_hawk,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(falcon)).
|
||||||
|
|
||||||
|
eats(insects).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(vulture,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(falconiforms)).
|
||||||
|
|
||||||
|
family(vulture).
|
||||||
|
feed(scavange).
|
||||||
|
wings(broad).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(california_condor,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(vulture)).
|
||||||
|
|
||||||
|
flight_profile(flat).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(turkey_vulture,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(vulture)).
|
||||||
|
|
||||||
|
flight_profile(v_shaped).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(passerformes,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(order)).
|
||||||
|
|
||||||
|
order(passerformes).
|
||||||
|
feet(one_long_backward_toe).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(flycatcher,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(passerformes)).
|
||||||
|
|
||||||
|
family(flycatcher).
|
||||||
|
bill(flat).
|
||||||
|
eats(flying_insects).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(ash_throated_flycatcher,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(flycatcher)).
|
||||||
|
|
||||||
|
throat(white).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(great_crested_flycatcher,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(flycatcher)).
|
||||||
|
|
||||||
|
tail(long_rusty).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(swallow,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(passerformes)).
|
||||||
|
|
||||||
|
family(swallow).
|
||||||
|
wings(long_pointed).
|
||||||
|
tail(forked).
|
||||||
|
bill(short).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(barn_swallow,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(swallow)).
|
||||||
|
|
||||||
|
tail(forked).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(cliff_swallow,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(swallow)).
|
||||||
|
|
||||||
|
tail(square).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(purple_martin,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(swallow)).
|
||||||
|
|
||||||
|
color(dark).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(tubenose,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(order)).
|
||||||
|
|
||||||
|
order(tubenose).
|
||||||
|
nostrils(external_tubular).
|
||||||
|
live(at_sea).
|
||||||
|
bill(hooked).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(fulmar,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(tubenose)).
|
||||||
|
|
||||||
|
size(medium).
|
||||||
|
flight(flap_glide).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(albatross,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(tubenose)).
|
||||||
|
|
||||||
|
family(albatross).
|
||||||
|
size(large).
|
||||||
|
wings(long_narrow).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(black_footed_albatross,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(albatross)).
|
||||||
|
|
||||||
|
color(dark).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(laysan_albatross,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(albatross)).
|
||||||
|
|
||||||
|
color(white).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(waterfowl,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(order)).
|
||||||
|
|
||||||
|
order(waterfowl).
|
||||||
|
feet(webbed).
|
||||||
|
bill(flat).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(duck,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(waterfowl)).
|
||||||
|
|
||||||
|
family(duck).
|
||||||
|
feed(on_water_surface).
|
||||||
|
flight(agile).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(female_mallard,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(duck)).
|
||||||
|
|
||||||
|
voice(quack).
|
||||||
|
color(mottled_brown).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(male_mallard,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(duck)).
|
||||||
|
|
||||||
|
voice(quack).
|
||||||
|
head(green).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(pintail,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(duck)).
|
||||||
|
|
||||||
|
voice(short_whistle).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(goose,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(waterfowl)).
|
||||||
|
|
||||||
|
family(goose).
|
||||||
|
size(plump).
|
||||||
|
flight(powerful).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(canada_goose,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(goose)).
|
||||||
|
|
||||||
|
head(black).
|
||||||
|
cheek(white).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(snow_goose,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(goose)).
|
||||||
|
|
||||||
|
color(white).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(swan,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(waterfowl)).
|
||||||
|
|
||||||
|
family(swan).
|
||||||
|
neck(long).
|
||||||
|
color(white).
|
||||||
|
flight(ponderous).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(trumpeter_swan,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(swan)).
|
||||||
|
|
||||||
|
voice(loud_trumpeting).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(whistling_swan,
|
||||||
|
imports(descriptors),
|
||||||
|
extends(swan)).
|
||||||
|
|
||||||
|
voice(muffled_musical_whistle).
|
||||||
|
|
||||||
|
:- end_object.
|
141
Logtalk/examples/bricks/bricks.lgt
Normal file
141
Logtalk/examples/bricks/bricks.lgt
Normal file
@ -0,0 +1,141 @@
|
|||||||
|
|
||||||
|
:- object(brick,
|
||||||
|
instantiates(class),
|
||||||
|
specializes(object)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.1,
|
||||||
|
date is 2000/10/31,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Two-dimensional brick (or should I say square?) class.']).
|
||||||
|
|
||||||
|
:- public(position/2).
|
||||||
|
:- mode(position(?integer, ?integer), zero_or_one).
|
||||||
|
:- info(position/2, [
|
||||||
|
comment is 'Brick current position.',
|
||||||
|
argnames is ['X', 'Y']]).
|
||||||
|
|
||||||
|
:- private(position_/2).
|
||||||
|
:- dynamic(position_/2).
|
||||||
|
:- mode(position_(?integer, ?integer), zero_or_one).
|
||||||
|
:- info(position_/2, [
|
||||||
|
comment is 'Stores brick current position.',
|
||||||
|
argnames is ['X', 'Y']]).
|
||||||
|
|
||||||
|
:- public(move/2).
|
||||||
|
:- mode(move(+integer, +integer), one).
|
||||||
|
:- info(move/2, [
|
||||||
|
comment is 'Moves a brick to a new position.',
|
||||||
|
argnames is ['X', 'Y']]).
|
||||||
|
|
||||||
|
position(X, Y) :-
|
||||||
|
::position_(X, Y).
|
||||||
|
|
||||||
|
move(X, Y) :-
|
||||||
|
::retractall(position_(_, _)),
|
||||||
|
::assertz(position_(X, Y)).
|
||||||
|
|
||||||
|
default_init_option(position-(0, 0)).
|
||||||
|
default_init_option(Default) :-
|
||||||
|
^^default_init_option(Default).
|
||||||
|
|
||||||
|
process_init_option(position-(X, Y)) :-
|
||||||
|
::assertz(position_(X, Y)).
|
||||||
|
process_init_option(Option) :-
|
||||||
|
^^process_init_option(Option).
|
||||||
|
|
||||||
|
valid_init_option(position-(X, Y)) :-
|
||||||
|
!,
|
||||||
|
integer(X),
|
||||||
|
integer(Y).
|
||||||
|
valid_init_option(Option) :-
|
||||||
|
^^valid_init_option(Option).
|
||||||
|
|
||||||
|
instance_base_name(b).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(brick_stack,
|
||||||
|
instantiates(constrained_relation)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 1998/3/23,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Stack of bricks as a constrained binary relation.']).
|
||||||
|
|
||||||
|
descriptor_([top, bottom]).
|
||||||
|
|
||||||
|
domain_(top, brick).
|
||||||
|
domain_(bottom, brick).
|
||||||
|
|
||||||
|
key_([top, bottom]).
|
||||||
|
|
||||||
|
cardinality_(top, 0, 1).
|
||||||
|
cardinality_(bottom, 0, 1).
|
||||||
|
|
||||||
|
delete_option_(top, cascade).
|
||||||
|
delete_option_(bottom, restrict).
|
||||||
|
|
||||||
|
add_tuple([A, B]) :-
|
||||||
|
B::position(Xb, Yb),
|
||||||
|
Ya2 is Yb + 1,
|
||||||
|
{A::move(Xb, Ya2)},
|
||||||
|
^^add_tuple([A, B]).
|
||||||
|
|
||||||
|
activ_points_(top, before, []).
|
||||||
|
activ_points_(top, after, [move(_, _)]).
|
||||||
|
|
||||||
|
activ_points_(bottom, before, []).
|
||||||
|
activ_points_(bottom, after, [move(_, _)]).
|
||||||
|
|
||||||
|
propagate(after, move(X, Y), Top, top, [Top, Bottom]) :-
|
||||||
|
!,
|
||||||
|
Y2 is Y - 1,
|
||||||
|
(Bottom::position(X, Y2) ->
|
||||||
|
true
|
||||||
|
;
|
||||||
|
::remove_tuple([Top, Bottom])).
|
||||||
|
|
||||||
|
propagate(after, move(X, Y), Bottom, bottom, [Top, Bottom]) :-
|
||||||
|
!,
|
||||||
|
Y2 is Y + 1,
|
||||||
|
{Top::move(X, Y2)}.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(stack_monitor,
|
||||||
|
implements(event_handlersp)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 1998/3/23,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Monitor for brick movements printing an ascii representation of each brick position.']).
|
||||||
|
|
||||||
|
:- uses(loop).
|
||||||
|
:- uses(list).
|
||||||
|
|
||||||
|
after(_, move(_, _), _) :-
|
||||||
|
findall(
|
||||||
|
(Brick, X, Y),
|
||||||
|
(instantiates_class(Brick, brick), Brick::position(X, Y)),
|
||||||
|
Bricks),
|
||||||
|
setof(X, Brick^Y^ (list::member((Brick,X,Y), Bricks)), Xs),
|
||||||
|
list::last(Xs, Xmax),
|
||||||
|
setof(Y, Brick^X^ (list::member((Brick,X,Y), Bricks)), Ys),
|
||||||
|
list::last(Ys, Ymax),
|
||||||
|
loop::fordownto(Y, Ymax, 1,
|
||||||
|
(write('|'),
|
||||||
|
loop::forto(X, 1, Xmax,
|
||||||
|
(list::member((Brick, X, Y), Bricks) ->
|
||||||
|
write(Brick)
|
||||||
|
;
|
||||||
|
write('.'))),
|
||||||
|
nl)),
|
||||||
|
write('-'),
|
||||||
|
loop::forto(X, 1, Xmax, write('-')), nl.
|
||||||
|
|
||||||
|
:- end_object.
|
42
Logtalk/examples/classvars/classvars.lgt
Normal file
42
Logtalk/examples/classvars/classvars.lgt
Normal file
@ -0,0 +1,42 @@
|
|||||||
|
|
||||||
|
:- object(root, % avoid infinite metaclass regression by
|
||||||
|
instantiates(root)). % making the class its own metaclass
|
||||||
|
|
||||||
|
:- private(cv_/1).
|
||||||
|
:- dynamic(cv_/1).
|
||||||
|
:- mode(cv_(?integer), zero_or_one).
|
||||||
|
|
||||||
|
:- public(cv/1).
|
||||||
|
:- mode(cv(?integer), zero_or_one).
|
||||||
|
|
||||||
|
:- public(set_cv/1).
|
||||||
|
:- mode(set_cv(+integer), one).
|
||||||
|
|
||||||
|
cv_(0). % cv_/1 value is stored locally, in this class
|
||||||
|
|
||||||
|
cv(Value) :-
|
||||||
|
cv_(Value). % retrive cv_/1 value, shared for all instances
|
||||||
|
|
||||||
|
set_cv(Value) :-
|
||||||
|
retractall(cv_(_)), % retract old cv_/1 value from this class
|
||||||
|
asserta(cv_(Value)). % assert the new value into this class
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(instance1,
|
||||||
|
instantiates(root)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(instance2,
|
||||||
|
instantiates(root)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(instance3,
|
||||||
|
instantiates(root)).
|
||||||
|
|
||||||
|
:- end_object.
|
53
Logtalk/examples/dcgs/sentences.lgt
Normal file
53
Logtalk/examples/dcgs/sentences.lgt
Normal file
@ -0,0 +1,53 @@
|
|||||||
|
|
||||||
|
|
||||||
|
% Categories allows us to neatly organize the different "kinds"
|
||||||
|
% of words on this example: determiners, nouns, and verbs
|
||||||
|
|
||||||
|
|
||||||
|
:- category(determiners).
|
||||||
|
|
||||||
|
:- private(determiner//0). % private category non-terminals become private
|
||||||
|
% non-terminals of the objects importing the category
|
||||||
|
determiner --> [the].
|
||||||
|
determiner --> [a].
|
||||||
|
|
||||||
|
:- end_category.
|
||||||
|
|
||||||
|
|
||||||
|
:- category(nouns).
|
||||||
|
|
||||||
|
:- private(noun//0).
|
||||||
|
|
||||||
|
noun --> [boy].
|
||||||
|
noun --> [girl].
|
||||||
|
|
||||||
|
:- end_category.
|
||||||
|
|
||||||
|
|
||||||
|
:- category(verbs).
|
||||||
|
|
||||||
|
:- private(verb//0).
|
||||||
|
|
||||||
|
verb --> [likes].
|
||||||
|
verb --> [hates].
|
||||||
|
|
||||||
|
:- end_category.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(sentence,
|
||||||
|
implements(parsep),
|
||||||
|
imports(determiners, nouns, verbs)).
|
||||||
|
|
||||||
|
parse(List, true) :-
|
||||||
|
phrase(sentence, List).
|
||||||
|
parse(_, false).
|
||||||
|
|
||||||
|
sentence --> noun_phrase, verb_phrase.
|
||||||
|
|
||||||
|
noun_phrase --> ::determiner, ::noun. % the ::/1 control construct is used to call grammar
|
||||||
|
noun_phrase --> ::noun. % rules encapsulated on the imported categories
|
||||||
|
|
||||||
|
verb_phrase --> ::verb.
|
||||||
|
verb_phrase --> ::verb, noun_phrase.
|
||||||
|
|
||||||
|
:- end_object.
|
21
Logtalk/examples/dynpred/classes.lgt
Normal file
21
Logtalk/examples/dynpred/classes.lgt
Normal file
@ -0,0 +1,21 @@
|
|||||||
|
|
||||||
|
:- object(metaclass, % avoid infinite metaclass regression by
|
||||||
|
instantiates(metaclass)). % making the class its own metaclass
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(class,
|
||||||
|
instantiates(metaclass)).
|
||||||
|
|
||||||
|
:- public(p1/1).
|
||||||
|
|
||||||
|
p1(class).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(instance,
|
||||||
|
instantiates(class)).
|
||||||
|
|
||||||
|
:- end_object.
|
15
Logtalk/examples/dynpred/protos.lgt
Normal file
15
Logtalk/examples/dynpred/protos.lgt
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
|
||||||
|
:- object(root).
|
||||||
|
|
||||||
|
:- public(p/1).
|
||||||
|
:- dynamic(p/1).
|
||||||
|
|
||||||
|
p(root).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(descendant,
|
||||||
|
extends(root)).
|
||||||
|
|
||||||
|
:- end_object.
|
64
Logtalk/examples/errors/warnings.lgt
Normal file
64
Logtalk/examples/errors/warnings.lgt
Normal file
@ -0,0 +1,64 @@
|
|||||||
|
|
||||||
|
:- object(misspell).
|
||||||
|
|
||||||
|
% misspelt call to Prolog built-in predicate
|
||||||
|
output(A) :-
|
||||||
|
writr(A).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
% singleton variables in opening object directive
|
||||||
|
:- object(singletons(L)).
|
||||||
|
|
||||||
|
% singleton variables in predicate clause
|
||||||
|
predicate(A) :-
|
||||||
|
write(C).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(plredef).
|
||||||
|
|
||||||
|
% redefinition of a Prolog built-in predicate
|
||||||
|
write(_).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(lgtredef).
|
||||||
|
|
||||||
|
% redefinition of Logtalk built-in predicate
|
||||||
|
current_object(_).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
% references to unknown entities in object opening directive
|
||||||
|
|
||||||
|
:- object(unknownrefs,
|
||||||
|
implements(protocol),
|
||||||
|
imports(category),
|
||||||
|
extends(object)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(portability).
|
||||||
|
|
||||||
|
:- public(predicate/0).
|
||||||
|
|
||||||
|
% clause with calls to non-ISO Prolog standard predicates
|
||||||
|
predicate :-
|
||||||
|
compare(Result, first, second),
|
||||||
|
retractall(result(Result, _)),
|
||||||
|
sort([], []),
|
||||||
|
consult(file).
|
||||||
|
|
||||||
|
:- end_object.
|
71
Logtalk/examples/inheritance/classes.lgt
Normal file
71
Logtalk/examples/inheritance/classes.lgt
Normal file
@ -0,0 +1,71 @@
|
|||||||
|
/*
|
||||||
|
This source file defines the following class-based hierarchy:
|
||||||
|
|
||||||
|
root
|
||||||
|
subclass1
|
||||||
|
instance1
|
||||||
|
subclass2
|
||||||
|
instance2
|
||||||
|
subclass3
|
||||||
|
instance3
|
||||||
|
|
||||||
|
The root object imports the category "predicates", which defines one
|
||||||
|
public predicate, public/0, one protected predicate, protected/0, and
|
||||||
|
one private predicate, private/0.
|
||||||
|
|
||||||
|
All objects import the category "interface", which defines a predicate,
|
||||||
|
interface/0, for listing the object interface.
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
:- object(root,
|
||||||
|
imports(predicates, interface),
|
||||||
|
instantiates(root)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% public inheritance:
|
||||||
|
% root predicates will be inherited without scope changes
|
||||||
|
:- object(subclass1,
|
||||||
|
imports(interface),
|
||||||
|
specializes(public::root)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(instance1,
|
||||||
|
instantiates(subclass1)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% protected inheritance:
|
||||||
|
% root public predicates will be inherited as protected predicates
|
||||||
|
:- object(subclass2,
|
||||||
|
imports(interface),
|
||||||
|
specializes(protected::root)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(instance2,
|
||||||
|
instantiates(subclass2)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% private inheritance:
|
||||||
|
% root predicates will be inherited as private predicates
|
||||||
|
:- object(subclass3,
|
||||||
|
imports(interface),
|
||||||
|
specializes(private::root)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(instance3,
|
||||||
|
instantiates(subclass3)).
|
||||||
|
|
||||||
|
:- end_object.
|
72
Logtalk/examples/inheritance/prototypes.lgt
Normal file
72
Logtalk/examples/inheritance/prototypes.lgt
Normal file
@ -0,0 +1,72 @@
|
|||||||
|
/*
|
||||||
|
This source file defines the following prototype-based hierarchy:
|
||||||
|
|
||||||
|
parent
|
||||||
|
prototype1
|
||||||
|
descendant1
|
||||||
|
prototype2
|
||||||
|
descendant2
|
||||||
|
prototype3
|
||||||
|
descendant3
|
||||||
|
|
||||||
|
The root object imports the category "predicates", which defines one
|
||||||
|
public predicate, public/0, one protected predicate, protected/0, and
|
||||||
|
one private predicate, private/0.
|
||||||
|
|
||||||
|
All objects import the category "interface", which defines a predicate,
|
||||||
|
interface/0, for listing the object interface.
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
:- object(parent,
|
||||||
|
imports(predicates, interface)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% public inheritance:
|
||||||
|
% parent predicates will be inherited without scope changes
|
||||||
|
:- object(prototype1,
|
||||||
|
imports(interface),
|
||||||
|
extends(public::parent)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(descendant1,
|
||||||
|
imports(interface),
|
||||||
|
extends(prototype1)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% protected inheritance:
|
||||||
|
% parent public predicates will be inherited as protected predicates
|
||||||
|
:- object(prototype2,
|
||||||
|
imports(interface),
|
||||||
|
extends(protected::parent)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(descendant2,
|
||||||
|
imports(interface),
|
||||||
|
extends(prototype2)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% private inheritance:
|
||||||
|
% parent predicates will be inherited as private predicates
|
||||||
|
:- object(prototype3,
|
||||||
|
imports(interface),
|
||||||
|
extends(private::parent)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(descendant3,
|
||||||
|
imports(interface),
|
||||||
|
extends(prototype3)).
|
||||||
|
|
||||||
|
:- end_object.
|
47
Logtalk/examples/instmethods/instmethods.lgt
Normal file
47
Logtalk/examples/instmethods/instmethods.lgt
Normal file
@ -0,0 +1,47 @@
|
|||||||
|
|
||||||
|
:- object(root, % avoid infinite metaclass regression by
|
||||||
|
instantiates(root)). % making the class its own metaclass
|
||||||
|
|
||||||
|
:- public(method/0).
|
||||||
|
|
||||||
|
method :-
|
||||||
|
this(This),
|
||||||
|
write('This is the default definition for the method, stored in class '),
|
||||||
|
writeq(This), write('.'), nl.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(instance1, % this instance simply inherits the method/0 predicate
|
||||||
|
instantiates(root)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(instance2, % this instance provides its own definition for the
|
||||||
|
instantiates(root)). % method/0 predicate
|
||||||
|
|
||||||
|
method :-
|
||||||
|
this(This),
|
||||||
|
write('This is an overriding definition stored in the '),
|
||||||
|
writeq(This),
|
||||||
|
write(' instance itself.'), nl.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(instance3, % this instance specializes the inherited definition
|
||||||
|
instantiates(root)). % of the method/0 predicate
|
||||||
|
|
||||||
|
method :-
|
||||||
|
this(This),
|
||||||
|
write('This is a specializing definition stored in the '),
|
||||||
|
writeq(This),
|
||||||
|
write(' instance itself.'), nl,
|
||||||
|
write('It makes a super call to execute the default definition:'), nl, nl,
|
||||||
|
^^method.
|
||||||
|
|
||||||
|
:- end_object.
|
211
Logtalk/examples/lo/planner/planner.lgt
Normal file
211
Logtalk/examples/lo/planner/planner.lgt
Normal file
@ -0,0 +1,211 @@
|
|||||||
|
|
||||||
|
% Planner
|
||||||
|
|
||||||
|
:- object(plan(_)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Air-line trip planner.',
|
||||||
|
parnames is ['Mode'],
|
||||||
|
source is 'Example adopted from the Francis G. McCabe L&O documentation.']).
|
||||||
|
|
||||||
|
:- public(from/3).
|
||||||
|
:- mode(from(+atom, +atom, -list), zero_or_more).
|
||||||
|
:- info(from/3,
|
||||||
|
[comment is 'Plan a trip from Start to Destination.',
|
||||||
|
argnames is ['Start', 'Destination', 'Plan']]).
|
||||||
|
|
||||||
|
from(Start, Destination, Plan) :-
|
||||||
|
from(Start, Destination, [], Plan).
|
||||||
|
|
||||||
|
from(Start, Destination, _, [Step]) :-
|
||||||
|
parameter(1, Mode),
|
||||||
|
Mode::step(Start, Destination, Step),
|
||||||
|
!.
|
||||||
|
from(Start, Destination, Locations, [Step| Steps]) :-
|
||||||
|
parameter(1, Mode),
|
||||||
|
Mode::step(Start, City2, Step),
|
||||||
|
not_member(City2, Locations),
|
||||||
|
from(City2, Destination, [Start| Locations], Steps).
|
||||||
|
|
||||||
|
not_member(_, []).
|
||||||
|
not_member(City, [Location| Locations]) :-
|
||||||
|
City \= Location,
|
||||||
|
not_member(City, Locations).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
% Abstractions of City, Airport, and Flight
|
||||||
|
|
||||||
|
:- object(city).
|
||||||
|
|
||||||
|
:- public(step/3).
|
||||||
|
:- mode(step(+, +, -), zero_or_more).
|
||||||
|
|
||||||
|
:- public(airport/1).
|
||||||
|
:- mode(airport(?atom), zero_or_more).
|
||||||
|
|
||||||
|
step(X, Y, P1-P-P2) :-
|
||||||
|
\+ same_city(X, Y), !,
|
||||||
|
X::airport(XA),
|
||||||
|
Y::airport(YA),
|
||||||
|
plan(fly)::from(XA, YA, P),
|
||||||
|
plan(city)::from(X, XA, P1),
|
||||||
|
plan(city)::from(YA, Y, P2).
|
||||||
|
|
||||||
|
step(X, Y, taxi(X, Y)) :-
|
||||||
|
same_city(X, Y),
|
||||||
|
X \= Y.
|
||||||
|
|
||||||
|
same_city(X, Y) :-
|
||||||
|
X::airport(A),
|
||||||
|
Y::airport(A).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(airport).
|
||||||
|
|
||||||
|
:- public(fly/1).
|
||||||
|
:- mode(fly(?), zero_or_more).
|
||||||
|
|
||||||
|
:- public(airport/1).
|
||||||
|
:- mode(airport(?), zero_or_more).
|
||||||
|
|
||||||
|
airport(Airport) :-
|
||||||
|
self(Airport).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(fly).
|
||||||
|
|
||||||
|
:- public(step/3).
|
||||||
|
:- mode(step(+, +, -), zero_or_more).
|
||||||
|
|
||||||
|
step(From, To, fly(From, To)) :-
|
||||||
|
From::fly(To).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
% Edinburgh locations
|
||||||
|
|
||||||
|
:- object(edinburgh,
|
||||||
|
extends(city)).
|
||||||
|
|
||||||
|
airport(edin).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(edin,
|
||||||
|
extends(edinburgh)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(castle,
|
||||||
|
extends(edinburgh)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(aiai,
|
||||||
|
extends(edinburgh)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
% Glasgow locations
|
||||||
|
|
||||||
|
:- object(glasgow,
|
||||||
|
extends(city)).
|
||||||
|
|
||||||
|
airport(renfrew).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
% London locations
|
||||||
|
|
||||||
|
:- object(london,
|
||||||
|
extends(city)).
|
||||||
|
|
||||||
|
airport(lhr).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(albert_hall,
|
||||||
|
extends(london)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(imperial,
|
||||||
|
extends(london)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
% Manchester locations
|
||||||
|
|
||||||
|
:- object(manchester,
|
||||||
|
extends(city)).
|
||||||
|
|
||||||
|
airport(ringway).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(victoria,
|
||||||
|
extends(manchester)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
% Airports
|
||||||
|
|
||||||
|
:- object(aberdeen_air,
|
||||||
|
extends(airport)).
|
||||||
|
|
||||||
|
fly(renfrew).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(lhr,
|
||||||
|
extends(airport)).
|
||||||
|
|
||||||
|
fly(edin).
|
||||||
|
fly(ringway).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(renfrew,
|
||||||
|
extends(airport)).
|
||||||
|
|
||||||
|
fly(aberdeen_air).
|
||||||
|
fly(ringway).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(ringway,
|
||||||
|
extends(manchester, airport)).
|
||||||
|
|
||||||
|
fly(lhr).
|
||||||
|
fly(renfrew).
|
||||||
|
|
||||||
|
:- end_object.
|
153
Logtalk/examples/lo/travellers/sorting.lgt
Normal file
153
Logtalk/examples/lo/travellers/sorting.lgt
Normal file
@ -0,0 +1,153 @@
|
|||||||
|
|
||||||
|
:- object(quick(_Order)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
parnames is ['Order'],
|
||||||
|
comment is '.',
|
||||||
|
source is 'Example adopted from the Francis G. McCabe L&O documentation.']).
|
||||||
|
|
||||||
|
:- public(sort/2).
|
||||||
|
:- mode(sort(+list, -list), one).
|
||||||
|
|
||||||
|
sort([], []).
|
||||||
|
sort([X| L], S):-
|
||||||
|
split(L, X, L1, L2),
|
||||||
|
sort(L1, S1),
|
||||||
|
sort(L2, S2),
|
||||||
|
app(S1, [X| S2], S).
|
||||||
|
|
||||||
|
split([], _, [], []).
|
||||||
|
split([D| L], X, [D| L1], L2):-
|
||||||
|
parameter(1, Order),
|
||||||
|
Order::less(D, X),
|
||||||
|
!,
|
||||||
|
split(L, X, L1, L2).
|
||||||
|
split([D| L], X, L1, [D| L2]):-
|
||||||
|
split(L, X, L1, L2).
|
||||||
|
|
||||||
|
app([], L, L).
|
||||||
|
app([H| T], L, [H| T2]) :-
|
||||||
|
app(T, L, T2).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(descend).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is '.',
|
||||||
|
source is 'Example adopted from the Francis G. McCabe L&O documentation.']).
|
||||||
|
|
||||||
|
:- public(less/2).
|
||||||
|
|
||||||
|
less(X, Y):-
|
||||||
|
X >= Y.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(natural).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is '.',
|
||||||
|
source is 'Example adopted from the Francis G. McCabe L&O documentation.']).
|
||||||
|
|
||||||
|
:- public(less/2).
|
||||||
|
|
||||||
|
less(X, Y):-
|
||||||
|
X < Y.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(geographic(_OX, _OY)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
parnames is ['OX', 'OY'],
|
||||||
|
comment is '.',
|
||||||
|
source is 'Example adopted from the Francis G. McCabe L&O documentation.']).
|
||||||
|
|
||||||
|
:- public(less/2).
|
||||||
|
|
||||||
|
less(Town1, Town2):-
|
||||||
|
angle(Town1, Angle1),
|
||||||
|
angle(Town2, Angle2),
|
||||||
|
Angle1 < Angle2.
|
||||||
|
|
||||||
|
angle(Town, Angle) :-
|
||||||
|
Town::at(X, Y),
|
||||||
|
parameter(1, OX),
|
||||||
|
parameter(2, OY),
|
||||||
|
angle(X, Y, OX, OY, Angle).
|
||||||
|
|
||||||
|
angle(X, Y, OX, OY, Angle) :-
|
||||||
|
X > OX,
|
||||||
|
Y >= OY,
|
||||||
|
Angle is atan((Y-OY)/(X-OX)).
|
||||||
|
|
||||||
|
angle(X, Y, OX, OY, Angle) :-
|
||||||
|
X > OX,
|
||||||
|
Y < OY,
|
||||||
|
pi(Pi),
|
||||||
|
Angle is Pi + Pi - atan((OY-Y)/(X-OX)).
|
||||||
|
|
||||||
|
angle(X, Y, OX, OY, Angle) :-
|
||||||
|
X < OX,
|
||||||
|
Y >= OY,
|
||||||
|
pi(Pi),
|
||||||
|
Angle is Pi - atan((Y-OY)/(OX-X)).
|
||||||
|
|
||||||
|
angle(X, Y, OX, OY, Angle) :-
|
||||||
|
X < OX,
|
||||||
|
Y < OY,
|
||||||
|
pi(Pi),
|
||||||
|
Angle is Pi + atan((OY-Y)/(OX-X)).
|
||||||
|
|
||||||
|
angle(OX, Y, OX, OY, Angle) :-
|
||||||
|
Y > OY,
|
||||||
|
pi(Pi),
|
||||||
|
Angle is Pi / 2.
|
||||||
|
|
||||||
|
angle(OX, Y, OX, OY, Angle) :-
|
||||||
|
Y =< OY,
|
||||||
|
pi(Pi),
|
||||||
|
Angle is 1.5 * Pi.
|
||||||
|
|
||||||
|
pi(Pi) :-
|
||||||
|
Pi is 4.0*atan(1.0).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(metric(_Town)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is '.',
|
||||||
|
parnames is ['Town'],
|
||||||
|
source is 'Example adopted from the Francis G. McCabe L&O documentation.']).
|
||||||
|
|
||||||
|
:- public(less/2).
|
||||||
|
|
||||||
|
less((Town1, _), (Town2, _)):-
|
||||||
|
parameter(1, Town),
|
||||||
|
Town::crow_flies(Town1, Distance1),
|
||||||
|
Town::crow_flies(Town2, Distance2),
|
||||||
|
Distance1 < Distance2.
|
||||||
|
|
||||||
|
:- end_object.
|
351
Logtalk/examples/lo/travellers/towns.lgt
Normal file
351
Logtalk/examples/lo/travellers/towns.lgt
Normal file
@ -0,0 +1,351 @@
|
|||||||
|
|
||||||
|
:- object(location(_X, _Y)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
parnames is ['X', 'Y'],
|
||||||
|
comment is '.',
|
||||||
|
source is 'Example adopted from the Francis G. McCabe L&O documentation.']).
|
||||||
|
|
||||||
|
:- public(at/2).
|
||||||
|
:- mode(at(-integer, -integer), one).
|
||||||
|
|
||||||
|
:- public(crow_flies/2).
|
||||||
|
:- mode(crow_flies(+atom, -integer), one).
|
||||||
|
|
||||||
|
:- public(drive/2).
|
||||||
|
:- mode(drive(+atom, -nonvar), zero_or_more).
|
||||||
|
|
||||||
|
:- public(links/1).
|
||||||
|
:- mode(links(-list), one).
|
||||||
|
|
||||||
|
:- public(road_distance/2).
|
||||||
|
:- mode(road_distance(?atom, ?integer), zero_or_more).
|
||||||
|
|
||||||
|
at(X, Y) :-
|
||||||
|
parameter(1, X),
|
||||||
|
parameter(2, Y).
|
||||||
|
|
||||||
|
crow_flies(Town, Distance) :-
|
||||||
|
::at(X, Y),
|
||||||
|
Town::at(U, V),
|
||||||
|
U0 is U-X,
|
||||||
|
V0 is V-Y,
|
||||||
|
Distance is sqrt(U0*U0+V0*V0).
|
||||||
|
|
||||||
|
road_distance(Town, Distance) :-
|
||||||
|
::links(Links),
|
||||||
|
member((Town, Distance), Links).
|
||||||
|
|
||||||
|
drive(To, Route) :- % plan a road journey
|
||||||
|
self(Self),
|
||||||
|
plan_drive(Self, To, [], _, Route).
|
||||||
|
|
||||||
|
% go directly
|
||||||
|
plan_drive(From, To, _, Distance, From-To):-
|
||||||
|
To::links(Links),
|
||||||
|
member((From, Distance), Links).
|
||||||
|
|
||||||
|
% go indirectly
|
||||||
|
plan_drive(From, To, R, D+DI, Route-To):-
|
||||||
|
To::links(Links),
|
||||||
|
nearest(Links, From, Int, DI),
|
||||||
|
\+ member(Int, R),
|
||||||
|
plan_drive(From, Int, [To| R], D, Route).
|
||||||
|
|
||||||
|
nearest(Links, To, Int, Distance):-
|
||||||
|
quick(metric(To))::sort(Links, Sorted),
|
||||||
|
member((Int, Distance), Sorted).
|
||||||
|
|
||||||
|
member(Head, [Head| _]).
|
||||||
|
member(Head, [_| Tail]) :-
|
||||||
|
member(Head, Tail).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(aberdeen,
|
||||||
|
extends(location(194, 340))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(edinburgh, 115),
|
||||||
|
(glasgow, 142)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(aberystwyth,
|
||||||
|
extends(location(126, 102))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(birmingham, 114),
|
||||||
|
(liverpool, 100),
|
||||||
|
(swansea, 75)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(birmingham,
|
||||||
|
extends(location(192, 106))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(aberystwyth, 114),
|
||||||
|
(bristol, 86),
|
||||||
|
(cambridge, 97),
|
||||||
|
(liverpool, 99),
|
||||||
|
(nottingham, 48),
|
||||||
|
(oxford, 63),
|
||||||
|
(sheffield, 75)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(brighton,
|
||||||
|
extends(location(248, 10))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(dover, 81),
|
||||||
|
(portsmouth, 49),
|
||||||
|
(london, 52)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(bristol,
|
||||||
|
extends(location(168, 47))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(cardiff, 44),
|
||||||
|
(exeter, 76),
|
||||||
|
(oxford, 71),
|
||||||
|
(birmingham, 86)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(cambridge,
|
||||||
|
extends(location(254, 92))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(nottingham, 82),
|
||||||
|
(oxford, 80),
|
||||||
|
(london, 54),
|
||||||
|
(birmingham, 97)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(cardiff,
|
||||||
|
extends(location(148, 56))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(bristol, 44),
|
||||||
|
(swansea, 45)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(carlisle,
|
||||||
|
extends(location(166, 226))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(glasgow, 94),
|
||||||
|
(leeds, 117),
|
||||||
|
(newcastle, 58)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(dover,
|
||||||
|
extends(location(292, 38))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(brighton, 81),
|
||||||
|
(london, 71)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(edinburgh,
|
||||||
|
extends(location(162, 282))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(aberdeen, 115),
|
||||||
|
(glasgow, 44),
|
||||||
|
(newcastle, 104)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(exeter,
|
||||||
|
extends(location(138, 18))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(bristol, 76),
|
||||||
|
(penzance, 112),
|
||||||
|
(portsmouth, 126)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(glasgow,
|
||||||
|
extends(location(132, 273))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(aberdeen, 142),
|
||||||
|
(carlisle, 94),
|
||||||
|
(edinburgh, 44)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(hull,
|
||||||
|
extends(location(240, 168))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(leeds, 58),
|
||||||
|
(sheffield, 65),
|
||||||
|
(york, 37)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(leeds,
|
||||||
|
extends(location(208, 170))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(carlisle, 117),
|
||||||
|
(hull, 58),
|
||||||
|
(sheffield, 34),
|
||||||
|
(manchester, 41),
|
||||||
|
(york, 23)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(liverpool,
|
||||||
|
extends(location(164, 150))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(aberystwyth, 100),
|
||||||
|
(birmingham, 99),
|
||||||
|
(manchester, 35),
|
||||||
|
(sheffield, 70)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(london,
|
||||||
|
extends(location(244,54))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(brighton, 52),
|
||||||
|
(dover, 71),
|
||||||
|
(cambridge, 54),
|
||||||
|
(oxford, 57),
|
||||||
|
(portsmouth, 72)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(manchester,
|
||||||
|
extends(location(180, 156))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(leeds, 41),
|
||||||
|
(liverpool, 35),
|
||||||
|
(sheffield, 38)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(newcastle,
|
||||||
|
extends(location(210, 230))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(edinburgh, 104),
|
||||||
|
(carlisle, 58),
|
||||||
|
(york, 80)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(nottingham,
|
||||||
|
extends(location(216, 128))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(birmingham, 48),
|
||||||
|
(cambridge, 82),
|
||||||
|
(sheffield, 38)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(oxford,
|
||||||
|
extends(location(214, 66))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(bristol, 71),
|
||||||
|
(birmingham, 63),
|
||||||
|
(cambridge, 80),
|
||||||
|
(london, 57)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(penzance,
|
||||||
|
extends(location(10, 0))).
|
||||||
|
|
||||||
|
links([(
|
||||||
|
exeter, 112)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(portsmouth,
|
||||||
|
extends(location(216, 22))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(brighton, 49),
|
||||||
|
(exeter, 126),
|
||||||
|
(london, 72)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(sheffield,
|
||||||
|
extends(location(208, 142))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(birmingham, 75),
|
||||||
|
(hull, 65),
|
||||||
|
(leeds, 34),
|
||||||
|
(liverpool, 70),
|
||||||
|
(manchester, 38),
|
||||||
|
(nottingham, 38)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(swansea,
|
||||||
|
extends(location(126, 66))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(cardiff, 45),
|
||||||
|
(aberystwyth, 75)]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(york,
|
||||||
|
extends(location(218, 184))).
|
||||||
|
|
||||||
|
links([
|
||||||
|
(leeds, 23),
|
||||||
|
(hull, 37),
|
||||||
|
(newcastle, 80)]).
|
||||||
|
|
||||||
|
:- end_object.
|
11
Logtalk/examples/lpa/faults/NOTES
Normal file
11
Logtalk/examples/lpa/faults/NOTES
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
=================================================================
|
||||||
|
Logtalk - Object oriented extension to Prolog
|
||||||
|
Release 2.26.2
|
||||||
|
|
||||||
|
Copyright (c) 1998-2005 Paulo Moura. All Rights Reserved.
|
||||||
|
=================================================================
|
||||||
|
|
||||||
|
|
||||||
|
This example is an adaptation of the LPA Prolog++ faults example.
|
||||||
|
|
||||||
|
To load this example and for sample queries, please see the SCRIPT file.
|
34
Logtalk/examples/lpa/faults/SCRIPT
Normal file
34
Logtalk/examples/lpa/faults/SCRIPT
Normal file
@ -0,0 +1,34 @@
|
|||||||
|
=================================================================
|
||||||
|
Logtalk - Object oriented extension to Prolog
|
||||||
|
Release 2.26.2
|
||||||
|
|
||||||
|
Copyright (c) 1998-2005 Paulo Moura. All Rights Reserved.
|
||||||
|
=================================================================
|
||||||
|
|
||||||
|
|
||||||
|
% start by loading the necessary library support files (if not
|
||||||
|
% already loaded):
|
||||||
|
|
||||||
|
| ?- logtalk_load(library(hierarchies_loader)).
|
||||||
|
...
|
||||||
|
|
||||||
|
|
||||||
|
% now you are ready for loading the example:
|
||||||
|
|
||||||
|
| ?- logtalk_load(lpa_faults(loader)).
|
||||||
|
...
|
||||||
|
|
||||||
|
|
||||||
|
| ?- fault::findall.
|
||||||
|
|
||||||
|
Please answer all questions with yes or no.
|
||||||
|
|
||||||
|
The starter turns but the engine doesnt fire? no.
|
||||||
|
The engine has difficulty starting? yes.
|
||||||
|
The engine cuts out shortly after starting? yes.
|
||||||
|
|
||||||
|
Location : distributor
|
||||||
|
Possible Fault: Worn distributor brushes
|
||||||
|
|
||||||
|
No (more) explanations found.
|
||||||
|
yes.
|
6
Logtalk/examples/lpa/faults/cylinders.lgt
Normal file
6
Logtalk/examples/lpa/faults/cylinders.lgt
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
|
||||||
|
:- object(cylinders,
|
||||||
|
extends(engine)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
25
Logtalk/examples/lpa/faults/distributor.lgt
Normal file
25
Logtalk/examples/lpa/faults/distributor.lgt
Normal file
@ -0,0 +1,25 @@
|
|||||||
|
|
||||||
|
:- object(distributor,
|
||||||
|
extends(sparking)).
|
||||||
|
|
||||||
|
|
||||||
|
fault(f1001, 'Condensation in the distributor cap').
|
||||||
|
fault(f1002, 'Faulty distributor arm').
|
||||||
|
fault(f1003, 'Worn distributor brushes').
|
||||||
|
|
||||||
|
symptom(s1001, 'The starter turns but the engine doesnt fire').
|
||||||
|
symptom(s1002, 'The engine has difficulty starting').
|
||||||
|
symptom(s1003, 'The engine cuts out shortly after starting').
|
||||||
|
symptom(s1004, 'The engine cuts out at speed').
|
||||||
|
|
||||||
|
effect(f1001, s1001).
|
||||||
|
effect(f1002, s1001).
|
||||||
|
effect(f1002, s1004).
|
||||||
|
effect(f1003, s1002).
|
||||||
|
effect(f1003, s1003).
|
||||||
|
|
||||||
|
contrary(s1002, s1001).
|
||||||
|
contrary(s1003, s1001).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
6
Logtalk/examples/lpa/faults/electrical.lgt
Normal file
6
Logtalk/examples/lpa/faults/electrical.lgt
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
|
||||||
|
:- object(electrical,
|
||||||
|
extends(fault)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
6
Logtalk/examples/lpa/faults/engine.lgt
Normal file
6
Logtalk/examples/lpa/faults/engine.lgt
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
|
||||||
|
:- object(engine,
|
||||||
|
extends(mechanical)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
72
Logtalk/examples/lpa/faults/fault.lgt
Normal file
72
Logtalk/examples/lpa/faults/fault.lgt
Normal file
@ -0,0 +1,72 @@
|
|||||||
|
|
||||||
|
:- object(fault,
|
||||||
|
imports(proto_hierarchy)).
|
||||||
|
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Expert system for automobile fault diagnosis.',
|
||||||
|
source is 'Example adopted from the LPA Prolog++ documentation.']).
|
||||||
|
|
||||||
|
|
||||||
|
:- public(findall/0).
|
||||||
|
:- mode(findall, one).
|
||||||
|
|
||||||
|
:- private(told_by_user_/2).
|
||||||
|
:- dynamic(told_by_user_/2).
|
||||||
|
:- mode(told_by_user_(?nonvar, ?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
:- public(find/1).
|
||||||
|
:- mode(find(?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
:- private(exhibited/1).
|
||||||
|
:- mode(exhibited(+nonvar), zero_or_one).
|
||||||
|
|
||||||
|
:- public(contrary/2).
|
||||||
|
:- mode(contrary(?nonvar, ?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
:- public(fault/2).
|
||||||
|
:- mode(fault(?nonvar, ?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
:- public(effect/2).
|
||||||
|
:- mode(effect(?nonvar, ?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
:- public(symptom/2).
|
||||||
|
:- mode(symptom(?nonvar, ?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
|
||||||
|
findall :-
|
||||||
|
retractall(told_by_user_(_, _)),
|
||||||
|
write('Please answer all questions with yes or no.'), nl, nl,
|
||||||
|
forall(
|
||||||
|
(::descendant(Where), Where::find(Description)),
|
||||||
|
(nl, write('Location : '), write(Where), nl,
|
||||||
|
write('Possible Fault: '), write(Description), nl)),
|
||||||
|
nl, write('No (more) explanations found.').
|
||||||
|
|
||||||
|
|
||||||
|
find(Description) :-
|
||||||
|
::fault(Fault, Description),
|
||||||
|
forall(::effect(Fault, Symptom), exhibited(Symptom)).
|
||||||
|
|
||||||
|
|
||||||
|
exhibited(Symptom) :-
|
||||||
|
told_by_user_(Symptom, Reply),
|
||||||
|
!,
|
||||||
|
Reply = yes.
|
||||||
|
|
||||||
|
exhibited(Symptom) :-
|
||||||
|
::symptom(Symptom, Description),
|
||||||
|
write(Description), write('? '),
|
||||||
|
read(Reply),
|
||||||
|
asserta(told_by_user_(Symptom, Reply)),
|
||||||
|
Reply = yes,
|
||||||
|
forall(
|
||||||
|
(::contrary(Symptom, Contrary);
|
||||||
|
::contrary(Contrary, Symptom)),
|
||||||
|
asserta(told_by_user_(Contrary, no))).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
178
Logtalk/examples/lpa/faults/faults.lgt
Normal file
178
Logtalk/examples/lpa/faults/faults.lgt
Normal file
@ -0,0 +1,178 @@
|
|||||||
|
|
||||||
|
:- object(fault,
|
||||||
|
imports(proto_hierarchy)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Expert system for automobile fault diagnosis.',
|
||||||
|
source is 'Example adopted from the LPA Prolog++ documentation.']).
|
||||||
|
|
||||||
|
:- public(findall/0).
|
||||||
|
:- mode(findall, one).
|
||||||
|
|
||||||
|
:- private(told_by_user_/2).
|
||||||
|
:- dynamic(told_by_user_/2).
|
||||||
|
:- mode(told_by_user_(?nonvar, ?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
:- public(find/1).
|
||||||
|
:- mode(find(?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
:- private(exhibited/1).
|
||||||
|
:- mode(exhibited(+nonvar), zero_or_one).
|
||||||
|
|
||||||
|
:- public(contrary/2).
|
||||||
|
:- mode(contrary(?nonvar, ?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
:- public(fault/2).
|
||||||
|
:- mode(fault(?nonvar, ?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
:- public(effect/2).
|
||||||
|
:- mode(effect(?nonvar, ?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
:- public(symptom/2).
|
||||||
|
:- mode(symptom(?nonvar, ?nonvar), zero_or_more).
|
||||||
|
|
||||||
|
findall :-
|
||||||
|
retractall(told_by_user_(_, _)),
|
||||||
|
write('Please answer all questions with yes or no.'), nl, nl,
|
||||||
|
forall(
|
||||||
|
(::descendant(Where), Where::find(Description)),
|
||||||
|
(nl, write('Location : '), write(Where), nl,
|
||||||
|
write('Possible Fault: '), write(Description), nl)),
|
||||||
|
nl, write('No (more) explanations found.').
|
||||||
|
|
||||||
|
find(Description) :-
|
||||||
|
::fault(Fault, Description),
|
||||||
|
forall(::effect(Fault, Symptom), exhibited(Symptom)).
|
||||||
|
|
||||||
|
exhibited(Symptom) :-
|
||||||
|
told_by_user_(Symptom, Reply) ->
|
||||||
|
Reply = yes
|
||||||
|
;
|
||||||
|
::symptom(Symptom, Description),
|
||||||
|
write(Description), write('? '),
|
||||||
|
read(Reply),
|
||||||
|
asserta(told_by_user_(Symptom, Reply)),
|
||||||
|
Reply = yes,
|
||||||
|
forall(
|
||||||
|
(::contrary(Symptom, Contrary); ::contrary(Contrary, Symptom)),
|
||||||
|
asserta(told_by_user_(Contrary, no))).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/* electrical sub-system:
|
||||||
|
|
||||||
|
electrical
|
||||||
|
lights
|
||||||
|
starting
|
||||||
|
sparking
|
||||||
|
distributor
|
||||||
|
plugs
|
||||||
|
starter_motor
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
:- object(electrical,
|
||||||
|
extends(fault)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(lights,
|
||||||
|
extends(electrical)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(starting,
|
||||||
|
extends(electrical)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(sparking,
|
||||||
|
extends(starting)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(distributor,
|
||||||
|
extends(sparking)).
|
||||||
|
|
||||||
|
fault(f1001, 'Condensation in the distributor cap').
|
||||||
|
fault(f1002, 'Faulty distributor arm').
|
||||||
|
fault(f1003, 'Worn distributor brushes').
|
||||||
|
|
||||||
|
symptom(s1001, 'The starter turns but the engine doesnt fire').
|
||||||
|
symptom(s1002, 'The engine has difficulty starting').
|
||||||
|
symptom(s1003, 'The engine cuts out shortly after starting').
|
||||||
|
symptom(s1004, 'The engine cuts out at speed').
|
||||||
|
|
||||||
|
effect(f1001, s1001).
|
||||||
|
effect(f1002, s1001).
|
||||||
|
effect(f1002, s1004).
|
||||||
|
effect(f1003, s1002).
|
||||||
|
effect(f1003, s1003).
|
||||||
|
|
||||||
|
contrary(s1002, s1001).
|
||||||
|
contrary(s1003, s1001).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(plugs,
|
||||||
|
extends(sparking)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(starter_motor,
|
||||||
|
extends(starting)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/* mechanical sub-system:
|
||||||
|
|
||||||
|
mechanical
|
||||||
|
engine
|
||||||
|
cylinders
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
:- object(mechanical,
|
||||||
|
extends(fault)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(engine,
|
||||||
|
extends(mechanical)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(cylinders,
|
||||||
|
extends(engine)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/* fuel_system sub-system:
|
||||||
|
|
||||||
|
fuel_system
|
||||||
|
...
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
:- object(fuel_system,
|
||||||
|
extends(fault)).
|
||||||
|
|
||||||
|
:- end_object.
|
6
Logtalk/examples/lpa/faults/fuel_system.lgt
Normal file
6
Logtalk/examples/lpa/faults/fuel_system.lgt
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
|
||||||
|
:- object(fuel_system,
|
||||||
|
extends(fault)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
6
Logtalk/examples/lpa/faults/lights.lgt
Normal file
6
Logtalk/examples/lpa/faults/lights.lgt
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
|
||||||
|
:- object(lights,
|
||||||
|
extends(electrical)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
13
Logtalk/examples/lpa/faults/loader.lgt
Normal file
13
Logtalk/examples/lpa/faults/loader.lgt
Normal file
@ -0,0 +1,13 @@
|
|||||||
|
|
||||||
|
:- initialization(
|
||||||
|
logtalk_load([
|
||||||
|
faults])).
|
||||||
|
|
||||||
|
/*
|
||||||
|
If you intend to use the FOP XSL:FO processor for generating PDF documenting
|
||||||
|
files, comment the directive above and uncomment the directive below
|
||||||
|
|
||||||
|
:- initialization(
|
||||||
|
logtalk_load(
|
||||||
|
[faults], [xmlsref(standalone)])).
|
||||||
|
*/
|
6
Logtalk/examples/lpa/faults/mechanical.lgt
Normal file
6
Logtalk/examples/lpa/faults/mechanical.lgt
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
|
||||||
|
:- object(mechanical,
|
||||||
|
extends(fault)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
6
Logtalk/examples/lpa/faults/plugs.lgt
Normal file
6
Logtalk/examples/lpa/faults/plugs.lgt
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
|
||||||
|
:- object(plugs,
|
||||||
|
extends(sparking)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
6
Logtalk/examples/lpa/faults/sparking.lgt
Normal file
6
Logtalk/examples/lpa/faults/sparking.lgt
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
|
||||||
|
:- object(sparking,
|
||||||
|
extends(starting)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
6
Logtalk/examples/lpa/faults/starter_motor.lgt
Normal file
6
Logtalk/examples/lpa/faults/starter_motor.lgt
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
|
||||||
|
:- object(starter_motor,
|
||||||
|
extends(starting)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
6
Logtalk/examples/lpa/faults/starting.lgt
Normal file
6
Logtalk/examples/lpa/faults/starting.lgt
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
|
||||||
|
:- object(starting,
|
||||||
|
extends(electrical)).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
11
Logtalk/examples/lpa/timetables/NOTES
Normal file
11
Logtalk/examples/lpa/timetables/NOTES
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
=================================================================
|
||||||
|
Logtalk - Object oriented extension to Prolog
|
||||||
|
Release 2.26.2
|
||||||
|
|
||||||
|
Copyright (c) 1998-2005 Paulo Moura. All Rights Reserved.
|
||||||
|
=================================================================
|
||||||
|
|
||||||
|
|
||||||
|
This example is an adaptation of the LPA Prolog++ timetables example.
|
||||||
|
|
||||||
|
To load this example and for sample queries, please see the SCRIPT file.
|
532
Logtalk/examples/lpa/timetables/SCRIPT
Normal file
532
Logtalk/examples/lpa/timetables/SCRIPT
Normal file
@ -0,0 +1,532 @@
|
|||||||
|
=================================================================
|
||||||
|
Logtalk - Object oriented extension to Prolog
|
||||||
|
Release 2.26.2
|
||||||
|
|
||||||
|
Copyright (c) 1998-2005 Paulo Moura. All Rights Reserved.
|
||||||
|
=================================================================
|
||||||
|
|
||||||
|
|
||||||
|
% start by loading the necessary library support example files (if not
|
||||||
|
% already loaded):
|
||||||
|
|
||||||
|
| ?- logtalk_load(library(types_loader)).
|
||||||
|
...
|
||||||
|
|
||||||
|
|
||||||
|
% now you are ready for loading the example:
|
||||||
|
|
||||||
|
| ?- logtalk_load(lpa_timetables(loader)).
|
||||||
|
...
|
||||||
|
|
||||||
|
|
||||||
|
% the setup phase initializes the timetable:
|
||||||
|
|
||||||
|
| ?- timetable::setup.
|
||||||
|
|
||||||
|
yes
|
||||||
|
|
||||||
|
|
||||||
|
| ?- timetable::make(2).
|
||||||
|
|
||||||
|
+ first_year - p1 - nicky - french
|
||||||
|
+ first_year - p2 - nicky - biology
|
||||||
|
+ first_year - p3 - brian - maths
|
||||||
|
+ first_year - p4 - brian - music
|
||||||
|
+ first_year - p5 - clive - prolog
|
||||||
|
+ second_year - p1 - brian - maths
|
||||||
|
+ second_year - p2 - brian - music
|
||||||
|
+ second_year - p3 - nicky - french
|
||||||
|
+ second_year - p4 - nicky - biology
|
||||||
|
+ second_year - p5 - diane - accountancy
|
||||||
|
+ third_year - p1 - dave - maths
|
||||||
|
+ third_year - p2 - clive - french
|
||||||
|
+ third_year - p3 - clive - prolog
|
||||||
|
+ third_year - p4 - diane - accountancy
|
||||||
|
+ third_year - p5 - nicky - biology
|
||||||
|
+ fourth_year - p1 - clive - french
|
||||||
|
+ fourth_year - p2 - dave - maths
|
||||||
|
+ fourth_year - p3 - diane - accountancy
|
||||||
|
+ fourth_year - p4 - clive - prolog
|
||||||
|
+ fourth_year - p5 - brian - music
|
||||||
|
yes
|
||||||
|
|
||||||
|
|
||||||
|
% the partially completed timetable is ...
|
||||||
|
|
||||||
|
| ?- timetable::print.
|
||||||
|
|
||||||
|
FORM TIMETABLE...
|
||||||
|
|
||||||
|
FORM: first_year
|
||||||
|
p1: nicky teaches french
|
||||||
|
p2: nicky teaches biology
|
||||||
|
p3: brian teaches maths
|
||||||
|
p4: brian teaches music
|
||||||
|
p5: clive teaches prolog
|
||||||
|
|
||||||
|
FORM: second_year
|
||||||
|
p1: brian teaches maths
|
||||||
|
p2: brian teaches music
|
||||||
|
p3: nicky teaches french
|
||||||
|
p4: nicky teaches biology
|
||||||
|
p5: diane teaches accountancy
|
||||||
|
|
||||||
|
FORM: third_year
|
||||||
|
p1: dave teaches maths
|
||||||
|
p2: clive teaches french
|
||||||
|
p3: clive teaches prolog
|
||||||
|
p4: diane teaches accountancy
|
||||||
|
p5: nicky teaches biology
|
||||||
|
|
||||||
|
FORM: fourth_year
|
||||||
|
p1: clive teaches french
|
||||||
|
p2: dave teaches maths
|
||||||
|
p3: diane teaches accountancy
|
||||||
|
p4: clive teaches prolog
|
||||||
|
p5: brian teaches music
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
PERIOD TIMETABLE ...
|
||||||
|
|
||||||
|
PERIOD: p1
|
||||||
|
first_year: nicky teaches french
|
||||||
|
second_year: brian teaches maths
|
||||||
|
third_year: dave teaches maths
|
||||||
|
fourth_year: clive teaches french
|
||||||
|
|
||||||
|
PERIOD: p2
|
||||||
|
first_year: nicky teaches biology
|
||||||
|
second_year: brian teaches music
|
||||||
|
third_year: clive teaches french
|
||||||
|
fourth_year: dave teaches maths
|
||||||
|
|
||||||
|
PERIOD: p3
|
||||||
|
first_year: brian teaches maths
|
||||||
|
second_year: nicky teaches french
|
||||||
|
third_year: clive teaches prolog
|
||||||
|
fourth_year: diane teaches accountancy
|
||||||
|
|
||||||
|
PERIOD: p4
|
||||||
|
first_year: brian teaches music
|
||||||
|
second_year: nicky teaches biology
|
||||||
|
third_year: diane teaches accountancy
|
||||||
|
fourth_year: clive teaches prolog
|
||||||
|
|
||||||
|
PERIOD: p5
|
||||||
|
first_year: clive teaches prolog
|
||||||
|
second_year: diane teaches accountancy
|
||||||
|
third_year: nicky teaches biology
|
||||||
|
fourth_year: brian teaches music
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
TEACHER TIMETABLE ...
|
||||||
|
|
||||||
|
TEACHER: nicky
|
||||||
|
p1: teach french to first_year
|
||||||
|
p2: teach biology to first_year
|
||||||
|
p3: teach french to second_year
|
||||||
|
p4: teach biology to second_year
|
||||||
|
p5: teach biology to third_year
|
||||||
|
|
||||||
|
TEACHER: brian
|
||||||
|
p1: teach maths to second_year
|
||||||
|
p2: teach music to second_year
|
||||||
|
p3: teach maths to first_year
|
||||||
|
p4: teach music to first_year
|
||||||
|
p5: teach music to fourth_year
|
||||||
|
|
||||||
|
TEACHER: dave
|
||||||
|
p1: teach maths to third_year
|
||||||
|
p2: teach maths to fourth_year
|
||||||
|
p3:
|
||||||
|
p4:
|
||||||
|
p5:
|
||||||
|
|
||||||
|
TEACHER: clive
|
||||||
|
p1: teach french to fourth_year
|
||||||
|
p2: teach french to third_year
|
||||||
|
p3: teach prolog to third_year
|
||||||
|
p4: teach prolog to fourth_year
|
||||||
|
p5: teach prolog to first_year
|
||||||
|
|
||||||
|
TEACHER: diane
|
||||||
|
p1:
|
||||||
|
p2:
|
||||||
|
p3: teach accountancy to fourth_year
|
||||||
|
p4: teach accountancy to third_year
|
||||||
|
p5: teach accountancy to second_year
|
||||||
|
|
||||||
|
TEACHER: phil
|
||||||
|
p1:
|
||||||
|
p2:
|
||||||
|
p3:
|
||||||
|
p4:
|
||||||
|
p5:
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
SUBJECT TIMETABLE ...
|
||||||
|
|
||||||
|
SUBJECT: maths
|
||||||
|
p1: second_year taught by brian
|
||||||
|
p1: third_year taught by dave
|
||||||
|
p2: fourth_year taught by dave
|
||||||
|
p3: first_year taught by brian
|
||||||
|
|
||||||
|
SUBJECT: music
|
||||||
|
p2: second_year taught by brian
|
||||||
|
p4: first_year taught by brian
|
||||||
|
p5: fourth_year taught by brian
|
||||||
|
|
||||||
|
SUBJECT: french
|
||||||
|
p1: first_year taught by nicky
|
||||||
|
p1: fourth_year taught by clive
|
||||||
|
p2: third_year taught by clive
|
||||||
|
p3: second_year taught by nicky
|
||||||
|
|
||||||
|
SUBJECT: prolog
|
||||||
|
p3: third_year taught by clive
|
||||||
|
p4: fourth_year taught by clive
|
||||||
|
p5: first_year taught by clive
|
||||||
|
|
||||||
|
SUBJECT: biology
|
||||||
|
p2: first_year taught by nicky
|
||||||
|
p4: second_year taught by nicky
|
||||||
|
p5: third_year taught by nicky
|
||||||
|
|
||||||
|
SUBJECT: prolog++
|
||||||
|
|
||||||
|
SUBJECT: accountancy
|
||||||
|
p3: fourth_year taught by diane
|
||||||
|
p4: third_year taught by diane
|
||||||
|
p5: second_year taught by diane
|
||||||
|
|
||||||
|
yes
|
||||||
|
|
||||||
|
|
||||||
|
| ?- timetable::make(5).
|
||||||
|
|
||||||
|
+ first_year - p1 - diane - accountancy
|
||||||
|
+ first_year - p2 - phil - prolog++
|
||||||
|
+ second_year - p1 - phil - prolog++
|
||||||
|
Swap subject...
|
||||||
|
- third_year - p4 - diane - accountancy
|
||||||
|
+ third_year - p4 - phil - prolog++
|
||||||
|
Swap teacher...
|
||||||
|
- third_year - p2 - clive - french
|
||||||
|
+ third_year - p2 - diane - accountancy
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - brian - music
|
||||||
|
+ second_year - p2 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
Swap subject...
|
||||||
|
- third_year - p2 - diane - accountancy
|
||||||
|
+ third_year - p2 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
- third_year - p2 - brian - music
|
||||||
|
+ third_year - p2 - diane - accountancy
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - clive - prolog
|
||||||
|
+ second_year - p2 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - brian - music
|
||||||
|
+ second_year - p2 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - clive - prolog
|
||||||
|
+ second_year - p2 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - brian - music
|
||||||
|
+ second_year - p2 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - clive - prolog
|
||||||
|
+ second_year - p2 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - brian - music
|
||||||
|
+ second_year - p2 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - clive - prolog
|
||||||
|
+ second_year - p2 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - brian - music
|
||||||
|
+ second_year - p2 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - clive - prolog
|
||||||
|
+ second_year - p2 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - brian - music
|
||||||
|
+ second_year - p2 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - clive - prolog
|
||||||
|
+ second_year - p2 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - brian - music
|
||||||
|
+ second_year - p2 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - clive - prolog
|
||||||
|
+ second_year - p2 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - brian - music
|
||||||
|
+ second_year - p2 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - clive - prolog
|
||||||
|
+ second_year - p2 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - brian - music
|
||||||
|
+ second_year - p2 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- second_year - p2 - clive - prolog
|
||||||
|
+ second_year - p2 - brian - music
|
||||||
|
Swap subject...
|
||||||
|
- third_year - p2 - diane - accountancy
|
||||||
|
+ third_year - p2 - clive - french
|
||||||
|
Swap subject...
|
||||||
|
- third_year - p4 - phil - prolog++
|
||||||
|
+ third_year - p4 - diane - accountancy
|
||||||
|
Swap teacher...
|
||||||
|
- third_year - p3 - clive - prolog
|
||||||
|
+ third_year - p3 - phil - prolog++
|
||||||
|
Swap subject...
|
||||||
|
Swap subject...
|
||||||
|
Swap subject...
|
||||||
|
- third_year - p3 - phil - prolog++
|
||||||
|
+ third_year - p3 - clive - prolog
|
||||||
|
Swap subject...
|
||||||
|
- third_year - p4 - diane - accountancy
|
||||||
|
+ third_year - p4 - phil - prolog++
|
||||||
|
Swap teacher...
|
||||||
|
- third_year - p2 - clive - french
|
||||||
|
+ third_year - p2 - diane - accountancy
|
||||||
|
+ second_year - p2 - clive - prolog
|
||||||
|
Swap subject...
|
||||||
|
- fourth_year - p3 - diane - accountancy
|
||||||
|
+ fourth_year - p3 - phil - prolog++
|
||||||
|
Swap teacher...
|
||||||
|
- fourth_year - p4 - clive - prolog
|
||||||
|
+ fourth_year - p4 - diane - accountancy
|
||||||
|
Swap subject...
|
||||||
|
- third_year - p4 - phil - prolog++
|
||||||
|
+ third_year - p4 - clive - french
|
||||||
|
Swap teacher...
|
||||||
|
- third_year - p3 - clive - prolog
|
||||||
|
+ third_year - p3 - phil - prolog++
|
||||||
|
Swap subject...
|
||||||
|
- fourth_year - p3 - phil - prolog++
|
||||||
|
+ fourth_year - p3 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
Swap subject...
|
||||||
|
- fourth_year - p4 - diane - accountancy
|
||||||
|
+ fourth_year - p4 - phil - prolog++
|
||||||
|
Swap teacher...
|
||||||
|
- fourth_year - p3 - clive - prolog
|
||||||
|
+ fourth_year - p3 - diane - accountancy
|
||||||
|
Swap subject...
|
||||||
|
- fourth_year - p3 - diane - accountancy
|
||||||
|
+ fourth_year - p3 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
- fourth_year - p3 - clive - prolog
|
||||||
|
+ fourth_year - p3 - diane - accountancy
|
||||||
|
Swap subject...
|
||||||
|
- third_year - p3 - phil - prolog++
|
||||||
|
+ third_year - p3 - clive - prolog
|
||||||
|
Swap teacher...
|
||||||
|
- third_year - p5 - nicky - biology
|
||||||
|
+ third_year - p5 - phil - prolog++
|
||||||
|
Swap teacher...
|
||||||
|
- fourth_year - p5 - brian - music
|
||||||
|
+ fourth_year - p5 - nicky - biology
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- fourth_year - p5 - nicky - biology
|
||||||
|
+ fourth_year - p5 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
- fourth_year - p5 - brian - music
|
||||||
|
+ fourth_year - p5 - nicky - biology
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- fourth_year - p5 - nicky - biology
|
||||||
|
+ fourth_year - p5 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
- fourth_year - p5 - brian - music
|
||||||
|
+ fourth_year - p5 - nicky - biology
|
||||||
|
Swap teacher...
|
||||||
|
Swap teacher...
|
||||||
|
- fourth_year - p5 - nicky - biology
|
||||||
|
+ fourth_year - p5 - brian - music
|
||||||
|
Swap teacher...
|
||||||
|
- fourth_year - p5 - brian - music
|
||||||
|
+ fourth_year - p5 - nicky - biology
|
||||||
|
+ third_year - p5 - brian - music
|
||||||
|
|
||||||
|
yes
|
||||||
|
|
||||||
|
|
||||||
|
% the completed timetable is ...
|
||||||
|
|
||||||
|
| ?- timetable::print.
|
||||||
|
|
||||||
|
FORM TIMETABLE...
|
||||||
|
|
||||||
|
FORM: first_year
|
||||||
|
p1: nicky teaches french
|
||||||
|
p2: nicky teaches biology
|
||||||
|
p3: brian teaches maths
|
||||||
|
p4: brian teaches music
|
||||||
|
p5: clive teaches prolog
|
||||||
|
|
||||||
|
FORM: second_year
|
||||||
|
p1: brian teaches maths
|
||||||
|
p2: brian teaches music
|
||||||
|
p3: nicky teaches french
|
||||||
|
p4: nicky teaches biology
|
||||||
|
p5: diane teaches accountancy
|
||||||
|
|
||||||
|
FORM: third_year
|
||||||
|
p1: dave teaches maths
|
||||||
|
p2: diane teaches accountancy
|
||||||
|
p3: clive teaches prolog
|
||||||
|
p4: clive teaches french
|
||||||
|
p5: phil teaches prolog++
|
||||||
|
|
||||||
|
FORM: fourth_year
|
||||||
|
p1: clive teaches french
|
||||||
|
p2: dave teaches maths
|
||||||
|
p3: diane teaches accountancy
|
||||||
|
p4: phil teaches prolog++
|
||||||
|
p5: nicky teaches biology
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
PERIOD TIMETABLE ...
|
||||||
|
|
||||||
|
PERIOD: p1
|
||||||
|
first_year: nicky teaches french
|
||||||
|
second_year: brian teaches maths
|
||||||
|
third_year: dave teaches maths
|
||||||
|
fourth_year: clive teaches french
|
||||||
|
|
||||||
|
PERIOD: p2
|
||||||
|
first_year: nicky teaches biology
|
||||||
|
second_year: brian teaches music
|
||||||
|
third_year: diane teaches accountancy
|
||||||
|
fourth_year: dave teaches maths
|
||||||
|
|
||||||
|
PERIOD: p3
|
||||||
|
first_year: brian teaches maths
|
||||||
|
second_year: nicky teaches french
|
||||||
|
third_year: clive teaches prolog
|
||||||
|
fourth_year: diane teaches accountancy
|
||||||
|
|
||||||
|
PERIOD: p4
|
||||||
|
first_year: brian teaches music
|
||||||
|
second_year: nicky teaches biology
|
||||||
|
third_year: clive teaches french
|
||||||
|
fourth_year: phil teaches prolog++
|
||||||
|
|
||||||
|
PERIOD: p5
|
||||||
|
first_year: clive teaches prolog
|
||||||
|
second_year: diane teaches accountancy
|
||||||
|
third_year: phil teaches prolog++
|
||||||
|
fourth_year: nicky teaches biology
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
TEACHER TIMETABLE ...
|
||||||
|
|
||||||
|
TEACHER: nicky
|
||||||
|
p1: teach french to first_year
|
||||||
|
p2: teach biology to first_year
|
||||||
|
p3: teach french to second_year
|
||||||
|
p4: teach biology to second_year
|
||||||
|
p5: teach biology to fourth_year
|
||||||
|
|
||||||
|
TEACHER: brian
|
||||||
|
p1: teach maths to second_year
|
||||||
|
p2: teach music to second_year
|
||||||
|
p3: teach maths to first_year
|
||||||
|
p4: teach music to first_year
|
||||||
|
p5: teach music to third_year
|
||||||
|
|
||||||
|
TEACHER: dave
|
||||||
|
p1: teach maths to third_year
|
||||||
|
p2: teach maths to fourth_year
|
||||||
|
p3:
|
||||||
|
p4:
|
||||||
|
p5:
|
||||||
|
|
||||||
|
TEACHER: clive
|
||||||
|
p1: teach french to fourth_year
|
||||||
|
p2: teach prolog to second_year
|
||||||
|
p3: teach prolog to third_year
|
||||||
|
p4: teach french to third_year
|
||||||
|
p5: teach prolog to first_year
|
||||||
|
|
||||||
|
TEACHER: diane
|
||||||
|
p1: teach accountancy to first_year
|
||||||
|
p2: teach accountancy to third_year
|
||||||
|
p3: teach accountancy to fourth_year
|
||||||
|
p4:
|
||||||
|
p5: teach accountancy to second_year
|
||||||
|
|
||||||
|
TEACHER: phil
|
||||||
|
p1: teach prolog++ to second_year
|
||||||
|
p2: teach prolog++ to first_year
|
||||||
|
p3:
|
||||||
|
p4: teach prolog++ to fourth_year
|
||||||
|
p5: teach prolog++ to third_year
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
SUBJECT TIMETABLE ...
|
||||||
|
|
||||||
|
SUBJECT: maths
|
||||||
|
p1: second_year taught by brian
|
||||||
|
p1: third_year taught by dave
|
||||||
|
p2: fourth_year taught by dave
|
||||||
|
p3: first_year taught by brian
|
||||||
|
|
||||||
|
SUBJECT: music
|
||||||
|
p2: second_year taught by brian
|
||||||
|
p4: first_year taught by brian
|
||||||
|
p5: third_year taught by brian
|
||||||
|
|
||||||
|
SUBJECT: french
|
||||||
|
p1: first_year taught by nicky
|
||||||
|
p1: fourth_year taught by clive
|
||||||
|
p3: second_year taught by nicky
|
||||||
|
p4: third_year taught by clive
|
||||||
|
|
||||||
|
SUBJECT: prolog
|
||||||
|
p2: second_year taught by clive
|
||||||
|
p3: third_year taught by clive
|
||||||
|
p5: first_year taught by clive
|
||||||
|
|
||||||
|
SUBJECT: biology
|
||||||
|
p2: first_year taught by nicky
|
||||||
|
p4: second_year taught by nicky
|
||||||
|
p5: fourth_year taught by nicky
|
||||||
|
|
||||||
|
SUBJECT: prolog++
|
||||||
|
p1: second_year taught by phil
|
||||||
|
p2: first_year taught by phil
|
||||||
|
p4: fourth_year taught by phil
|
||||||
|
p5: third_year taught by phil
|
||||||
|
|
||||||
|
SUBJECT: accountancy
|
||||||
|
p1: first_year taught by diane
|
||||||
|
p2: third_year taught by diane
|
||||||
|
p3: fourth_year taught by diane
|
||||||
|
p5: second_year taught by diane
|
||||||
|
|
||||||
|
yes
|
80
Logtalk/examples/lpa/timetables/forms.lgt
Normal file
80
Logtalk/examples/lpa/timetables/forms.lgt
Normal file
@ -0,0 +1,80 @@
|
|||||||
|
|
||||||
|
:- object(forms).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2005/5/8,
|
||||||
|
author is 'Example by LPA; adapted to Logtalk by Paulo Moura.',
|
||||||
|
comment is 'General attributes & methods for all forms.']).
|
||||||
|
|
||||||
|
:- public(print/0).
|
||||||
|
:- info(print/0, [
|
||||||
|
comment is 'Print the complete timetable from the pupil viewpoint.']).
|
||||||
|
|
||||||
|
print :-
|
||||||
|
nl, write('FORM TIMETABLE...'), nl, nl,
|
||||||
|
forall(extends_object(Form, form), Form::print), nl.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(form).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2005/5/8,
|
||||||
|
author is 'Example by LPA; adapted to Logtalk by Paulo Moura.',
|
||||||
|
comment is 'General attributes & methods for all forms.']).
|
||||||
|
|
||||||
|
:- public(print/0).
|
||||||
|
:- info(print/0, [
|
||||||
|
comment is 'Print the complete timetable from the pupil viewpoint.']).
|
||||||
|
|
||||||
|
:- public(print_period/1).
|
||||||
|
:- info(print_period/1, [
|
||||||
|
comment is 'Print the pupil timetable for a specific period.',
|
||||||
|
argnames is ['Period']]).
|
||||||
|
|
||||||
|
print :-
|
||||||
|
self(Self),
|
||||||
|
write('FORM: '), write(Self), nl,
|
||||||
|
forall(extends_object(Period, period), Period::print_form(Self)), nl.
|
||||||
|
|
||||||
|
print_period(Period) :-
|
||||||
|
self(Self),
|
||||||
|
timetable::filled_entry(Self, Period, Teacher, Subject),
|
||||||
|
!,
|
||||||
|
write(Self), write(': '),
|
||||||
|
write(Teacher), write(' teaches '),
|
||||||
|
write(Subject), nl.
|
||||||
|
|
||||||
|
print_period(_) :-
|
||||||
|
self(Self),
|
||||||
|
write(Self), write(': '), nl.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(first_year,
|
||||||
|
extends(form)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(second_year,
|
||||||
|
extends(form)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(third_year,
|
||||||
|
extends(form)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(fourth_year,
|
||||||
|
extends(form)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
8
Logtalk/examples/lpa/timetables/loader.lgt
Normal file
8
Logtalk/examples/lpa/timetables/loader.lgt
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
|
||||||
|
:- initialization(
|
||||||
|
logtalk_load([
|
||||||
|
timetable,
|
||||||
|
forms,
|
||||||
|
periods,
|
||||||
|
subjects,
|
||||||
|
teachers])).
|
129
Logtalk/examples/lpa/timetables/periods.lgt
Normal file
129
Logtalk/examples/lpa/timetables/periods.lgt
Normal file
@ -0,0 +1,129 @@
|
|||||||
|
|
||||||
|
:- object(periods).
|
||||||
|
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2005/5/8,
|
||||||
|
author is 'Example by LPA; adapted to Logtalk by Paulo Moura.',
|
||||||
|
comment is 'General attributes & methods for all periods.']).
|
||||||
|
|
||||||
|
|
||||||
|
:- public(print/0).
|
||||||
|
:- info(print/0, [
|
||||||
|
comment is 'Print period timetable.']).
|
||||||
|
|
||||||
|
|
||||||
|
print :-
|
||||||
|
nl, write('PERIOD TIMETABLE ...'), nl, nl,
|
||||||
|
forall(extends_object(Period, period), Period::print), nl.
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(period).
|
||||||
|
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2005/5/8,
|
||||||
|
author is 'Example by LPA; adapted to Logtalk by Paulo Moura.',
|
||||||
|
comment is 'General attributes & methods for all periods.']).
|
||||||
|
|
||||||
|
|
||||||
|
:- public(print/0).
|
||||||
|
:- info(print/0, [
|
||||||
|
comment is 'Print complete timetable from the period viewpoint.']).
|
||||||
|
|
||||||
|
:- public(print_teacher/1).
|
||||||
|
:- info(print_teacher/1, [
|
||||||
|
comment is 'Print entry for a specific teacher in this period.',
|
||||||
|
argnames is ['Teacher']]).
|
||||||
|
|
||||||
|
:- public(print_form/1).
|
||||||
|
:- info(print_form/1, [
|
||||||
|
comment is 'Print entry for a specific form in this period.',
|
||||||
|
argnames is ['Form']]).
|
||||||
|
|
||||||
|
:- public(print_subject/1).
|
||||||
|
:- info(print_subject/1, [
|
||||||
|
comment is 'Print entry for a specific subject in this period.',
|
||||||
|
argnames is ['Subject']]).
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
print :-
|
||||||
|
self(Self),
|
||||||
|
write('PERIOD: '), write(Self), nl,
|
||||||
|
forall(extends_object(Form, form), Form::print_period(Self)), nl.
|
||||||
|
|
||||||
|
|
||||||
|
print_teacher(Teacher) :-
|
||||||
|
self(Self),
|
||||||
|
timetable::filled_entry(Form, Self, Teacher, Subject),
|
||||||
|
!,
|
||||||
|
write(Self), write(': teach '),
|
||||||
|
write(Subject), write(' to '),
|
||||||
|
write(Form), nl.
|
||||||
|
|
||||||
|
print_teacher(_) :-
|
||||||
|
self(Self),
|
||||||
|
write(Self), write(':'), nl.
|
||||||
|
|
||||||
|
|
||||||
|
print_form(Form) :-
|
||||||
|
self(Self),
|
||||||
|
timetable::filled_entry(Form, Self, Teacher, Subject),
|
||||||
|
!,
|
||||||
|
write(Self), write(': '),
|
||||||
|
write(Teacher), write(' teaches '),
|
||||||
|
write(Subject), nl.
|
||||||
|
|
||||||
|
print_form(_) :-
|
||||||
|
self(Self),
|
||||||
|
write(Self), write(':'), nl.
|
||||||
|
|
||||||
|
|
||||||
|
print_subject(Subject) :-
|
||||||
|
self(Self),
|
||||||
|
timetable::filled_entry(Form, Self, Teacher, Subject),
|
||||||
|
write(Self), write(': '),
|
||||||
|
write(Form), write(' taught by '),
|
||||||
|
write(Teacher), nl,
|
||||||
|
fail.
|
||||||
|
|
||||||
|
print_subject(_).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(p1,
|
||||||
|
extends(period)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(p2,
|
||||||
|
extends(period)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(p3,
|
||||||
|
extends(period)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(p4,
|
||||||
|
extends(period)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(p5,
|
||||||
|
extends(period)).
|
||||||
|
|
||||||
|
:- end_object.
|
82
Logtalk/examples/lpa/timetables/subjects.lgt
Normal file
82
Logtalk/examples/lpa/timetables/subjects.lgt
Normal file
@ -0,0 +1,82 @@
|
|||||||
|
|
||||||
|
:- object(subjects).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2005/5/8,
|
||||||
|
author is 'Example by LPA; adapted to Logtalk by Paulo Moura.',
|
||||||
|
comment is 'General attributes & methods for all subjects.']).
|
||||||
|
|
||||||
|
:- public(print/0).
|
||||||
|
:- info(print/0, [
|
||||||
|
comment is 'Print complete timetable from the subject viewpoint.']).
|
||||||
|
|
||||||
|
print :-
|
||||||
|
nl, write('SUBJECT TIMETABLE ...'), nl, nl,
|
||||||
|
forall(extends_object(Subject, subject), Subject::print),
|
||||||
|
nl.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(subject).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2005/5/8,
|
||||||
|
author is 'Example by LPA; adapted to Logtalk by Paulo Moura.',
|
||||||
|
comment is 'General attributes & methods for all subjects.']).
|
||||||
|
|
||||||
|
:- public(print/0).
|
||||||
|
:- info(print/0, [
|
||||||
|
comment is 'Print complete timetable from the subject viewpoint.']).
|
||||||
|
|
||||||
|
print :-
|
||||||
|
self(Self),
|
||||||
|
write('SUBJECT: '), write(Self), nl,
|
||||||
|
forall(extends_object(Period, period), Period::print_subject(Self)),
|
||||||
|
nl.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(maths,
|
||||||
|
extends(subject)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(music,
|
||||||
|
extends(subject)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(french,
|
||||||
|
extends(subject)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(prolog,
|
||||||
|
extends(subject)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(biology,
|
||||||
|
extends(subject)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object('prolog++',
|
||||||
|
extends(subject)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(accountancy,
|
||||||
|
extends(subject)).
|
||||||
|
|
||||||
|
:- end_object.
|
128
Logtalk/examples/lpa/timetables/teachers.lgt
Normal file
128
Logtalk/examples/lpa/timetables/teachers.lgt
Normal file
@ -0,0 +1,128 @@
|
|||||||
|
|
||||||
|
:- object(teachers).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2005/5/8,
|
||||||
|
author is 'Example by LPA; adapted to Logtalk by Paulo Moura.',
|
||||||
|
comment is 'General attributes & methods for all teachers.']).
|
||||||
|
|
||||||
|
:- public(print/0).
|
||||||
|
:- info(print/0, [
|
||||||
|
comment is 'Print teachers timetable.']).
|
||||||
|
|
||||||
|
print :-
|
||||||
|
nl, write('TEACHER TIMETABLE ...'), nl, nl,
|
||||||
|
forall(extends_object(Teacher, teacher), Teacher::print),
|
||||||
|
nl.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(teacher).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2005/5/8,
|
||||||
|
author is 'Example by LPA; adapted to Logtalk by Paulo Moura.',
|
||||||
|
comment is 'General attributes & methods for all teachers.']).
|
||||||
|
|
||||||
|
:- public(teach_period/1).
|
||||||
|
:- info(teach_period/1, [
|
||||||
|
comment is 'A period for which the teacher can be assigned.']).
|
||||||
|
|
||||||
|
:- public(teach_subject/1).
|
||||||
|
:- info(teach_subject/1, [
|
||||||
|
comment is 'A subject which the teacher can teach.']).
|
||||||
|
|
||||||
|
:- public(print/0).
|
||||||
|
:- info(print/0, [
|
||||||
|
comment is 'Print complete timetable from the teacher viewpoint.']).
|
||||||
|
|
||||||
|
:- public(freetime/1).
|
||||||
|
:- info(freetime/1, [
|
||||||
|
comment is '.',
|
||||||
|
argnames is ['Freetime']]).
|
||||||
|
|
||||||
|
:- public(subject/1).
|
||||||
|
:- info(subject/1, [
|
||||||
|
comment is '.',
|
||||||
|
argnames is ['Subject']]).
|
||||||
|
|
||||||
|
teach_period(Period) :-
|
||||||
|
\+ ::freetime(Period).
|
||||||
|
|
||||||
|
teach_subject(Subject) :-
|
||||||
|
::subject(Subject).
|
||||||
|
|
||||||
|
print :-
|
||||||
|
self(Self),
|
||||||
|
write('TEACHER: '), write(Self), nl,
|
||||||
|
forall(extends_object(Period, period), Period::print_teacher(Self)),
|
||||||
|
nl.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(nicky,
|
||||||
|
extends(teacher)).
|
||||||
|
|
||||||
|
subject(french).
|
||||||
|
subject(biology).
|
||||||
|
|
||||||
|
freetime(1).
|
||||||
|
freetime(4).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(brian,
|
||||||
|
extends(teacher)).
|
||||||
|
|
||||||
|
subject(maths).
|
||||||
|
subject(music).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(dave,
|
||||||
|
extends(teacher)).
|
||||||
|
|
||||||
|
subject(maths).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(clive,
|
||||||
|
extends(teacher)).
|
||||||
|
|
||||||
|
subject(french).
|
||||||
|
subject(prolog).
|
||||||
|
|
||||||
|
freetime(2).
|
||||||
|
freetime(3).
|
||||||
|
freetime(5).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(diane,
|
||||||
|
extends(teacher)).
|
||||||
|
|
||||||
|
subject(accountancy).
|
||||||
|
|
||||||
|
freetime(2).
|
||||||
|
freetime(4).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(phil,
|
||||||
|
extends(teacher)).
|
||||||
|
|
||||||
|
subject(maths).
|
||||||
|
subject('prolog++').
|
||||||
|
|
||||||
|
freetime(3).
|
||||||
|
|
||||||
|
:- end_object.
|
134
Logtalk/examples/lpa/timetables/timetable.lgt
Normal file
134
Logtalk/examples/lpa/timetables/timetable.lgt
Normal file
@ -0,0 +1,134 @@
|
|||||||
|
|
||||||
|
:- object(timetable).
|
||||||
|
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2005/5/8,
|
||||||
|
author is 'Example by LPA; adapted to Logtalk by Paulo Moura.',
|
||||||
|
comment is 'Set up & create a timetable satisfying all of the constraints.']).
|
||||||
|
|
||||||
|
|
||||||
|
:- public(setup/0).
|
||||||
|
:- info(setup/0, [
|
||||||
|
comment is 'Set up the teachers, subjects, forms & periods for this school.']).
|
||||||
|
|
||||||
|
:- public(make/0).
|
||||||
|
:- info(make/0, [
|
||||||
|
comment is 'Make the timetable according to the school setup.']).
|
||||||
|
|
||||||
|
:- public(make/1).
|
||||||
|
:- info(make/1, [
|
||||||
|
comment is 'Make with max. depth of swaps.',
|
||||||
|
argnames is ['Effort']]).
|
||||||
|
|
||||||
|
:- public(print/0).
|
||||||
|
:- info(print/0, [
|
||||||
|
comment is 'Print from different perspectives.']).
|
||||||
|
|
||||||
|
:- public(filled_entry/4).
|
||||||
|
:- info(filled_entry/4, [
|
||||||
|
comment is 'Timetable entry.',
|
||||||
|
argnames is ['Form', 'Period', 'Teacher', 'Subject']]).
|
||||||
|
|
||||||
|
:- private(entry/4).
|
||||||
|
:- dynamic(entry/4).
|
||||||
|
:- info(entry/4, [
|
||||||
|
comment is 'Timetable entry.',
|
||||||
|
argnames is ['Form', 'Period', 'Teacher', 'Subject']]).
|
||||||
|
|
||||||
|
|
||||||
|
:- uses(list).
|
||||||
|
|
||||||
|
|
||||||
|
print :-
|
||||||
|
(forms, periods, teachers, subjects)::print.
|
||||||
|
|
||||||
|
|
||||||
|
setup :-
|
||||||
|
retractall(entry(_, _, _, _)).
|
||||||
|
|
||||||
|
|
||||||
|
make :-
|
||||||
|
make(3).
|
||||||
|
|
||||||
|
|
||||||
|
make(Effort) :-
|
||||||
|
list::length(E, Effort),
|
||||||
|
forall(
|
||||||
|
(extends_object(Form, form), extends_object(Period, period)),
|
||||||
|
fill_entry(E, Form, Period, _Teacher, _Subject)).
|
||||||
|
|
||||||
|
|
||||||
|
unfilled_entry(Form, Period) :-
|
||||||
|
extends_object(Form, form),
|
||||||
|
extends_object(Period, period),
|
||||||
|
\+ filled_entry(Form, Period, _, _).
|
||||||
|
|
||||||
|
|
||||||
|
filled_entry(Form, Period, Teacher, Subject) :-
|
||||||
|
entry(Form, Period, Teacher, Subject).
|
||||||
|
|
||||||
|
|
||||||
|
fill_entry(E, Form, Period, Teacher, Subject) :-
|
||||||
|
find_entry(E, Form, Period, Teacher, Subject),
|
||||||
|
!,
|
||||||
|
assert(Form, Period, Teacher, Subject).
|
||||||
|
|
||||||
|
fill_entry(_, _, _, _, _).
|
||||||
|
|
||||||
|
|
||||||
|
find_entry(_, Form, Period, Teacher, Subject) :-
|
||||||
|
extends_object(Teacher, teacher),
|
||||||
|
Teacher::teach_period(Period),
|
||||||
|
\+ filled_entry(_, Period, Teacher, _),
|
||||||
|
extends_object(Subject, subject),
|
||||||
|
Teacher::teach_subject(Subject),
|
||||||
|
\+ filled_entry(Form, _, _, Subject).
|
||||||
|
|
||||||
|
find_entry([_| E], FormA, Period, TeacherA, SubjectA) :-
|
||||||
|
extends_object(Teacher, teacher),
|
||||||
|
Teacher::teach_period(Period),
|
||||||
|
filled_entry(FormB, Period, TeacherA, _),
|
||||||
|
extends_object(SubjectA, subject),
|
||||||
|
TeacherA::teach_subject(SubjectA),
|
||||||
|
\+ filled_entry(FormA, _, _, SubjectA),
|
||||||
|
find_entry(E, FormB, Period, TeacherB, SubjectB),
|
||||||
|
TeacherB \= TeacherA,
|
||||||
|
write('Swap teacher... '), nl,
|
||||||
|
retract(FormB, Period, TeacherA, _),
|
||||||
|
assert(FormB, Period, TeacherB, SubjectB).
|
||||||
|
|
||||||
|
find_entry([_| E], Form, PeriodA, TeacherA, SubjectA) :-
|
||||||
|
extends_object(TeacherA, teacher),
|
||||||
|
TeacherA::teach_period(PeriodA),
|
||||||
|
\+ filled_entry(_, PeriodA, TeacherA, _),
|
||||||
|
extends_object(SubjectA, subject),
|
||||||
|
TeacherA::teach_subject(SubjectA),
|
||||||
|
filled_entry(Form, PeriodB, _, SubjectA),
|
||||||
|
find_entry(E, Form, PeriodB, TeacherB, SubjectB),
|
||||||
|
SubjectA \= SubjectB,
|
||||||
|
write('Swap subject... '), nl,
|
||||||
|
retract(Form, PeriodB, _, SubjectA),
|
||||||
|
assert(Form, PeriodB, TeacherB, SubjectB).
|
||||||
|
|
||||||
|
|
||||||
|
assert(Form, Period, Teacher, Subject) :-
|
||||||
|
assertz(entry(Form, Period, Teacher, Subject)),
|
||||||
|
write('+ '),
|
||||||
|
write(Form), write(' - '),
|
||||||
|
write(Period), write(' - '),
|
||||||
|
write(Teacher), write(' - '),
|
||||||
|
write(Subject), nl.
|
||||||
|
|
||||||
|
|
||||||
|
retract(Form, Period, Teacher, Subject) :-
|
||||||
|
retract(entry(Form, Period, Teacher, Subject)),
|
||||||
|
write('- '),
|
||||||
|
write(Form), write(' - '),
|
||||||
|
write(Period), write(' - '),
|
||||||
|
write(Teacher), write(' - '),
|
||||||
|
write(Subject), nl.
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
88
Logtalk/examples/metainterpreters/metainterpreters.lgt
Normal file
88
Logtalk/examples/metainterpreters/metainterpreters.lgt
Normal file
@ -0,0 +1,88 @@
|
|||||||
|
|
||||||
|
:- object(solver).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2004/5/2,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Simple meta-interpreter for pure Prolog with only conjunctions as clause bodies.']).
|
||||||
|
|
||||||
|
:- public(solve/1).
|
||||||
|
:- mode(solve(+goal), zero_or_more).
|
||||||
|
:- info(solve/1, [
|
||||||
|
comment is 'Proves goal.',
|
||||||
|
argnames is ['Goal']]).
|
||||||
|
|
||||||
|
solve(true) :-
|
||||||
|
!.
|
||||||
|
solve((A, B)) :-
|
||||||
|
!, solve(A), solve(B).
|
||||||
|
solve(A) :-
|
||||||
|
clause(A, B), solve(B).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(proof_tree).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2004/5/2,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Meta-interpreter for pure Prolog with only conjunctions as clause bodies.']).
|
||||||
|
|
||||||
|
:- public(solve/2).
|
||||||
|
:- mode(solve(+goal, -tree), zero_or_more).
|
||||||
|
:- info(solve/2, [
|
||||||
|
comment is 'Constructs a proof tree for a goal.',
|
||||||
|
argnames is ['Goal', 'Tree']]).
|
||||||
|
|
||||||
|
solve(true, true).
|
||||||
|
solve((A, B), (PA, PB)) :-
|
||||||
|
!, solve(A, PA), solve(B, PB).
|
||||||
|
solve(A, (A :- PB)) :-
|
||||||
|
clause(A, B), solve(B, PB).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(tracer).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2004/5/5,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'A simple tracer meta-interpreter for pure Prolog with only conjunctions as clause bodies.']).
|
||||||
|
|
||||||
|
:- public(trace/1).
|
||||||
|
:- mode(trace(+goal), zero_or_more).
|
||||||
|
:- info(trace/1, [
|
||||||
|
comment is 'Traces goal proof.',
|
||||||
|
argnames is ['Goal']]).
|
||||||
|
|
||||||
|
trace(Goal) :-
|
||||||
|
trace(Goal, 1).
|
||||||
|
|
||||||
|
trace(true, _) :-
|
||||||
|
!.
|
||||||
|
trace((A, B), Depth) :-
|
||||||
|
!, trace(A, Depth), trace(B, Depth).
|
||||||
|
trace(A, Depth) :-
|
||||||
|
write_trace(call, A, Depth),
|
||||||
|
clause(A, B),
|
||||||
|
Depth2 is Depth + 1,
|
||||||
|
trace(B, Depth2),
|
||||||
|
( write_trace(exit, A, Depth)
|
||||||
|
;
|
||||||
|
write_trace(redo, A, Depth),
|
||||||
|
fail).
|
||||||
|
trace(A, Depth) :-
|
||||||
|
write_trace(fail, A, Depth),
|
||||||
|
fail.
|
||||||
|
|
||||||
|
write_trace(Port, Goal, Depth) :-
|
||||||
|
write(Depth), write(' '), write(Port), write(': '), writeq(Goal), nl.
|
||||||
|
|
||||||
|
:- end_object.
|
79
Logtalk/examples/metapredicates/metapredicates.lgt
Normal file
79
Logtalk/examples/metapredicates/metapredicates.lgt
Normal file
@ -0,0 +1,79 @@
|
|||||||
|
|
||||||
|
% example adopted from:
|
||||||
|
% Programming Language Prolog Part 2, Modules
|
||||||
|
% Committee Draft - January 14, 1998 X3J17/97/5
|
||||||
|
|
||||||
|
:- object(tracer).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 2.0,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
date is 2000/7/24,
|
||||||
|
comment is 'Tracer for a goal call, exit, and fail ports.']).
|
||||||
|
|
||||||
|
:- public(trace/1).
|
||||||
|
:- metapredicate(trace(::)). % changes interpretation of meta-calls on trace/1 clauses
|
||||||
|
:- mode(trace(+callable), zero_or_more).
|
||||||
|
:- info(trace/1, [
|
||||||
|
comment is 'Traces goal execution.',
|
||||||
|
argnames is ['Goal']]).
|
||||||
|
|
||||||
|
trace(Goal) :-
|
||||||
|
write('call: '), writeq(Goal), nl,
|
||||||
|
call(Goal), % Goal is called in the context of the object sending the message trace/1
|
||||||
|
write('exit: '), writeq(Goal), nl.
|
||||||
|
|
||||||
|
trace(Goal) :-
|
||||||
|
write('fail: '), writeq(Goal), nl,
|
||||||
|
fail.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% sort code adopted from an example on the SICStus Prolog User Manual
|
||||||
|
% metapredicate example taken from Prolog Part 2, Modules - Committee Draft
|
||||||
|
|
||||||
|
:- object(sort(_Type)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
date is 2000/7/24,
|
||||||
|
comment is 'List sorting parameterized by the type of the list elements.']).
|
||||||
|
|
||||||
|
:- uses(list, [append/3]). % calls to append(...) will be translated to list::append(...)
|
||||||
|
:- uses(tracer, [trace/1]). % calls to trace(...) will be translated to tracer::trace(...)
|
||||||
|
|
||||||
|
:- calls(comparingp).
|
||||||
|
|
||||||
|
:- public(sort/2).
|
||||||
|
:- mode(sort(+list, -list), one).
|
||||||
|
:- info(sort/2, [
|
||||||
|
comment is 'Sorts a list in ascending order (quicksort algorithm).',
|
||||||
|
argnames is ['List', 'Sorted']]).
|
||||||
|
|
||||||
|
:- private(partition/4).
|
||||||
|
:- mode(partition(+list, +nonvar, -list, -list), one).
|
||||||
|
:- info(partition/4, [
|
||||||
|
comment is 'Partition a list in two lists containing the elements smaller and larger than a pivot.',
|
||||||
|
argnames is ['List', 'Pivot', 'Small', 'Large']]).
|
||||||
|
|
||||||
|
sort([], []).
|
||||||
|
|
||||||
|
sort([Head| Tail], Sorted) :-
|
||||||
|
trace(partition(Tail, Head, Small, Large)),
|
||||||
|
trace(sort(Small, Sorted1)),
|
||||||
|
trace(sort(Large, Sorted2)),
|
||||||
|
append(Sorted1, [Head| Sorted2], Sorted).
|
||||||
|
|
||||||
|
partition([], _, [], []).
|
||||||
|
|
||||||
|
partition([Head| Tail], Pivot, Small, Large) :-
|
||||||
|
parameter(1, Type),
|
||||||
|
( Type::(Head < Pivot) ->
|
||||||
|
Small = [Head| Small1], Large = Large1
|
||||||
|
; Small = Small1, Large = [Head| Large1]
|
||||||
|
),
|
||||||
|
partition(Tail, Pivot, Small1, Large1).
|
||||||
|
|
||||||
|
:- end_object.
|
93
Logtalk/examples/mi/mi.lgt
Normal file
93
Logtalk/examples/mi/mi.lgt
Normal file
@ -0,0 +1,93 @@
|
|||||||
|
|
||||||
|
:- object(space).
|
||||||
|
|
||||||
|
:- public(xyz/3).
|
||||||
|
:- mode(xyz(?integer, ?integer, ?integer), zero_or_one).
|
||||||
|
|
||||||
|
:- private(xyz_/3).
|
||||||
|
:- mode(xyz_(?integer, ?integer, ?integer), zero_or_one).
|
||||||
|
:- dynamic(xyz_/3).
|
||||||
|
|
||||||
|
:- public(rotate/3).
|
||||||
|
:- mode(rotate(+integer, +integer, +integer), zero_or_one).
|
||||||
|
|
||||||
|
xyz(X, Y, Z) :-
|
||||||
|
::xyz_(X, Y, Z).
|
||||||
|
|
||||||
|
rotate(X, Y, Z) :-
|
||||||
|
integer(X),
|
||||||
|
integer(Y),
|
||||||
|
integer(Z),
|
||||||
|
::retractall(xyz_(_, _, _)),
|
||||||
|
::assertz(xyz_(X, Y, Z)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(time).
|
||||||
|
|
||||||
|
:- public(t/1).
|
||||||
|
:- mode(t(?integer), zero_or_one).
|
||||||
|
|
||||||
|
:- private(t_/1).
|
||||||
|
:- mode(t_(?integer), zero_or_one).
|
||||||
|
:- dynamic(t_/1).
|
||||||
|
|
||||||
|
:- public(translate/1).
|
||||||
|
:- mode(translate(+integer), zero_or_one).
|
||||||
|
|
||||||
|
t(T) :-
|
||||||
|
::t_(T).
|
||||||
|
|
||||||
|
translate(T) :-
|
||||||
|
integer(T),
|
||||||
|
::retractall(t_(_)),
|
||||||
|
::assertz(t_(T)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(space_time,
|
||||||
|
extends(space, time)).
|
||||||
|
|
||||||
|
:- public(xyzt/4).
|
||||||
|
:- mode(xyzt(?integer, ?integer, ?integer, ?integer), zero_or_one).
|
||||||
|
|
||||||
|
xyzt(X, Y, Z, T) :-
|
||||||
|
::xyz(X, Y, Z),
|
||||||
|
::t(T).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(space(_X,_Y,_Z)).
|
||||||
|
|
||||||
|
:- public(distance/1).
|
||||||
|
:- mode(xyz(?nunber), one).
|
||||||
|
|
||||||
|
distance(Distance) :-
|
||||||
|
parameter(1, X),
|
||||||
|
parameter(2, Y),
|
||||||
|
parameter(3, Z),
|
||||||
|
Distance is sqrt(X*X+Y*Y+Z*Z).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(time(_T)).
|
||||||
|
|
||||||
|
:- public(time/1).
|
||||||
|
:- mode(time(?integer), zero_or_one).
|
||||||
|
|
||||||
|
time(Time) :-
|
||||||
|
parameter(1, Time).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(space_time(X, Y, Z, T),
|
||||||
|
extends(space(X, Y, Z), time(T))).
|
||||||
|
|
||||||
|
:- end_object.
|
215
Logtalk/examples/parametric/parametric.lgt
Normal file
215
Logtalk/examples/parametric/parametric.lgt
Normal file
@ -0,0 +1,215 @@
|
|||||||
|
|
||||||
|
/* This example illustrates how to associate a set of predicates with a
|
||||||
|
compound term. Parameters can be accessed from within an object by
|
||||||
|
using the execution-context built-in methods this/1 and parameter/2;
|
||||||
|
both alternatives are illustrated below.
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/* The first two parametric objects represent time and date values as
|
||||||
|
compound terms using the object's identifiers.
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
:- object(date(_Year, _Month, _Day)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.1,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
date is 2005/9/5,
|
||||||
|
comment is 'Dates as parametric objects.',
|
||||||
|
parnames is ['Year', 'Month', 'Day']]).
|
||||||
|
|
||||||
|
:- public(year/1).
|
||||||
|
:- mode(year(?integer), one).
|
||||||
|
|
||||||
|
:- public(month/1).
|
||||||
|
:- mode(month(?integer), one).
|
||||||
|
|
||||||
|
:- public(day/1).
|
||||||
|
:- mode(day(?integer), one).
|
||||||
|
|
||||||
|
:- public(today/0).
|
||||||
|
:- mode(today, one).
|
||||||
|
|
||||||
|
:- public(leap_year/0).
|
||||||
|
:- mode(leap_year, zero_or_one).
|
||||||
|
|
||||||
|
year(Year) :-
|
||||||
|
parameter(1, Year).
|
||||||
|
|
||||||
|
month(Month) :-
|
||||||
|
parameter(2, Month).
|
||||||
|
|
||||||
|
day(Day) :-
|
||||||
|
parameter(3, Day).
|
||||||
|
|
||||||
|
today :-
|
||||||
|
{'$lgt_current_date'(Year, Month, Day)}, % defined in the config files
|
||||||
|
parameter(1, Year),
|
||||||
|
parameter(2, Month),
|
||||||
|
parameter(3, Day).
|
||||||
|
|
||||||
|
/* Alternative predicate definitions using this/1 instead of parameter/2
|
||||||
|
(see the User Manual for the pros and cons of both alternatives):
|
||||||
|
|
||||||
|
year(Year) :-
|
||||||
|
this(date(Year, _, _)).
|
||||||
|
|
||||||
|
month(Month) :-
|
||||||
|
this(date(_, Month, _)).
|
||||||
|
|
||||||
|
day(Day) :-
|
||||||
|
this(date(_, _, Day)).
|
||||||
|
|
||||||
|
today :-
|
||||||
|
{'$lgt_current_date'(Year, Month, Day)}, % defined in the config files
|
||||||
|
this(date(Year, Month, Day)).
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
leap_year :-
|
||||||
|
parameter(1, Year),
|
||||||
|
(0 =:= mod(Year, 4), 0 =\= mod(Year, 100)
|
||||||
|
;
|
||||||
|
0 =:= mod(Year, 400)),
|
||||||
|
!.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(time(_Hours, _Mins, _Secs)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.1,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
date is 2005/9/5,
|
||||||
|
comment is 'Time as parametric objects.',
|
||||||
|
parnames is ['Hours', 'Mins', 'Secs']]).
|
||||||
|
|
||||||
|
:- public(hours/1).
|
||||||
|
:- mode(hours(?integer), one).
|
||||||
|
|
||||||
|
:- public(mins/1).
|
||||||
|
:- mode(mins(?integer), one).
|
||||||
|
|
||||||
|
:- public(secs/1).
|
||||||
|
:- mode(secs(?integer), one).
|
||||||
|
|
||||||
|
:- public(now/0).
|
||||||
|
:- mode(now, one).
|
||||||
|
|
||||||
|
hours(Hours) :-
|
||||||
|
parameter(1, Hours).
|
||||||
|
|
||||||
|
mins(Mins) :-
|
||||||
|
parameter(2, Mins).
|
||||||
|
|
||||||
|
secs(Secs) :-
|
||||||
|
parameter(3, Secs).
|
||||||
|
|
||||||
|
now :-
|
||||||
|
{'$lgt_current_time'(Hours, Mins, Secs)}, % defined in the config files
|
||||||
|
parameter(1, Hours),
|
||||||
|
parameter(2, Mins),
|
||||||
|
parameter(3, Secs).
|
||||||
|
|
||||||
|
/* Alternative predicate definitions using this/1 instead of parameter/2
|
||||||
|
(see the User Manual for the pros and cons of both alternatives):
|
||||||
|
|
||||||
|
hours(Hours) :-
|
||||||
|
this(time(Hours, _, _)).
|
||||||
|
|
||||||
|
mins(Mins) :-
|
||||||
|
this(time(_, Mins, _)).
|
||||||
|
|
||||||
|
secs(Secs) :-
|
||||||
|
this(time(_, _, Secs)).
|
||||||
|
|
||||||
|
now :-
|
||||||
|
{'$lgt_current_time'(Hours, Mins, Secs)}, % defined in the config files
|
||||||
|
this(time(Hours, Mins, Secs)).
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/* The following parametric object illustrates a solution for implementing
|
||||||
|
modifiable object state. The idea is to represent object state by using
|
||||||
|
object parameters, defining "setter" predicates/methods that return the
|
||||||
|
updated object identifier.
|
||||||
|
*/
|
||||||
|
|
||||||
|
:- object(rectangle(_width, _height, _x, _y)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
date is 2005/9/5,
|
||||||
|
comment is 'A simple implementation of a geometric rectangle using parametric objects.',
|
||||||
|
parnames is ['Width', 'Height', 'X', 'Y']]).
|
||||||
|
|
||||||
|
:- public(init/0).
|
||||||
|
:- mode(init, one).
|
||||||
|
:- info(init/0,
|
||||||
|
[comment is 'Initialize rectangle position.']).
|
||||||
|
|
||||||
|
:- public(area/1).
|
||||||
|
:- mode(area(-integer), one).
|
||||||
|
:- info(area/1,
|
||||||
|
[comment is 'Rectangle area.',
|
||||||
|
argnames is ['Area']]).
|
||||||
|
|
||||||
|
:- public(move/3).
|
||||||
|
:- mode(move(+integer, +integer, -compound), one).
|
||||||
|
:- info(move/3, [
|
||||||
|
comment is 'Moves a rectangle to a new position, returning the updated rectangle.',
|
||||||
|
argnames is ['X', 'Y', 'NewRectangle']]).
|
||||||
|
|
||||||
|
:- public(position/2).
|
||||||
|
:- mode(position(?integer, ?integer), zero_or_one).
|
||||||
|
:- info(position/2, [
|
||||||
|
comment is 'Rectangle current position.',
|
||||||
|
argnames is ['X', 'Y']]).
|
||||||
|
|
||||||
|
init :-
|
||||||
|
parameter(1, 2), % Width
|
||||||
|
parameter(2, 1), % Height
|
||||||
|
parameter(3, 0), % X
|
||||||
|
parameter(4, 0). % Y
|
||||||
|
|
||||||
|
area(Area) :-
|
||||||
|
parameter(1, Width),
|
||||||
|
parameter(2, Height),
|
||||||
|
Area is Width*Height.
|
||||||
|
|
||||||
|
move(X, Y, rectangle(Width, Height, X, Y)) :-
|
||||||
|
parameter(1, Width),
|
||||||
|
parameter(2, Height).
|
||||||
|
|
||||||
|
position(X, Y) :-
|
||||||
|
parameter(3, X),
|
||||||
|
parameter(4, Y).
|
||||||
|
|
||||||
|
/* Alternative predicate definitions using this/1 instead of parameter/2
|
||||||
|
(see the User Manual for the pros and cons of both alternatives):
|
||||||
|
|
||||||
|
init :-
|
||||||
|
this(rectangle(2, 1, 0, 0)).
|
||||||
|
|
||||||
|
area(Area) :-
|
||||||
|
this(rectangle(Width, Height, _, _)),
|
||||||
|
Area is Width*Height.
|
||||||
|
|
||||||
|
move(X, Y, rectangle(Width, Height, X, Y)) :-
|
||||||
|
this(rectangle(Width, Height, _, _)).
|
||||||
|
|
||||||
|
position(X, Y) :-
|
||||||
|
this(rectangle(_, _, X, Y)).
|
||||||
|
|
||||||
|
*/
|
||||||
|
|
||||||
|
:- end_object.
|
176
Logtalk/examples/poem/poem.lgt
Normal file
176
Logtalk/examples/poem/poem.lgt
Normal file
@ -0,0 +1,176 @@
|
|||||||
|
|
||||||
|
/* Points are going to be the fundamental quantity. */
|
||||||
|
/* These will be defined in Cartesian co-ordinates. */
|
||||||
|
|
||||||
|
:- object(point(_X, _Y)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Parametric object for representing geometric points.',
|
||||||
|
parnames is ['X', 'Y'],
|
||||||
|
source is 'Example adopted from the POEM system by Ben Staveley-Taylor.']).
|
||||||
|
|
||||||
|
:- public(identical/1).
|
||||||
|
:- mode(identical(+nonvar), one).
|
||||||
|
|
||||||
|
:- public(distance/2).
|
||||||
|
:- mode(distance(+nonvar, -number), one).
|
||||||
|
|
||||||
|
identical(point(X1, Y1)) :-
|
||||||
|
/* succeeds if the argument and owner points are the same. */
|
||||||
|
parameter(1, X),
|
||||||
|
parameter(2, Y),
|
||||||
|
X1 = X,
|
||||||
|
Y1 = Y.
|
||||||
|
|
||||||
|
distance(point(X1, Y1), Distance) :-
|
||||||
|
/* finds the distance between argument and owner points. */
|
||||||
|
parameter(1, X),
|
||||||
|
parameter(2, Y),
|
||||||
|
Distance is sqrt((X1-X)*(X1-X)+(Y1-Y)*(Y1-Y)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/* A line is defined by its end points. */
|
||||||
|
/* This class shows examples of calling its own and other class */
|
||||||
|
/* predicates. */
|
||||||
|
|
||||||
|
:- object(line(_Point1, _Point2)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Parametric object for representing geometric lines.',
|
||||||
|
parnames is ['Point1', 'Point2'],
|
||||||
|
source is 'Example adopted from the POEM system by Ben Staveley-Taylor.']).
|
||||||
|
|
||||||
|
:- public(length/1).
|
||||||
|
:- mode(length(-number), one).
|
||||||
|
|
||||||
|
:- public(intersects/1).
|
||||||
|
:- mode(intersects(+nonvar), one).
|
||||||
|
|
||||||
|
:- public(signed_distance/2).
|
||||||
|
:- mode(signed_distance(+nonvar, -number), one).
|
||||||
|
|
||||||
|
:- public(distance/2).
|
||||||
|
:- mode(distance(+nonvar, -number), one).
|
||||||
|
|
||||||
|
length(Length) :-
|
||||||
|
/* sets Len to the length of the owner line */
|
||||||
|
parameter(1, P1),
|
||||||
|
parameter(2, P2),
|
||||||
|
P1::distance(P2, Length).
|
||||||
|
|
||||||
|
intersects(Line2) :-
|
||||||
|
/* succeeds if Line2 intersects the owner line. */
|
||||||
|
/* this isn't necessarily a good method, but shows how to */
|
||||||
|
/* call class procedures from within the class definition. */
|
||||||
|
parameter(1, P1),
|
||||||
|
parameter(2, P2),
|
||||||
|
Line1 = line(P1, P2),
|
||||||
|
Line2 = line(P3, P4),
|
||||||
|
Line2::signed_distance(P1, D1),
|
||||||
|
Line2::signed_distance(P2, D2),
|
||||||
|
opposite_signs(D1, D2),
|
||||||
|
Line1::signed_distance(P3, D3),
|
||||||
|
Line1::signed_distance(P4, D4),
|
||||||
|
opposite_signs(D3, D4).
|
||||||
|
|
||||||
|
signed_distance(Point, Dist) :-
|
||||||
|
/* finds the perpendicular distance from point to line. */
|
||||||
|
/* the sign of the answer depends on which side of the */
|
||||||
|
/* line the point is on. */
|
||||||
|
parameter(1, P1),
|
||||||
|
parameter(2, P2),
|
||||||
|
P1 = point(X1, Y1),
|
||||||
|
P2 = point(X2, Y2),
|
||||||
|
Point = point(X3, Y3),
|
||||||
|
A is X2-X1,
|
||||||
|
B is Y1-Y2,
|
||||||
|
C is X1*Y2-X2*Y1,
|
||||||
|
Dist is (A*Y3+B*X3+C)/sqrt(A*A+B*B).
|
||||||
|
|
||||||
|
distance(Point, Dist) :-
|
||||||
|
/* as 'signed_distance', but Dist always >= 0 */
|
||||||
|
parameter(1, P1),
|
||||||
|
parameter(2, P2),
|
||||||
|
line(P1, P2)::signed_distance(Point, Temp),
|
||||||
|
Dist is abs(Temp).
|
||||||
|
|
||||||
|
/* 'opposite_signs' succeeds if its arguments are of opposite signs. */
|
||||||
|
/* It has a feature in that 'opposite_signs(0,0)' succeeds: this is */
|
||||||
|
/* because 0 is treated as having optional sign. */
|
||||||
|
|
||||||
|
opposite_signs(A, B) :-
|
||||||
|
o_s_aux(A, B).
|
||||||
|
opposite_signs(A, B) :-
|
||||||
|
o_s_aux(B, A).
|
||||||
|
|
||||||
|
o_s_aux(A, B) :-
|
||||||
|
A >= 0,
|
||||||
|
B =< 0.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/* Ellipses are defined by centre and semi-axes */
|
||||||
|
|
||||||
|
:- object(ellipse(_Center, _A, _B)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Parametric object for representing geometric ellipses.',
|
||||||
|
parnames is ['Center', 'Rx', 'Ry'],
|
||||||
|
source is 'Example adopted from the POEM system by Ben Staveley-Taylor.']).
|
||||||
|
|
||||||
|
:- public(area/1).
|
||||||
|
:- mode(area(-number), one).
|
||||||
|
|
||||||
|
area(Area) :-
|
||||||
|
pi(Pi),
|
||||||
|
parameter(2, A),
|
||||||
|
parameter(3, B),
|
||||||
|
Area is Pi*A*B.
|
||||||
|
|
||||||
|
pi(3.14196).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
/* Circle is a special form of ellipse */
|
||||||
|
/* Subclasses ('circle' here) must have the same number of arguments */
|
||||||
|
/* as their superclass ('ellipse') for the superclass predicates to */
|
||||||
|
/* be applicable. The arguments may be renamed for clarity. */
|
||||||
|
|
||||||
|
:- object(circle(Center, Radius),
|
||||||
|
extends(ellipse(Center, Radius, Radius))).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Parametric object for representing geometric circles.',
|
||||||
|
parnames is ['Center', 'Radius'],
|
||||||
|
source is 'Example adopted from the POEM system by Ben Staveley-Taylor.']).
|
||||||
|
|
||||||
|
:- public(circumference/1).
|
||||||
|
:- mode(circumference(-number), one).
|
||||||
|
|
||||||
|
circumference(Circumference) :-
|
||||||
|
pi(Pi),
|
||||||
|
parameter(2, Radius),
|
||||||
|
Circumference is 2*Pi*Radius.
|
||||||
|
|
||||||
|
pi(3.14196).
|
||||||
|
|
||||||
|
:- end_object.
|
336
Logtalk/examples/points/points.lgt
Normal file
336
Logtalk/examples/points/points.lgt
Normal file
@ -0,0 +1,336 @@
|
|||||||
|
|
||||||
|
:- object(point,
|
||||||
|
instantiates(class),
|
||||||
|
specializes(object)).
|
||||||
|
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.1,
|
||||||
|
date is 2000/10/31,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Two dimensional point class.',
|
||||||
|
source is 'Example adopted from the SICStus Objects documentation.']).
|
||||||
|
|
||||||
|
|
||||||
|
:- public(move/2).
|
||||||
|
:- mode(move(+integer, +integer), zero_or_one).
|
||||||
|
|
||||||
|
:- public(position/2).
|
||||||
|
:- mode(position(?integer, ?integer), one).
|
||||||
|
|
||||||
|
:- private(position_/2).
|
||||||
|
:- dynamic(position_/2).
|
||||||
|
:- mode(position_(?integer, ?integer), one).
|
||||||
|
|
||||||
|
|
||||||
|
move(X, Y) :-
|
||||||
|
::retractall(position_(_, _)),
|
||||||
|
::assertz(position_(X, Y)).
|
||||||
|
|
||||||
|
|
||||||
|
position(X, Y) :-
|
||||||
|
::position_(X, Y).
|
||||||
|
|
||||||
|
|
||||||
|
print :-
|
||||||
|
self(Self),
|
||||||
|
::position_(X, Y),
|
||||||
|
writeq(Self), write(' @ '), write((X, Y)), nl.
|
||||||
|
|
||||||
|
|
||||||
|
default_init_option(position-(0, 0)).
|
||||||
|
|
||||||
|
default_init_option(Default) :-
|
||||||
|
^^default_init_option(Default).
|
||||||
|
|
||||||
|
|
||||||
|
process_init_option(position-(X, Y)) :-
|
||||||
|
::assertz(position_(X, Y)).
|
||||||
|
|
||||||
|
process_init_option(Option) :-
|
||||||
|
^^process_init_option(Option).
|
||||||
|
|
||||||
|
|
||||||
|
instance_base_name(p).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- category(bounded_coordinate).
|
||||||
|
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 1998/3/23,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Point coordinate bounds management predicates.',
|
||||||
|
source is 'Example adopted from the SICStus Objects documentation.']).
|
||||||
|
|
||||||
|
|
||||||
|
:- public(set_bounds/3).
|
||||||
|
:- mode(set_bounds(+atom, +integer, +integer), one).
|
||||||
|
|
||||||
|
:- public(clear_bounds/1).
|
||||||
|
:- mode(clear_bounds(+atom), one).
|
||||||
|
|
||||||
|
:- public(bounds/3).
|
||||||
|
:- mode(bounds(?atom, ?integer, ?integer), zero_or_more).
|
||||||
|
|
||||||
|
:- public(check_bounds/2).
|
||||||
|
:- mode(check_bounds(+atom, +integer), zero_or_one).
|
||||||
|
|
||||||
|
:- public(print_bounds/1).
|
||||||
|
:- mode(print_bounds(?atom), zero_or_more).
|
||||||
|
|
||||||
|
:- public(valid_value/2).
|
||||||
|
:- mode(valid_value(+atom, +integer), zero_or_one).
|
||||||
|
|
||||||
|
:- private(bounds_/3).
|
||||||
|
:- dynamic(bounds_/3).
|
||||||
|
:- mode(bounds_(?atom, ?integer, ?integer), zero_or_more).
|
||||||
|
|
||||||
|
|
||||||
|
set_bounds(Coordinate, Min, Max) :-
|
||||||
|
::retractall(bounds_(Coordinate, _, _)),
|
||||||
|
::assertz(bounds_(Coordinate, Min, Max)).
|
||||||
|
|
||||||
|
|
||||||
|
clear_bounds(Coordinate) :-
|
||||||
|
::retractall(bounds_(Coordinate, _, _)).
|
||||||
|
|
||||||
|
|
||||||
|
bounds(Coordinate, Min, Max) :-
|
||||||
|
::bounds_(Coordinate, Min, Max).
|
||||||
|
|
||||||
|
|
||||||
|
check_bounds(Coordinate, Value) :-
|
||||||
|
::bounds_(Coordinate, Min, Max),
|
||||||
|
Value >= Min,
|
||||||
|
Value =< Max.
|
||||||
|
|
||||||
|
|
||||||
|
print_bounds(Coordinate) :-
|
||||||
|
::bounds_(Coordinate, Min, Max),
|
||||||
|
writeq(bounds(Coordinate)),
|
||||||
|
write(' : '),
|
||||||
|
write((Min, Max)),
|
||||||
|
nl.
|
||||||
|
|
||||||
|
|
||||||
|
valid_value(Coordinate, Value) :-
|
||||||
|
::bounds_(Coordinate, Min, Max) ->
|
||||||
|
Value >= Min, Value =< Max
|
||||||
|
;
|
||||||
|
true.
|
||||||
|
|
||||||
|
|
||||||
|
:- end_category.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(bounded_point,
|
||||||
|
imports(bounded_coordinate),
|
||||||
|
instantiates(class),
|
||||||
|
specializes(point)).
|
||||||
|
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.1,
|
||||||
|
date is 2000/10/31,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Two dimensional point moving in a constrained area.',
|
||||||
|
source is 'Example adopted from the SICStus Objects documentation.']).
|
||||||
|
|
||||||
|
|
||||||
|
move(X, Y) :-
|
||||||
|
::check_bounds(x, X),
|
||||||
|
::check_bounds(y, Y),
|
||||||
|
^^move(X, Y).
|
||||||
|
|
||||||
|
|
||||||
|
print :-
|
||||||
|
::print_bounds(x),
|
||||||
|
::print_bounds(y),
|
||||||
|
^^print.
|
||||||
|
|
||||||
|
|
||||||
|
instance_base_name(bp).
|
||||||
|
|
||||||
|
|
||||||
|
default_init_option(bounds(x)-(-10, 10)).
|
||||||
|
|
||||||
|
default_init_option(bounds(y)-(-10, 10)).
|
||||||
|
|
||||||
|
default_init_option(Default) :-
|
||||||
|
^^default_init_option(Default).
|
||||||
|
|
||||||
|
|
||||||
|
process_init_option(bounds(Coordinate)-(Min, Max)) :-
|
||||||
|
::set_bounds(Coordinate, Min, Max).
|
||||||
|
|
||||||
|
process_init_option(Option) :-
|
||||||
|
^^process_init_option(Option).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- category(point_history).
|
||||||
|
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 1998/3/23,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Point position history management predicates.',
|
||||||
|
source is 'Example adopted from the SICStus Objects documentation.']).
|
||||||
|
|
||||||
|
|
||||||
|
:- public(add_to_history/1).
|
||||||
|
:- mode(add_to_history(+nonvar), one).
|
||||||
|
|
||||||
|
:- public(init_history/1).
|
||||||
|
:- mode(init_history(+list), one).
|
||||||
|
|
||||||
|
:- public(history/1).
|
||||||
|
:- mode(history(-list), zero_or_one).
|
||||||
|
|
||||||
|
:- public(print_history/0).
|
||||||
|
:- mode(print_history, zero_or_one).
|
||||||
|
|
||||||
|
:- private(history_/1).
|
||||||
|
:- dynamic(history_/1).
|
||||||
|
:- mode(history_(-list), zero_or_one).
|
||||||
|
|
||||||
|
|
||||||
|
add_to_history(Location) :-
|
||||||
|
::retract(history_(History)),
|
||||||
|
::assertz(history_([Location| History])).
|
||||||
|
|
||||||
|
|
||||||
|
init_history(History) :-
|
||||||
|
::retractall(history_(_)),
|
||||||
|
::assertz(history_(History)).
|
||||||
|
|
||||||
|
|
||||||
|
history(History) :-
|
||||||
|
::history_(History).
|
||||||
|
|
||||||
|
|
||||||
|
print_history :-
|
||||||
|
::history_(History),
|
||||||
|
write('location history: '),
|
||||||
|
write(History),
|
||||||
|
nl.
|
||||||
|
|
||||||
|
|
||||||
|
:- end_category.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(history_point,
|
||||||
|
imports(point_history),
|
||||||
|
instantiates(class),
|
||||||
|
specializes(point)).
|
||||||
|
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.1,
|
||||||
|
date is 2000/10/31,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Two dimensional point remembering past positions.',
|
||||||
|
source is 'Example adopted from the SICStus Objects documentation.']).
|
||||||
|
|
||||||
|
|
||||||
|
move(X, Y) :-
|
||||||
|
::position(OldX, OldY),
|
||||||
|
^^move(X, Y),
|
||||||
|
::add_to_history((OldX, OldY)).
|
||||||
|
|
||||||
|
|
||||||
|
print :-
|
||||||
|
::print_history,
|
||||||
|
^^print.
|
||||||
|
|
||||||
|
|
||||||
|
instance_base_name(hp).
|
||||||
|
|
||||||
|
|
||||||
|
default_init_option(history-[]).
|
||||||
|
|
||||||
|
default_init_option(Default) :-
|
||||||
|
^^default_init_option(Default).
|
||||||
|
|
||||||
|
|
||||||
|
process_init_option(history-History) :-
|
||||||
|
::init_history(History).
|
||||||
|
|
||||||
|
process_init_option(Option) :-
|
||||||
|
^^process_init_option(Option).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(bounded_history_point,
|
||||||
|
imports(bounded_coordinate, point_history),
|
||||||
|
instantiates(class),
|
||||||
|
specializes(point)).
|
||||||
|
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.1,
|
||||||
|
date is 2000/10/31,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Two dimensional point moving in a constrained area and remembering past point positions.',
|
||||||
|
source is 'Example adopted from the SICStus Objects documentation.']).
|
||||||
|
|
||||||
|
|
||||||
|
move(X, Y) :-
|
||||||
|
::check_bounds(x, X),
|
||||||
|
::check_bounds(y, Y),
|
||||||
|
::position(OldX, OldY),
|
||||||
|
^^move(X, Y),
|
||||||
|
::add_to_history((OldX, OldY)).
|
||||||
|
|
||||||
|
|
||||||
|
print :-
|
||||||
|
::print_bounds(x),
|
||||||
|
::print_bounds(y),
|
||||||
|
::print_history,
|
||||||
|
^^print.
|
||||||
|
|
||||||
|
|
||||||
|
instance_base_name(bhp).
|
||||||
|
|
||||||
|
|
||||||
|
default_init_option(history-[]).
|
||||||
|
|
||||||
|
default_init_option(bounds(x)-(-10, 10)).
|
||||||
|
|
||||||
|
default_init_option(bounds(y)-(-10, 10)).
|
||||||
|
|
||||||
|
default_init_option(Default) :-
|
||||||
|
^^default_init_option(Default).
|
||||||
|
|
||||||
|
|
||||||
|
process_init_option(history-History) :-
|
||||||
|
::init_history(History).
|
||||||
|
|
||||||
|
process_init_option(bounds(Coordinate)-(Min, Max)) :-
|
||||||
|
::set_bounds(Coordinate, Min, Max).
|
||||||
|
|
||||||
|
process_init_option(Option) :-
|
||||||
|
^^process_init_option(Option).
|
||||||
|
|
||||||
|
|
||||||
|
:- end_object.
|
194
Logtalk/examples/polygons/polygons.lgt
Normal file
194
Logtalk/examples/polygons/polygons.lgt
Normal file
@ -0,0 +1,194 @@
|
|||||||
|
|
||||||
|
:- object(polygon,
|
||||||
|
instantiates(abstract_class),
|
||||||
|
specializes(object)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.2,
|
||||||
|
date is 2005/8/15,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Polygon predicates.']).
|
||||||
|
|
||||||
|
:- public(move/2).
|
||||||
|
:- mode(move(+integer, +integer), one).
|
||||||
|
|
||||||
|
:- public(trans_x/2).
|
||||||
|
:- mode(trans_x(+integer), one).
|
||||||
|
|
||||||
|
:- public(trans_y/2).
|
||||||
|
:- mode(trans_y(+integer), one).
|
||||||
|
|
||||||
|
:- public(number_of_sides/1).
|
||||||
|
:- mode(number_of_sides(?integer), zero_or_one).
|
||||||
|
|
||||||
|
:- public(position/2).
|
||||||
|
:- mode(position(?integer, ?integer), zero_or_one).
|
||||||
|
|
||||||
|
:- private(position_/2).
|
||||||
|
:- dynamic(position_/2).
|
||||||
|
:- mode(position_(?integer, ?integer), zero_or_one).
|
||||||
|
|
||||||
|
position(X, Y) :-
|
||||||
|
::position_(X, Y).
|
||||||
|
|
||||||
|
move(X, Y) :-
|
||||||
|
::retractall(position_(_, _)),
|
||||||
|
::assertz(position_(X, Y)).
|
||||||
|
|
||||||
|
trans_x(X) :-
|
||||||
|
::retractall(position_(_, Y)),
|
||||||
|
::assertz(position_(X, Y)).
|
||||||
|
|
||||||
|
trans_y(Y) :-
|
||||||
|
::retractall(position_(X, _)),
|
||||||
|
::assertz(position_(X, Y)).
|
||||||
|
|
||||||
|
default_init_option(position-(0, 0)).
|
||||||
|
default_init_option(Default) :-
|
||||||
|
^^default_init_option(Default).
|
||||||
|
|
||||||
|
process_init_option(position-(X, Y)) :-
|
||||||
|
::move(X, Y).
|
||||||
|
process_init_option(Option) :-
|
||||||
|
^^process_init_option(Option).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(triangle,
|
||||||
|
instantiates(class),
|
||||||
|
specializes(polygon)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 1998/3/23,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Triangle class.']).
|
||||||
|
|
||||||
|
number_of_sides(3).
|
||||||
|
|
||||||
|
instance_base_name(tri).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(square,
|
||||||
|
instantiates(class),
|
||||||
|
specializes(polygon)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 1998/3/23,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Square class.']).
|
||||||
|
|
||||||
|
number_of_sides(4).
|
||||||
|
|
||||||
|
instance_base_name(sq).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(pentagon,
|
||||||
|
instantiates(class),
|
||||||
|
specializes(polygon)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 1998/3/23,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Pentagon class.']).
|
||||||
|
|
||||||
|
number_of_sides(5).
|
||||||
|
|
||||||
|
instance_base_name(pen).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(hexagon,
|
||||||
|
instantiates(class),
|
||||||
|
specializes(polygon)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 1998/3/23,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Hexagon class.']).
|
||||||
|
|
||||||
|
number_of_sides(6).
|
||||||
|
|
||||||
|
instance_base_name(hex).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(concentric,
|
||||||
|
instantiates(constrained_relation)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.1,
|
||||||
|
date is 2004/8/15,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Concentric polygons as a constrained binary relation.']).
|
||||||
|
|
||||||
|
:- uses(list,
|
||||||
|
[member/2, select/3]).
|
||||||
|
|
||||||
|
descriptor_([x1, x2]).
|
||||||
|
|
||||||
|
domain_(x1, polygon).
|
||||||
|
domain_(x2, polygon).
|
||||||
|
|
||||||
|
key_([x1, x2]).
|
||||||
|
|
||||||
|
cardinality_(x1, 0, n).
|
||||||
|
cardinality_(x2, 0, n).
|
||||||
|
|
||||||
|
delete_option_(x1, cascade).
|
||||||
|
delete_option_(x2, cascade).
|
||||||
|
|
||||||
|
add_tuple([Polygon| Polygons]) :-
|
||||||
|
Polygon::position(X, Y),
|
||||||
|
forall(member(Polygon2, Polygons), {Polygon2::move(X, Y)}),
|
||||||
|
^^add_tuple([Polygon| Polygons]).
|
||||||
|
|
||||||
|
activ_points_(x1, before, []).
|
||||||
|
activ_points_(x1, after, [move(_, _), trans_x(_), trans_y(_)]).
|
||||||
|
|
||||||
|
activ_points_(x2, before, []).
|
||||||
|
activ_points_(x2, after, [move(_, _), trans_x(_), trans_y(_)]).
|
||||||
|
|
||||||
|
propagate(after, move(X, Y), Polygon, _, Tuple) :-
|
||||||
|
select(Polygon, Tuple, Polygons),
|
||||||
|
!,
|
||||||
|
forall(
|
||||||
|
(member(Polygon2, Polygons),\+ Polygon2::position(X, Y)),
|
||||||
|
{Polygon2::move(X, Y)}).
|
||||||
|
|
||||||
|
propagate(after, trans_x(X), Polygon, _, Tuple) :-
|
||||||
|
select(Polygon, Tuple, Polygons),
|
||||||
|
!,
|
||||||
|
forall(
|
||||||
|
(member(Polygon2, Polygons), \+ Polygon2::position(X, _)),
|
||||||
|
{Polygon2::trans_x(X)}).
|
||||||
|
|
||||||
|
propagate(after, trans_y(Y), Polygon, _, Tuple) :-
|
||||||
|
select(Polygon, Tuple, Polygons),
|
||||||
|
!,
|
||||||
|
forall(
|
||||||
|
(member(Polygon2, Polygons), \+ Polygon2::position(_, Y)),
|
||||||
|
{Polygon2::trans_y(Y)}).
|
||||||
|
|
||||||
|
:- end_object.
|
106
Logtalk/examples/reflection/reflection.lgt
Normal file
106
Logtalk/examples/reflection/reflection.lgt
Normal file
@ -0,0 +1,106 @@
|
|||||||
|
|
||||||
|
/*
|
||||||
|
In order to better grasp this example, draw a diagram of the hierarchy made of
|
||||||
|
the three objects below with their instantiation and specialization relations.
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
|
:- object(object, % root of the inheritance graph
|
||||||
|
instantiates(class)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Inheritance root for all objects.']).
|
||||||
|
|
||||||
|
:- public(strict_instance/0).
|
||||||
|
:- mode(strict_instance, zero_or_one).
|
||||||
|
|
||||||
|
:- public(print/0).
|
||||||
|
:- mode(print, one).
|
||||||
|
|
||||||
|
strict_instance. % descendant instances of this class
|
||||||
|
% are, by default, strict instances
|
||||||
|
print :-
|
||||||
|
self(Self),
|
||||||
|
write('Object: '), writeq(Self), nl, nl,
|
||||||
|
write(' interface:'), nl,
|
||||||
|
forall(
|
||||||
|
::current_predicate(Predicate),
|
||||||
|
(write(' '), writeq(Predicate), nl)),
|
||||||
|
nl.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(class, % default metaclass for all instantiable classes
|
||||||
|
instantiates(class),
|
||||||
|
specializes(abstract_class)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Instantiation root and default metaclass for all classes.']).
|
||||||
|
|
||||||
|
:- public(new/1).
|
||||||
|
:- mode(new(+object), zero_or_one).
|
||||||
|
|
||||||
|
:- public(delete/1).
|
||||||
|
:- mode(delete(+object), zero_or_one).
|
||||||
|
|
||||||
|
:- public(instances/1).
|
||||||
|
:- mode(instances(-list), one).
|
||||||
|
|
||||||
|
new(Object) :-
|
||||||
|
self(Self),
|
||||||
|
create_object(Object, [instantiates(Self)], [], []).
|
||||||
|
|
||||||
|
delete(Object) :-
|
||||||
|
self(Self),
|
||||||
|
instantiates_class(Object, Self),
|
||||||
|
\+ instantiates_class(_, Object),
|
||||||
|
\+ specializes_class(_, Object),
|
||||||
|
abolish_object(Object).
|
||||||
|
|
||||||
|
instances(Instances) :-
|
||||||
|
self(Self),
|
||||||
|
findall(Instance, instantiates_class(Instance, Self), Instances).
|
||||||
|
|
||||||
|
abstract_class :- % instances of this class are instantiable classes,
|
||||||
|
fail. % not abstract classes
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(abstract_class, % default metaclass for all abstract classes
|
||||||
|
instantiates(class),
|
||||||
|
specializes(object)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Default metaclass for all abstract classes.']).
|
||||||
|
|
||||||
|
:- public(metaclass/0).
|
||||||
|
:- mode(metaclass, zero_or_one).
|
||||||
|
|
||||||
|
:- public(abstract_class/0).
|
||||||
|
:- mode(abstract_class, zero_or_one).
|
||||||
|
|
||||||
|
abstract_class :- % by default, descendant instances of this class are abstract
|
||||||
|
self(Self), % classes except this class itself which is an instantiable class
|
||||||
|
Self \= abstract_class.
|
||||||
|
|
||||||
|
metaclass :- % descendant instances of this class are metaclasses if
|
||||||
|
self(Self), % their instances are themselves classes, i.e. if their
|
||||||
|
once(( % instances accept the abstract_class/0 message
|
||||||
|
instantiates_class(Class, Self),
|
||||||
|
Class::current_predicate(abstract_class/0))).
|
||||||
|
|
||||||
|
strict_instance :- % instances of this class are not strict instances;
|
||||||
|
fail. % they are classes
|
||||||
|
|
||||||
|
:- end_object.
|
795
Logtalk/examples/relations/relations.lgt
Normal file
795
Logtalk/examples/relations/relations.lgt
Normal file
@ -0,0 +1,795 @@
|
|||||||
|
|
||||||
|
:- protocol(relationp).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
date is 2000/7/24,
|
||||||
|
comment is 'Relations between objects protocol.']).
|
||||||
|
|
||||||
|
:- private(tuple_/1).
|
||||||
|
:- dynamic(tuple_/1).
|
||||||
|
:- mode(tuple_(?list), zero_or_more).
|
||||||
|
:- info(tuple_/1, [
|
||||||
|
comment is 'Stores the relation tuples.',
|
||||||
|
argnames is ['Tuple']]).
|
||||||
|
|
||||||
|
:- public(tuple/1).
|
||||||
|
:- mode(tuple(?list), zero_or_more).
|
||||||
|
:- info(tuple/1, [
|
||||||
|
comment is 'Returns a relation tuple.',
|
||||||
|
argnames is ['Tuple']]).
|
||||||
|
|
||||||
|
:- public(tuples/1).
|
||||||
|
:- mode(tuples(-list), one).
|
||||||
|
:- info(tuples/1, [
|
||||||
|
comment is 'Returns a list of all relation tuples.',
|
||||||
|
argnames is ['Tuples']]).
|
||||||
|
|
||||||
|
:- public(add_tuple/1).
|
||||||
|
:- mode(add_tuple(+list), zero_or_one).
|
||||||
|
:- info(add_tuple/1, [
|
||||||
|
comment is 'Adds a new relation tuple.',
|
||||||
|
argnames is ['Tuple']]).
|
||||||
|
|
||||||
|
:- public(remove_tuple/1).
|
||||||
|
:- mode(remove_tuple(?list), zero_or_more).
|
||||||
|
:- info(remove_tuple/1, [
|
||||||
|
comment is 'Removes a matching relation tuple.',
|
||||||
|
argnames is ['Tuple']]).
|
||||||
|
|
||||||
|
:- public(remove_all_tuples/0).
|
||||||
|
:- mode(remove_all_tuples, one).
|
||||||
|
:- info(remove_all_tuples/0, [
|
||||||
|
comment is 'Removes all relation tuples.']).
|
||||||
|
|
||||||
|
:- public(number_of_tuples/1).
|
||||||
|
:- mode(number_of_tuples(-integer), one).
|
||||||
|
:- info(number_of_tuples/1, [
|
||||||
|
comment is 'Returns the current number of relation tuples.',
|
||||||
|
argnames is ['Number']]).
|
||||||
|
|
||||||
|
:- public(plays_role_in_tuple/3).
|
||||||
|
:- mode(plays_role_in_tuple(?object, ?atom, ?list), zero_or_more).
|
||||||
|
:- info(plays_role_in_tuple/3, [
|
||||||
|
comment is 'List of tuples where an object plays a role.',
|
||||||
|
argnames is ['Object', 'Role', 'Tuples']]).
|
||||||
|
|
||||||
|
:- public(plays_roles/2).
|
||||||
|
:- mode(plays_roles(?object, -list), zero_or_more).
|
||||||
|
:- info(plays_roles/2, [
|
||||||
|
comment is 'Returns a list of all roles played by an object in the relation tuples.',
|
||||||
|
argnames is ['Object', 'Roles']]).
|
||||||
|
|
||||||
|
:- public(plays_role_n_times/3).
|
||||||
|
:- mode(plays_role_n_times(?object, ?atom, -integer), zero_or_more).
|
||||||
|
:- info(plays_role_n_times/3, [
|
||||||
|
comment is 'Number of times that an object plays a role in the relation tuples.',
|
||||||
|
argnames is ['Object', 'Role', 'Times']]).
|
||||||
|
|
||||||
|
:- private(domain_/2).
|
||||||
|
:- dynamic(domain_/2).
|
||||||
|
:- mode(domain_(?atom, ?object), zero_or_more).
|
||||||
|
:- info(domain_/2, [
|
||||||
|
comment is 'Table of role domains.',
|
||||||
|
argnames is ['Role', 'Domain']]).
|
||||||
|
|
||||||
|
:- public(domains/1).
|
||||||
|
:- mode(domains(-list), zero_or_one).
|
||||||
|
:- info(domains/1, [
|
||||||
|
comment is 'List of domains for all roles.',
|
||||||
|
argnames is ['Domains']]).
|
||||||
|
|
||||||
|
:- public(domain/2).
|
||||||
|
:- mode(domain(?atom, ?object), zero_or_more).
|
||||||
|
:- info(domain/2, [
|
||||||
|
comment is 'Role domain.',
|
||||||
|
argnames is ['Role', 'Domain']]).
|
||||||
|
|
||||||
|
:- public(set_domains/1).
|
||||||
|
:- mode(set_domains(+list), zero_or_one).
|
||||||
|
:- info(set_domains/1, [
|
||||||
|
comment is 'Set the domains for all roles.',
|
||||||
|
argnames is ['Domains']]).
|
||||||
|
|
||||||
|
:- private(descriptor_/1).
|
||||||
|
:- dynamic(descriptor_/1).
|
||||||
|
:- mode(descriptor_(?list), zero_or_one).
|
||||||
|
:- info(descriptor_/1, [
|
||||||
|
comment is 'Stores the relation tuple descriptor.',
|
||||||
|
argnames is ['Descriptor']]).
|
||||||
|
|
||||||
|
:- public(descriptor/1).
|
||||||
|
:- mode(descriptor(?list), zero_or_one).
|
||||||
|
:- info(descriptor/1, [
|
||||||
|
comment is 'Returns the relation tuple descriptor.',
|
||||||
|
argnames is ['Descriptor']]).
|
||||||
|
|
||||||
|
:- public(degree/1).
|
||||||
|
:- mode(degree(?integer), zero_or_one).
|
||||||
|
:- info(degree/1, [
|
||||||
|
comment is 'Descriptor length.',
|
||||||
|
argnames is ['Degree']]).
|
||||||
|
|
||||||
|
:- public(set_descriptor/1).
|
||||||
|
:- mode(set_descriptor(+list), zero_or_one).
|
||||||
|
:- info(set_descriptor/1, [
|
||||||
|
comment is 'Sets the relation tuple descriptor.',
|
||||||
|
argnames is ['Descriptor']]).
|
||||||
|
|
||||||
|
:- private(key_/1).
|
||||||
|
:- dynamic(key_/1).
|
||||||
|
:- mode(key_(?list), zero_or_more).
|
||||||
|
:- info(key_/1, [
|
||||||
|
comment is 'Stores the relation keys.',
|
||||||
|
argnames is ['Key']]).
|
||||||
|
|
||||||
|
:- public(key/1).
|
||||||
|
:- mode(key(?list), zero_or_more).
|
||||||
|
:- info(key/1, [
|
||||||
|
comment is 'Returns a relation key.',
|
||||||
|
argnames is ['Key']]).
|
||||||
|
|
||||||
|
:- public(keys/1).
|
||||||
|
:- mode(keys(-list), one).
|
||||||
|
:- info(keys/1, [
|
||||||
|
comment is 'Returns a list of all relation keys.',
|
||||||
|
argnames is ['Keys']]).
|
||||||
|
|
||||||
|
:- public(set_keys/1).
|
||||||
|
:- mode(set_keys(+list), zero_or_one).
|
||||||
|
:- info(set_keys/1, [
|
||||||
|
comment is 'Sets the relation keys.',
|
||||||
|
argnames is ['Keys']]).
|
||||||
|
|
||||||
|
:- private(delete_option_/2).
|
||||||
|
:- dynamic(delete_option_/2).
|
||||||
|
:- mode(delete_option_(?atom, ?atom), zero_or_more).
|
||||||
|
:- info(delete_option_/2, [
|
||||||
|
comment is 'Stores role delete options.',
|
||||||
|
argnames is ['Role', 'Option']]).
|
||||||
|
|
||||||
|
:- public(delete_options/1).
|
||||||
|
:- mode(delete_options(-list), zero_or_one).
|
||||||
|
:- info(delete_options/1, [
|
||||||
|
comment is 'Returns a list of all role - delete option pairs.',
|
||||||
|
argnames is ['Options']]).
|
||||||
|
|
||||||
|
:- public(delete_option/2).
|
||||||
|
:- mode(delete_option(?atom, ?atom), zero_or_more).
|
||||||
|
:- info(delete_option/2, [
|
||||||
|
comment is 'Returns role delete options.',
|
||||||
|
argnames is ['Role', 'Option']]).
|
||||||
|
|
||||||
|
:- public(set_delete_options/1).
|
||||||
|
:- mode(set_delete_options(+list), zero_or_one).
|
||||||
|
:- info(set_delete_options/1, [
|
||||||
|
comment is 'Sets the roles delete options.',
|
||||||
|
argnames is ['Options']]).
|
||||||
|
|
||||||
|
:- private(cardinality_/3).
|
||||||
|
:- dynamic(cardinality_/3).
|
||||||
|
:- mode(cardinality_(?atom, ?nonvar, ?nonvar), zero_or_more).
|
||||||
|
:- info(cardinality_/3, [
|
||||||
|
comment is 'Table of roles minimum and maximum cardinalities.',
|
||||||
|
argnames is ['Role', 'Min', 'Max']]).
|
||||||
|
|
||||||
|
:- public(cardinalities/1).
|
||||||
|
:- mode(cardinalities(-list), zero_or_one).
|
||||||
|
:- info(cardinalities/1, [
|
||||||
|
comment is 'List of minimum and maximum cardinalities of all roles.',
|
||||||
|
argnames is ['Cardinalities']]).
|
||||||
|
|
||||||
|
:- public(cardinality/3).
|
||||||
|
:- mode(cardinality(?atom, ?nonvar, ?nonvar), zero_or_more).
|
||||||
|
:- info(cardinality/3, [
|
||||||
|
comment is 'Role minimum and maximum cardinalities.',
|
||||||
|
argnames is ['Role', 'Min', 'Max']]).
|
||||||
|
|
||||||
|
:- public(set_cardinalities/1).
|
||||||
|
:- mode(set_cardinalities(+list), zero_or_one).
|
||||||
|
:- info(cardinalities/1, [
|
||||||
|
comment is 'Sets the minimum and maximum cardinalities of all roles.',
|
||||||
|
argnames is ['Cardinalities']]).
|
||||||
|
|
||||||
|
:- protected(set_monitors/1).
|
||||||
|
:- mode(set_monitors(+list), one).
|
||||||
|
|
||||||
|
:- protected(del_all_monitors/0).
|
||||||
|
:- mode(del_all_monitors, one).
|
||||||
|
|
||||||
|
:- protected(del_monitors/1).
|
||||||
|
:- mode(del_monitors(+list), one).
|
||||||
|
|
||||||
|
:- protected(restore_monitors/0).
|
||||||
|
:- mode(restore_monitors, zero_or_one).
|
||||||
|
|
||||||
|
:- end_protocol.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(relation,
|
||||||
|
implements(relationp),
|
||||||
|
instantiates(class),
|
||||||
|
specializes(object)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.2,
|
||||||
|
date is 2004/8/15,
|
||||||
|
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,
|
||||||
|
[length/2, member/2, memberchk/2, nth1/3, same_length/2]).
|
||||||
|
|
||||||
|
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),
|
||||||
|
\+ 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),
|
||||||
|
nth1(Position, Tuple, Object),
|
||||||
|
nth1(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),
|
||||||
|
nth1(Position, Tuple, Object),
|
||||||
|
nth1(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]) :-
|
||||||
|
(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),
|
||||||
|
nth1(Position, Tuple, Object),
|
||||||
|
nth1(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),
|
||||||
|
length(List, Number).
|
||||||
|
|
||||||
|
plays_roles(Object, Roles) :-
|
||||||
|
::descriptor(Descriptor),
|
||||||
|
setof(Role,
|
||||||
|
Tuple^Position^ (::tuple(Tuple),
|
||||||
|
member(Object, Tuple),
|
||||||
|
nth1(Position, Tuple, Object),
|
||||||
|
once(nth1(Position, Descriptor, Role))),
|
||||||
|
Roles).
|
||||||
|
|
||||||
|
plays_role_in_tuple(Object, Role, Tuple) :-
|
||||||
|
::descriptor(Descriptor),
|
||||||
|
::tuple(Tuple),
|
||||||
|
nth1(Position, Tuple, Object),
|
||||||
|
nth1(Position, Descriptor, Role).
|
||||||
|
|
||||||
|
plays_role_n_times(Object, Role, Number) :-
|
||||||
|
::descriptor(Descriptor),
|
||||||
|
nth1(Position, Descriptor, Role),
|
||||||
|
setof(Tuple,
|
||||||
|
(::tuple(Tuple),
|
||||||
|
nth1(Position, Tuple, Object)),
|
||||||
|
Tuples),
|
||||||
|
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),
|
||||||
|
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(
|
||||||
|
member(Role, Key),
|
||||||
|
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),
|
||||||
|
\+ 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), 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.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(constrained_relation,
|
||||||
|
instantiates(class),
|
||||||
|
specializes(relation)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 3.2,
|
||||||
|
date is 2005/1/29,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Enables the representation of relations with constraints on the state of participating objects.']).
|
||||||
|
|
||||||
|
:- uses(list,
|
||||||
|
[member/2, memberchk/2, subtract/3]).
|
||||||
|
|
||||||
|
:- private(activ_points_/3).
|
||||||
|
:- dynamic(activ_points_/3).
|
||||||
|
:- mode(activ_points_(?atom, ?event, -list), zero_or_more).
|
||||||
|
|
||||||
|
:- public(activ_point/3).
|
||||||
|
:- mode(activ_point(?atom, ?event, ?callable), zero_or_more).
|
||||||
|
|
||||||
|
:- public(activ_points/3).
|
||||||
|
:- mode(activ_points(?atom, ?event, -list), zero_or_more).
|
||||||
|
|
||||||
|
:- public(set_activ_points/3).
|
||||||
|
:- mode(set_activ_points(+atom, +event, +list), one).
|
||||||
|
|
||||||
|
:- protected(unique_messages/4).
|
||||||
|
:- mode(unique_messages(+list, +atom, +event, -list), one).
|
||||||
|
|
||||||
|
:- protected(propagate/5).
|
||||||
|
:- mode(propagate(+atom, +callable, +object, +atom, +list), zero_or_one).
|
||||||
|
|
||||||
|
before(Object, Message, Sender) :-
|
||||||
|
self(Self),
|
||||||
|
(Self \= Sender ->
|
||||||
|
forall(
|
||||||
|
(::activ_point(Role, before, Message),
|
||||||
|
::plays_role_in_tuple(Object, Role, Tuple)),
|
||||||
|
::propagate(before, Message, Object, Role, Tuple))
|
||||||
|
;
|
||||||
|
true),
|
||||||
|
^^before(Object, Message, Sender).
|
||||||
|
|
||||||
|
after(Object, Message, Sender) :-
|
||||||
|
self(Self),
|
||||||
|
(Self \= Sender ->
|
||||||
|
forall(
|
||||||
|
(::activ_point(Role, after, Message),
|
||||||
|
::plays_role_in_tuple(Object, Role, Tuple)),
|
||||||
|
::propagate(after, Message, Object, Role, Tuple))
|
||||||
|
;
|
||||||
|
true),
|
||||||
|
^^after(Object, Message, Sender).
|
||||||
|
|
||||||
|
set_monitors(Tuple) :-
|
||||||
|
^^set_monitors(Tuple),
|
||||||
|
::descriptor(Descriptor),
|
||||||
|
set_monitors(Tuple, Descriptor).
|
||||||
|
|
||||||
|
set_monitors([], []).
|
||||||
|
set_monitors([Object| Objects], [Role| Roles]) :-
|
||||||
|
once(::activ_points(Role, before, Messages1)), % avoid spurious backtracking
|
||||||
|
set_object_before_monitors(Messages1, Object),
|
||||||
|
once(::activ_points(Role, after, Messages2)), % avoid spurious backtracking
|
||||||
|
set_object_after_monitors(Messages2, Object),
|
||||||
|
set_monitors(Objects, Roles).
|
||||||
|
|
||||||
|
set_object_before_monitors([], _).
|
||||||
|
set_object_before_monitors([Message| Messages], Object) :-
|
||||||
|
self(Self),
|
||||||
|
before_event_registry::set_monitor(Object, Message, _, Self),
|
||||||
|
set_object_before_monitors(Messages, Object).
|
||||||
|
|
||||||
|
set_object_after_monitors([], _).
|
||||||
|
set_object_after_monitors([Message| Messages], Object) :-
|
||||||
|
self(Self),
|
||||||
|
after_event_registry::set_monitor(Object, Message, _, Self),
|
||||||
|
set_object_after_monitors(Messages, Object).
|
||||||
|
|
||||||
|
del_monitors(Tuple) :-
|
||||||
|
^^del_monitors(Tuple),
|
||||||
|
::descriptor(Descriptor),
|
||||||
|
del_monitors(Tuple, Descriptor).
|
||||||
|
|
||||||
|
del_monitors([], []).
|
||||||
|
del_monitors([Object| Objects], [Role| Roles]) :-
|
||||||
|
del_object_monitors(Object, Role),
|
||||||
|
del_monitors(Objects, Roles).
|
||||||
|
|
||||||
|
del_object_monitors(Object, Role) :-
|
||||||
|
::plays_roles(Object, Roles) ->
|
||||||
|
(member(Role, Roles) ->
|
||||||
|
true
|
||||||
|
;
|
||||||
|
del_object_monitors(Object, Role, Roles))
|
||||||
|
;
|
||||||
|
del_object_monitors(Object, Role, []).
|
||||||
|
|
||||||
|
del_object_monitors(Object, Role, Roles) :-
|
||||||
|
::unique_messages(Roles, Role, before, Messages1),
|
||||||
|
del_object_before_monitors(Messages1, Object),
|
||||||
|
::unique_messages(Roles, Role, after, Messages2),
|
||||||
|
del_object_after_monitors(Messages2, Object).
|
||||||
|
|
||||||
|
del_object_before_monitors([], _).
|
||||||
|
del_object_before_monitors([Message| Messages], Object) :-
|
||||||
|
self(Self),
|
||||||
|
before_event_registry::del_monitors(Object, Message, _, Self),
|
||||||
|
del_object_before_monitors(Messages, Object).
|
||||||
|
|
||||||
|
del_object_after_monitors([], _).
|
||||||
|
del_object_after_monitors([Message| Messages], Object) :-
|
||||||
|
self(Self),
|
||||||
|
after_event_registry::del_monitors(Object, Message, _, Self),
|
||||||
|
del_object_after_monitors(Messages, Object).
|
||||||
|
|
||||||
|
propagate(Event, Message, Object, Role, Tuple) :-
|
||||||
|
self(Self),
|
||||||
|
sender(Sender),
|
||||||
|
throw(error(desc_responsibility, Self::propagate(Event, Message, Object, Role, Tuple), Sender)).
|
||||||
|
|
||||||
|
activ_point(Role, Event, Message) :-
|
||||||
|
::activ_points_(Role, Event, Messages),
|
||||||
|
member(Message, Messages).
|
||||||
|
|
||||||
|
activ_points(Role, Event, List) :-
|
||||||
|
::activ_points_(Role, Event, List).
|
||||||
|
|
||||||
|
set_activ_points(Role, Event, List) :-
|
||||||
|
\+ ::descriptor(_),
|
||||||
|
self(Self),
|
||||||
|
sender(Sender),
|
||||||
|
throw(error(descriptor_not_defined, Self::set_activ_points(Role, Event, List), Sender)).
|
||||||
|
|
||||||
|
set_activ_points(Role, Event, List) :-
|
||||||
|
::descriptor(Descriptor),
|
||||||
|
memberchk(Role, Descriptor),
|
||||||
|
::retractall(activ_points_(Role, Event, _)),
|
||||||
|
::assertz(activ_points_(Role, Event, List)).
|
||||||
|
|
||||||
|
unique_messages(Roles, Role, Event, Messages) :-
|
||||||
|
::activ_points_(Role, Event, Original),
|
||||||
|
filter_messages(Roles, Original, Event, Messages).
|
||||||
|
|
||||||
|
filter_messages([], Messages, _, Messages).
|
||||||
|
filter_messages([Role| Roles], Original, Event, Messages) :-
|
||||||
|
::activ_points_(Role, Event, Excluded),
|
||||||
|
subtract(Original, Excluded, Rest),
|
||||||
|
filter_messages(Roles, Rest, Event, Messages).
|
||||||
|
|
||||||
|
set_descriptor(Descriptor) :-
|
||||||
|
^^set_descriptor(Descriptor),
|
||||||
|
set_default_activ_points(Descriptor).
|
||||||
|
|
||||||
|
set_default_activ_points([]).
|
||||||
|
set_default_activ_points([Role| Roles]) :-
|
||||||
|
::set_activ_points(Role, before, []),
|
||||||
|
::set_activ_points(Role, after, []),
|
||||||
|
set_default_activ_points(Roles).
|
||||||
|
|
||||||
|
print :-
|
||||||
|
^^print,
|
||||||
|
::descriptor(Descriptor),
|
||||||
|
write('call activation points:'), nl,
|
||||||
|
findall(Messages,
|
||||||
|
(member(Role, Descriptor),
|
||||||
|
::activ_points(Role, before, Messages)),
|
||||||
|
CallList),
|
||||||
|
write(' '), writeq(CallList), nl,
|
||||||
|
write('exit activation points:'), nl,
|
||||||
|
findall(Messages,
|
||||||
|
(member(Role, Descriptor),
|
||||||
|
::activ_points(Role, after, Messages)),
|
||||||
|
ExitList),
|
||||||
|
write(' '), writeq(ExitList), nl.
|
||||||
|
|
||||||
|
:- end_object.
|
281
Logtalk/examples/roots/classes.lgt
Normal file
281
Logtalk/examples/roots/classes.lgt
Normal file
@ -0,0 +1,281 @@
|
|||||||
|
|
||||||
|
:- 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.
|
62
Logtalk/examples/roots/prototypes.lgt
Normal file
62
Logtalk/examples/roots/prototypes.lgt
Normal file
@ -0,0 +1,62 @@
|
|||||||
|
|
||||||
|
:- protocol(protop).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/7/24,
|
||||||
|
author 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.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(proto,
|
||||||
|
implements(protop, event_handlersp),
|
||||||
|
imports(initialization, proto_hierarchy)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
version is 1.1,
|
||||||
|
date is 2005/10/22,
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
comment is 'Minimal predicates for all prototypes. Default root of the extension graph.']).
|
||||||
|
|
||||||
|
:- uses(event_registry, [del_monitors/4]).
|
||||||
|
|
||||||
|
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),
|
||||||
|
del_monitors(Self, _, _, _),
|
||||||
|
del_monitors(_, _, Self, _),
|
||||||
|
del_monitors(_, _, _, Self).
|
||||||
|
|
||||||
|
print :-
|
||||||
|
self(Self),
|
||||||
|
writeq(Self), nl, nl,
|
||||||
|
forall(
|
||||||
|
::current_predicate(Predicate),
|
||||||
|
(writeq(Predicate), nl)),
|
||||||
|
nl.
|
||||||
|
|
||||||
|
before(_, _, _).
|
||||||
|
|
||||||
|
after(_, _, _).
|
||||||
|
|
||||||
|
:- end_object.
|
132
Logtalk/examples/shapes/ch/ch.lgt
Normal file
132
Logtalk/examples/shapes/ch/ch.lgt
Normal file
@ -0,0 +1,132 @@
|
|||||||
|
|
||||||
|
% "shape" abstract class
|
||||||
|
|
||||||
|
:- object(shape,
|
||||||
|
instantiates(abstract_class),
|
||||||
|
specializes(object)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2003/2/3,
|
||||||
|
comment is 'Generic geometric shape.']).
|
||||||
|
|
||||||
|
:- public(color/1).
|
||||||
|
:- mode(color(?atom), zero_or_one).
|
||||||
|
:- info(color/1, [
|
||||||
|
comment is 'Shape color.',
|
||||||
|
argnames is ['Color']]).
|
||||||
|
|
||||||
|
:- public(position/2).
|
||||||
|
:- mode(position(?integer, ?integer), zero_or_one).
|
||||||
|
:- info(position/2, [
|
||||||
|
comment is 'Shape position.',
|
||||||
|
argnames is ['X', 'Y']]).
|
||||||
|
|
||||||
|
color(red). % default shape color
|
||||||
|
|
||||||
|
position(0, 0). % default shape position
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% "polygon" abstract class
|
||||||
|
|
||||||
|
:- object(polygon,
|
||||||
|
instantiates(abstract_class),
|
||||||
|
specializes(shape)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.1,
|
||||||
|
date is 2004/1/8,
|
||||||
|
comment is 'Generic polygon.']).
|
||||||
|
|
||||||
|
:- public(nsides/1).
|
||||||
|
:- mode(nsides(?integer), zero_or_one).
|
||||||
|
:- info(nsides/1, [
|
||||||
|
comment is 'Polygon number of sides.',
|
||||||
|
argnames is ['Number']]).
|
||||||
|
|
||||||
|
:- public(area/1).
|
||||||
|
:- mode(area(-float), zero_or_one).
|
||||||
|
:- info(area/1, [
|
||||||
|
comment is 'Polygon area.',
|
||||||
|
argnames is ['Area']]).
|
||||||
|
|
||||||
|
:- public(perimeter/1).
|
||||||
|
:- mode(perimeter(?atom), zero_or_one).
|
||||||
|
:- info(perimeter/1, [
|
||||||
|
comment is 'Polygon perimeter.',
|
||||||
|
argnames is ['Perimeter']]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% "regular_polygon" abstract class
|
||||||
|
|
||||||
|
:- object(regular_polygon,
|
||||||
|
instantiates(abstract_class),
|
||||||
|
specializes(polygon)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.1,
|
||||||
|
date is 2004/1/8,
|
||||||
|
comment is 'Generic regular polygon.']).
|
||||||
|
|
||||||
|
:- public(side/1).
|
||||||
|
:- mode(side(?atom), zero_or_one).
|
||||||
|
:- info(side/1, [
|
||||||
|
comment is 'Regular polygon side length.',
|
||||||
|
argnames is ['Length']]).
|
||||||
|
|
||||||
|
side(1). % default side length
|
||||||
|
|
||||||
|
perimeter(Perimeter) :-
|
||||||
|
::nsides(Number),
|
||||||
|
::side(Side),
|
||||||
|
Perimeter is Number*Side.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% "square" instantiable class
|
||||||
|
|
||||||
|
:- object(square,
|
||||||
|
instantiates(class),
|
||||||
|
specializes(regular_polygon)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2003/2/3,
|
||||||
|
comment is 'Geometric square.']).
|
||||||
|
|
||||||
|
nsides(4).
|
||||||
|
|
||||||
|
area(Area) :-
|
||||||
|
::side(Side),
|
||||||
|
Area is Side*Side.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(q1,
|
||||||
|
instantiates(square)).
|
||||||
|
|
||||||
|
% inherits default values for position/2, color/1, and side/1
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(q2,
|
||||||
|
instantiates(square)).
|
||||||
|
|
||||||
|
position(2, 3).
|
||||||
|
|
||||||
|
color(blue).
|
||||||
|
|
||||||
|
side(3).
|
||||||
|
|
||||||
|
:- end_object.
|
117
Logtalk/examples/shapes/ph/ph.lgt
Normal file
117
Logtalk/examples/shapes/ph/ph.lgt
Normal file
@ -0,0 +1,117 @@
|
|||||||
|
|
||||||
|
:- object(shape). % an object with no hierarchy relations with other
|
||||||
|
% objects is always compiled as a prototype
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2003/2/3,
|
||||||
|
comment is 'Generic geometric shape.']).
|
||||||
|
|
||||||
|
:- public(color/1).
|
||||||
|
:- mode(color(?atom), zero_or_one).
|
||||||
|
:- info(color/1, [
|
||||||
|
comment is 'Shape color.',
|
||||||
|
argnames is ['Color']]).
|
||||||
|
|
||||||
|
:- public(position/2).
|
||||||
|
:- mode(position(?integer, ?integer), zero_or_one).
|
||||||
|
:- info(position/2, [
|
||||||
|
comment is 'Shape position.',
|
||||||
|
argnames is ['X', 'Y']]).
|
||||||
|
|
||||||
|
color(red). % default shape color
|
||||||
|
|
||||||
|
position(0, 0). % default shape position
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(polygon,
|
||||||
|
extends(shape)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.1,
|
||||||
|
date is 2004/1/8,
|
||||||
|
comment is 'Generic polygon.']).
|
||||||
|
|
||||||
|
:- public(nsides/1).
|
||||||
|
:- mode(nsides(?integer), zero_or_one).
|
||||||
|
:- info(nsides/1, [
|
||||||
|
comment is 'Polygon number of sides.',
|
||||||
|
argnames is ['Number']]).
|
||||||
|
|
||||||
|
:- public(area/1).
|
||||||
|
:- mode(area(-float), zero_or_one).
|
||||||
|
:- info(area/1, [
|
||||||
|
comment is 'Polygon area.',
|
||||||
|
argnames is ['Area']]).
|
||||||
|
|
||||||
|
:- public(perimeter/1).
|
||||||
|
:- mode(perimeter(?atom), zero_or_one).
|
||||||
|
:- info(perimeter/1, [
|
||||||
|
comment is 'Polygon perimeter.',
|
||||||
|
argnames is ['Perimeter']]).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(regular_polygon,
|
||||||
|
extends(polygon)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.1,
|
||||||
|
date is 2004/1/8,
|
||||||
|
comment is 'Generic regular polygon.']).
|
||||||
|
|
||||||
|
:- public(side/1).
|
||||||
|
:- mode(side(?atom), zero_or_one).
|
||||||
|
:- info(side/1, [
|
||||||
|
comment is 'Regular polygon side length.',
|
||||||
|
argnames is ['Length']]).
|
||||||
|
|
||||||
|
side(1). % default side length
|
||||||
|
|
||||||
|
perimeter(Perimeter) :-
|
||||||
|
::nsides(Number),
|
||||||
|
::side(Side),
|
||||||
|
Perimeter is Number*Side.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(square,
|
||||||
|
extends(regular_polygon)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2003/2/3,
|
||||||
|
comment is 'Geometric square.']).
|
||||||
|
|
||||||
|
nsides(4).
|
||||||
|
|
||||||
|
area(Area) :-
|
||||||
|
::side(Side),
|
||||||
|
Area is Side*Side.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(q1,
|
||||||
|
extends(square)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(q2,
|
||||||
|
extends(square)).
|
||||||
|
|
||||||
|
position(2, 3).
|
||||||
|
|
||||||
|
color(blue).
|
||||||
|
|
||||||
|
side(3).
|
||||||
|
|
||||||
|
:- end_object.
|
169
Logtalk/examples/sicstus/ovals.lgt
Normal file
169
Logtalk/examples/sicstus/ovals.lgt
Normal file
@ -0,0 +1,169 @@
|
|||||||
|
|
||||||
|
:- object(math_constants).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Implements predicates for retriving common mathematical constants.']).
|
||||||
|
|
||||||
|
:- public(pi/1).
|
||||||
|
:- mode(pi(-float), one).
|
||||||
|
|
||||||
|
:- public(e/1).
|
||||||
|
:- mode(e(-float), one).
|
||||||
|
|
||||||
|
pi(Pi) :-
|
||||||
|
Pi is 4.0*atan(1.0).
|
||||||
|
|
||||||
|
e(E) :-
|
||||||
|
E is exp(1.0).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(ellipse(_RX, _RY, _Color),
|
||||||
|
imports(proto_hierarchy)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Parametric object for representing geometric ellipses.',
|
||||||
|
parnames is ['RX', 'RY', 'Color'],
|
||||||
|
source is 'Example adopted from the SICStus Objects documentation.']).
|
||||||
|
|
||||||
|
:- uses(math_constants).
|
||||||
|
|
||||||
|
:- public(color/1).
|
||||||
|
:- mode(color(?atom), zero_or_one).
|
||||||
|
:- info(color/1, [
|
||||||
|
comment is 'Ellipse color.',
|
||||||
|
argnames is ['Color']]).
|
||||||
|
|
||||||
|
:- public(rx/1).
|
||||||
|
:- mode(rx(?number), zero_or_one).
|
||||||
|
:- info(rx/1, [
|
||||||
|
comment is 'Ellipse x axis.',
|
||||||
|
argnames is ['Rx']]).
|
||||||
|
|
||||||
|
:- public(ry/1).
|
||||||
|
:- mode(ry(?number), zero_or_one).
|
||||||
|
:- info(ry/1, [
|
||||||
|
comment is 'Ellipse y axis.',
|
||||||
|
argnames is ['Ry']]).
|
||||||
|
|
||||||
|
:- public(area/1).
|
||||||
|
:- mode(area(-number), one).
|
||||||
|
:- info(area/1, [
|
||||||
|
comment is 'Ellipse area.',
|
||||||
|
argnames is ['Area']]).
|
||||||
|
|
||||||
|
:- public(context/0).
|
||||||
|
:- mode(context, one).
|
||||||
|
:- info(context/0, [
|
||||||
|
comment is 'Shows execution context (self, this and sender values).']).
|
||||||
|
|
||||||
|
color(Color) :-
|
||||||
|
parameter(3, Color).
|
||||||
|
|
||||||
|
rx(Rx) :-
|
||||||
|
parameter(1, Rx).
|
||||||
|
|
||||||
|
ry(Ry) :-
|
||||||
|
parameter(2, Ry).
|
||||||
|
|
||||||
|
area(Area) :-
|
||||||
|
::rx(Rx),
|
||||||
|
::ry(Ry),
|
||||||
|
math_constants::pi(Pi),
|
||||||
|
Area is Rx*Ry*Pi.
|
||||||
|
|
||||||
|
context :-
|
||||||
|
write(ellipse3), nl,
|
||||||
|
self(Self), write('self: '), writeq(Self), nl,
|
||||||
|
this(This), write('this: '), writeq(This), nl,
|
||||||
|
sender(Sender), write('sender: '), writeq(Sender), nl, nl.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(circle(Radius, Color),
|
||||||
|
extends(ellipse(Radius, Radius, Color))).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Parametric object for representing geometric circles.',
|
||||||
|
parnames is ['Radius', 'Color'],
|
||||||
|
source is 'Example adopted from the SICStus Objects documentation.']).
|
||||||
|
|
||||||
|
:- public(r/1).
|
||||||
|
:- mode(r(?number), zero_or_one).
|
||||||
|
:- info(r/1, [
|
||||||
|
comment is 'Circle radius.',
|
||||||
|
argnames is ['Radius']]).
|
||||||
|
|
||||||
|
r(Radius) :-
|
||||||
|
parameter(1, Radius).
|
||||||
|
|
||||||
|
color(Color) :-
|
||||||
|
parameter(2, Color).
|
||||||
|
|
||||||
|
rx(Radius) :-
|
||||||
|
::r(Radius).
|
||||||
|
|
||||||
|
ry(Radius) :-
|
||||||
|
::r(Radius).
|
||||||
|
|
||||||
|
context :-
|
||||||
|
write(circle2), nl,
|
||||||
|
self(Self), write('self: '), writeq(Self), nl,
|
||||||
|
this(This), write('this: '), writeq(This), nl,
|
||||||
|
sender(Sender), write('sender: '), writeq(Sender), nl, nl,
|
||||||
|
^^context.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(circle1(Color),
|
||||||
|
extends(circle(1, Color))).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Parametric object for representing geometric circles with radius = 1.',
|
||||||
|
parnames is ['Color'],
|
||||||
|
source is 'Example adopted from the SICStus Objects documentation.']).
|
||||||
|
|
||||||
|
context :-
|
||||||
|
write(circle11), nl,
|
||||||
|
self(Self), write('self: '), writeq(Self), nl,
|
||||||
|
this(This), write('this: '), writeq(This), nl,
|
||||||
|
sender(Sender), write('sender: '), writeq(Sender), nl,
|
||||||
|
^^context.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(red_circle(Radius),
|
||||||
|
extends(circle(Radius, red))).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Parametric object for representing geometric red circles.',
|
||||||
|
parnames is ['Radius'],
|
||||||
|
source is 'Example adopted from the SICStus Objects documentation.']).
|
||||||
|
|
||||||
|
context :-
|
||||||
|
write(red_circle1), nl,
|
||||||
|
self(Self), write('self: '), writeq(Self), nl,
|
||||||
|
this(This), write('this: '), writeq(This), nl,
|
||||||
|
sender(Sender), write('sender: '), writeq(Sender), nl, nl,
|
||||||
|
^^context.
|
||||||
|
|
||||||
|
:- end_object.
|
68
Logtalk/examples/sicstus/polygons.lgt
Normal file
68
Logtalk/examples/sicstus/polygons.lgt
Normal file
@ -0,0 +1,68 @@
|
|||||||
|
|
||||||
|
:- object(rectangle(_Width, _Height)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Parametric object for representing geometric rectangles.',
|
||||||
|
parnames is ['Width', 'Height']]).
|
||||||
|
|
||||||
|
:- public(width/1).
|
||||||
|
:- mode(width(?number), zero_or_one).
|
||||||
|
:- info(width/1, [
|
||||||
|
comment is 'Rectangle width.',
|
||||||
|
argnames is ['Width']]).
|
||||||
|
|
||||||
|
:- public(height/1).
|
||||||
|
:- mode(height(?number), zero_or_one).
|
||||||
|
:- info(height/1, [
|
||||||
|
comment is 'Rectangle height.',
|
||||||
|
argnames is ['Height']]).
|
||||||
|
|
||||||
|
:- public(area/1).
|
||||||
|
:- mode(area(-number), one).
|
||||||
|
:- info(area/1, [
|
||||||
|
comment is 'Rectangle area.',
|
||||||
|
argnames is ['Area']]).
|
||||||
|
|
||||||
|
width(Width) :-
|
||||||
|
parameter(1, Width).
|
||||||
|
|
||||||
|
height(Height) :-
|
||||||
|
parameter(2, Height).
|
||||||
|
|
||||||
|
area(Area) :-
|
||||||
|
::width(Width),
|
||||||
|
::height(Height),
|
||||||
|
Area is Width*Height.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(square(Side),
|
||||||
|
extends(rectangle(Side, Side))).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Parametric object for representing geometric squares.',
|
||||||
|
parnames is ['Side']]).
|
||||||
|
|
||||||
|
:- public(side/1).
|
||||||
|
:- mode(side(?number), zero_or_one).
|
||||||
|
:- info(side/1, [
|
||||||
|
comment is 'Square side.',
|
||||||
|
argnames is ['Side']]).
|
||||||
|
|
||||||
|
side(Side) :-
|
||||||
|
parameter(1, Side).
|
||||||
|
|
||||||
|
width(Width) :-
|
||||||
|
parameter(1, Width).
|
||||||
|
|
||||||
|
height(Height) :-
|
||||||
|
parameter(1, Height).
|
||||||
|
|
||||||
|
:- end_object.
|
119
Logtalk/examples/sicstus/sorting.lgt
Normal file
119
Logtalk/examples/sicstus/sorting.lgt
Normal file
@ -0,0 +1,119 @@
|
|||||||
|
|
||||||
|
:- object(sort(_Type)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'List sorting parameterized by the type of the list elements.',
|
||||||
|
parnames is ['Type'],
|
||||||
|
source is 'Example adopted from the SICStus Objects documentation.']).
|
||||||
|
|
||||||
|
:- uses(list).
|
||||||
|
:- calls(comparingp).
|
||||||
|
|
||||||
|
:- public(sort/2).
|
||||||
|
:- mode(sort(+list, -list), one).
|
||||||
|
:- info(sort/2, [
|
||||||
|
comment is 'Sorts a list in ascending order.',
|
||||||
|
argnames is ['List', 'Sorted']]).
|
||||||
|
|
||||||
|
:- private(partition/4).
|
||||||
|
:- mode(partition(+list, +nonvar, -list, -list), one).
|
||||||
|
:- info(partition/4, [
|
||||||
|
comment is 'List partition in two sub-lists using a pivot.',
|
||||||
|
argnames is ['List', 'Pivot', 'Lowers', 'Biggers']]).
|
||||||
|
|
||||||
|
sort([], []).
|
||||||
|
sort([P| L], S) :-
|
||||||
|
partition(L, P, Small, Large),
|
||||||
|
sort(Small, S0),
|
||||||
|
sort(Large, S1),
|
||||||
|
list::append(S0, [P| S1], S).
|
||||||
|
|
||||||
|
partition([], _, [], []).
|
||||||
|
partition([X| L1], P, Small, Large) :-
|
||||||
|
parameter(1, Type),
|
||||||
|
( Type::(X < P) ->
|
||||||
|
Small = [X| Small1], Large = Large1
|
||||||
|
; Small = Small1, Large = [X| Large1]
|
||||||
|
),
|
||||||
|
partition(L1, P, Small1, Large1).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(rational,
|
||||||
|
implements(comparingp)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Implements comparison between rational numbers represented as Num/Den.']).
|
||||||
|
|
||||||
|
N1/D1 < N2/D2 :-
|
||||||
|
{N1*D2 < N2*D1}.
|
||||||
|
|
||||||
|
N1/D1 =< N2/D2 :-
|
||||||
|
{N1*D2 =< N2*D1}.
|
||||||
|
|
||||||
|
N1/D1 > N2/D2 :-
|
||||||
|
{N1*D2 > N2*D1}.
|
||||||
|
|
||||||
|
N1/D1 >= N2/D2 :-
|
||||||
|
{N1*D2 >= N2*D1}.
|
||||||
|
|
||||||
|
N1/D1 =:= N2/D2 :-
|
||||||
|
{N1*D2 =:= N2*D1}.
|
||||||
|
|
||||||
|
N1/D1 =\= N2/D2 :-
|
||||||
|
{N1*D2 =\= N2*D1}.
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
:- object(colours,
|
||||||
|
implements(comparingp)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 2000/4/22,
|
||||||
|
comment is 'Implements comparison between visible colors.']).
|
||||||
|
|
||||||
|
Colour1 < Colour2 :-
|
||||||
|
order(Colour1, N1),
|
||||||
|
order(Colour2, N2),
|
||||||
|
{N1 < N2}.
|
||||||
|
|
||||||
|
Colour1 =< Colour2 :-
|
||||||
|
order(Colour1, N1),
|
||||||
|
order(Colour2, N2),
|
||||||
|
{N1 =< N2}.
|
||||||
|
|
||||||
|
Colour1 > Colour2 :-
|
||||||
|
order(Colour1, N1),
|
||||||
|
order(Colour2, N2),
|
||||||
|
{N1 > N2}.
|
||||||
|
|
||||||
|
Colour1 >= Colour2 :-
|
||||||
|
order(Colour1, N1),
|
||||||
|
order(Colour2, N2),
|
||||||
|
{N1 >= N2}.
|
||||||
|
|
||||||
|
Colour1 =:= Colour2 :-
|
||||||
|
{Colour1 == Colour2}.
|
||||||
|
|
||||||
|
Colour1 =\= Colour2 :-
|
||||||
|
{Colour1 \== Colour2}.
|
||||||
|
|
||||||
|
order(red, 1).
|
||||||
|
order(orange, 2).
|
||||||
|
order(yellow, 3).
|
||||||
|
order(green, 4).
|
||||||
|
order(blue, 5).
|
||||||
|
order(indigo, 6).
|
||||||
|
order(violet, 7).
|
||||||
|
|
||||||
|
:- end_object.
|
334
Logtalk/examples/symdiff/symdiff.lgt
Normal file
334
Logtalk/examples/symdiff/symdiff.lgt
Normal file
@ -0,0 +1,334 @@
|
|||||||
|
|
||||||
|
:- protocol(symdiffp).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 1999/12/29,
|
||||||
|
comment is 'Symbolic differentiation and simplification protocol.',
|
||||||
|
source is 'Example based on the Clocksin and Mellish Prolog book.']).
|
||||||
|
|
||||||
|
:- public(diff/1).
|
||||||
|
:- mode(diff(-expression), one).
|
||||||
|
:- info(diff/1, [
|
||||||
|
comment is 'Returns the symbolic differentiation of self.',
|
||||||
|
argnames is ['Expression']]).
|
||||||
|
|
||||||
|
:- public(simplify/1).
|
||||||
|
:- mode(simplify(-expression), one).
|
||||||
|
:- info(simplify/1, [
|
||||||
|
comment is 'Returns the symbolic simplification of self.',
|
||||||
|
argnames is ['Expression']]).
|
||||||
|
|
||||||
|
:- end_protocol.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(x,
|
||||||
|
implements(symdiffp)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 1999/12/29,
|
||||||
|
comment is 'Symbolic differentiation and simplification of a variable.',
|
||||||
|
source is 'Example based on the Clocksin and Mellish Prolog book.']).
|
||||||
|
|
||||||
|
diff(1).
|
||||||
|
|
||||||
|
simplify(x).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(_ + _,
|
||||||
|
implements(symdiffp)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 1999/12/29,
|
||||||
|
parnames is ['Expression1', 'Expression2'],
|
||||||
|
comment is 'Symbolic differentiation and simplification of +/2 expressions.',
|
||||||
|
source is 'Example based on the Clocksin and Mellish Prolog book.']).
|
||||||
|
|
||||||
|
diff(Diff) :-
|
||||||
|
this(X + Y),
|
||||||
|
once(diff(X, Y, Diff)).
|
||||||
|
|
||||||
|
diff(I, J, 0) :-
|
||||||
|
integer(I),
|
||||||
|
integer(J).
|
||||||
|
|
||||||
|
diff(X, J, DX) :-
|
||||||
|
integer(J),
|
||||||
|
X::diff(DX).
|
||||||
|
|
||||||
|
diff(I, Y, DY) :-
|
||||||
|
integer(I),
|
||||||
|
Y::diff(DY).
|
||||||
|
|
||||||
|
diff(X, Y, DX + DY) :-
|
||||||
|
X::diff(DX),
|
||||||
|
Y::diff(DY).
|
||||||
|
|
||||||
|
|
||||||
|
simplify(S) :-
|
||||||
|
this(X + Y),
|
||||||
|
once(simplify(X, Y, S)).
|
||||||
|
|
||||||
|
|
||||||
|
simplify(I, J, S) :-
|
||||||
|
integer(I),
|
||||||
|
integer(J),
|
||||||
|
S is I + J.
|
||||||
|
|
||||||
|
simplify(X, 0, S) :-
|
||||||
|
X::simplify(S).
|
||||||
|
|
||||||
|
simplify(0, Y, S) :-
|
||||||
|
Y::simplify(S).
|
||||||
|
|
||||||
|
simplify(X, J, S + J) :-
|
||||||
|
integer(J),
|
||||||
|
X::simplify(S).
|
||||||
|
|
||||||
|
simplify(I, Y, I + S) :-
|
||||||
|
integer(I),
|
||||||
|
Y::simplify(S).
|
||||||
|
|
||||||
|
simplify(X, Y, S) :-
|
||||||
|
X::simplify(SX),
|
||||||
|
Y::simplify(SY),
|
||||||
|
(X + Y \= SX + SY ->
|
||||||
|
(SX + SY)::simplify(S)
|
||||||
|
;
|
||||||
|
S = SX + SY).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(_ - _,
|
||||||
|
implements(symdiffp)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 1999/12/29,
|
||||||
|
parnames is ['Expression1', 'Expression2'],
|
||||||
|
comment is 'Symbolic differentiation and simplification of -/2 expressions.',
|
||||||
|
source is 'Example based on the Clocksin and Mellish Prolog book.']).
|
||||||
|
|
||||||
|
diff(Diff) :-
|
||||||
|
this(X - Y),
|
||||||
|
once(diff(X, Y, Diff)).
|
||||||
|
|
||||||
|
diff(I, J, 0) :-
|
||||||
|
integer(I),
|
||||||
|
integer(J).
|
||||||
|
|
||||||
|
diff(X, J, DX) :-
|
||||||
|
integer(J),
|
||||||
|
X::diff(DX).
|
||||||
|
|
||||||
|
diff(I, Y, DY) :-
|
||||||
|
integer(I),
|
||||||
|
Y::diff(DY).
|
||||||
|
|
||||||
|
diff(X, Y, DX - DY) :-
|
||||||
|
X::diff(DX),
|
||||||
|
Y::diff(DY).
|
||||||
|
|
||||||
|
|
||||||
|
simplify(S) :-
|
||||||
|
this(X - Y),
|
||||||
|
once(simplify(X, Y, S)).
|
||||||
|
|
||||||
|
|
||||||
|
simplify(X, X, 0).
|
||||||
|
|
||||||
|
simplify(I, J, S) :-
|
||||||
|
integer(I),
|
||||||
|
integer(J),
|
||||||
|
S is I - J.
|
||||||
|
|
||||||
|
simplify(X, 0, S) :-
|
||||||
|
X::simplify(S).
|
||||||
|
|
||||||
|
simplify(0, Y, S) :-
|
||||||
|
Y::simplify(S).
|
||||||
|
|
||||||
|
simplify(X, J, S - J) :-
|
||||||
|
integer(J),
|
||||||
|
X::simplify(S).
|
||||||
|
|
||||||
|
simplify(I, Y, I - S) :-
|
||||||
|
integer(I),
|
||||||
|
Y::simplify(S).
|
||||||
|
|
||||||
|
simplify(X, Y, S) :-
|
||||||
|
X::simplify(SX),
|
||||||
|
Y::simplify(SY),
|
||||||
|
(X - Y \= SX - SY ->
|
||||||
|
(SX - SY)::simplify(S)
|
||||||
|
;
|
||||||
|
S = SX - SY).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(_ * _,
|
||||||
|
implements(symdiffp)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 1999/12/29,
|
||||||
|
parnames is ['Expression1', 'Expression2'],
|
||||||
|
comment is 'Symbolic differentiation and simplification of */2 expressions.',
|
||||||
|
source is 'Example based on the Clocksin and Mellish Prolog book.']).
|
||||||
|
|
||||||
|
diff(Diff) :-
|
||||||
|
this(X * Y),
|
||||||
|
once(diff(X, Y, Diff)).
|
||||||
|
|
||||||
|
diff(I, J, 0) :-
|
||||||
|
integer(I),
|
||||||
|
integer(J).
|
||||||
|
|
||||||
|
diff(0, _, 0).
|
||||||
|
|
||||||
|
diff(_, 0, 0).
|
||||||
|
|
||||||
|
diff(X, J, J * DX) :-
|
||||||
|
integer(J),
|
||||||
|
X::diff(DX).
|
||||||
|
|
||||||
|
diff(I, Y, I * DY) :-
|
||||||
|
integer(I),
|
||||||
|
Y::diff(DY).
|
||||||
|
|
||||||
|
diff(X, Y, X * DY + DX * Y) :-
|
||||||
|
X::diff(DX),
|
||||||
|
Y::diff(DY).
|
||||||
|
|
||||||
|
|
||||||
|
simplify(S) :-
|
||||||
|
this(X * Y),
|
||||||
|
once(simplify(X, Y, S)).
|
||||||
|
|
||||||
|
|
||||||
|
simplify(I, J, S) :-
|
||||||
|
integer(I),
|
||||||
|
integer(J),
|
||||||
|
S is I * J.
|
||||||
|
|
||||||
|
simplify(0, _, 0).
|
||||||
|
|
||||||
|
simplify(_, 0, 0).
|
||||||
|
|
||||||
|
simplify(1, Y, SY) :-
|
||||||
|
Y::simplify(SY).
|
||||||
|
|
||||||
|
simplify(X, 1, SX) :-
|
||||||
|
X::simplify(SX).
|
||||||
|
|
||||||
|
simplify(I, Y, I * SY) :-
|
||||||
|
integer(I),
|
||||||
|
Y::simplify(SY).
|
||||||
|
|
||||||
|
simplify(X, J, J * SX) :-
|
||||||
|
integer(J),
|
||||||
|
X::simplify(SX).
|
||||||
|
|
||||||
|
simplify(X, Y, SX * SY) :-
|
||||||
|
X::simplify(SX),
|
||||||
|
Y::simplify(SY).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(_ ** _,
|
||||||
|
implements(symdiffp)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 1999/12/29,
|
||||||
|
parnames is ['Expression', 'Power'],
|
||||||
|
comment is 'Symbolic differentiation and simplification of **/2 expressions.',
|
||||||
|
source is 'Example based on the Clocksin and Mellish Prolog book.']).
|
||||||
|
|
||||||
|
diff(Diff) :-
|
||||||
|
this(X ** Y),
|
||||||
|
once(diff(X, Y, Diff)).
|
||||||
|
|
||||||
|
diff(X, Y, Y * X ** Y2 * DX) :-
|
||||||
|
integer(Y),
|
||||||
|
Y2 is Y - 1,
|
||||||
|
X::diff(DX).
|
||||||
|
|
||||||
|
diff(X, Y, Y * X ** Y2 * DX) :-
|
||||||
|
Y2 = Y - 1,
|
||||||
|
X::diff(DX).
|
||||||
|
|
||||||
|
|
||||||
|
simplify(S) :-
|
||||||
|
this(X ** Y),
|
||||||
|
once(simplify(X, Y, S)).
|
||||||
|
|
||||||
|
|
||||||
|
simplify(_, 0, 1).
|
||||||
|
|
||||||
|
simplify(X, 1, X).
|
||||||
|
|
||||||
|
simplify(X, Y, S ** Y) :-
|
||||||
|
integer(Y),
|
||||||
|
X::simplify(S).
|
||||||
|
|
||||||
|
simplify(X, Y, SX ** SY) :-
|
||||||
|
X::simplify(SX),
|
||||||
|
Y::simplify(SY).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
:- object(log(_),
|
||||||
|
implements(symdiffp)).
|
||||||
|
|
||||||
|
:- info([
|
||||||
|
author is 'Paulo Moura',
|
||||||
|
version is 1.0,
|
||||||
|
date is 1999/12/29,
|
||||||
|
parnames is ['Expression'],
|
||||||
|
comment is 'Symbolic differentiation and simplification of log/1 expressions.',
|
||||||
|
source is 'Example based on the Clocksin and Mellish Prolog book.']).
|
||||||
|
|
||||||
|
diff(Diff) :-
|
||||||
|
this(log(X)),
|
||||||
|
once(diff(X, Diff)).
|
||||||
|
|
||||||
|
diff(I, 0) :-
|
||||||
|
integer(I).
|
||||||
|
|
||||||
|
diff(X, DX * X ** -1) :-
|
||||||
|
X::diff(DX).
|
||||||
|
|
||||||
|
simplify(S) :-
|
||||||
|
this(log(X)),
|
||||||
|
once(simplify(X, S)).
|
||||||
|
|
||||||
|
simplify(1, 0).
|
||||||
|
|
||||||
|
simplify(I, Log) :-
|
||||||
|
integer(I),
|
||||||
|
Log is log(I).
|
||||||
|
|
||||||
|
simplify(X, X).
|
||||||
|
|
||||||
|
:- end_object.
|
113
Logtalk/examples/viewpoints/viewpoints.lgt
Normal file
113
Logtalk/examples/viewpoints/viewpoints.lgt
Normal file
@ -0,0 +1,113 @@
|
|||||||
|
|
||||||
|
% general information about Joe:
|
||||||
|
|
||||||
|
:- object(joePerson).
|
||||||
|
|
||||||
|
:- public(getOlder/0).
|
||||||
|
|
||||||
|
:- public(address/1).
|
||||||
|
|
||||||
|
:- public(age/1).
|
||||||
|
:- dynamic(age/1).
|
||||||
|
|
||||||
|
:- public(name/1).
|
||||||
|
|
||||||
|
:- public(phone/1).
|
||||||
|
|
||||||
|
:- public(score/1).
|
||||||
|
:- dynamic(score/1).
|
||||||
|
|
||||||
|
:- public(setScore/1).
|
||||||
|
|
||||||
|
getOlder :- % this predicate uses property sharing, i.e.
|
||||||
|
retract(age(Old)), % the property and its value are shared by all
|
||||||
|
New is Old + 1, % descendant prototypes/viewpoints; changes
|
||||||
|
asserta(age(New)). % are shared no matter which viewpoint receives
|
||||||
|
% the getOlder/1 message
|
||||||
|
address('8 Octave Street').
|
||||||
|
|
||||||
|
age(30).
|
||||||
|
|
||||||
|
name('John').
|
||||||
|
|
||||||
|
phone(11-11-11-11).
|
||||||
|
|
||||||
|
score(0). % default value for the score/1 property,
|
||||||
|
% shared by all descendant prototypes/viewpoints;
|
||||||
|
setScore(Score) :- % changing the default value results in
|
||||||
|
::retractall(score(_)), % in a local value stored in the descendant
|
||||||
|
::asserta(score(Score)). % prototype that received the setScore/1 message
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% information on Joe as an employee:
|
||||||
|
|
||||||
|
:- object(joeEmployee,
|
||||||
|
extends(joePerson)).
|
||||||
|
|
||||||
|
:- public(worksFor/1).
|
||||||
|
|
||||||
|
:- public(salary/1).
|
||||||
|
:- dynamic(salary/1).
|
||||||
|
|
||||||
|
:- public(giveRaise/1).
|
||||||
|
|
||||||
|
worksFor('ToonTown').
|
||||||
|
|
||||||
|
salary(1500).
|
||||||
|
|
||||||
|
giveRaise(Raise) :- % another example of property sharing
|
||||||
|
retract(salary(Old)),
|
||||||
|
New is Old + Raise,
|
||||||
|
asserta(salary(New)).
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% information on Joe as an chess player:
|
||||||
|
|
||||||
|
:- object(joeChessPlayer,
|
||||||
|
extends(joePerson)).
|
||||||
|
|
||||||
|
:- public(category/1).
|
||||||
|
|
||||||
|
category('National Master').
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% information on Joe as a movies fan:
|
||||||
|
|
||||||
|
:- object(joeFilmEnthusiast,
|
||||||
|
extends(joePerson)).
|
||||||
|
|
||||||
|
:- public(favActor/1).
|
||||||
|
:- public(favFilm/1).
|
||||||
|
:- public(favDirector/1).
|
||||||
|
|
||||||
|
favActor('Fred Filistone').
|
||||||
|
|
||||||
|
favFilm('The Wizard of Oz').
|
||||||
|
|
||||||
|
favDirector('Krzystof Kieslowski').
|
||||||
|
|
||||||
|
:- end_object.
|
||||||
|
|
||||||
|
|
||||||
|
% information on Joe as a sportsman:
|
||||||
|
|
||||||
|
:- object(joeSportsman,
|
||||||
|
extends(joePerson)).
|
||||||
|
|
||||||
|
:- public(sport/1).
|
||||||
|
:- public(stamina/1).
|
||||||
|
:- public(weight/1).
|
||||||
|
|
||||||
|
sport(snowboard).
|
||||||
|
|
||||||
|
stamina(30).
|
||||||
|
|
||||||
|
weight(111).
|
||||||
|
|
||||||
|
:- end_object.
|
Reference in New Issue
Block a user