----------------------------------------------- -- Пример программы на Акторном Прологе. -- -- (c) 2003, Алексей А. Морозов, ИРЭ РАН. -- -- Построение теоретико-модельной семантики. -- ----------------------------------------------- -- Шаг 4. Моделирование резидентов. -- ----------------------------------------------- project: (('Example')) ----------------------------------------------- class 'Example': -- p1 = ('C1'); -- p2 = ('C2', target=p1, protecting:output=data); -- p3 = ('C3', receiver=p1, input=data); -- data; -- [ goal. ] ----------------------------------------------- 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 /* = target ?? function1() */ ; -- 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),!, -- Отсечение "!" служит для -- моделирования операции not. 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:- receiver <- message1(input). ] ----------------------------------------------- -- В классе 'Ground' реализован -- -- вспомогательный предикат ground_term. -- ----------------------------------------------- class 'Ground': [ goal. -- ground_term(T):- simple_ground_term(T). ground_term(L):- ground_list(L). -- simple_ground_term(#). simple_ground_term(100). simple_ground_term(300). -- ground_list([]). ground_list([H|Tail]):- ground_term(H), ground_list(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. -- ----------------------------------------------- -- Класс 'Sort' является потомком -- -- предопределённого класса 'Alpha', в -- -- котором, в частности, реализованы -- -- предикаты для работы с целыми числами: -- -- integer/1, проверяющий, является ли -- -- аргумент целым числом, и арифметическое -- -- сравнение "<". -- ----------------------------------------------- class 'Sort' specializing 'Alpha': -- g = ('Ground'); -- [ goal:-!. -- Отсечение "!" использовано -- потому, что предикат goal -- уже реализован в классе -- 'Alpha'. На декларативную -- семантику программы оно не -- влияет. -- 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. -- Перед integer/1 вызывается -- ground_term, чтобы использование -- этого предиката было корректным -- при любых (в том числе, несвязанных) -- значениях аргумента. 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). ] ----------------------------------------------- |