Logtalk 2.26.2 files.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1488 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
pmoura
parent
3455276aa2
commit
60fbc754f9
@ -1,70 +0,0 @@
|
||||
/*
|
||||
This example illustrates the use of the predicate directive alias/3 for
|
||||
defining alternative names for inherited predicates.
|
||||
*/
|
||||
|
||||
|
||||
% first, we define a simple parametric object for representing rectangles:
|
||||
|
||||
:- object(rectangle(_Width, _Height)).
|
||||
|
||||
:- public(width/1).
|
||||
:- public(height/1).
|
||||
:- public(area/1).
|
||||
|
||||
width(Width) :-
|
||||
parameter(1, Width).
|
||||
|
||||
height(Height) :-
|
||||
parameter(2, Height).
|
||||
|
||||
area(Area) :-
|
||||
::width(Width),
|
||||
::height(Height),
|
||||
Area is Width*Height.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% next, we define a square object which adds an alias, side/1, for the
|
||||
% inherited predicate width/1:
|
||||
|
||||
:- object(square(Side),
|
||||
extends(rectangle(Side, Side))).
|
||||
|
||||
:- alias(rectangle(_, _), width/1, side/1).
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% a similar example can be defined using ellipses and circles:
|
||||
|
||||
:- object(ellipse(_RX, _RY)).
|
||||
|
||||
:- public(rx/1).
|
||||
:- public(ry/1).
|
||||
:- public(area/1).
|
||||
|
||||
rx(Rx) :-
|
||||
parameter(1, Rx).
|
||||
|
||||
ry(Ry) :-
|
||||
parameter(2, Ry).
|
||||
|
||||
area(Area) :-
|
||||
::rx(Rx),
|
||||
::ry(Ry),
|
||||
Area is Rx*Ry*3.1415927.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% in this case, we define an alias named r/1 for the inherited
|
||||
% predicate rx/1:
|
||||
|
||||
:- object(circle(Radius),
|
||||
extends(ellipse(Radius, Radius))).
|
||||
|
||||
:- alias(ellipse(_, _), rx/1, r/1).
|
||||
|
||||
:- end_object.
|
||||
@ -1,14 +0,0 @@
|
||||
|
||||
:- object(albatross,
|
||||
imports(descriptors),
|
||||
extends(tubenose)).
|
||||
|
||||
|
||||
family(albatross).
|
||||
|
||||
size(large).
|
||||
|
||||
wings(long_narrow).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(ash_throated_flycatcher,
|
||||
imports(descriptors),
|
||||
extends(flycatcher)).
|
||||
|
||||
|
||||
throat(white).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(barn_swallow,
|
||||
imports(descriptors),
|
||||
extends(swallow)).
|
||||
|
||||
|
||||
tail(forked).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(black_footed_albatross,
|
||||
imports(descriptors),
|
||||
extends(albatross)).
|
||||
|
||||
|
||||
color(dark).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(california_condor,
|
||||
imports(descriptors),
|
||||
extends(vulture)).
|
||||
|
||||
|
||||
flight_profile(flat).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,12 +0,0 @@
|
||||
|
||||
:- object(canada_goose,
|
||||
imports(descriptors),
|
||||
extends(goose)).
|
||||
|
||||
|
||||
head(black).
|
||||
|
||||
cheek(white).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(cliff_swallow,
|
||||
imports(descriptors),
|
||||
extends(swallow)).
|
||||
|
||||
|
||||
tail(square).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,14 +0,0 @@
|
||||
|
||||
:- object(duck,
|
||||
imports(descriptors),
|
||||
extends(waterfowl)).
|
||||
|
||||
|
||||
family(duck).
|
||||
|
||||
feed(on_water_surface).
|
||||
|
||||
flight(agile).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,16 +0,0 @@
|
||||
|
||||
:- object(falcon,
|
||||
imports(descriptors),
|
||||
extends(falconiforms)).
|
||||
|
||||
|
||||
family(falcon).
|
||||
|
||||
wings(long_pointed).
|
||||
|
||||
head(large).
|
||||
|
||||
tail(narrow_at_tip).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,16 +0,0 @@
|
||||
|
||||
:- object(falconiforms,
|
||||
imports(descriptors),
|
||||
extends(order)).
|
||||
|
||||
|
||||
order(falconiforms).
|
||||
|
||||
eats(meat).
|
||||
|
||||
feet(curved_talons).
|
||||
|
||||
bill(sharp_hooked).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,12 +0,0 @@
|
||||
|
||||
:- object(female_mallard,
|
||||
imports(descriptors),
|
||||
extends(duck)).
|
||||
|
||||
|
||||
voice(quack).
|
||||
|
||||
color(mottled_brown).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,14 +0,0 @@
|
||||
|
||||
:- object(flycatcher,
|
||||
imports(descriptors),
|
||||
extends(passerformes)).
|
||||
|
||||
|
||||
family(flycatcher).
|
||||
|
||||
bill(flat).
|
||||
|
||||
eats(flying_insects).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,12 +0,0 @@
|
||||
|
||||
:- object(fulmar,
|
||||
imports(descriptors),
|
||||
extends(tubenose)).
|
||||
|
||||
|
||||
size(medium).
|
||||
|
||||
flight(flap_glide).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,14 +0,0 @@
|
||||
|
||||
:- object(goose,
|
||||
imports(descriptors),
|
||||
extends(waterfowl)).
|
||||
|
||||
|
||||
family(goose).
|
||||
|
||||
size(plump).
|
||||
|
||||
flight(powerful).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(great_crested_flycatcher,
|
||||
imports(descriptors),
|
||||
extends(flycatcher)).
|
||||
|
||||
|
||||
tail(long_rusty).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,11 +0,0 @@
|
||||
|
||||
:- object(laysan_albatross,
|
||||
imports(descriptors),
|
||||
extends(albatross)).
|
||||
|
||||
|
||||
color(white).
|
||||
|
||||
|
||||
:- end_object.
|
||||
|
||||
@ -1,12 +0,0 @@
|
||||
|
||||
:- object(male_mallard,
|
||||
imports(descriptors),
|
||||
extends(duck)).
|
||||
|
||||
|
||||
voice(quack).
|
||||
|
||||
head(green).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(order,
|
||||
imports(descriptors, proto_hierarchy)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,12 +0,0 @@
|
||||
|
||||
:- object(passerformes,
|
||||
imports(descriptors),
|
||||
extends(order)).
|
||||
|
||||
|
||||
order(passerformes).
|
||||
|
||||
feet(one_long_backward_toe).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(peregrine_falcon,
|
||||
imports(descriptors),
|
||||
extends(falcon)).
|
||||
|
||||
|
||||
eats(birds).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(pintail,
|
||||
imports(descriptors),
|
||||
extends(duck)).
|
||||
|
||||
|
||||
voice(short_whistle).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(purple_martin,
|
||||
imports(descriptors),
|
||||
extends(swallow)).
|
||||
|
||||
|
||||
color(dark).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(snow_goose,
|
||||
imports(descriptors),
|
||||
extends(goose)).
|
||||
|
||||
|
||||
color(white).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(sparrow_hawk,
|
||||
imports(descriptors),
|
||||
extends(falcon)).
|
||||
|
||||
|
||||
eats(insects).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,16 +0,0 @@
|
||||
|
||||
:- object(swallow,
|
||||
imports(descriptors),
|
||||
extends(passerformes)).
|
||||
|
||||
|
||||
family(swallow).
|
||||
|
||||
wings(long_pointed).
|
||||
|
||||
tail(forked).
|
||||
|
||||
bill(short).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,16 +0,0 @@
|
||||
|
||||
:- object(swan,
|
||||
imports(descriptors),
|
||||
extends(waterfowl)).
|
||||
|
||||
|
||||
family(swan).
|
||||
|
||||
neck(long).
|
||||
|
||||
color(white).
|
||||
|
||||
flight(ponderous).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(trumpeter_swan,
|
||||
imports(descriptors),
|
||||
extends(swan)).
|
||||
|
||||
|
||||
voice(loud_trumpeting).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,16 +0,0 @@
|
||||
|
||||
:- object(tubenose,
|
||||
imports(descriptors),
|
||||
extends(order)).
|
||||
|
||||
|
||||
order(tubenose).
|
||||
|
||||
nostrils(external_tubular).
|
||||
|
||||
live(at_sea).
|
||||
|
||||
bill(hooked).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(turkey_vulture,
|
||||
imports(descriptors),
|
||||
extends(vulture)).
|
||||
|
||||
|
||||
flight_profile(v_shaped).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,14 +0,0 @@
|
||||
|
||||
:- object(vulture,
|
||||
imports(descriptors),
|
||||
extends(falconiforms)).
|
||||
|
||||
|
||||
family(vulture).
|
||||
|
||||
feed(scavange).
|
||||
|
||||
wings(broad).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,14 +0,0 @@
|
||||
|
||||
:- object(waterfowl,
|
||||
imports(descriptors),
|
||||
extends(order)).
|
||||
|
||||
|
||||
order(waterfowl).
|
||||
|
||||
feet(webbed).
|
||||
|
||||
bill(flat).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,10 +0,0 @@
|
||||
|
||||
:- object(whistling_swan,
|
||||
imports(descriptors),
|
||||
extends(swan)).
|
||||
|
||||
|
||||
voice(muffled_musical_whistle).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,76 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,59 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,38 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(instance1,
|
||||
instantiates(root)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(instance2,
|
||||
instantiates(root)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(instance3,
|
||||
instantiates(root)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,29 +0,0 @@
|
||||
|
||||
:- object(root,
|
||||
instantiates(root)).
|
||||
|
||||
|
||||
:- 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 value is stored locally, in this class
|
||||
|
||||
|
||||
cv(Value) :-
|
||||
cv_(Value). % retrive cv value, shared for all instances
|
||||
|
||||
|
||||
set_cv(Value) :-
|
||||
retractall(cv_(_)), % retract old cv value from this class
|
||||
asserta(cv_(Value)). % assert the new value in this class
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,11 +0,0 @@
|
||||
|
||||
:- category(determiners).
|
||||
|
||||
|
||||
:- private(determiner//0).
|
||||
|
||||
determiner --> [the].
|
||||
determiner --> [a].
|
||||
|
||||
|
||||
:- end_category.
|
||||
@ -1,11 +0,0 @@
|
||||
|
||||
:- category(nouns).
|
||||
|
||||
|
||||
:- private(noun//0).
|
||||
|
||||
noun --> [boy].
|
||||
noun --> [girl].
|
||||
|
||||
|
||||
:- end_category.
|
||||
@ -1,22 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
noun_phrase --> ::noun.
|
||||
|
||||
verb_phrase --> ::verb.
|
||||
verb_phrase --> ::verb, noun_phrase.
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,11 +0,0 @@
|
||||
|
||||
:- category(verbs).
|
||||
|
||||
|
||||
:- private(verb//0).
|
||||
|
||||
verb --> [likes].
|
||||
verb --> [hates].
|
||||
|
||||
|
||||
:- end_category.
|
||||
@ -1,57 +0,0 @@
|
||||
/*
|
||||
These metafile objects illustrate a variant of the "diamond problem" using
|
||||
a prototype hierarchy.
|
||||
|
||||
In this simple case, the inherited definition which will be used in the
|
||||
bottom object is determined by the Logtalk predicate lookup algorithm.
|
||||
*/
|
||||
|
||||
|
||||
% root object, declaring and defining a predicate m/0:
|
||||
|
||||
:- object(a1).
|
||||
|
||||
:- public(m/0).
|
||||
|
||||
m :-
|
||||
this(This),
|
||||
write('Default definition of method m/0 in object '),
|
||||
write(This), nl.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% an object descending from the root object, which redefines predicate m/0:
|
||||
|
||||
:- object(b1,
|
||||
extends(a1)).
|
||||
|
||||
m :-
|
||||
this(This),
|
||||
write('Redefinition of method m/0 in object '),
|
||||
write(This), nl.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% another object descending from the root object, which also redefines predicate m/0:
|
||||
|
||||
:- object(c1,
|
||||
extends(a1)).
|
||||
|
||||
m :-
|
||||
this(This),
|
||||
write('Redefinition of method m/0 in object '),
|
||||
write(This), nl.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% bottom object, descending from the two previous objects and, as such, inheriting
|
||||
% two definitions for the predicate m/0:
|
||||
|
||||
:- object(d1,
|
||||
extends(b1, c1)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,64 +0,0 @@
|
||||
/*
|
||||
These metafile objects illustrate a variant of the "diamond problem" using
|
||||
a prototype hierarchy.
|
||||
|
||||
In this simple case, a solution for making the overridden definition inherited
|
||||
by the bottom object the visible one is implemented using the alias/3 predicate
|
||||
directive.
|
||||
*/
|
||||
|
||||
|
||||
% root object, declaring and defining a predicate m/0:
|
||||
|
||||
:- object(a2).
|
||||
|
||||
:- public(m/0).
|
||||
|
||||
m :-
|
||||
this(This),
|
||||
write('Default definition of method m/0 in object '),
|
||||
write(This), nl.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% an object descending from the root object, which redefines predicate m/0:
|
||||
|
||||
:- object(b2,
|
||||
extends(a2)).
|
||||
|
||||
m :-
|
||||
this(This),
|
||||
write('Redefinition of method m/0 in object '),
|
||||
write(This), nl.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% another object descending from the root object, which also redefines predicate m/0:
|
||||
|
||||
:- object(c2,
|
||||
extends(a2)).
|
||||
|
||||
m :-
|
||||
this(This),
|
||||
write('Redefinition of method m/0 in object '),
|
||||
write(This), nl.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% bottom object, descending from the two previous objects and, as such, inheriting
|
||||
% two definitions for the predicate m/0; the overridden definition inherited from
|
||||
% object "c2" is renamed using the alias/3 directive and then we redefined the
|
||||
% predicate m/0 to call the renamed definition:
|
||||
|
||||
:- object(d2,
|
||||
extends(b2, c2)).
|
||||
|
||||
:- alias(c2, m/0, c2_m/0).
|
||||
|
||||
m :-
|
||||
::c2_m.
|
||||
|
||||
:- end_object.
|
||||
@ -1,61 +0,0 @@
|
||||
/*
|
||||
These metafile objects illustrate a variant of the "diamond problem" using
|
||||
a prototype hierarchy.
|
||||
|
||||
In this simple case, a solution is presented for making two conflicting
|
||||
definitions inherited by the bottom object visible through the use of the
|
||||
alias/3 predicate directive.
|
||||
*/
|
||||
|
||||
|
||||
% root object, declaring and defining a predicate m/0:
|
||||
|
||||
:- object(a3).
|
||||
|
||||
:- public(m/0).
|
||||
|
||||
m :-
|
||||
this(This),
|
||||
write('Default definition of method m/0 in object '),
|
||||
write(This), nl.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% an object descending from the root object, which redefines predicate m/0:
|
||||
|
||||
:- object(b3,
|
||||
extends(a3)).
|
||||
|
||||
m :-
|
||||
this(This),
|
||||
write('Redefinition of method m/0 in object '),
|
||||
write(This), nl.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% another object descending from the root object, which also redefines predicate m/0:
|
||||
|
||||
:- object(c3,
|
||||
extends(a3)).
|
||||
|
||||
m :-
|
||||
this(This),
|
||||
write('Redefinition of method m/0 in object '),
|
||||
write(This), nl.
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
% bottom object, descending from the two previous objects and, as such, inheriting
|
||||
% two definitions for the predicate m/0; both inherited definitions are renamed
|
||||
% using the alias/3 directive:
|
||||
|
||||
:- object(d3,
|
||||
extends(b3, c3)).
|
||||
|
||||
:- alias(b3, m/0, b3_m/0).
|
||||
:- alias(c3, m/0, c3_m/0).
|
||||
|
||||
:- end_object.
|
||||
@ -1,12 +0,0 @@
|
||||
|
||||
:- object(class,
|
||||
instantiates(metaclass)).
|
||||
|
||||
|
||||
:- public(p1/1).
|
||||
|
||||
|
||||
p1(class).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(descendant,
|
||||
extends(root)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(instance,
|
||||
instantiates(class)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(metaclass,
|
||||
instantiates(metaclass)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,12 +0,0 @@
|
||||
|
||||
:- object(root).
|
||||
|
||||
|
||||
:- public(p/1).
|
||||
:- dynamic(p/1).
|
||||
|
||||
|
||||
p(root).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,67 +0,0 @@
|
||||
/*
|
||||
This is a simple example of category composition, i.e. importation of
|
||||
categories by other categories in order to provide modified components
|
||||
for building objects, using car engines.
|
||||
|
||||
The example defines a car engine protocol (enginep), a standard engine
|
||||
(classic), and an improved version of it (sport). Both engines are then
|
||||
imported in two car models (sedan and coupe).
|
||||
*/
|
||||
|
||||
|
||||
% first we define a protocol for describing the characteristics of an engine:
|
||||
|
||||
:- protocol(enginep).
|
||||
|
||||
:- public(reference/1).
|
||||
:- public(capacity/1).
|
||||
:- public(cylinders/1).
|
||||
:- public(horsepower_rpm/2).
|
||||
:- public(bore_stroke/2).
|
||||
:- public(fuel/1).
|
||||
|
||||
:- end_protocol.
|
||||
|
||||
|
||||
% second, we can define a typical engine as a category, which will be used
|
||||
% when "assembling" cars:
|
||||
|
||||
:- category(classic,
|
||||
implements(enginep)).
|
||||
|
||||
reference('M180.940').
|
||||
capacity(2195).
|
||||
cylinders(6).
|
||||
horsepower_rpm(94, 4800).
|
||||
bore_stroke(80, 72.8).
|
||||
fuel(gasoline).
|
||||
|
||||
:- end_category.
|
||||
|
||||
|
||||
% next, we define a souped up version of the previous engine, which differs
|
||||
% from the standard one only in its reference and in its horsepower:
|
||||
|
||||
:- category(sport,
|
||||
imports(classic)).
|
||||
|
||||
reference('M180.941').
|
||||
horsepower_rpm(110, 5000).
|
||||
|
||||
:- end_category.
|
||||
|
||||
|
||||
% with engines (and other components), we may start "assembling" some cars:
|
||||
|
||||
:- object(sedan,
|
||||
imports(classic)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
|
||||
|
||||
:- object(coupe,
|
||||
imports(sport)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(descendant1,
|
||||
imports(interface),
|
||||
extends(prototype1)).
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(descendant2,
|
||||
imports(interface),
|
||||
extends(prototype2)).
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(descendant3,
|
||||
imports(interface),
|
||||
extends(prototype3)).
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(instance1,
|
||||
instantiates(subclass1)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(instance2,
|
||||
instantiates(subclass2)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(instance3,
|
||||
instantiates(subclass3)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(parent,
|
||||
imports(predicates, interface)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,7 +0,0 @@
|
||||
|
||||
:- object(prototype1,
|
||||
imports(interface),
|
||||
extends(public::parent)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,7 +0,0 @@
|
||||
|
||||
:- object(prototype2,
|
||||
imports(interface),
|
||||
extends(protected::parent)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,7 +0,0 @@
|
||||
|
||||
:- object(prototype3,
|
||||
imports(interface),
|
||||
extends(private::parent)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,7 +0,0 @@
|
||||
|
||||
:- object(root,
|
||||
imports(predicates, interface),
|
||||
instantiates(root)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,7 +0,0 @@
|
||||
|
||||
:- object(subclass1,
|
||||
imports(interface),
|
||||
specializes(public::root)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,7 +0,0 @@
|
||||
|
||||
:- object(subclass2,
|
||||
imports(interface),
|
||||
specializes(protected::root)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,7 +0,0 @@
|
||||
|
||||
:- object(subclass3,
|
||||
imports(interface),
|
||||
specializes(private::root)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(instance1,
|
||||
instantiates(root)).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,13 +0,0 @@
|
||||
|
||||
:- object(instance2,
|
||||
instantiates(root)).
|
||||
|
||||
|
||||
method :-
|
||||
this(This),
|
||||
write('This is an overriding definition stored in the '),
|
||||
writeq(This),
|
||||
write(' instance itself.'), nl.
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,15 +0,0 @@
|
||||
|
||||
:- object(instance3,
|
||||
instantiates(root)).
|
||||
|
||||
|
||||
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.
|
||||
@ -1,15 +0,0 @@
|
||||
|
||||
:- object(root,
|
||||
instantiates(root)).
|
||||
|
||||
|
||||
:- public(method/0).
|
||||
|
||||
|
||||
method :-
|
||||
this(This),
|
||||
write('This is the default definition for the method, stored in class '),
|
||||
writeq(This), write('.'), nl.
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,22 +0,0 @@
|
||||
|
||||
:- object(proof_tree).
|
||||
|
||||
:- info([
|
||||
version is 1.0,
|
||||
date is 2004/5/2,
|
||||
author is 'Paulo Moura',
|
||||
comment is 'Meta-interpreter for pure Prolog.']).
|
||||
|
||||
:- 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.
|
||||
@ -1,23 +0,0 @@
|
||||
|
||||
:- object(solver).
|
||||
|
||||
:- info([
|
||||
version is 1.0,
|
||||
date is 2004/5/2,
|
||||
author is 'Paulo Moura',
|
||||
comment is 'Simple meta-interpreter for pure Prolog.']).
|
||||
|
||||
:- public(solve/1).
|
||||
:- mode(solve(+goal), zero_or_more).
|
||||
:- info(solve/1, [
|
||||
comment is 'Proofs goal.',
|
||||
argnames is ['Goal']]).
|
||||
|
||||
solve(true) :-
|
||||
!.
|
||||
solve((A, B)) :-
|
||||
!, solve(A), solve(B).
|
||||
solve(A) :-
|
||||
clause(A, B), solve(B).
|
||||
|
||||
:- end_object.
|
||||
@ -1,39 +0,0 @@
|
||||
|
||||
:- 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.']).
|
||||
|
||||
:- 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.
|
||||
@ -1,61 +0,0 @@
|
||||
|
||||
% sort code adopted from an example in 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).
|
||||
:- uses(tracer).
|
||||
|
||||
:- 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 '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) :-
|
||||
tracer::(
|
||||
trace(partition(Tail, Head, Small, Large)),
|
||||
trace(sort(Small, Sorted1)),
|
||||
trace(sort(Large, Sorted2))),
|
||||
list::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.
|
||||
@ -1,37 +0,0 @@
|
||||
|
||||
% example adopted from:
|
||||
% Programming Language Prolog Part 2, Modules
|
||||
% Committee Draft - January 14, 1998 X3J17/97/5
|
||||
|
||||
|
||||
:- object(tracer).
|
||||
|
||||
|
||||
:- info([
|
||||
version is 2,
|
||||
author is 'Paulo Moura',
|
||||
date is 2000/7/24,
|
||||
comment is 'Tracer for a goal call and exit ports.']).
|
||||
|
||||
|
||||
:- public(trace/1).
|
||||
:- metapredicate(trace(::)).
|
||||
|
||||
:- mode(trace(+callable), zero_or_more).
|
||||
|
||||
:- info(trace/1, [
|
||||
comment is '.',
|
||||
argnames is ['Goal']]).
|
||||
|
||||
|
||||
trace(Goal) :-
|
||||
write('call: '), writeq(Goal), nl,
|
||||
call(Goal),
|
||||
write('exit: '), writeq(Goal), nl.
|
||||
|
||||
trace(Goal) :-
|
||||
write('fail: '), writeq(Goal), nl,
|
||||
fail.
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,28 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,16 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,15 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,6 +0,0 @@
|
||||
|
||||
:- object(space_time(X, Y, Z, T),
|
||||
extends(space(X, Y, Z), time(T))).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,26 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,13 +0,0 @@
|
||||
|
||||
:- object(time(_T)).
|
||||
|
||||
|
||||
:- public(time/1).
|
||||
:- mode(time(?integer), zero_or_one).
|
||||
|
||||
|
||||
time(Time) :-
|
||||
parameter(1, Time).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,57 +0,0 @@
|
||||
|
||||
:- object(date(_Year, _Month, _Day)).
|
||||
|
||||
|
||||
:- info([
|
||||
version is 1.0,
|
||||
author is 'Paulo Moura',
|
||||
date is 1998/3/23,
|
||||
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)},
|
||||
parameter(1, Year),
|
||||
parameter(2, Month),
|
||||
parameter(3, Day).
|
||||
|
||||
|
||||
leap_year :-
|
||||
parameter(1, Year),
|
||||
(0 is mod(Year, 4),
|
||||
0 is mod(Year, 100)
|
||||
;
|
||||
0 is mod(Year, 400)),
|
||||
!.
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,45 +0,0 @@
|
||||
|
||||
:- object(time(_Hours, _Mins, _Secs)).
|
||||
|
||||
|
||||
:- info([
|
||||
version is 1.0,
|
||||
author is 'Paulo Moura',
|
||||
date is 1998/3/23,
|
||||
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)},
|
||||
parameter(1, Hours),
|
||||
parameter(2, Mins),
|
||||
parameter(3, Secs).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,70 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,54 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,46 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,43 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,57 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,51 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,70 +0,0 @@
|
||||
|
||||
:- 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(_, _), transX(_), transY(_)]).
|
||||
|
||||
activ_points_(x2, before, []).
|
||||
activ_points_(x2, after, [move(_, _), transX(_), transY(_)]).
|
||||
|
||||
|
||||
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, transX(X), Polygon, _, Tuple) :-
|
||||
select(Polygon, Tuple, Polygons),
|
||||
!,
|
||||
forall(
|
||||
(member(Polygon2, Polygons), \+ Polygon2::position(X, _)),
|
||||
{Polygon2::transX(X)}).
|
||||
|
||||
propagate(after, transY(Y), Polygon, _, Tuple) :-
|
||||
select(Polygon, Tuple, Polygons),
|
||||
!,
|
||||
forall(
|
||||
(member(Polygon2, Polygons), \+ Polygon2::position(_, Y)),
|
||||
{Polygon2::transY(Y)}).
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,20 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,20 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,68 +0,0 @@
|
||||
|
||||
:- object(polygon,
|
||||
instantiates(abstract_class),
|
||||
specializes(object)).
|
||||
|
||||
|
||||
:- info([
|
||||
version is 1.1,
|
||||
date is 2000/10/31,
|
||||
author is 'Paulo Moura',
|
||||
comment is 'Polygon predicates.']).
|
||||
|
||||
|
||||
:- public(move/2).
|
||||
:- mode(move(+integer, +integer), one).
|
||||
|
||||
:- public(number_of_sides/1).
|
||||
:- mode(number_of_sides(?integer), zero_or_one).
|
||||
|
||||
:- private(position_/2).
|
||||
:- dynamic(position_/2).
|
||||
:- mode(position_(?integer, ?integer), zero_or_one).
|
||||
|
||||
:- public(position/2).
|
||||
:- mode(position(?integer, ?integer), zero_or_one).
|
||||
|
||||
|
||||
:- info([
|
||||
version is 2,
|
||||
date is 1998/2/23,
|
||||
author is 'Paulo Moura',
|
||||
comment is 'Default protocol for all polygons.']).
|
||||
|
||||
|
||||
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.
|
||||
|
||||
@ -1,20 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,20 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
@ -1,38 +0,0 @@
|
||||
|
||||
:- object(abstract_class,
|
||||
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 :-
|
||||
self(Self),
|
||||
Self \= abstract_class.
|
||||
|
||||
|
||||
metaclass :-
|
||||
self(Self),
|
||||
once((
|
||||
instantiates_class(Class, Self),
|
||||
Class::current_predicate(abstract_class/0))).
|
||||
|
||||
|
||||
strict_instance :-
|
||||
fail.
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,46 +0,0 @@
|
||||
|
||||
:- object(class,
|
||||
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 :-
|
||||
fail.
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,33 +0,0 @@
|
||||
|
||||
:- object(object,
|
||||
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.
|
||||
|
||||
|
||||
print :-
|
||||
self(Self),
|
||||
write('Object: '), writeq(Self), nl, nl,
|
||||
write(' interface:'), nl,
|
||||
forall(
|
||||
::current_predicate(Predicate),
|
||||
(write(' '), writeq(Predicate), nl)),
|
||||
nl.
|
||||
|
||||
|
||||
:- end_object.
|
||||
@ -1,212 +0,0 @@
|
||||
|
||||
:- 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.
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user