-----------------------------------------------
-- Пример программы на Акторном Прологе. --
-- (c) 2003, Алексей А. Морозов, ИРЭ РАН. --
-- Построение теоретико-модельной семантики. --
-----------------------------------------------
-- Тест. Вычисление фрагмента --
-- теоретико-модельной семантики. --
-----------------------------------------------
project: (('Example'))
-----------------------------------------------
class 'Example':
--
p1 = ('C1');
--
-- Порядок определений слотов изменён чтобы
-- ускорить работу тестовой программы.
--
p3 = ('C3',
receiver=p1,
input=data);
--
p2 = ('C2',
target=p1,
output=data);
--
data;
--
con = ('Console');
--
[
--
-- В предикат goal внесены изменения. Теперь он
-- осуществляет перебор с откатом и печатает
-- все найденные значения слота data.
--
goal:-
con ? writeln(data),
fail.
]
-----------------------------------------------
class 'C1':
--
internal_data;
--
[
goal:-
accept(internal_data).
--
accept(_).
--
message1(A):-
internal_data== A.
--
function1()= 100.
function1()= 300.
function1()= internal_data.
]
-----------------------------------------------
class 'C2':
--
target;
output;
--
data;
--
e = ('Element');
s = ('Sort');
g = ('Ground');
--
[
goal:-
setof([],ListOfResults),
data== ListOfResults,
native_goal.
--
native_goal:-
output == data.
--
setof(List,Total):-
another_solution_does_not_exist(List),
s ? sort(List,Total).
setof(List,Total):-
Result== target ? function1(),
g ? ground_term(Result),
e ? is_not_element(Result,List),
setof([Result|List],Total).
--
another_solution_does_not_exist(List):-
another_solution_does_exist(List),!,
fail.
another_solution_does_not_exist(_).
--
another_solution_does_exist(List):-
Result== target ? function1(),
g ? ground_term(Result),
e ? is_not_element(Result,List).
]
-----------------------------------------------
class 'C3':
--
input;
receiver;
--
g = ('Ground');
--
[
goal:-
input == #.
goal:-
g ? ground_term(input),
is_not_suspending_value(input),
native_goal.
--
is_not_suspending_value(#):-!,
fail.
is_not_suspending_value(_).
--
native_goal.
]
-----------------------------------------------
-- В классе 'Ground' реализован --
-- вспомогательный предикат ground_term. --
-----------------------------------------------
class 'Ground' specializing 'Alpha':
[
goal:-!.
--
ground_term(T):-
simple_ground_term(T).
ground_term(L):-
ground_term(1,3,1,3,L).
--
ground_term(_,_,_,_,T):-
simple_ground_term(T).
ground_term(N,MaxN,K,MaxK,L):-
ground_list(N,MaxN,K,MaxK,L).
--
simple_ground_term(#).
simple_ground_term(100).
simple_ground_term(300).
--
-- В предикат ground_list внесены изменения,
-- чтобы ограничить глубину рекурсии и тем
-- самым искусственно предотвратить
-- построение списков бесконечной длины.
--
ground_list(_,_,_,_,[]).
ground_list(N,MaxN,K,MaxK,[H|Tail]):-
N <= MaxN,
K <= MAxK,
ground_term(1,3,K+1,MaxK,H),
ground_list(N+1,MaxN,K,MaxK,Tail).
]
-----------------------------------------------
-- В классе 'Element' реализован --
-- вспомогательный предикат is_not_element. --
-----------------------------------------------
class 'Element':
[
goal.
--
is_not_element(A,List):-
is_element(A,List),!,
fail.
is_not_element(_,_).
--
is_element(A,[A|_]).
is_element(A,[_|List]):-
is_element(A,List).
]
-----------------------------------------------
-- В классе 'Sort' реализован --
-- вспомогательный предикат sort. --
-----------------------------------------------
class 'Sort' specializing 'Alpha':
--
g = ('Ground');
--
[
goal:-!.
--
sort([],[]).
sort([E|L1],L4):-
sort(L1,L3),
insert(E,L3,L4).
--
insert(E,[],[E]).
insert(E,[E|L],[E|L]).
insert(E,[X|L1],[X|L2]):-
less(E,X),
insert(E,L1,L2).
insert(E,[X|L],[E,X|L]):-
less(X,E).
--
less(A,B):-
g ? ground_term(A),
integer(A),
g ? ground_term(B),
integer(B),
A < B.
less(#,A):-
g ? ground_term(A),
integer(A).
less(#,[]).
less(#,[_|_]).
less(A,[]):-
g ? ground_term(A),
integer(A).
less(A,[_|_]):-
g ? ground_term(A),
integer(A).
less([A|T1],[A|T2]):-
less(T1,T2).
less([A|_],[B|_]):-
less(A,B).
]
-----------------------------------------------
|