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:
20
Logtalk/examples/assignvars/NOTES
Normal file
20
Logtalk/examples/assignvars/NOTES
Normal 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.
|
75
Logtalk/examples/assignvars/SCRIPT
Normal file
75
Logtalk/examples/assignvars/SCRIPT
Normal 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
|
63
Logtalk/examples/assignvars/fsm3.lgt
Normal file
63
Logtalk/examples/assignvars/fsm3.lgt
Normal 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.
|
5
Logtalk/examples/assignvars/loader.lgt
Normal file
5
Logtalk/examples/assignvars/loader.lgt
Normal file
@@ -0,0 +1,5 @@
|
||||
|
||||
:- initialization(
|
||||
logtalk_load([
|
||||
fsm3,
|
||||
rectangle3])).
|
52
Logtalk/examples/assignvars/rectangle3.lgt
Normal file
52
Logtalk/examples/assignvars/rectangle3.lgt
Normal 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.
|
Reference in New Issue
Block a user