1/* @(#)talkr.pl	24.1 2/23/88 */
    2
    3/*
    4	Copyright 1986, Fernando C.N. Pereira and David H.D. Warren,
    5
    6			   All Rights Reserved
    7*/
    8/* Simplifying and executing the logical form of a NL query. */
    9
   10:-op(500,xfy,--).   11:-op(359,xf,ject).   12
   13
   14:-public write_tree/1, answer/1, satisfy//2.   15
   16:-mode write_tree(+).   17:-mode wt(+,+).   18:-mode header(+).   19:-mode decomp(+,-,-).   20:-mode complex(+).   21:-mode othervars(+,-,-).   22
   23write_tree(T):-
   24   numbervars(T,0,_),
   25   wt(T,0),
   26   fail.
   27write_tree(_).
   28
   29wt((P:-Q),L) :- !, L1 is L+3,
   30   write(P), tab(1), write((:-)), nl,
   31   tab(L1), wt(Q,L1).
   32wt((P,Q),L) :- !, L1 is L-2,
   33   wt(P,L), nl,
   34   tab(L1), put_char('&'), tab(1), wt(Q,L).
   35wt({P},L) :- complex(P), !, L1 is L+2,
   36   put_char('{'), tab(1), wt(P,L1), tab(1), put_char('}').
   37wt(E,L) :- decomp(E,H,P), !, L1 is L+2,
   38   header(H), nl,
   39   tab(L1), wt(P,L1).
   40wt(E,_) :- write(E).
   41
   42header([]).
   43header([X|H]) :- write(X), tab(1), header(H).
   44
   45decomp(setof(X,P,S),[S,=,setof,X],P).
   46decomp(\+(P),[\+],P) :- complex(P).
   47decomp(numberof(X,P,N),[N,=,numberof,X],P).
   48decomp(X^P,[exists,X|XX],P1) :- othervars(P,XX,P1).
   49
   50othervars(X^P,[X|XX],P1) :- !, othervars(P,XX,P1).
   51othervars(P,[],P).
   52
   53complex((_,_)).
   54complex({_}).
   55complex(setof(_,_,_)).
   56complex(numberof(_,_,_)).
   57complex(_^_).
   58complex(\+P) :- complex(P).
   59
   60% Query execution.
   61
   62:-mode respond(?).   63:-mode holds(+,?).   64:-mode answer(+).   65:-mode yesno(+).         :-mode replies(+).   66:-mode reply(+).   67:-mode seto(?,+,-).   68:-mode satisfy(+).   69:-mode pickargs(+,+,+).   70:-mode pick(+,?).   71
   72respond([]) :- display('Nothing satisfies your question.'), nl.
   73respond([A|L]) :- reply(A), replies(L).
   74
   75answer((answer([]):-E)) :- !, holds(E,B), yesno(B).
   76answer((answer([X]):-E)) :- !, seto(X,E,S), respond(S).
   77answer((answer(X):-E)) :- seto(X,E,S), respond(S).
   78
   79seto(X,E,S) :-
   80%	portray_clause(({X} :- E)),
   81	phrase(satisfy(E,G),Vars),
   82%	portray_clause(({X} :- G)),
   83	(   setof(X,Vars^G,S)
   84	->  true
   85	;   S = []
   86	).
   87
   88holds(E,True) :-
   89	phrase(satisfy(E, G), _),
   90	(   G
   91	->  True = true
   92	;   True = false
   93	).
   94
   95yesno(true) :- display('Yes.').
   96yesno(false) :- display('No.').
   97
   98replies([]) :- display('.').
   99replies([A]) :- display(' and '), reply(A), display('.').
  100replies([A|X]) :- display(', '), reply(A), replies(X).
  101
  102reply(N--U) :- !, write(N), display(' '), write(U).
  103reply(X) :- write(X).

 satisfy(+Term, -Goal)//

Originally, Term was meta-interpreted. If we do not want every ^/2-term to act as an existential quantification, this no longer works. Hence, we now compile the term into a goal and compute the existentially quantified variables.

  112satisfy((P0,Q0), (P,Q)) --> !, satisfy(P0, P), satisfy(Q0, Q).
  113satisfy({P0}, (P->true)) --> !, satisfy(P0, P).
  114satisfy(X^P0, P) --> !, satisfy(P0, P), [X].
  115satisfy(\+P0, \+P) --> !, satisfy(P0, P).
  116satisfy(numberof(X,P0,N), (setof(X,Vars^P,S),length(S,N))) --> !,
  117	{ phrase(satisfy(P0,P),Vars) },
  118	[S], Vars.			% S is an internal variable!
  119satisfy(setof(X,P0,S), setof(X,Vars^P,S)) --> !,
  120	{ phrase(satisfy(P0,P),Vars) },
  121	Vars.
  122satisfy(+P0, \+ exceptionto(P)) --> !,
  123	satisfy(P0, P).
  124satisfy(X<Y, X<Y) --> !.
  125satisfy(X=<Y, X=<Y) --> !.
  126satisfy(X>=Y, X>=Y) --> !.
  127satisfy(X>Y, X>Y) --> !.
  128satisfy(P, database(P)) --> [].
  129
  130exceptionto(P) :-
  131   functor(P,F,N), functor(P1,F,N),
  132   pickargs(N,P,P1),
  133   exception(P1).
  134
  135exception(P) :- database(P), !, fail.
  136exception(P).
  137
  138pickargs(0,_,_) :- !.
  139pickargs(N,P,P1) :- N1 is N-1,
  140   arg(N,P,S),
  141   pick(S,X),
  142   arg(N,P1,X),
  143   pickargs(N1,P,P1).
  144
  145pick([X|_S],X).
  146pick([_|S],X) :- !, pick(S,X).
  147pick([],_) :- !, fail.
  148pick(X,X)