/*----------------------------------------------------------* A Natural Language Querying System Based on Discourse Representation Theory and Incorporating Event Semantics Copyright 1994 Daniel Wayne Brown Thesis, M.S., University of Georgia, 1994 For documentation see Research Report AI-1994-03, Artificial Intelligence Center, The University of Georgia. Quick sample run: (1) Load this program in GULP 2 or 3 (not Prolog). (See U.Ga. research reports for information about GULP.) (2) Sample query: ?- run. |: Pedro is happy. *----------------------------------------------------------*/ /*-----------------------------------------------------------* Experimental English-to-Prolog translator using Discourse Representation Theory as an intermediate language. Programmed by Michael Covington, University of Georgia incorporating ideas of Donald Nute, Nora Schmitz, David Goodman Supported by National Science Foundation Grant IST-85-02477 Extended by Daniel Brown to incorporate event semantics 19 May 1994 *-----------------------------------------------------------*/ /*-----------------------------------------------------------* FEATURE AND OPERATOR DECLARATIONS *-----------------------------------------------------------*/ :- dynamic unique_aux/1. :- dynamic fact/1. g_features([syn,sem,agr,index,class,akt,arg1,arg2,in,out,res, scope,num,tense,asp]). :- op(1200, /* priority same as :- */ xfx, /* no associativity */ '::-'). /* This operator is used as the internal representation for conditionals. It is meant to look a lot like the ordinary Prolog ':-'. However, it has two super-powers: (1) GoalA ::- GoalB can be queried as well as asserted. (2) In GoalA ::- GoalB, GoalA as well as GoalB can be compound. */ /*-----------------------------------------------------------* COMPUTATIONAL UTILITIES *-----------------------------------------------------------*/ /* * reverse(List,Result). * Fast list reversal with stacks. * NOTE: If the tail of the list is uninstantiated, this * procedure will instantiate it to nil. So don't use this * procedure on open lists that need to remain open. */ reverse(List,Result) :- nonvar(List), reverse_aux(List,[],Result). reverse_aux([],Result,Result). reverse_aux([H|T],Stack,Result) :- reverse_aux(T,[H|Stack],Result). /* * unique_integer(N). * unifies N with a different integer every time it is * called. */ unique_integer(N) :- retract(unique_aux(N)), NN is N+1, assert(unique_aux(NN)), !. /* Cut needed by Quintus, not Arity */ unique_aux(0). /*-----------------------------------------------------------* I/O UTILITIES *-----------------------------------------------------------*/ /*-----------------------------------------------------------*/ % File READATOM.PL % Michael A. Covington % Natural Language Processing for Prolog Programmers % (Prentice-Hall) % Appendix B % Version of read_atomics/1 for most Prologs. See text. % read_atomics(-Atomics) % Reads a line of text, breaking it into a % list of atomic terms: [this,is,an,example]. read_atomics(Atomics) :- read_char(FirstC,FirstT), complete_line(FirstC,FirstT,Atomics). % read_char(-Char,-Type) % Reads a character and runs it through char_type/1. read_char(Char,Type) :- get0(C), char_type(C,Type,Char). % complete_line(+FirstC,+FirstT,-Atomics) % Given FirstC (the first character) and FirstT (its type), reads % and tokenizes the rest of the line into atoms and numbers. complete_line(_,end,[]) :- !. % stop at end complete_line(_,blank,Atomics) :- % skip blanks !, read_atomics(Atomics). complete_line(FirstC,special,[A|Atomics]) :- % special char !, name(A,[FirstC]), read_atomics(Atomics). complete_line(FirstC,alpha,[A|Atomics]) :- % begin word complete_word(FirstC,alpha,Word,NextC,NextT), name(A,Word), % may not handle numbers correctly - see text complete_line(NextC,NextT,Atomics). % complete_word(+FirstC,+FirstT,-List,-FollC,-FollT) % Given FirstC (the first character) and FirstT (its type), % reads the rest of a word, putting its characters into List. complete_word(FirstC,alpha,[FirstC|List],FollC,FollT) :- !, read_char(NextC,NextT), complete_word(NextC,NextT,List,FollC,FollT). complete_word(FirstC,FirstT,[],FirstC,FirstT). % where FirstT is not alpha % char_type(+Code,?Type,-NewCode) % Given an ASCII code, classifies the character as % 'end' (of line/file), 'blank', 'alpha'(numeric), or 'special', % and changes it to a potentially different character (NewCode). char_type(10,end,10) :- !. % UNIX end of line mark char_type(13,end,13) :- !. % DOS end of line mark char_type(-1,end,-1) :- !. % get0 end of file code char_type(Code,blank,32) :- % blanks, other ctrl codes Code =< 32, !. char_type(Code,alpha,Code) :- % digits 48 =< Code, Code =< 57, !. char_type(Code,alpha,Code) :- % lower-case letters 97 =< Code, Code =< 122, !. char_type(Code,alpha,NewCode) :- % upper-case letters 65 =< Code, Code =< 90, !, NewCode is Code + 32. % (translate to lower case) char_type(Code,special,Code). % all others /*-----------------------------------------------------------*/ /* * display_drs(X). * outputs a readable representation of a DRS */ display_drs(X) :- display_drs_indented(X,0). display_drs_indented(X,_) :- var(X), !, write(X),nl. display_drs_indented(ifthen(X,Y),N) :- !, tab(N), write('IF:'), nl, NN is N+2, display_drs_indented(X,NN), tab(N), write('THEN:'), nl, display_drs_indented(Y,NN). display_drs_indented(neg(X),N) :- !, tab(N), write('NOT:'), nl, NN is N+2, display_drs_indented(X,NN). display_drs_indented(query(X),N) :- !, tab(N), write('QUERY:'), nl, NN is N+2, display_drs_indented(X,NN). display_drs_indented(drs(X,Y),N) :- !, reverse(X,RX), tab(N), write(RX), nl, reverse(Y,RY), display_drs_indented(RY,N). display_drs_indented([H|T],N) :- !, display_drs_indented(H,N), display_drs_indented(T,N). display_drs_indented([],_) :- !. display_drs_indented(Cond,N) :- tab(N), write(Cond), nl. /*-----------------------------------------------------------* DRS-BUILDER *-----------------------------------------------------------*/ /* Modeled on that of Johnson and Klein (CSLI Report 86-63) */ /* with many minor changes. */ /*************************************** * Lexicon and lexical insertion rules * ***************************************/ /* * Nouns */ n(N) --> [Form], { proper_noun(Form,Num,lambda(I,Semantics)), N = sem:in:In, already_in(Semantics,In), % check to see if name already exists N = syn: (index:I :: class:proper) :: sem: out: In :: agr: num: Num }. n(N) --> [Form], { proper_noun(Form,Num,lambda(I,Semantics)), append(Semantics,Con,NewCon), N = syn: (index:I :: class:proper) :: sem: (in: [drs(U,Con)|Super] :: out: [drs([I|U],NewCon)|Super]) :: agr: num: Num }. n(N) --> [Form], { common_noun(Form,Num,lambda(I,Semantics)), append(Semantics,Con,NewCon), N = syn: (index:I :: class:common) :: sem: (in: [drs(U,Con)|Super] :: out: [drs([I|U],NewCon)|Super]) :: agr: num: Num }. already_in([],_). already_in([H|T],[drs(U,Con)|S]) :- ( member(H,Con), ! ; already_in([H],S) ), already_in(T,[drs(U,Con)|S]). proper_noun(pedro, sg, lambda(X, [named(X,'Pedro'), gender(X,m)])). proper_noun(chiquita, sg, lambda(X, [named(X,'Chiquita'), gender(X,f)])). proper_noun(maria, sg, lambda(X, [named(X,'Maria'), gender(X,f)])). common_noun(bandersnatch, sg, lambda(X,[bandersnatch(X),gender(X,n)] )). common_noun(boojum, sg, lambda(X,[boojum(X), gender(X,n)] )). common_noun(man, sg, lambda(X,[man(X), gender(X,m)] )). common_noun(woman, sg, lambda(X,[woman(X), gender(X,f)] )). common_noun(donkey, sg, lambda(X,[donkey(X), gender(X,n)] )). common_noun(farmer, sg, lambda(X,[farmer(X), gender(X,m)] )). common_noun(knight, sg, lambda(X,[knight(X), gender(X,m)] )). common_noun(lady, sg, lambda(X,[lady(X), gender(X,f)] )). common_noun(knave, sg, lambda(X,[knave(X), gender(X,m)] )). /* * Adjectives */ adj(Adj) --> [Form], { adjective(Form,Tense,lambda(I,S,Time,Semantics)), append(Semantics,Con,NewCon), Adj = syn: (index:I) :: sem: (in: [drs(U,Con)|Super] :: out: [drs([Time,S|U],NewCon)|Super]) :: agr:tense:Tense }. adjective(big, pres, lambda(X,S,T,[at(T,now),hold(S,T),big(S,X)])). adjective(big, past, lambda(X,S,T,[before(T,now),hold(S,T),big(S,X)])). adjective(green, pres, lambda(X,S,T,[at(T,now),hold(S,T),green(S,X)])). adjective(green, past, lambda(X,S,T,[before(T,now),hold(S,T),green(S,X)])). adjective(rich, pres, lambda(X,S,T,[at(T,now),hold(S,T),rich(S,X)])). adjective(rich, past, lambda(X,S,T,[before(T,now),hold(S,T),rich(S,X)])). adjective(old, pres, lambda(X,S,T,[at(T,now),hold(S,T),old(S,X)])). adjective(old, past, lambda(X,S,T,[before(T,now),hold(S,T),old(S,X)])). adjective(happy, pres, lambda(X,S,T,[at(T,now),hold(S,T),happy(S,X)])). adjective(happy, past, lambda(X,S,T,[before(T,now),hold(S,T),happy(S,X)])). /* * Verbs */ v(V) --> [Form], { verb(Form,Akt,Num,Tense,Asp, lambda(I,A1,A2,Time,Semantics)), append(Semantics,Con,NewCon), V = syn: (class:transitive :: akt:Akt :: arg1:A1 :: arg2:A2) :: sem: (in: [drs(U,Con)|Super] :: out: [drs([Time,I|U],NewCon)|Super]) :: agr: (num: Num :: tense: Tense :: asp:Asp) }. v(V) --> [is,Form], { verb(Form,Akt,_,pres,prog, lambda(I,A1,A2,Time,Semantics)), append(Semantics,Con,NewCon), V = syn: (class:transitive :: akt:Akt :: arg1:A1 :: arg2:A2) :: sem: (in: [drs(U,Con)|Super] :: out: [drs([Time,I|U],NewCon)|Super]) :: agr: (num: sg :: tense: pres :: asp: none) }. v(V) --> [are,Form], { verb(Form,Akt,_,pres,prog, lambda(I,A1,A2,Time,Semantics)), append(Semantics,Con,NewCon), V = syn: (class:transitive :: akt:Akt :: arg1:A1 :: arg2:A2) :: sem: (in: [drs(U,Con)|Super] :: out: [drs([Time,I|U],NewCon)|Super]) :: agr: (num: pl :: tense: pres :: asp: none) }. v(V) --> [was,Form], { verb(Form,Akt,_,past,prog, lambda(I,A1,A2,Time,Semantics)), append(Semantics,Con,NewCon), V = syn: (class:transitive :: akt:Akt :: arg1:A1 :: arg2:A2) :: sem: (in: [drs(U,Con)|Super] :: out: [drs([Time,I|U],NewCon)|Super]) :: agr: (num: sg :: tense: past :: asp: none) }. v(V) --> [were,Form], { verb(Form,Akt,_,past,prog, lambda(I,A1,A2,Time,Semantics)), append(Semantics,Con,NewCon), V = syn: (class:transitive :: akt:Akt :: arg1:A1 :: arg2:A2) :: sem: (in: [drs(U,Con)|Super] :: out: [drs([Time,I|U],NewCon)|Super]) :: agr: (num: pl :: tense: past :: asp: none) }. v(V) --> [Form], { verb(Form,Akt,Num,Tense,Asp, lambda(I,Arg,Time,Semantics)), append(Semantics,Con,NewCon), V = syn : (class:intransitive :: akt:Akt :: arg1:Arg) :: sem : (in: [drs(U,Con)|Super] :: out: [drs([Time,I|U],NewCon)|Super]) :: agr: (num: Num :: tense: Tense :: asp:Asp) }. v(V) --> [is,Form], { verb(Form,Akt,_,pres,prog, lambda(I,Arg,Time,Semantics)), append(Semantics,Con,NewCon), V = syn : (class:intransitive :: akt:Akt :: arg1:Arg) :: sem : (in: [drs(U,Con)|Super] :: out: [drs([Time,I|U],NewCon)|Super]) :: agr: (num: sg :: tense: pres :: asp: none) }. v(V) --> [are,Form], { verb(Form,Akt,_,pres,prog, lambda(I,Arg,Time,Semantics)), append(Semantics,Con,NewCon), V = syn : (class:intransitive :: akt:Akt :: arg1:Arg) :: sem : (in: [drs(U,Con)|Super] :: out: [drs([Time,I|U],NewCon)|Super]) :: agr: (num: pl :: tense: pres :: asp: none) }. v(V) --> [was,Form], { verb(Form,Akt,_,past,prog, lambda(I,Arg,Time,Semantics)), append(Semantics,Con,NewCon), V = syn : (class:intransitive :: akt:Akt :: arg1:Arg) :: sem : (in: [drs(U,Con)|Super] :: out: [drs([Time,I|U],NewCon)|Super]) :: agr: (num: sg :: tense: past :: asp: none) }. v(V) --> [were,Form], { verb(Form,Akt,_,past,prog, lambda(I,Arg,Time,Semantics)), append(Semantics,Con,NewCon), V = syn : (class:intransitive :: akt:Akt :: arg1:Arg) :: sem : (in: [drs(U,Con)|Super] :: out: [drs([Time,I|U],NewCon)|Super]) :: agr: (num: pl :: tense: past :: asp: none) }. verb(see, s, pl, pres, _, lambda(S,X,Y,T,[at(T,now),hold(S,T),seeing(S,X,Y)])). verb(sees, s, sg, pres, _, lambda(S,X,Y,T,[at(T,now),hold(S,T),seeing(S,X,Y)])). verb(love, s, pl, pres, _, lambda(S,X,Y,T,[at(T,now),hold(S,T),loving(S,X,Y)])). verb(loves, s, sg, pres, _, lambda(S,X,Y,T,[at(T,now),hold(S,T),loving(S,X,Y)])). verb(own, s, pl, pres, _, lambda(S,X,Y,T,[at(T,now),hold(S,T),owning(S,X,Y)])). verb(owns, s, sg, pres, _, lambda(S,X,Y,T,[at(T,now),hold(S,T),owning(S,X,Y)])). verb(have, s, pl, pres, _, lambda(S,X,Y,T,[at(T,now),hold(S,T),having(S,X,Y)])). verb(has, s, sg, pres, _, lambda(S,X,Y,T,[at(T,now),hold(S,T),having(S,X,Y)])). verb(admire, s, pl, pres, _, lambda(S,X,Y,T,[at(T,now),hold(S,T),admiring(S,X,Y)])). verb(admires, s, sg, pres, _, lambda(S,X,Y,T,[at(T,now),hold(S,T),admiring(S,X,Y)])). verb(beat, e, pl, pres, none, lambda(S,X,Y,T,[at(T,now),hab(S,T),beating(S,X,Y)])). verb(beats, e, sg, pres, none, lambda(S,X,Y,T,[at(T,now),hab(S,T),beating(S,X,Y)])). verb(beating, e, _, pres, prog, lambda(S,X,Y,T,[at(T,now),hold(S,T),beating(S,X,Y)])). verb(beating, e, _, past, prog, lambda(S,X,Y,T,[before(T,now),hold(S,T),beating(S,X,Y)])). verb(feed, e, pl, pres, none, lambda(S,X,Y,T,[at(T,now),hab(S,T),feeding(S,X,Y)])). verb(feeds, e, sg, pres, none, lambda(S,X,Y,T,[at(T,now),hab(S,T),feeding(S,X,Y)])). verb(feeding, e, _, pres, prog, lambda(S,X,Y,T,[at(T,now),hold(S,T),feeding(S,X,Y)])). verb(feeding, e, _, past, prog, lambda(S,X,Y,T,[before(T,now),hold(S,T),feeding(S,X,Y)])). verb(fight, e, pl, pres, none, lambda(S,X,Y,T,[at(T,now),hab(S,T),fighting(S,X,Y)])). verb(fights, e, sg, pres, none, lambda(S,X,Y,T,[at(T,now),hab(S,T),fighting(S,X,Y)])). verb(fighting, e, _, pres, prog, lambda(S,X,Y,T,[at(T,now),hold(S,T),fighting(S,X,Y)])). verb(fighting, e, _, past, prog, lambda(S,X,Y,T,[before(T,now),hold(S,T),fighting(S,X,Y)])). verb(insult, e, pl, pres, none, lambda(S,X,Y,T,[at(T,now),hab(S,T),insulting(S,X,Y)])). verb(insults, e, sg, pres, none, lambda(S,X,Y,T,[at(T,now),hab(S,T),insulting(S,X,Y)])). verb(insulting,e, _, pres, prog, lambda(S,X,Y,T,[at(T,now),hold(S,T),insulting(S,X,Y)])). verb(insulting,e, _, past, prog, lambda(S,X,Y,T,[before(T,now),hold(S,T),insulting(S,X,Y)])). verb(saw, s, _, past, _, lambda(S,X,Y,T,[before(T,now),hold(S,T),seeing(S,X,Y)])). verb(loved, s, _, past, _, lambda(S,X,Y,T,[before(T,now),hold(S,T),loving(S,X,Y)])). verb(owned, s, _, past, _, lambda(S,X,Y,T,[before(T,now),hold(S,T),owning(S,X,Y)])). verb(had, s, _, past, _, lambda(S,X,Y,T,[before(T,now),hold(S,T),having(S,X,Y)])). verb(admired, s, _, past, _, lambda(S,X,Y,T,[before(T,now),hold(S,T),admiring(S,X,Y)])). verb(beat, e, _, past, _, lambda(E,X,Y,T,[before(T,now),cul(E,T),beating(E,X,Y)])). verb(fed, e, _, past, _, lambda(E,X,Y,T,[before(T,now),cul(E,T),feeding(E,X,Y)])). verb(fought, e, _, past, _, lambda(E,X,Y,T,[before(T,now),cul(E,T),fighting(E,X,Y)])). verb(insulted, e, _, past, _, lambda(E,X,Y,T,[before(T,now),cul(E,T),insulting(E,X,Y)])). verb(barks, e, _, pres, none, lambda(S,X,T,[at(T,now),hab(S,T),barking(S,X)])). verb(bark, e, _, pres, none, lambda(S,X,T,[at(T,now),hab(S,T),barking(S,X)])). verb(barking, e, _, pres, prog, lambda(S,X,T,[at(T,now),hold(S,T),barking(S,X)])). verb(barking, e, _, past, prog, lambda(S,X,T,[before(T,now),hold(S,T),barking(S,X)])). verb(eats, e, _, pres, none, lambda(S,X,T,[at(T,now),hab(S,T),eating(S,X)])). verb(eat, e, _, pres, none, lambda(S,X,T,[at(T,now),hab(S,T),eating(S,X)])). verb(eating, e, _, pres, prog, lambda(S,X,T,[at(T,now),hold(S,T),eating(S,X)])). verb(eating, e, _, past, prog, lambda(S,X,T,[before(T,now),hold(S,T),eating(S,X)])). verb(brays, e, _, pres, none, lambda(S,X,T,[at(T,now),hab(S,T),braying(S,X)])). verb(bray, e, _, pres, none, lambda(S,X,T,[at(T,now),hab(S,T),braying(S,X)])). verb(braying, e, _, pres, prog, lambda(S,X,T,[at(T,now),hold(S,T),braying(S,X)])). verb(braying, e, _, past, prog, lambda(S,X,T,[before(T,now),hold(S,T),braying(S,X)])). verb(barked, e, _, past, _, lambda(S,X,T,[before(T,now),cul(S,T),barking(S,X)])). verb(ate, e, _, past, _, lambda(S,X,T,[before(T,now),cul(S,T),eating(S,X)])). verb(brayed, e, _, past, _, lambda(S,X,T,[before(T,now),cul(S,T),braying(S,X)])). /* * Determiners, each with its own semantics */ det(Det) --> ([a] ; [an]), { Det = sem:in:A, Det = sem:res:in:A, % Pass sem:in to res Det = sem:res:out:B, Det = sem:scope:in:B, % Pass res:out to scope:in Det = sem:scope:out:C, Det = sem:out:C }. % Whatever comes out of scope is the % result. det(Det) --> [every], { Det = sem:in:A, Det = sem:res:in:[drs([],[])|A], Det = sem:res:out:B, Det = sem:scope:in:[drs([],[])|B], Det = sem:scope:out: [Scope,Res,drs(U,Con)|Super], Det = sem:out:[drs(U, [ifthen(Res,Scope)|Con])|Super] }. det(Det) --> [no], { Det = sem:in:A, Det = sem:res:in:[drs([],[])|A], Det = sem:res:out:B, Det = sem:scope:in:B, Det = sem:scope:out:[DRS,drs(U,Con)|Super], Det = sem:out:[drs(U,[neg(DRS)|Con])|Super] }. det(Det) --> [not,every], { Det = sem:in:A, Det = sem:res:in:[drs([],[])|A], Det = sem:res:out:B, Det = sem:scope:in:[drs([],[])|B], Det = sem:scope:out:[Scope,Res, drs(U,Con)|Super], Det = sem:out:[drs(U,[neg(drs([], [ifthen(Res,Scope)]))|Con])|Super] }. /************************** * Phrase structure rules * **************************/ /* * n1: common noun preceded by zero or more adjectives */ n1(N1,H,H) --> n(N1). n1(N1A,H1,H2) --> { N1A = agr:X, N1B = agr:X, N1A = syn:A, Adj = syn:A, N1B = syn:A, /* Indexes are in syn, not sem */ N1A = sem:in:B, N1B = sem:in:B, N1B = sem:out:C, Adj = sem:in:C, Adj = sem:out:D, N1A = sem:out:D }, adj(Adj), n1(N1B,H1,H2). /* * n2: n1 optionally followed by relative clause */ n2(N2,H1,H2) --> n1(N2,H1,H2). n2(N2,H1,H3) --> { N2 = agr:X, N1 = agr:X, N2 = syn:Syn, N1 = syn:Syn, RC = syn:Syn, /* pass index to RC */ N2 = sem:in:S1, N1 = sem: (in:S1 :: out:S2), RC = sem: (in:S2 :: out:S3), N2 = sem:out:S3 }, n1(N1,H1,H2), relcl(RC,H2,H3). /* Noun phrase ending with relative clause */ /* * noun phrase */ np(NP,H,H) --> { NP = agr:X, N = agr:X, N = syn:class:proper, N = syn:A, NP = syn:A, % NP gets its syntax from N N = sem:B, NP = sem:res:B, % NP gets its res from N NP = sem:in:C, NP = sem:res:in:C, % Pass sem:in through res NP = sem:res:out:D, NP = sem:scope:in:D, % then through scope NP = sem:scope:out:E, NP = sem:out:E }, n(N). /* Proper names do not take determiners */ np(NP,H1,H2) --> { NP = agr:X, N2 = agr:X, N2 = syn:class:common, N2 = syn:C, NP = syn:C, % NP gets its syntax from N Det = sem:A, NP = sem:A, % NP gets its semantics from Det N2 = sem:B, Det = sem:res:B }, % Det gets its res from N det(Det), n2(N2,H1,H2). /* * trace (gap) from moved relative pronoun */ np(NP,[rel(Index)|Rest],Rest) --> [], % trace of moved rel pronoun { NP = sem:in:B, % This kind of NP has no semantics and hence no res NP = sem:scope:in:B, NP = sem:scope:out:C, NP = sem:out:C, NP = syn:index:Index }. /* * anaphoric pronouns, with anaphora resolving routine */ np(NP,H,H) --> ([he];[him]), { NP=sem:in:DrsList, member(drs(U,Con),DrsList), member(Index,U), member(gender(Index2,m),Con), Index == Index2, NP=syn:index:Index, NP=sem:scope:in:DrsList, NP=sem:scope:out:DrsOut, NP=sem:out:DrsOut, NP=agr:num:sg }. np(NP,H,H) --> ([she];[her]), { NP=sem:in:DrsList, member(drs(U,Con),DrsList), member(Index,U), member(gender(Index2,f),Con), Index == Index2, NP=syn:index:Index, NP=sem:scope:in:DrsList, NP=sem:scope:out:DrsOut, NP=sem:out:DrsOut, NP=agr:num:sg }. np(NP,H,H) --> [it], { NP=sem:in:DrsList, member(drs(U,Con),DrsList), member(Index,U), member(gender(Index2,n),Con), Index == Index2, NP=syn:index:Index, NP=sem:scope:in:DrsList, NP=sem:scope:out:DrsOut, NP=sem:out:DrsOut, NP=agr:num:sg }. /* * verb phrase */ vp(VP,H1,H2) --> { V = syn:class:transitive, V = syn:D, VP = syn:D, % VP gets its syntax from V NP = sem:A, VP = sem:A, % VP gets its semantics from NP NP = syn:index:C, VP = syn:arg2:C, % VP gets object index from NP V = sem:B, NP = sem:scope:B, % NP gets scope from V sem VP = agr:X, V = agr:X }, v(V), np(NP,H1,H2). vp(VP,H,H) --> v(VP), { VP = syn:class:intransitive }. vp(VP,H1,H2) --> % Compound verb phrase { VP = agr:X, VP1 = agr:X, VP2 = agr:X, VP = sem:in:A, VP1 = sem:in:A, VP1 = sem:out:B, VP2 = sem:in:B, VP2 = sem:out:C, VP = sem:out:C, VP1 = syn:arg1:D, VP2 = syn:arg1:D, VP = syn:arg1:D }, [both], vp(VP1,H1,H1A), [and], vp(VP2,H1A,H2). /* 'Both' is required to avoid left-recursion with this simple parser */ /* * relative clause */ relcl(RC,H1,H2) --> { RC = syn:index:Index, RC = sem:Sem, S = sem:Sem }, ([who];[whom];[which];[that]), s(S,[rel(Index)|H1],H2). /* * simple sentences */ s(S,H1,H3) --> { NP = agr:X, VP = agr:X, VP = agr:asp:none, NP = sem:A, S = sem:A, % Pass sem from NP to S VP = sem:C, NP = sem:scope:C, % Pass VP sem to NP sem scope NP = syn:index:D, VP = syn:arg1:D }, % Pass NP index to VP arg1 np(NP,H1,H2), vp(VP,H2,H3). s(S,H1,H3) --> /* * Note: "does not" is given sentential scope here. * That is, "Every man does not love a woman" is * taken to mean "It is not the case that every * man loves a woman." */ { NP = agr:num:sg, VP = agr:(num:pl::tense:pres::asp:none), % infinitive form S = sem:in:A, NP = sem:in:[drs([],[])|A], VP = sem:C, NP = sem:scope:C, NP = syn:index:D, VP = syn:arg1:D, NP = sem:out:[DRS,drs(U,Con)|Super], S = sem:out:[drs(U,[neg(DRS)|Con])|Super] }, np(NP,H1,H2), [does,not], vp(VP,H2,H3). s(S,H1,H2) --> { NP = agr:num:sg, Adj = agr:tense:pres, S = sem:A, NP = sem:A, NP = sem:scope:B, Adj = sem:B, NP = syn:C, /* Pass along syntax */ Adj = syn:C }, np(NP,H1,H2), [is], adj(Adj). s(S,H1,H2) --> { NP = agr:num:sg, Adj = agr:tense:pres, S = sem:in:A, NP = sem:in:[drs([],[])|A], NP = sem:out:[DRS,drs(U,Con)|Super], S = sem:out:[drs(U,[neg(DRS)|Con])|Super], NP = sem:scope:B, Adj = sem:B, NP = syn:C, Adj = syn:C }, np(NP,H1,H2), [is,not], adj(Adj). s(S,H1,H3) --> { NP1 = agr:num:sg, S = sem:A, NP1 = sem:A, NP2 = sem:B, NP1 = sem:scope:B, NP1 = syn:index:A1, NP2 = syn:index:A2, NP2 = sem:scope: (in: [drs(U,Con)|Super] :: out: [drs(U,[(A1=A2)|Con])| Super]) }, np(NP1,H1,H2), [is], np(NP2,H2,H3). s(S,H1,H3) --> { NP1 = agr:num:sg, S = sem:in:A, NP1 = sem:in:[drs([],[])|A], NP1 = sem:out:[DRS,drs(U1,Con1)|Super1], S = sem:out:[drs(U1,[neg(DRS)|Con1])|Super1], NP2 = sem:B, NP1 = sem:scope:B, NP1 = syn:index:A1, NP2 = syn:index:A2, NP2 = sem:scope: (in: [drs(U2,Con2)|Super2] :: out: [drs(U2,[(A1=A2)|Con2])| Super2]) }, np(NP1,H1,H2), [is,not], np(NP2,H2,H3). s(S,H1,H2) --> { NP = agr:num:sg, Adj = agr:tense:past, S = sem:A, NP = sem:A, NP = sem:scope:B, Adj = sem:B, NP = syn:C, /* Pass along syntax */ Adj = syn:C }, np(NP,H1,H2), [was], adj(Adj). /* * complex sentence */ s(S,H,H) --> { S = sem:in: A, S1 = sem:in: [drs([],[])|A], S1 = sem:out:B, S2 = sem:in: [drs([],[])|B], S2 = sem:out:[S2DRS,S1DRS,drs(U,Con)|Super], S = sem:out:[drs(U,[ifthen(S1DRS,S2DRS)|Con])| Super] }, [if], s(S1,[],[]), [then], s(S2,[],[]). /* Empty hold lists enforce Coordinate Structure Constraint */ /* * statement, i.e., top-level, non-embedded sentence */ statement(S) --> s(S,[],[]). /* * question */ question(Q) --> { NP = agr:num:sg, VP = agr:(num:pl::tense:pres::asp:none), % infinitive form Q = sem:in:A, NP = sem:in:[drs([],[])|A], VP = sem:C, NP = sem:scope:C, NP = syn:index:D, VP = syn:arg1:D, NP = sem:out:[DRS,drs(U,Con)|Super], Q = sem:out:[drs(U,[query(QDRS)|Con])|Super] }, [does], np(NP,[],H2), vp(VP,H2,[]), { ( VP = syn:akt:s, !, QDRS = DRS; habituate(DRS,QDRS) ) }. question(Q) --> { NP = agr:num:sg, VP = agr:(tense:pres::asp:prog), Q = sem:in:A, NP = sem:in:[drs([],[])|A], VP = sem:C, NP = sem:scope:C, NP = syn:index:D, VP = syn:arg1:D, NP = sem:out:[DRS,drs(U,Con)|Super], Q = sem:out:[drs(U,[query(DRS)|Con])|Super] }, [is], np(NP,[],H2), vp(VP,H2,[]). question(Q) --> { NP = agr:num:sg, Adj = agr:tense:pres, Q = sem:in:A, NP = sem:in:[drs([],[])|A], NP = sem:out:[DRS,drs(U,Con)|Super], Q = sem:out:[drs(U,[query(DRS)|Con])|Super], NP = sem:scope:B, Adj = sem:B, NP = syn:C, Adj = syn:C }, [is], np(NP,[],[]), adj(Adj). question(Q) --> { NP1 = agr:num:sg, Q = sem:in:A, NP1 = sem:in:[drs([],[])|A], NP1 = sem:out:[DRS,drs(U1,Con1)|Super1], Q = sem:out:[drs(U1,[query(DRS)|Con1])|Super1], NP2 = sem:B, NP1 = sem:scope:B, NP1 = syn:index:A1, NP2 = syn:index:A2, NP2 = sem:scope: (in: [drs(U2,Con2)|Super2] :: out: [drs(U2,[(A1=A2)|Con2])| Super2]) }, [is], np(NP1,[],[]), np(NP2,[],[]). question(Q) --> { NP = agr:num:sg, VP = agr:(num:pl::tense:pres::asp:none), % infinitive form Q = sem:in:A, NP = sem:in:[drs([],[])|A], VP = sem:C, NP = sem:scope:C, NP = syn:index:D, VP = syn:arg1:D, NP = sem:out:[DRS,drs(U,Con)|Super], Q = sem:out:[drs(U,[query(QDRS)|Con])|Super] }, [did], np(NP,[],H2), vp(VP,H2,[]), { pastify(DRS,QDRS) }. question(Q) --> { NP = agr:num:sg, VP = agr:(tense:past::asp:prog), Q = sem:in:A, NP = sem:in:[drs([],[])|A], VP = sem:C, NP = sem:scope:C, NP = syn:index:D, VP = syn:arg1:D, NP = sem:out:[DRS,drs(U,Con)|Super], Q = sem:out:[drs(U,[query(DRS)|Con])|Super] }, [was], np(NP,[],H2), vp(VP,H2,[]). question(Q) --> { NP = agr:num:sg, Adj = agr:tense:past, Q = sem:in:A, NP = sem:in:[drs([],[])|A], NP = sem:out:[DRS,drs(U,Con)|Super], Q = sem:out:[drs(U,[query(DRS)|Con])|Super], NP = sem:scope:B, Adj = sem:B, NP = syn:C, Adj = syn:C }, [was], np(NP,[],[]), adj(Adj). /* * Discourse * [a,discourse,is,a,series,of,consecutive,sentences, * separated,by,endpuncts,like,this,'.',note,that,an, * endpunct,is,required,after,the,final,sentence,'!'] */ discourse(D) --> { retractall(fact(_)), D = sem:in:[drs([now],[])] }, discourse_aux(D). discourse_aux(D1) --> { D1 = sem:in:A, S = sem:in:A, S = sem:out:B, D2 = sem:in:B, D2 = sem:out:C, D1 = sem:out:C }, ( statement(S) ; question(S) ), endpunct, {!}, discourse_aux(D2). discourse_aux(D) --> [], { D = sem:in:A, D = sem:out:A }. /* * endpunct (sentence terminator). */ endpunct --> ['.'] ; ['?'] ; ['!']. /*-----------------------------------------------------------* TEMPORAL REASONING *-----------------------------------------------------------*/ /* * pastify(DRS1,DRS2). * replaces conditions with their past tense equivalents; * used for queries beginning with 'Did' */ pastify(drs(U,Con),drs(U,PastCon)) :- pastify_list(Con,PastCon). pastify_list([],[]). pastify_list([cul(E,T)|C],[(cul(E,T);hold(E,T);hab(E,T))|P]) :- !, pastify_list(C,P). pastify_list([hold(E,T)|C], [(cul(E,T);hold(E,T);hab(E,T))|P]) :- !, pastify_list(C,P). pastify_list([hab(E,T)|C],[(cul(E,T);hold(E,T);hab(E,T))|P]) :- !, pastify_list(C,P). pastify_list([at(T,now)|C],[before(T,now)|P]) :- !, pastify_list(C,P). pastify_list([H|C],[H|P]) :- pastify_list(C,P). /* * habituate(DRS1,DRS2). * replaces conditions with their habitual equivalents; * used for queries beginning with 'Does' and involving * event verbs */ habituate(drs(U,Con),drs(U,PastCon)) :- habituate_list(Con,PastCon). habituate_list([],[]). habituate_list([cul(E,T)|C],[hab(E,T)|P]) :- !, habituate_list(C,P). habituate_list([hold(E,T)|C],[hab(E,T)|P]) :- !, habituate_list(C,P). habituate_list([H|C],[H|P]) :- habituate_list(C,P). /*-----------------------------------------------------------* DRS-TO-PROLOG TRANSLATOR *-----------------------------------------------------------*/ /* * prologize_whole_drs(DRS). * processes the top-level DRS by translating into Prolog * and asserting or querying the appropriate facts or rules. */ prologize_whole_drs(DRS) :- clean_up(DRS,drs(U,Con)), display_drs(drs(U,Con)), skolemize(U,[]), write('----------------------------------------'), nl, prologize_recursively_list(Con,NewCon), assert_or_process_list(NewCon). /* * clean_up(DRS1,DRS2). * performs preprocessing needed on all DRSes to clean up * extraneous information left in by the DRS-builder. */ clean_up(drs(OldU,OldCon),drs(NewU,NewCon)) :- discard_gender_information(OldCon,Con1), unify_equated_referents(drs(OldU,Con1),drs(NewU,Con2)), reverse(Con2,NewCon). % restore original discourse order /* * prologize_recursively(Condition,Goal). * prologize_recursively_list(ConditionList,GoalList). * These predicates turn DRS conditions into Prolog goals. * The bulk of the work of the implementation is done * here. */ prologize_recursively_list([],[]). prologize_recursively_list([H|T],[NewH|NewT]) :- prologize_recursively(H,NewH), prologize_recursively_list(T,NewT). prologize_recursively(query(DRS),query(Goal)) :- !, clean_up(DRS,drs(_,Con)), prologize_recursively_list(Con,NewCon), list_conj(NewCon,Goal). prologize_recursively(ifthen(DRSA,DRSC),(GoalC ::- GoalA)) :- !, clean_up(DRSA,drs(UA,ConA)), clean_up(DRSC,drs(UC,ConC)), skolemize(UC,UA), prologize_recursively_list(ConA,NewConA), prologize_recursively_list(ConC,NewConC), list_conj(NewConA,GoalA), list_conj(NewConC,GoalC). prologize_recursively(PlainGoal,PlainGoal). /* * assert_or_process(Goal). * assert_or_process_list(GoalList). * These predicates accept Prolog goals and process each * by either adding it to the knowledge base as a fact, * or executing it as a query, as appropriate. */ assert_or_process_list([]) :- !. assert_or_process_list([H|T]) :- assert_or_process(H), assert_or_process_list(T). assert_or_process(query(X)) :- !, test(X,Result), write('Result: '), write(Result),nl. assert_or_process(neg(_)) :- !, write('neg not yet supported'),nl. assert_or_process((neg(_)::-_)) :- !, write('neg not yet supported'),nl. assert_or_process((C::-A)) :- !, distribute_consequents((C::-A),Rules), assert_or_process_list(Rules). assert_or_process((neg(_):-_)) :- !, write('neg not yet supported'),nl. assert_or_process((C:-A)) :- ( C=(_:-_), !; C=(_::-_) ), !, reduce_lhs((C:-A),Rule), assert_or_process(Rule). assert_or_process(Fact) :- note(Fact). /* * unify_equated_referents(DRS1,DRS2). * unifies all discourse referents that are joined by '=' * in the DRS conditions. For instance, * drs([X,Y],[X=Y,donkey(Y)]). * is changed to * drs([X],[donkey(X)]). * This is a temporary measure to reduce the need for a table * of identity. It will be dropped when the table of identity * is fully supported. */ unify_equated_referents(drs(U,Con),drs(NewU,NewCon)) :- unify_equated(Con,NewCon), remove_dups(U,NewU). remove_dups([],[]). remove_dups([H|T],X) :- already_member(H,T), !, remove_dups(T,X). remove_dups([H|T],[H|X]) :- remove_dups(T,X). unify_equated([],[]). unify_equated([X=X|Tail],NewTail) :- !, unify_equated(Tail,NewTail). unify_equated([Head|Tail],[Head|NewTail]) :- unify_equated(Tail,NewTail). /* * discard_gender_information(DRS1,DRS2). * simplifies DRS1 by removing gender conditions (which were * needed only to resolve anaphors), giving DRS2. * Fully recursive -- actually removes all terms of the form * gender(_,_) from any Prolog structure. */ discard_gender_information(X,X) :- (var(X) ; atomic(X)), !. discard_gender_information([Head|Rest],Result) :- nonvar(Head), Head = gender(_,_), !, discard_gender_information(Rest,Result). discard_gender_information([Head|Rest],[NewHead|NewRest]) :- !, discard_gender_information(Head,NewHead), discard_gender_information(Rest,NewRest). discard_gender_information(Term,NewTerm) :- Term =.. [Functor|List], discard_gender_information(List,NewList), NewTerm =.. [Functor|NewList]. /* * note(Clause). * note_list(Clause). * adds a clause or list of clauses to the knowledge base. */ note(X) :- write('Asserting: '), write(X),nl, ( fact(X), ! ; assertz(fact(X)) ). /* facts asserted as fact(_) for easy retraction */ note_list([]). note_list([Clause|Rest]) :- note(Clause), note_list(Rest). /* * test(Query,Result). * Attempts to find one solution for Query. If successful, * unifies Result with 'yes'; otherwise, with 'no'. * test/2 itself always succeeds if Result is initially * uninstantiated. */ test(Goal,X) :- write('Querying: '), write(Goal),nl, test_aux(Goal,X). test_aux((G1,G2),yes) :- test_aux(G1,yes), test_aux(G2,yes), !. test_aux((G1;_),yes) :- test_aux(G1,yes), !. test_aux((_;G2),yes) :- test_aux(G2,yes), !. test_aux(Goal,yes) :- fact((Goal:-Test)), test_aux(Test,yes), !. test_aux(Goal,yes) :- fact(Goal), !. test_aux(true,yes). test_aux(_,no). /* * skolemize(Term,Args). * Instantiates every free variable in Term to a unique * structure containing Args. In effect, this replaces each * variable in Term with a unique Skolem function of Args. */ skolemize(Variable,Args) :- var(Variable), already_member(Variable,Args), !. /* If a variable appears in Args, it is not really a new variable in its sub-DRS and therefore shouldn't be skolemized. */ skolemize(Variable,Args) :- var(Variable), !, unique_integer(N), Variable = [N|Args]. skolemize(Atom,_) :- atomic(Atom), !. skolemize([Head|Tail],Args) :- !, skolemize(Head,Args), skolemize(Tail,Args). skolemize(Structure,Args) :- Structure =.. List, skolemize(List,Args). already_member(X,[Y|_]) :- X==Y. already_member(X,[_|Z]) :- already_member(X,Z). /* * list_conj(ListOfGoals,ConjoinedGoals). * Transforms [Goal1,Goal2,Goal3] into (Goal1,Goal2,Goal3). * The latter is executable in Prolog. * We must never pass a list to Prolog for execution because * it would be interpreted as a list of files to consult. */ list_conj([],true) :- !. list_conj([Goal],Goal) :- !. list_conj([Goal|Rest],(Goal,NewRest)) :- list_conj(Rest,NewRest). /* * distribute_consequents(IllFormedRule,ListOfRules). * Deals with rules that have compound (list) consequents. * Transforms a,b,c ::- d,e,f into the list: * [(a:-d,e,f),(b:-d,e,f),(c:-d,e,f)]. */ distribute_consequents(((C,Cs)::-A),[(C:-A)|Rest]) :- !, distribute_consequents((Cs::-A),Rest). distribute_consequents((C::-A), [(C:-A)]). /* This version assumes that C will be a flat compound goal, i.e., (a,b,c) but not ((a,b),c). This may need fixing. */ /* * reduce_lhs(Rule,NewRule). * Simplifies LHS of rule by getting rid of :- and ::-. */ reduce_lhs(((A:-B):-Q),(X:-Y,Q)) :- !, reduce_lhs((A:-B),(X:-Y)). reduce_lhs(((A::-B):-Q),(X::-Y,Q)) :- !, reduce_lhs((A::-B),(X::-Y)). reduce_lhs(X,X). /* FURTHER PROBLEM: prologize_ifthen should really work recursively through ALL DRSes given to it. */ /*-----------------------------------------------------------* TESTING *-----------------------------------------------------------*/ try(String) :- append(String,['.'],Discourse), tryd(Discourse). tryd(String) :- write(String),nl, write('----------------------------------------'), nl, phrase(discourse(Features),String), Features = sem:out:DRS, DRS = [Current|_], prologize_whole_drs(Current). run :- read_atomics(S), ( S==[], !; tryd(S), !, nl, run; nl, run ). %% End of program