/****************************************************** TALK Program Augmented by some work by Eric Auer: The exercises for chapter 5 (better talk/2 error handling, gap threading and interactive N PN IV TV vocubulary extension) ******************************************************/ % Gap threading: % OLD NEW % nogap Gn-Gn no externally visible gap % gap(X,Y) [gap(X,Y)|Gs]-Gs introducing a gap % GapInfo G0-G processing the gap difflist % only the vp -> rov np vp rules can be simplified with this /*===================================================== Operators =====================================================*/ :- op(500,xfy,&). :- op(510,xfy,=>). :- op(100,fx,`). /*===================================================== Declare predicates as dynamic =====================================================*/ :- dynamic professor/1,book/1,program/1,halts/1. :- dynamic author/2,programmer/1,student/1. :- dynamic writes/2,runs/2,meets/2,concerns/2. :- dynamic tv/6,iv/6,pn/2,n/2. % *** ALLOW LEARNING *** /*===================================================== Dialogue Manager =====================================================*/ %%% main_loop *** ADDED INIT *** %%% ========= main_loop :- assert(init_done(0)), \+ init_done(1), assert(vtrans(subj,obj,theverb) :- fail), assert(vintrans(subj,theverb) :- fail), assert(noun(who,thenoun) :- fail), assert(init_done(1)), main_loop. main_loop :- init_done(1), write('Talk to me >> '), % prompt the user read_sent(Words), % read a sentence talk(Words, Reply), % process it with TALK print_reply(Reply), % generate a printed reply main_loop. % pocess more sentences %%% talk(Sentence, Reply) %%% ===================== %%% %%% Sentence ==> sentence to form a reply to %%% Reply <== appropriate reply to the sentence talk(Sentence, Reply) :- /* *** MODIFIED *** */ % parse the sentence parse(Sentence, LF, Type), ( \+ \+ Type = unparseable -> Reply = error('Cannot parse this - ungrammatical?') ; % convert the FOL logical form into a Horn % clause, if possible ( clausify(LF, Clause, FreeVars) % concoct a reply, based on the clause and % whether sentence was a query or assertion -> ( ! , reply(Type, FreeVars, Clause, Reply) ) ; ( Reply = error('Could not convert LF to Horn clause'), format('The LF was: ~p~n',[LF]) ) ) ). % No parse was found, sentence is too difficult. talk(_Sentence, error('too difficult')). %%% reply(Type, FreeVars, Clause, Reply) %%% ==================================== %%% %%% Type ==> the constant "query" or "assertion" %%% depending on whether clause should %%% be interpreted as a query or %%% assertion %%% FreeVars ==> the free variables (to be %%% interpreted existentially) in the %%% clause %%% Clause ==> the clause being replied to %%% Reply <== the reply %%% %%% If the clause is interpreted as an assertion, %%% the predicate has a side effect of asserting %%% the clause to the database. % Replying to a query. reply(query, FreeVars, (answer(Answer):-Condition), Reply) :- % find all the answers that satisfy the query, % replying with that set if it exists, or "no" % or "none" if it doesn't. (setof(Answer, FreeVars^Condition, Answers) -> Reply = answer(Answers) ; (Answer = yes -> Reply = answer([no]) ; Reply = answer([none]))), !. % Replying to an assertion. /* *** MODIFIED *** */ reply(assertion, _FreeVars, Assertion, Reply) :- % assert the assertion and tell user what we asserted ( \+ \+ Assertion = (This :- This) -> ( format('Tautology not explicitly stored: ~p :- ~p~n', [This,This]), Reply = done_nothing ) ; ( \+ \+ Assertion -> ( format('Already knew that ~p~n',Assertion), Reply = done_nothing ) ; ( assert(Assertion), Reply = asserted(Assertion) ) ) ), !. % Replying to some other type of sentence. reply(_Type, _FreeVars, _Clause, error('unknown type')). %%% print_reply(Reply) %%% ================== %%% %%% Reply ==> reply generated by reply predicate %%% that is to be printed to the %%% standard output. print_reply(error(ErrorType)) :- write('Error: "'), write(ErrorType), write('."'), nl. print_reply(asserted(Assertion)) :- write('Asserted "'), write(Assertion), write('."'), nl. print_reply(answer(Answers)) :- print_answers(Answers). /* *** ADDED *** */ print_reply(done_nothing) :- write('Sentence ignored'), nl. %%% print_answer(Answers) %%% ===================== %%% %%% Answers ==> nonempty list of answers to be printed %%% to the standard output separated %%% by commas. print_answers([Answer]) :- !, write(Answer), write('.'), nl. print_answers([Answer|Rest]) :- write(Answer), write(', '), print_reply(answer(Rest)). %%% parse(Sentence, LF, Type) %%% ========================= %%% %%% Sentence ==> sentence to parse %%% LF <== logical form (in FOL) of sentence %%% Type <== type of sentence %%% (query or assertion) % Parsing an assertion: a finite sentence without gaps. parse(Sentence, LF, assertion) :- s(LF, Gn-Gn, Sentence, []). % Parsing a query: a question. parse(Sentence, LF, query) :- q(LF, Sentence, []). /* *** ADDED *** */ parse(_Sentence, _LF, unparseable). % obvious: no assertion % and no query -> feels ungrammatical /*===================================================== Clausifier =====================================================*/ %%% clausify(FOL, Clause, FreeVars) %%% =============================== %%% %%% FOL ==> FOL expression to be converted %%% to clause form %%% Clause <== clause form of FOL expression %%% FreeVars <== free variables in clause % Universals: variable is left implicitly scoped. clausify(all(X,F0),F,[X|V]) :- clausify(F0,F,V). % Implications: consequent must be a literal, % antecedent is clausified specially. clausify(A0=>C0,(C:-A),V) :- clausify_literal(C0,C), clausify_antecedent(A0,A,V). % Literals: left unchanged (except literal % marker is removed). clausify(C0,C,[]) :- clausify_literal(C0,C). % Note that conjunctions and existentials are % disallowed, since they can't form Horn clauses. %%% clausify_antecedent(FOL, Clause, FreeVars) %%% ========================================== %%% %%% FOL ==> FOL expression to be converted %%% to clause form %%% Clause <== clause form of FOL expression %%% FreeVars ==> list of free variables in clause % Literals: left unchanged (except literal % marker is removed). clausify_antecedent(L0,L,[]) :- clausify_literal(L0,L). % Conjunctions: each conjunct is clausified separately. clausify_antecedent(E0&F0,(E,F),V) :- clausify_antecedent(E0,E,V0), clausify_antecedent(F0,F,V1), conc(V0,V1,V). % Existentials: variable is left implicitly scoped. clausify_antecedent(exists(X,F0),F,[X|V]) :- clausify_antecedent(F0,F,V). %%% clausify_literal(Literal, Clause) %%% ================================= %%% %%% Literal ==> FOL literal to be converted %%% to clause form %%% Clause <== clause form of FOL expression % Literal is left unchanged (except literal % marker is removed). clausify_literal(`L,L). /*===================================================== Grammar Nonterminal names: q Question sinv INVerted Sentence s noninverted Sentence np Noun Phrase vp Verb Phrase iv Intransitive Verb tv Transitive Verb aux AUXiliary verb rov subject-Object Raising Verb optrel OPTional RELative clause relpron RELative PRONoun whpron WH PRONoun det DETerminer n Noun pn Proper Noun Typical order of and values for arguments: 1. verb form: (main verbs) finite, nonfinite, etc. (auxiliaries and raising verbs) Form1-Form2 where Form1 is form of embedded VP Form2 is form of verb itself) 2. FOL logical form 3. gap information: Gn-Gn or [gap(Nonterm, Var)|Gs]-Gs where Nonterm is nonterminal for gap Var is the LF variable that the filler will bind =====================================================*/ %%% Questions q(S => `answer(X)) --> whpron, vp(finite, X^S, Gn-Gn). q(S => `answer(X)) --> whpron, sinv(S, [gap(np, X)|Gs]-Gs). q(S => `answer(yes)) --> sinv(S, Gn-Gn). q(S => `answer(yes)) --> [is], np((X^S0)^S, Gn-Gn), np((X^true)^exists(X,S0&true), Gn-Gn). %%% Declarative Sentences s(S, G0-G) --> np(VP^S, G0-G0), vp(finite, VP, G0-G). %%% Inverted Sentences sinv(S, G0-G) --> aux(finite/Form, VP1^VP2), np(VP2^S, G0-G0), vp(Form, VP1, G0-G). %%% Noun Phrases np(NP, Gn-Gn) --> det(N2^NP), n(N1), optrel(N1^N2). np(NP, Gn-Gn) --> pn(NP). np((X^S)^S, [gap(np, X)|Gs]-Gs) --> []. %%% Verb Phrases vp(Form, X^S, G0-G) --> tv(Form, X^VP), np(VP^S, G0-G). vp(Form, VP, Gn-Gn) --> iv(Form, VP). vp(Form1, VP2, G0-G) --> aux(Form1/Form2, VP1^VP2), vp(Form2, VP1, G0-G). /* *** ONE RULE SIMPLIFIED USING GAP THREADING *** */ vp(Form1, VP2, G0-G) --> rov(Form1/Form2, NP^VP1^VP2), np(NP, G0-G1), % THIS ... vp(Form2, VP1, G1-G). % ... or THAT may eat the gap! vp(finite, X^S, G0-G) --> [is], np((X^P)^exists(X,S&P), G0-G). %%% Relative Clauses optrel((X^S1)^(X^(S1&S2))) --> relpron, vp(finite,X^S2, Gn-Gn). optrel((X^S1)^(X^(S1&S2))) --> relpron, s(S2, [gap(np, X)|Gs]-Gs). optrel(N^N) --> []. /*===================================================== Dictionary =====================================================*/ /*----------------------------------------------------- Preterminals -----------------------------------------------------*/ det(LF) --> [D], {det(D, LF)}. n(LF) --> [N], {n(N, LF)}. /* *** N LEARNING *** */ n(LF) --> [Word], { newWord(Word), format('Expected noun but got ~p~n',[Word]), write('Enter y to learn that noun '), format('or press ENTER to forget about it~n'), read_sent([Q|_]), ( \+ Q = '' -> ( LF = X^ `noun(X,Word), assert(noun(foo,Word) :- fail), % seed what % we know about who is a Word (for LF use) assert(n(Word,LF)), % meaning format('Noun learned~n') ) ; ( format('Ok, no noun...~n'), fail ) ) }. /* *** N LEARNED *** */ pn((E^S)^S) --> [PN], {pn(PN, E)}. /* *** PN LEARNING *** */ pn(LF) --> [Word], { newWord(Word), format('Expected name but got ~p~n',[Word]), format('Enter the meaning (e.g. ~p) ',[Word]), format(' or press ENTER to forget about it~n'), read_sent([Meaning|_]), ( \+ Meaning = '' -> ( LF = (Meaning^S)^S, assert(pn(Word,Meaning)), % meaning format('Name learned~n') ) ; ( format('Ok, no name...~n'), fail ) ) }. /* *** PN LEARNED *** */ aux(Form, LF) --> [Aux], {aux(Aux, Form, LF)}. relpron --> [RP], {relpron(RP)}. whpron --> [WH], {whpron(WH)}. % Verb entry arguments: % 1. nonfinite form of the verb % 2. third person singular present tense form of the verb % 3. past tense form of the verb % 4. past participle form of the verb % 5. pres participle form of the verb % 6. logical form of the verb iv(nonfinite, LF) --> [IV], {iv(IV, _, _, _, _, LF)}. iv(finite, LF) --> [IV], {iv(_, IV, _, _, _, LF)}. iv(finite, LF) --> [IV], {iv(_, _, IV, _, _, LF)}. iv(past_participle, LF) --> [IV], {iv(_, _, _, IV, _, LF)}. iv(pres_participle, LF) --> [IV], {iv(_, _, _, _, IV, LF)}. /* *** INTRANSITIVE VERB LEARNING FACILITY *** */ iv(_,LF) --> [Word], { newWord(Word), learnIv(Word,LF) }. learnIv(Word,LF) :- format('Expected an intransitive verb but got ~p~n', [Word]), write('If this is NOT an intransitive verb,'), write(' please press ENTER'),nl, write('Please give me the inflection like this:'), nl,write('wug wugs wugged wugged wugging'), nl,write('-> inf, he, they, past, participle'), nl,read_sent([Inf,He,They,PastPart,PresPart]), ( Inf = '' -> ( format('Ok, no intransitive verb...~n'), fail ) ; LFint = X^ `vintrans(X,Inf), assert(vintrans(foo,Inf) :- fail), % seed what % we know about the Inf relation (LF use) assert(iv(Inf,He,They,PastPart,PresPart,LFint)), % now we have stored the lexicon entry format('Intransitive verb to ~p learned~n',[Inf]), !, LF = LFint % cut and then unification to avoid variables in % LFint to become instantiated... ). /* *** END OF INTRANSITIVE VERB LEARNING FACILITY *** */ /* *** HELPER: completely unknown word? *** */ newWord(Word) :- \+ iv(Word,_,_,_,_, _), \+ iv(_,Word,_,_,_, _), \+ iv(_,_,Word,_,_, _), \+ iv(_,_,_,Word,_, _), \+ iv(_,_,_,_,Word, _), \+ Word = is, \+ tv(Word,_,_,_,_, _), \+ tv(_,Word,_,_,_, _), \+ tv(_,_,Word,_,_, _), \+ tv(_,_,_,Word,_, _), \+ tv(_,_,_,_,Word, _), \+ Word = that, \+ rov(Word,_,_,_,_, _,_), \+ rov(_,Word,_,_,_, _,_), \+ rov(_,_,Word,_,_, _,_), \+ rov(_,_,_,Word,_, _,_), \+ rov(_,_,_,_,Word, _,_), \+ pn(Word,_), \+ n(Word,_), \+ aux(Word,_,_), \+ whpron(Word), \+ relpron(Word), \+ det(Word,_). /* *** END OF HELPER *** */ tv(nonfinite, LF) --> [TV], {tv(TV, _, _, _, _, LF)}. tv(finite, LF) --> [TV], {tv(_, TV, _, _, _, LF)}. tv(finite, LF) --> [TV], {tv(_, _, TV, _, _, LF)}. tv(past_participle, LF) --> [TV], {tv(_, _, _, TV, _, LF)}. tv(pres_participle, LF) --> [TV], {tv(_, _, _, _, TV, LF)}. /* *** TRANSITIVE VERB LEARNING FACILITY *** */ tv(_,LF) --> [Word], { newWord(Word), learnTv(Word,LF) }. learnTv(Word,LF) :- \+ Word = is, % avoid learning "is" - special word! \+ aux(Word,_,_), % avoid learning auxiliaries! format('Expected a transitive verb but got ~p~n', [Word]), write('If this is NOT a transitive verb,'), write(' please press ENTER'),nl, write('Please give me the inflection like this:'), nl,write('wug wugs wugged wugged wugging'), nl,write('-> inf, he, they, past, participle'), nl,read_sent([Inf,He,They,PastPart,PresPart]), ( Inf = '' -> ( format('Ok, no transitive verb...~n'), fail ) ; LFint = X^Y^ `vtrans(X,Y,Inf), assert(vtrans(foo,bar,Inf) :- fail), % seed what % we know about the Inf relation (LF use) assert(tv(Inf,He,They,PastPart,PresPart,LFint)), % now we have stored the lexicon entry format('Transitive verb to ~p learned~n',[Inf]), !, LF = LFint % cut and then unification to avoid variables in % LFint to become instantiated... ). /* *** END OF TRANSITIVE VERB LEARNING FACILITY *** */ rov(nonfinite /Requires, LF) --> [ROV], {rov(ROV, _, _, _, _, LF, Requires)}. rov(finite /Requires, LF) --> [ROV], {rov(_, ROV, _, _, _, LF, Requires)}. rov(finite /Requires, LF) --> [ROV], {rov(_, _, ROV, _, _, LF, Requires)}. rov(past_participle/Requires, LF) --> [ROV], {rov(_, _, _, ROV, _, LF, Requires)}. rov(pres_participle/Requires, LF) --> [ROV], {rov(_, _, _, _, ROV, LF, Requires)}. /*----------------------------------------------------- Lexical Items -----------------------------------------------------*/ relpron( that ). relpron( who ). relpron( whom ). whpron( who ). whpron( whom ). whpron( what ). det( every, (X^S1)^(X^S2)^ all(X,S1=>S2) ). det( a, (X^S1)^(X^S2)^exists(X,S1&S2) ). det( some, (X^S1)^(X^S2)^exists(X,S1&S2) ). n( author, X^ `author(X) ). n( book, X^ `book(X) ). n( professor, X^ `professor(X) ). n( program, X^ `program(X) ). n( programmer, X^ `programmer(X) ). n( student, X^ `student(X) ). pn( begriffsschrift, begriffsschrift ). pn( bertrand, bertrand ). pn( bill, bill ). pn( gottlob, gottlob ). pn( lunar, lunar ). pn( principia, principia ). pn( shrdlu, shrdlu ). pn( terry, terry ). iv( halt, halts, halted, halted, halting, X^ `halts(X) ). tv( write, writes, wrote, written, writing, X^Y^ `writes(X,Y) ). tv( meet, meets, met, met, meeting, X^Y^ `meets(X,Y) ). tv( concern, concerns, concerned, concerned, concerning, X^Y^ `concerns(X,Y) ). tv( run, runs, ran, run, running, X^Y^ `runs(X,Y) ). rov( want, wants, wanted, wanted, wanting, % semantics is partial execution of % NP ^ VP ^ Y ^ NP( X^want(Y,X,VP(X)) ) ((X^ `want(Y,X,Comp))^S) ^ (X^Comp) ^ Y ^ S, % form of VP required: infinitival). aux( to, infinitival/nonfinite, VP^ VP ). aux( does, finite/nonfinite, VP^ VP ). aux( did, finite/nonfinite, VP^ VP ). /*===================================================== Auxiliary Predicates =====================================================*/ %%% 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). %%% read_sent(Words) %%% ================ %%% %%% Words ==> set of words read from the %%% standard input %%% %%% Words are delimited by spaces and the %%% line is ended by a newline. Case is not %%% folded; punctuation is not stripped. read_sent(Words) :- get0(Char), % prime the lookahead read_sent(Char, Words). % get the words % Newlines end the input. read_sent(C, []) :- newline(C), !. % Spaces are ignored. read_sent(C, Words) :- interpunction(C), !, get0(Char), read_sent(Char, Words). % Everything else starts a word. read_sent(Char, [Word|Words]) :- read_word(Char, Chars, Next), % get the word name(Word, Chars), % pack the characters % into an atom read_sent(Next, Words). % get some more words %%% read_word(Chars) %%% ================ %%% %%% Chars ==> list of characters read from standard %%% input and delimited by spaces or %%% newlines % Space and newline end a word. read_word(C, [], C) :- interpunction(C), !. read_word(C, [], C) :- newline(C), !. % All other chars are added to the list. read_word(Char, [Char|Chars], Last) :- get0(Next), read_word(Next, Chars, Last). %%% space(Char) %%% =========== %%% %%% Char === the ASCII code for the space %%% character interpunction(32). % space interpunction(34). % " interpunction(39). % ' interpunction(45). % - interpunction(46). % . interpunction(58). % : interpunction(63). % ? %%% newline(Char) %%% ============= %%% %%% Char === the ASCII code for the newline %%% character newline(10). /*===================================================== Initial Database =====================================================*/ writes(terry, shrdlu). writes(bill, lunar). writes(roger, sam). writes(gottlob, begriffsschrift). writes(bertrand, principia). writes(alfred, principia). book(begriffsschrift). book(principia). program(lunar). program(sam). program(shrdlu). professor(terry). professor(roger). professor(bertrand). professor(gottlob). concerns(shrdlu, blocks). concerns(lunar, rocks). concerns(sam, stories). concerns(principia, logic). concerns(principia, mathematics). concerns(begriffsschrift, logic). % *** AUTO START ON CONSULTING *** % --- hm, seems not to work --- :- main_loop.