/***********************************************************************

                              DCG Compiler

***********************************************************************/


/*======================================================================
                         Operator Declarations
======================================================================*/

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

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


/*======================================================================
                            Compiler Driver
======================================================================*/

%%% compile
%%% =======
%%%
%%%        Generates compiled clauses by partial execution of the DCG 
%%%        metainterpreter below, and adds them to the Prolog database.

compile :-
    program_clause(Clause),
    partially_execute(Clause, CompiledClause),
    add_rule(CompiledClause),
    fail.


%%% add_rule(Clause)
%%% ================
%%%
%%%        Clause  ==>  clause to be added to database after rewriting into
%%%                     a normal form that changes calls to parse into
%%%                     calls on particular nonterminals

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


%%% rewrite(Term, NewTerm)
%%% ======================
%%%
%%%        Term     ==> a term encoding a literal or sequence of literals
%%%        NewTerm  <== the term rewritten so literals of the form
%%%                        parse(s(...),...)
%%%                     are rewritten into the form
%%%                        s(...,...)

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).


/*======================================================================
                 Partial Execution of Prolog Programs
======================================================================*/

%%% partially_execute(Term, NewTerm) 
%%% ================================ 
%%% 
%%%        Term    ==> term encoding Prolog clause, literal list or literal
%%%                    to be partially executed with respect to the program 
%%%                    clauses and auxiliary clauses given by program_clause
%%%                    and clause predicates respectively.
%%%        NewTerm <== the partially executed term.

%%% Partially executing a clause involves expanding the body.
partially_execute((Head:-Body), (Head:-ExpandedBody)) :- !,
    partially_execute(Body, ExpandedBody).

%%% Partially expanding a literal list involves conjoining the expansions
%%% of the respective expansions.
partially_execute((Literal, Rest), Expansion) :- !,
    % expand the first literal
    partially_execute(Literal, ExpandedLiteral),
    % and the rest of them
    partially_execute(Rest, ExpandedRest),
    % and conjoin the results
    conjoin(ExpandedLiteral, ExpandedRest, Expansion).

%%% Partially executing an auxiliary literal involves replacing it with
%%% the body of a matching clause (if there are any).
partially_execute(Literal, Expansion) :-
    % if the literal should be partially executed
    aux_literal(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).

%%% Otherwise (if the literal is not an auxiliary literal or if no rules 
%%% match) we just leave it alone.
partially_execute(Literal, Literal).


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

%%% conjoin(Conjunct1, Conjunct2, Conjunction)
%%% ==========================================
%%%
%%%        Conjunct1   ==>  two terms to be conjoined
%%%        Conjunct2   ==>
%%%        Conjunction <==  result of the conjunction

%%% Conjoining a conjunction works just like concatenation (conc).
conjoin((A,B), C, ABC) :- !,
    conjoin(B, C, BC),
    conjoin(A, BC, ABC).

%%% Conjoining true and anything leaves the other conjunct unchanged.
conjoin(true, A, A) :- !.
conjoin(A, true, A) :- !.

%%% Otherwise, use the normal comma conjunction operator.
conjoin(A, C, (A,C)).


%%% conc(List1, List2, List)
%%% ========================
%%%
%%%        List1 ==> a list
%%%        List2 ==> a list
%%%        List  <== the concatenation of the two lists

conc([], List, List).

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


%%% aclause(Head, Body)
%%% ===================
%%%
%%%        Head <== the head and body of a clause encoded with the unary 
%%%        Body <== predicate `clause';  unit clauses can be encoded directly 
%%%                 with clause and the Body returned will be `true'.

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

/*======================================================================
                      Program to Partially Execute
======================================================================*/


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

aux_literal( (_ ---> _)     ).
aux_literal( parse(_, _, _) ).


/*----------------------------------------------------------------------
	      DCG Metainterpreter to be Partially Executed
		      Encoded form of Program 6.3
----------------------------------------------------------------------*/


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)       )).



/*----------------------------------------------------------------------
              Sample Data for Program to Partially Execute:
               The parse tree building DCG of Program 3.9
----------------------------------------------------------------------*/

clause((                s(s(NP,VP)) ---> np(NP), vp(VP)           )).
clause((                np(np(Det,N,Rel)) ---> det(Det), 
                                              n(N), 
                                              optrel(Rel)         )).
clause((                np(np(PN)) ---> pn(PN)                    )).
clause((                vp(vp(TV,NP)) ---> tv(TV), np(NP)         )).
clause((                vp(vp(IV)) ---> iv(IV)                    )).
clause((                optrel(rel(epsilon)) ---> []              )).
clause((                optrel(rel(that,VP)) ---> [that], vp(VP)  )).

clause((                pn(pn(terry)) ---> [terry]                )).
clause((                pn(pn(shrdlu)) ---> [shrdlu]              )).
clause((                iv(iv(halts)) ---> [halts]                )).
clause((                det(det(a)) ---> [a]                      )).
clause((                n(n(program)) ---> [program]              )).
clause((                tv(tv(writes)) ---> [writes]              )).