------------------------------------------------------------------
--              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'(