Logtalk 2.22.4 files.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1232 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
pmoura
2005-01-13 12:22:42 +00:00
parent cd4fd05d45
commit a920e364c3
160 changed files with 838 additions and 465 deletions

View File

@@ -0,0 +1,20 @@
=================================================================
Logtalk - Object oriented extension to Prolog
Release 2.22.4
Copyright (c) 1998-2005 Paulo Moura. All Rights Reserved.
=================================================================
To load this example and for sample queries, please see the SCRIPT file.
This example illustrates the use of assignable variables and parametric
objects as alternative implementation to dynamic object predicates for
storing (backtracable) object state. For more information on assignable
variables please consult the URL:
http://www.kprolog.com/en/logical_assignment/
The objects in this example make use of the library category "assignvars".
This category contains an adaptation of the pure logical subset implementation
of assignable variables by Nobukuni Kino, which can be found on the URL above.

View File

@@ -0,0 +1,75 @@
=================================================================
Logtalk - Object oriented extension to Prolog
Release 2.22.4
Copyright (c) 1998-2005 Paulo Moura. All Rights Reserved.
=================================================================
% start by loading the "assignvars" category:
| ?- logtalk_load(library(assignvars)).
...
% now you are ready for loading the example:
| ?- logtalk_load(assignvars(loader)).
...
% rectangle example:
?- rectangle(2, 3, _)::(init, position(X0, Y0), move(3, 7), position(X1, Y1), move(2, 5), position(X2, Y2)).
X0 = 0
Y0 = 0
X1 = 3
Y1 = 7
X2 = 2
Y2 = 5
Yes
% finite state machine example:
| ?- fsm(T, I, F), fsm(T, I, F)::recognise([0,1,1,2,1,2,0]).
red-0-red
red-1-green
green-1-yellow
yellow-2-red
red-1-green
green-2-red
red-0-red
T = [red-0-red, red-1-green, red-2-red, yellow-0-red, yellow-1-green, yellow-2-red, green-0-yellow, ... -... -yellow, ... -...]
I = red
F = [red]
Yes
% finite state machine example:
| ?- fsm(T, I, F), !, fsm(T, I, F)::recognise([0,1,1,2,1,2,1,0]).
red-0-red
red-1-green
green-1-yellow
yellow-2-red
red-1-green
green-2-red
red-1-green
green-0-yellow
backtracking...
backtracking...
backtracking...
backtracking...
backtracking...
backtracking...
backtracking...
backtracking...
No

View File

@@ -0,0 +1,63 @@
% fsm(Transitions, Initial, Final)
%
% fsm(-list, -nonvar, -list)
fsm([red-0-red, red-1-green, red-2-red, % a simple finite state machine example
yellow-0-red, yellow-1-green, yellow-2-red,
green-0-yellow, green-1-yellow, green-2-red],
red,
[red]).
:- object(fsm(_transitions, _initial, _final),
imports(private::assignvars)).
:- info([
version is 1.0,
author is 'Paulo Moura',
date is 2005/1/8,
comment is 'A simple implementation of finite-state machines using assignable variables and parametric objects. Adapted from a similar example by Nobukuni Kino.',
parnames is ['Transitions', 'Initial state', 'Final states']]).
:- public(recognise/1).
:- mode(recognise(+list), zero_or_more).
:- info(recognise/1,
[comment is 'Recognise a list of events.',
argnames is ['Events']]).
recognise(Events) :-
parameter(2, Initial),
::assignable(Current, Initial),
recognise(Events, Current).
recognise([], State) :-
::State => Current,
final_state(Current).
recognise([Event| Events], State) :-
::State => Current,
transition(Event, Current, Next),
(write(Current-Event-Next), nl
;
write('backtracking...'), nl, fail),
::State <= Next,
recognise(Events, State).
transition(Event, Current, Next) :-
parameter(1, Transitions),
transition(Transitions, Event, Current, Next).
transition([Current-Event-Next| _], Event, Current, Next).
transition([_| Transitions], Event, Current, Next):-
transition(Transitions, Event, Current, Next).
final_state(State) :-
parameter(3, Final),
final_state(Final, State).
final_state([State| _], State).
final_state([_| States], State) :-
final_state(States, State).
:- end_object.

View File

@@ -0,0 +1,5 @@
:- initialization(
logtalk_load([
fsm3,
rectangle3])).

View File

@@ -0,0 +1,52 @@
:- object(rectangle(_width, _height, _position),
imports(private::assignvars)).
:- info([
version is 1.0,
author is 'Paulo Moura',
date is 2005/1/8,
comment is 'A simple implementation of a geometric rectangle using assignable variables and parametric objects.',
parnames is ['Width', 'Height', 'Position']]).
:- 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/2).
:- mode(move(+integer, +integer), one).
:- info(move/2, [
comment is 'Moves a rectangle to a new position.',
argnames is ['X', 'Y']]).
:- public(position/2).
:- mode(position(?integer, ?integer), zero_or_one).
:- info(position/2, [
comment is 'Rectangle current position.',
argnames is ['X', 'Y']]).
init :-
parameter(3, Position),
::assignable(Position, (0, 0)).
area(Area) :-
parameter(1, Width),
parameter(2, Height),
Area is Width*Height.
move(X, Y) :-
parameter(3, Position),
::Position <= (X, Y).
position(X, Y) :-
parameter(3, Position),
::Position => (X, Y).
:- end_object.