/*----------------------------------------------------------------------
		 Partial Execution of Prolog Programs
----------------------------------------------------------------------*/

compile :-
    program_clause((Head :- Body)),
    partially_execute(Body, ExpandedBody),
    add_rule((Head :- ExpandedBody)),
    fail.



partially_execute((Head:-Body), (Head:-ExpandedBody)) :-
    partially_execute(Body, ExpandedBody).

partially_execute((Literal, Rest), Expansion) :- !,
    partially_execute(Literal, ExpandedLiteral),
    partially_execute(Rest, ExpandedRest),
    conjoin(ExpandedLiteral, ExpandedRest, Expansion).

partially_execute(Literal, Expansion) :-
    % if the literal should be partially evaluated
    part_evaluate(Literal),
    % and at least one rule matches
    setof(Some, Literal^aclause(Literal, Some), [_Clause|_Others]), !,
    % then pick up any rule 
    aclause(Literal, Body),
    % and expand its body
    partially_execute(Body, Expansion).

partially_execute(Literal, true) :-
    % if the literal should be fully executed
    full_evaluate(Literal), !, 
    % just execute it, and add no literals to expanded body
    call(Literal).

partially_execute(Literal, Literal) :- !.


add_rule((Head :- Body)) :-
    rewrite(Head, NewHead),
    rewrite(Body, NewBody),
    write('Asserting "'), write((NewHead :- NewBody)), write('."'), nl,
    assert((NewHead :- NewBody)).

rewrite((A,B), (C,D)) :- !,
    rewrite(A, C), rewrite(B, D).
rewrite(parse(Term, P1, P2), NewLiteral) :- !,
    Term =.. [Function|Args],
    conc(Args, [P1, P2], AllArgs),
    NewLiteral =.. [Function|AllArgs].
rewrite(Term,Term).


/*----------------------------------------------------------------------
			       Utilities
----------------------------------------------------------------------*/


conjoin((A,B), C, ABC) :- !,
    conjoin(B, C, BC),
    conjoin(A, BC, ABC).

conjoin(true, A, A) :- !.
conjoin(A, true, A) :- !.

conjoin(A, C, (A,C)).

conc([], List, List).
conc([Element|Rest], List, [Element|LongRest]) :-
    conc(Rest, List, LongRest).

member(X, [X|_List]).
member(X, [_Y|List]) :- member(X, List).

aclause(Head, Body) :-
     clause((Head:-Body)) ; (clause(Head), Body = true).

/*----------------------------------------------------------------------
		      Program to Partially Execute
----------------------------------------------------------------------*/

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
		Control Information for Partial Executor
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 

:- op(1200,xfx,'--->').

:- dynamic (--->)/2, parse/3, connect/3, parse_body/3, compiled/1.

part_evaluate( (_ ---> _) ).
part_evaluate(parse(_, _, _)).
full_evaluate(X) :- fail.


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
			   The Program Itself
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ 


program_clause((        parse(NT, P_0, P) :-
                           (NT ---> Body), 
                           parse(Body, P_0, P)
              )).

program_clause((        connect(W, [W|R], R) :- true
              )).


clause((                parse((Body1, Body2), P_0, P) :-
                            parse(Body1, P_0, P_1), 
                            parse(Body2, P_1, P)
      )).

clause((                parse([], P, P)
      )).

clause((                parse([Word|Rest], P_0, P) :-
                            connect(Word, P_0, P_1), 
                            parse(Rest, P_1, P)
      )).

clause((                parse({Goals}, P, P) :- call(Goals)
      )).



/*----------------------------------------------------------------------
                 Data for Program to Partially Execute
----------------------------------------------------------------------*/

clause((                 s ---> np, vp				)).
clause((                 np ---> [john], {print((john))}	)).
clause((                 vp ---> v,  np				)).
clause((                 v ---> [loves]				)).
clause((                 np ---> [mary]				)).