------------------------------------------------------------------
-- An example of Actor Prolog program. --
-- (c) 2002, Alexei A. Morozov, IRE RAS. --
------------------------------------------------------------------
-- A SYNTHESIS OF MULTIPLICATION ALGORITHMS WITH THE HELP OF --
-- UNDERDETERMINED SETS AND FUNCTIONS IN ACTOR PROLOG. --
-- Input data of the program: --
-- 1) Some target function including integer multiplication and --
-- adding operations. --
-- 2) A definition of the multiplication and the adding. --
-- 3) Rules of use of cycles and branches in programs --
-- (all second order rules are defined with the help of --
-- underdetermined sets). --
-- THE PROBLEM TO BE SOLVED BY THE PROGRAM: --
-- The program must create algorithms implementing given target --
-- function with the help of adding and shift commands only. --
-- In particular, it must synthesize cycles for implementing --
-- the multiplying operations. --
-- The algorithms must be written in Ada language. --
------------------------------------------------------------------
-- Goal statement of the program --
------------------------------------------------------------------
project:
(('TRANSLATOR',
function = ('*',
input1 = ('DATA',
name="a"),
input2 = ('DATA',
name="b")),
report = ('ADA')))
------------------------------------------------------------------
-- Class 'TRANSLATOR' --
------------------------------------------------------------------
class 'TRANSLATOR' specializing 'RULES':
--
con = ('Console');
help_1 = ('Report',
title="TARGET",x=0,y=0,width=20,height=3);
function = ('TEST');
report;
format_output = ('FORMAT',device=help_1);
--
[
------------------------------------------------------------------
-- The problem to be solved --
------------------------------------------------------------------
goal:-
con ? show,
synthesis(Heading,Program),
spypoint('no_trace'),
report ? target_program(0,Heading,Program),
fail.
goal:-
true.
synthesis(TARGET_FUNCTION,
program([
declare([R|VARIABLES]),
input_list(VARIABLES),
'is'(R,X),
output(R)])):-
TARGET_FUNCTION== function ? value(),
create_list_of_variables(TARGET_FUNCTION,[],VARIABLES),
R == {value:"r"},
show_help_windows(TARGET_FUNCTION),
X == ?compute(TARGET_FUNCTION,0,_).
show_help_windows(TARGET_FUNCTION):-
help_1 ? write(" "),
format_output ? output(TARGET_FUNCTION),
report ? show_help_2,
fail.
show_help_windows(_).
------------------------------------------------------------------
-- Analysis of target function --
------------------------------------------------------------------
create_list_of_variables('*'(Right,Left),L1,L3):-!,
create_list_of_variables(Right,L1,L2),
create_list_of_variables(Left,L2,L3).
create_list_of_variables('+'(Right,Left),L1,L3):-!,
create_list_of_variables(Right,L1,L2),
create_list_of_variables(Left,L2,L3).
create_list_of_variables(Variable,Rest,Rest):-
is_member(Variable,Rest),!.
create_list_of_variables(Variable,Rest,[Variable|Rest]):-
Variable == {value:Symbol|_},
symbol(Symbol),!.
create_list_of_variables(Variable,Rest,[Variable|Rest]):-
Variable == {value:String|_},
string(String),!.
create_list_of_variables(_,Rest,Rest).
is_member(Variable,[Variable|_]):-!.
is_member(Variable,[_|Rest]):-
is_member(Variable,Rest).
------------------------------------------------------------------
]
------------------------------------------------------------------
-- Class 'TEST' --
------------------------------------------------------------------
class 'TEST' specializing 'TARGET':
--
value_A = {value:'a',even:'all',positive:'yes'};
value_B = {value:'b',even:'all',positive:'yes'};
value_C = {value:'c',even:'all',positive:'yes'};
value_D = {value:'d',even:'all',positive:'yes'};
test_value = '*'(value_A,'+'(value_B,'*'(value_C,value_D)));
--
[
value() = test_value.
]
------------------------------------------------------------------
-- Some dummy classes for definition --
-- of target function ('*', '+', 'DATA') --
------------------------------------------------------------------
class '*' specializing 'F':
[
f({value:X|_},{value:Y|_})
= {value:Z,even:Ze,positive:Zp}
:-
integer(X),
integer(Y),!,
Z== X * Y,
is_even(Z,Ze),
is_positive(Z,Zp).
f(X,Y) = '*'(X,Y).
]
------------------------------------------------------------------
class '+' specializing 'F':
[
f({value:X|_},{value:Y|_})
= {value:Z,even:Ze,positive:Zp}
:-
integer(X),
integer(Y),!,
Z== X + Y,
is_even(Z,Ze),
is_positive(Z,Zp).
f(X,Y) = '+'(X,Y).
]
------------------------------------------------------------------
class 'F' specializing 'TARGET':
input1;
input2;
[
value() = ?f(X,Y) :-
X== input1 ? value(),
Y== input2 ? value().
]
------------------------------------------------------------------
class 'DATA' specializing 'TARGET':
--
name;
window = ('Report',
title= "[Syntax error]",
height= 5,
width= 31,
y= 11,
x= 25);
--
[
value()= {value:name,even:Flag1,positive:Flag2}
:-
integer(name),!,
is_even(name,Flag1),
is_positive(name,Flag2).
value()= _ :-
real(name),!,
window ? write("\n Real values are not allowed !"),
fail.
value()= {value:name,even:'all',positive:'yes'}.
]
------------------------------------------------------------------
class 'TARGET' specializing 'ALPHA':
[
is_even(X,'yes'):- even(X),!.
is_even(_,'no').
is_positive(X,'yes'):- X > 0,!.
is_positive(0,'zero_valued'):-!.
is_positive(_,'no').
]
------------------------------------------------------------------
-- Definition of operation '*' --
------------------------------------------------------------------
class 'RULES' specializing 'SECOND_ORDER_RULES':
[
'*'{index:A|_} = {value:0} :-
is_zero(A).
'*'{index:A,argument_2:B|REST}
= ?'*'{index:?half(A),argument_2:('+'(B,B))|REST}
:-
positive(A),
is_even(A).
'*'{index:A,argument_2:B|REST}
= {value:'+'(
?get_value(
?'*'{
index:?plus(A,-1),
argument_2:B|REST} ),
B)}
:-
positive(A),
is_odd(A).
is_zero(0).
is_zero({positive:'zero_valued'|_}).
get_value({value:X})
= X.
]
------------------------------------------------------------------
-- The second order rules --
------------------------------------------------------------------
class 'SECOND_ORDER_RULES' specializing 'ALPHA':
--
w = ('Report',
title="RESOLUTION TREE",
x=35,y=0,height=3,width=45);
--
con = ('Console');
[
------------------------------------------------------------------
-- Definition of block --
------------------------------------------------------------------
compute({value:V|R},VN,VN)
= {value:V|R}.
compute('+'(A,B),VN1,VN5)
= ?internal_block(ANALOG_A,ANALOG_B,R1,R2,R3)
:-
ANALOG_A == ?analog(A,VN1,VN2),
ANALOG_B == ?analog(B,VN2,VN3),
R1 == ?compute(A,VN3,VN4),
R2 == ?compute(B,VN4,VN5),
w ? write(" {}"),
R3 == {value:'+'(ANALOG_A,ANALOG_B)}.
compute('*'(A,B),VN1,VN6)
= ?internal_block(ANALOG_A,ANALOG_B,R1,R2,R3)
:-
positive(A),!,
ANALOG_A == ?analog(A,VN1,VN2),
ANALOG_B == ?analog(B,VN2,VN3),
R1 == ?compute(A,VN3,VN4),
R2 == ?compute(B,VN4,VN5),
w ? write(" {"),
R3 == ?'*'{
index:ANALOG_A,
argument_2:ANALOG_B,
vn:vn(VN5,VN6) },
w ? write(" }").
compute('*'(B,A),VN1,VN6)
= ?internal_block(ANALOG_A,ANALOG_B,R1,R2,R3)
:-
positive(A),!,
ANALOG_A == ?analog(A,VN1,VN2),
ANALOG_B == ?analog(B,VN2,VN3),
R1 == ?compute(A,VN3,VN4),
R2 == ?compute(B,VN4,VN5),
w ? write(" {"),
R3 == ?'*'{
index:ANALOG_A,
argument_2:ANALOG_B,
result:R3,
vn:vn(VN5,VN6) },
w ? write(" }").
internal_block(ANALOG_A,ANALOG_B,R1,R2,R3)
= [
declare([ANALOG_A,ANALOG_B]),
'is'(ANALOG_A,R1),
'is'(ANALOG_B,R2),
R3
].
------------------------------------------------------------------
-- Definition of DO-OD operation --
-- --
-- Invariant: (For all S,Arg,XNew) F(X,A)=S+F(Arg,XNew) --
-- Guard: (XNew=0) => S=F(X,A) because F(0,_)=0 & Invariant --
-- Loop beginning: --
-- F(XNew,ArgEnd)=SEnd --
-- F(XNew,Arg)=S1 <= F(XEnd,ArgEnd)=SEnd & '*' definition --
-- For all loops: --
-- F(X,A)=F(XNew,Arg)+S => --
-- F(X,A)=F(XEnd,ArgEnd)+SEnd --
------------------------------------------------------------------
loop_result(X,Xnew,X1,A,Arg,A1,S,S1)
= [
?declare_do_od(S,XNew,Arg),
'is'(S,0),
'is'(XNew,X),
'is'(Arg,A),
?do_od_block(XNew,X1,Arg,A1,S,S1),
S].
declare_do_od(S,XNew,Arg)
= declare([S,XNew,Arg]).
do_od_block(XNew,X1,Arg,A1,S,S1)
= do( neq(XNew,0),
['is'(S,S1),'is'(Arg,A1),'is'(XNew,X1)]).
F{index:X,argument_2:A,vn:vn(VN1,VN5)|REST}
= {value:RESULT}
:-
positive(X),
XNew == ?analog(X,VN1,VN2),
S == ?newname(VN2,VN3),
Arg == ?newname(VN3,VN4),
0 == ?get_value(?F{
index:0,
argument_2:'any',
in_loop:b(XNew,S)|REST }),
w ? write(" DO"),
S1 == ?get_value(?F{
index:XNew,
argument_2:Arg,
in_loop:b(Xnew,S),
private:p(X1,A1),
vn:vn(VN4,VN5)|REST }),
RESULT == ?loop_result(X,Xnew,X1,A,Arg,A1,S,S1),
w ? write(" OD").
_{index:XEnd,argument_2:ArgEnd,
in_loop:b(XNew,SEnd),
private:p(XEnd,ArgEnd),vn:vn(VN,VN)|_}
= {value:SEnd}
:-
is_less(XEnd,XNew).
------------------------------------------------------------------
-- Definition of IF-FI operation --
------------------------------------------------------------------
F{index:Q,
private:p('if'([guard(odd(Q),P1),guard(even(Q),P2)]),
'if'([guard(odd(Q),A1),guard(even(Q),A2)]))|REST}
= {value:'if'([
guard(odd(Q),Z1),guard(even(Q),Z2)])}
:-
Q == {even:'all'|_},
Q1 == ?synonym1(Q),
Q2 == ?synonym1(Q),
is_odd(Q1),
is_even(Q2),
w ? write(" IF"),
Z1 == ?get_value(?F{index:Q1,private:p(P1,A1)|REST}),
Z2 == ?get_value(?F{index:Q2,private:p(P2,A2)|REST}),
w ? write(" FI").
------------------------------------------------------------------
-- Other operations --
------------------------------------------------------------------
half(0) = {value:0}.
half(s(s(A)))
= {value:s(?get_value(?half(A)))}.
half({value:N,even:'yes',positive:U})
= {value:half(N),even:'no',positive:U}.
plus(s(A),-1)
= {value:A}.
plus({value:A,even:E|_},-1)
= {value:'+'(A,-1),even:NoE}
:-
not(E,NoE).
not('yes','no').
not('no','yes').
positive(s(0)).
positive(half(A)):-
positive(A).
positive(s(A)):-
positive(A).
positive({positive:'yes'|_}).
is_even(0).
is_even(s(A)):-
is_odd(A).
is_even({even:'yes'|_}).
is_odd(s(A)):-
is_even(A).
is_odd({even:'no'|_}).
is_less(half(X),X):-!.
is_less({value:half(X)|_},{value:X|_}):-!.
is_less({value:half(X)|_},{value:X1|_}):-!,
is_less(X,X1).
is_less('+'(X,-1),X):-!.
is_less({value:'+'(X,-1)|_},{value:X|_}):-!.
is_less({value:'+'(X,-1)|_},{value:X1|_}):-
is_less(X,X1).
synonym1({value:A,even:_|R})
= {value:A,even:_|R}
:- !.
synonym1(A)
= {value:A,even:_}.
analog({value:_|REST},VN1,VN2)
= {value:?newname(VN1,VN2)|REST}.
analog('+'(_,_),VN1,VN2)
= {value:?newname(VN1,VN2),even:'all',positive:'yes'}.
analog('*'(_,_),VN1,VN2)
= {value:?newname(VN1,VN2),even:'all',positive:'yes'}.
neq(A,A):-!,
fail.
neq(_,_).
newname(VN1,VN2) = name(VN1) :-
VN2== VN1 + 1.
]
------------------------------------------------------------------
-- Syntax of target language --
------------------------------------------------------------------
class 'LANGUAGE' specializing 'Report':
--
help_2 = ('Report',title="OUTPUT",x=20,y=0,width=15,height=3);
--
title = "PROGRAM";
x = 0;
y = 3;
height = 22;
--
con = ('Console');
[
target_program(T,Heading,program(P)):-!,
nl(),
write_heading(T,Heading),
main_block(T,"",P),
write_end_of_program(T).
tab(0):-!.
tab(T):-!,
write(" "),
T1== T - 1,
tab(T1).
]
------------------------------------------------------------------
-- The syntax of Ada --
------------------------------------------------------------------
class 'ADA' specializing 'LANGUAGE':
--
help_2;
comment = "14.3.1994";
format_output = ('FORMAT',device=self);
--
[
show_help_2:-
help_2 ? write(" ADA").
write_heading(T,Heading):-
tab(T),
writeln("----------------------------------------------"),
tab(T),
writeln("-- A multiplication algorithm --"),
tab(T),
writeln("-- created by Actor Prolog. --"),
tab(T),
writeln("-- (c) 2002, Alexei A. Morozov, IRE RAS. --"),
tab(T),
writeln("----------------------------------------------"),
tab(T),
writeln("-- The begining of program"),
tab(T),
write("-- Target function: "),
format_output ? output(Heading),
nl,
tab(T),
writeln("with TEXT_IO;"),
tab(T),
writeln("use TEXT_IO;"),
tab(T),
writeln("procedure EXAMPLE is"),
tab(T),
writeln("package IO_INT is new INTEGER_IO(INTEGER);"),
tab(T),
writeln("use IO_INT;"),
fail.
write_heading(_,_).
write_end_of_program(T):-
tab(T),
writeln("-- The end of program").
variable_name(Name):-
free(Name),!,
write("Error!"),
break('unbound_value').
variable_name({value:Object|_}):-!,
variable_name(Object).
variable_name(name(N)):-!,
write("VAR",N).
variable_name(S):-
symbol(S),!, write(S).
variable_name(S):-
string(S),!, write(S).
declarations([]):-!,
writeln(": INTEGER;").
declarations([S]):-!,
variable_name(S),
declarations([]).
declarations([S|REST]):-!,
variable_name(S),
write(","),
declarations(REST).
main_block(T,Value,[declare(VARIABLES)|BODY]):-!,
tab(T), declarations(VARIABLES),
T1== T + 1,
tab(T), writeln("begin"),
operators(T1,Value,BODY),
tab(T), writeln("end;").
main_block(T,Value,Block):-
block_operator(T,Value,Block).
block_operator(T,Value,[declare(VARIABLES)|BODY]):-!,
tab(T), writeln("declare"),
tab(T), declarations(VARIABLES),
T1== T + 1,
tab(T), writeln("begin"),
operators(T1,Value,BODY),
tab(T), writeln("end;").
block_operator(T,Value,BODY):-!,
T1== T + 1,
tab(T), writeln("begin"),
operators(T1,Value,BODY),
tab(T), writeln("end;").
operators(_,_,[]):-!.
operators(T,Value,[OP|REST]):-!,
ada_operator(T,Value,OP),
operators(T,Value,REST).
ada_operator(_,_,Value):-
free(Value),!,
write("Error!\n"),
break('unbound_value').
ada_operator(T,_,input_list(LIST)):-
input_list(T,LIST),
fail.
ada_operator(T,_,output({value:A|_})):-
tab(T), write("put(\"Variable "),
variable_name(A),
writeln(" : \");"),
tab(T), write("put("),
variable_name(A),
writeln(");"),
fail.
ada_operator(T,_,'is'(Value,Expression)):-
ada_operator(T,Value,Expression),
fail.
ada_operator(T,Value,do(BB,OPERATORS)):-
tab(T), write("while "),
logic_expression(BB),
writeln(" loop"),
block_operator(T,Value,OPERATORS),
tab(T), writeln("end loop;"),
fail.
ada_operator(T,Value,'if'(OPERATORS)):-
tab(T),
write("if "),
if_operator(T,Value,OPERATORS),
fail.
ada_operator(T,Value,OPERATORS):-
OPERATORS == [_|_],
block_operator(T,Value,OPERATORS),
fail.
ada_operator(T,Value,{value:Object|_}):-
ada_operator(T,Value,Object),
fail.
ada_operator(T,Value,Object):-
is_arithmetic_expression(Object),
tab(T), variable_name(Value),
write(" := "),
arithmetic_expression(Object),
writeln(";"),
fail.
ada_operator(_,_,_).
input_list(_,[]):-!.
input_list(T,[{value:A|_}|Rest]):-
input_value(T,A),
input_list(T,Rest).
input_value(T,A):-
tab(T), write("put(\"Enter unsigned number '"),
variable_name(A),
writeln("', please: \");"),
tab(T), write("get("),
variable_name(A),
writeln(");"),
fail.
input_value(_,_).
is_arithmetic_expression(Object):- integer(Object),!.
is_arithmetic_expression(Object):- symbol(Object),!.
is_arithmetic_expression(Object):- string(Object),!.
is_arithmetic_expression(name(_)):-!.
is_arithmetic_expression(s(_)):-!.
is_arithmetic_expression('+'(_,_)):-!.
is_arithmetic_expression(half(_)):-!.
arithmetic_expression({value:Object|_}):-
arithmetic_expression(Object),
fail.
arithmetic_expression(Object):-
integer(Object),
Object < 0,
write("(",Object,")"),
fail.
arithmetic_expression(Object):-
integer(Object),
Object >= 0,
write(Object),
fail.
arithmetic_expression(Object):-
symbol(Object),
write(Object),
fail.
arithmetic_expression(Object):-
string(Object),
write(Object),
fail.
arithmetic_expression(name(N)):-
write("VAR",N),
fail.
arithmetic_expression(s(Object)):-
write("("),
arithmetic_expression(Object),
write("+1)"),
fail.
arithmetic_expression('+'(A,B)):-
write("("),
arithmetic_expression(A),
write(" + "),
arithmetic_expression(B),
write(")"),
fail.
arithmetic_expression(half(Object)):-
arithmetic_expression(Object),
write(" /2"),
fail.
arithmetic_expression(_).
logic_expression(neq(H1,H2)):-
arithmetic_expression(H1),
write(" /= "),
arithmetic_expression(H2),
fail.
logic_expression(odd(H)):-
arithmetic_expression(H),
write(" rem 2 = 1"),
fail.
logic_expression(even(H)):-
arithmetic_expression(H),
write(" rem 2 = 0"),
fail.
logic_expression(_).
if_operator(T1,Value,[guard(G,P)]):-!,
logic_expression(G),
writeln(" then"),
T2== T1 + 1,
ada_operator(T2,Value,P),
tab(T1), writeln("end if;").
if_operator(T1,Value,[guard(G,P)|REST]):-!,
logic_expression(G),
writeln(" then"),
T2== T1 + 1,
ada_operator(T2,Value,P),
tab(T1), write("elsif "),
if_operator(T1,Value,REST).
]
------------------------------------------------------------------
class 'FORMAT' specializing 'ALPHA':
device;
[
output({value:Name|_}):-!,
device ? write(Name).
output('*'(Value1,Value2)):-
output(Value1),
device ? write(" * "),
output(Value2).
output('+'(Value1,Value2)):-
device? write("("),
output(Value1),
device ? write(" + "),
output(Value2),
device ? write(")").
]
------------------------------------------------------------------
|