1% ===================================================================
    2% File 'parser_talk.pl'
    3% Purpose: English to KIF conversions from SWI-Prolog  
    4% This implementation is incomplete
    5% Maintainer: Douglas Miles
    6% Contact: $Author: dmiles $@users.sourceforge.net ;
    7% Version: 'parser_talk.pl' 1.0.0
    8% Revision:  $Revision: 1.3 $
    9% Revised At:   $Date: 2012/06/06 15:43:15 $
   10% ===================================================================
   11
   12:-module(parser_talk,[]).   13
   14:- op(500,xfy,&).   15:- op(50,xfx,+).   16:- op(510,xfy,=>).   17:- op(1200,xfx,-->).   18:- op(100,fx,'`').   19% exampels 
   20must_test_talkpl("bertrand wrote principia").
   21must_test_talkpl("is bertrand an author").
   22must_test_talkpl("bertrand is a author").
   23must_test_talkpl("every author is a programmer").
   24must_test_talkpl("what did bertrand write").
   25must_test_talkpl("what is a book").
   26must_test_talkpl("what is a author").
   27must_test_talkpl("principia is a book").
   28% must_test_talkpl("bertrand is bertrand").
   29must_test_talkpl("shrdlu halts").
   30must_test_talkpl("every student wrote a program").
   31must_test_talkpl("terry writes a program that halts").
   32must_test_talkpl("an author of every book wrote a program").
   33must_test_talkpl("bertand wrote a book about gottlob").
   34must_test_talkpl("what did alfred give to bertrand").
   35must_test_talkpl("alfred gave a book to bertrand").
   36must_test_talkpl("who did alfred give a book to").
   37
   38:-export(t3/0).   39t3:- forall(must_test_talkpl(Sent),talkpl(Sent)).
   40
   41m :- talkpl.
   42
   43:- asserta(t_l:into_form_code).   44
   45:-export(talkpl/0).   46talkpl :- locally(tracing80,
   47             with_no_assertions(lmconf:use_cyc_database,
   48                  locally(t_l:usePlTalk, (told, repeat, prompt_read('TALKPL> ',U),  
   49                            to_word_list(U,WL),(WL==[bye];WL==[end,'_',of,'_',file];talkpl(WL)))))).
   50
   51:-export(talkpl/1).   52talkpl(Sentence):- to_word_list(Sentence,Words),!,dmsg(sent_in_talkpl(Words)),talkpl(Words,Reply),  print_reply(Reply).
   53
   54:-export(talkpl/2).   55talkpl(Sentence,Reply) :-
   56   show_call(talkpl_parse(Sentence,LF,Type)),
   57   show_call(talkpl_clausify(LF,Clause,FreeVars)),!,
   58   talkpl_reply(Type,FreeVars,Clause,Reply).
   59
   60talkpl(Sentence,error('too difficult'(Sentence))).
   61
   62% talkpl_reply a question
   63talkpl_reply(query,FreeVars,  (answer(Answer) :- Condition),Reply) :-  
   64(setof(Answer,FreeVars^req(Condition),Answers)
   65 -> Reply = answer(Answers)
   66 ; (Answer == yes
   67 -> Reply = answer([no])
   68 ; Reply = answer([none]))),!.
   69 
   70% talkpl_reply an assertion
   71talkpl_reply(assertion,_,Assertion,asserted(Assertion)) :-  add(Assertion),  !.
   72talkpl_reply(_,_,_,error('unknown type')).
   73
   74
   75print_reply(Other) :-  fmt(Other).
   76
   77
   78talkpl_parse(Sentence,LF,Type):- \+ is_list(Sentence),!,to_word_list(Sentence,WL),!,talkpl_parse(WL,LF,Type).  
   79talkpl_parse(Sentence,LF,query) :-  q(LF,Sentence,[]).
   80talkpl_parse(Sentence,LF,assertion) :-  s(LF,nogap,Sentence,[]).
   81
   82% Universals
   83talkpl_clausify(all(X,F0),F,[X|V]) :-  talkpl_clausify(F0,F,V).
   84
   85% Implications 
   86talkpl_clausify('=>'(A0 , C0) ,(C:-A),V) :-  clausify_literal(C0,C),  clausify_antecedent(A0,A,V).
   87
   88% Literals
   89talkpl_clausify(C0,C,[]):-  clausify_literal(C0,C).
   90
   91
   92
   93% Literals
   94clausify_antecedent(L0,L,[]):-  clausify_literal(L0,L).
   95
   96% Conjunctions
   97clausify_antecedent(E0&F0,(E,F),V) :-  clausify_antecedent(E0,E,V0),  clausify_antecedent(F0,F,V1),  conc(V0,V1,V).
   98 
   99% Existentials
  100clausify_antecedent(exists(X,F0),F,[X|V]) :-  clausify_antecedent(F0,F,V).
  101
  102clausify_literal(L,L).
  103
  104% Grammar
  105% Questions
  106
  107
  108q(Q) --> q1(Q), optionalText([?]).
  109q(S => answer(S)) --> s(S,nogap),[?].
  110
  111
  112q1(S => answer(X)) -->   whpron,vp(_Tense+fin,X^S,nogap).
  113q1(S => answer(X)) -->   whpron,sinv(S,gap(np,X)). 
  114q1(S => answer(yes)) -->  sinv(S,nogap).
  115q1(S => answer(yes)) -->   copula,   np((X^SO)^S, nogap),   np((X^true)^exists(X,SO & true),nogap).
  116
  117
  118
  119
  120% Declarative sentences
  121s(S,GapInfo) -->   np(VP^S,nogap),   vp(_Tense+fin,VP,GapInfo).
  122
  123% Inverted sentences
  124sinv(S,GapInfo) --> 
  125 aux(_Tense+fin/Form,VP1^VP2),  np(VP2^S,nogap),  vp(Form,VP1,GapInfo).
  126 
  127% Noun Phrases
  128np(NP,nogap) -->  det(N2^NP),n(N1),optrel(N1^N2).
  129np(NP,nogap) --> pn(NP).
  130np((X^S)^S,gap(np,X)) --> [].
  131
  132
  133% Verb phrases
  134vp(Form,X^S,GapInfo) -->  talk_tv(Form,X^VP),  np(VP^S,GapInfo).
  135vp(Form,VP,nogap) -->  talk_iv(Form,VP).
  136vp(Form1,VP2,GapInfo) -->  aux(Form1/Form2,VP1^VP2),  vp(Form2,VP1,GapInfo).
  137vp(Form1,VP2,GapInfo) -->  rov(Form1/Form2,NP^VP1^VP2),  np(NP,GapInfo),  vp(Form2,VP1,nogap).
  138vp(Form2,VP2,GapInfo) -->  rov(Form1/Form2,NP^VP1^VP2),  np(NP,nogap),  vp(Form1,VP1,GapInfo).
  139vp(_Tense+fin,X^S,GapInfo) -->  copula,  np((X^P)^exists(X,S&P),GapInfo).
  140
  141
  142% relative clauses
  143optrel((X^S1)^(X^(S1&S2))) -->  relpron,vp(_Tense+fin,X^S2,nogap).
  144optrel((X^S1)^(X^(S1&S2))) -->  relpron,s(S2,gap(np,X)).
  145optrel(N^N) --> [].
  146
  147% Dictionary
  148% preterminals
  149
  150det(LF) --> [D],{det_lf(D,LF)}.
  151n(LF) --> [N],{noun_lf(N,LF)}.
  152pn((E^S)^S) --> [PN],{pn_lf(PN,E)}.
  153
  154aux(Form,LF) --> [Aux],{aux_lf(Aux,Form,LF)}.
  155relpron --> [RP],{relpron(RP)}.
  156whpron --> [WH], {whpron(WH)}.
  157
  158copula --> [C], {copula(C)}.
  159
  160talk_iv(nonfinite, LF) --> [IV],{talk_iv_lf(IV,_,_,_,_,LF)}.
  161talk_iv(pres+fin,  LF) --> [IV],{talk_iv_lf(_,IV,_,_,_,LF)}.
  162talk_iv(past+fin,  LF) --> [IV],{talk_iv_lf(_,_,IV,_,_,LF)}.
  163talk_iv(past+part, LF) --> [IV],{talk_iv_lf(_,_,_,IV,_,LF)}.
  164talk_iv(pres+part, LF) --> [IV],{talk_iv_lf(_,_,_,_,IV,LF)}.
  165
  166talk_tv(nonfinite, LF) --> [TV],{talk_tv_lf(TV,_,_,_,_,LF)}.
  167talk_tv(pres+fin,  LF) --> [TV],{talk_tv_lf(_,TV,_,_,_,LF)}.
  168talk_tv(past+fin,  LF) --> [TV],{talk_tv_lf(_,_,TV,_,_,LF)}.
  169talk_tv(past+part, LF) --> [TV],{talk_tv_lf(_,_,_,TV,_,LF)}.
  170talk_tv(pres+part, LF) --> [TV],{talk_tv_lf(_,_,_,_,TV,LF)}.
  171
  172rov(nonfinite /Requires,LF) --> [ROV], {rov_lf(ROV,_,_,_,_,LF,Requires)}.
  173rov(pres+fin /Requires,LF) --> [ROV], {rov_lf(_,ROV,_,_,_,LF,Requires)}.
  174rov(past+fin /Requires,LF) --> [ROV], {rov_lf(_,_,ROV,_,_,LF,Requires)}.
  175rov(past+part /Requires,LF) --> [ROV], {rov_lf(_,_,_,ROV,_,LF,Requires)}.
  176rov(pres+part /Requires,LF) --> [ROV], {rov_lf(_,_,_,_,ROV,LF,Requires)}.
  177 
  178% Lexical Items
  179
  180relpron(that).
  181relpron(who).
  182relpron(whom).
  183
  184whpron(who).
  185whpron(whom).
  186whpron(what).
  187whpron(Which):- talk_db(pronoun,Which).
  188
  189copula(is).
  190copula(does).
  191
  192
  193
  194det_lf(every, (X^S1)^(X^S2)^ all(X, =>(S1,S2))).
  195det_lf(an, (X^S1)^(X^S2)^ exists(X,S1& S2)).
  196det_lf(a, (X^S1)^(X^S2)^ exists(X,S1& S2)).
  197det_lf(some, (X^S1)^(X^S2)^ exists(X,S1& S2)).
  198
  199noun_lf(author,  X^isa(X,author) ).
  200noun_lf(book,  X^isa(X,book) ).
  201noun_lf(professor,  X^professor(X) ).
  202noun_lf(program,  X^program(X) ).
  203noun_lf(programmer, X^programmer(X) ).
  204noun_lf(student,  X^student(X) ).
  205
  206noun_lf(Plur,  X^isa(X,Sing)) :- talk_db(noun1,Sing,Plur).
  207
  208adj_lf(Sing,  X^adjIsa(X,Sing)) :- adj_db(Sing,restr).
  209
  210pn_lf(begriffsschrift ,begriffsschrift).
  211pn_lf(bertrand ,bertrand ).
  212pn_lf(bill  ,bill  ).
  213pn_lf(gottlob ,gottlob ).
  214pn_lf(alfred ,alfred ).
  215pn_lf(lunar  ,lunar ).
  216pn_lf(principia ,principia ).
  217pn_lf(shrdlu  ,shrdlu ).
  218pn_lf(terry  ,terry ).
  219pn_lf(Name  ,Name ):- name_template_db(Name,_).
  220
  221
  222%           nonfinite, pres+fin, past+fin,  past+part,  pres+part,  LF
  223talk_iv_lf( halt,      halts,    halted,    halted,     halting,    X^doing(X,halt)).
  224
  225talk_iv_lf( Write,     Writes,   Wrote,     Written,    Writing,    X^Y^holds_t(Writes,X,Y)) :- talk_db(iv,Write,Writes,Wrote,Writing,Written).
  226
  227%           nonfinite, pres+fin, past+fin,  past+part,  pres+part,  LF
  228talk_tv_lf( write,     writes,   wrote,     written,    writing,    X^Y^writes(X,Y)). 
  229talk_tv_lf( meet,      meets,    met,       met,        meeting,    X^Y^meets(X,Y)).
  230talk_tv_lf( concern, concerns, concerned, concerned, concerning,   X^Y^concerns(X,Y)).
  231talk_tv_lf( run,  runs, ran, run,  running, X^Y^runs(X,Y)).
  232
  233talk_tv_lf( Write,     Writes,   Wrote,     Written,    Writing,    X^Y^holds_t(Writes,X,Y)) :- talk_db(transitive,Write,Writes,Wrote,Writing,Written).
  234
  235rov_lf(want, wants, wanted, wanted, wanting,  ((X^want(Y,X,Comp))^S) ^(X^Comp) ^Y ^S,infinitival).
  236
  237%semantics is partially execution of 
  238% NP ^VP ^Y ^NP(X want(Y,X,VP(X)))
  239%((X^ '`'(want(Y,X,Comp)))^S) ^(X^Comp) ^Y ^S, % form of VP required:
  240%infinitival).
  241
  242aux_lf(to ,  infinitival/nonfinite , VP^VP).
  243aux_lf(does , _Tense+fin/nonfinite ,  VP^VP).
  244aux_lf(did ,  _Tense+fin/nonfinite ,  VP^VP).
  245aux_lf(to ,  _/_ , VP^VP).
  246
  247conc([],L,L).
  248conc([H|T],L,[H|R]) :- conc(T,L,R).
  249
  250
  251:- retract(t_l:into_form_code).  252
  253
  254:- context_module(CM),module_predicates_are_exported(CM).  255:- context_module(CM),module_meta_predicates_are_transparent(CM).  256% :- context_module(CM),module_property(CM, exports(List)),moo_hide_show_childs(List).