SEMANTIC-HEAD-DRIVEN GENERATOR Stuart M. Shieber, Fernando C. N. Pereira, and Robert Moore Version of 8/90 The following constitutes the code for the semantic-head-driven generator discussed by Shieber, et al. (1990). The system runs in Quintus Prolog and is comprised of the following files: sem-gen.pl Code for the generator itself. bfque.pl Library file for queues. weaken.pl Library file for weakening terms. A sample grammar, lexicon, testexamples, and test run are included at the end of the file sem-gen.pl. This material is made available for research purposes according to the following license. COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. Copyright 1987 by Fernando C. N. Pereira, Stuart M. Shieber, and Robert Moore Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both the copyright notice and this permission notice and warranty disclaimer appear in supporting documentation, and that the name of the authors, Fernando C. N. Pereira, Stuart M. Shieber, and Robert Moore, not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. The authors disclaim all warranties with regard to this software, including all implied warranties of merchantability and fitness. In no event shall the authors be liable for any special, indirect or consequential damages or any damages whatsoever resulting from loss of use, data or profits, whether in an action of contract, negligence or other tortious action, arising out of or in connection with the use or performance of this software. ........................................................................ sem-gen.pl ........................................................................ /*********************************************************************** Semantic Head-Driven DCG Generator Stuart M. Shieber, Fernando C. N. Pereira, and Robert Moore ************************************************************************ COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. Copyright 1987 by Fernando C. N. Pereira, Stuart M. Shieber, and Robert Moore Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both the copyright notice and this permission notice and warranty disclaimer appear in supporting documentation, and that the name of the authors, Fernando C. N. Pereira, Stuart M. Shieber, and Robert Moore, not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. The authors disclaim all warranties with regard to this software, including all implied warranties of merchantability and fitness. In no event shall the authors be liable for any special, indirect or consequential damages or any damages whatsoever resulting from loss of use, data or profits, whether in an action of contract, negligence or other tortious action, arising out of or in connection with the use or performance of this software. ***********************************************************************/ :- op(1200, xfx, --->). :- dynamic non_chain_rule/2, chain_rule/3, chained/2. :- ( library_directory('~pereira/link') -> true ; assert(library_directory('~pereira/link')) ). :- ensure_loaded(library(bfque)). :- ensure_loaded(library(weaken)). :- ensure_loaded(library(findall)). :- ensure_loaded(library(unify)). /*---------------------------------------------------------------------- Data Structures ----------------------------------------------------------------------*/ %%% CAT %%% === %%% %%% Category information. Includes syntax and semantics. cat_syntax(Syn/_, Syn). cat_semantics(_/Sem, Sem). %%% NODE %%% ==== %%% %%% Analyzed phrase information. Includes a category and difference %%% list representation of a sequence of words as two string %%% positions. node_syntax(node(Cat,_,_), Syn) :- cat_syntax(Cat, Syn). node_semantics(node(Cat,_,_), Sem) :- cat_semantics(Cat, Sem). /*---------------------------------------------------------------------- DCG Rule Compiler ------------------------------------------------------------------------ Compiles DCG rules in one of two ways, depending on whether the rule is a "chain rule" or not. A chain rule is one in which the semantics of the LHS is identical (==) to the semantics of some RHS constituent, the rules "semantic head". Chain rules are compiled into unit clauses of the form: chain_rule(, , ). The nodes are threaded as per the usual DCG compilation. The does not include a node for the semantic head. Non-chain rules are compiled into the form: non_chain_rule(, ). again threaded as usual. In addition, the "chained" relation, the transitive closure of the syntax part of the semantic head relation is computed. That is, if HeadSyn/HeadSem is the semantic head of LHSSyn/LHSSem, then HeadSyn and LHSSyn are in the chained relation. ----------------------------------------------------------------------*/ %%% CLEAR_RULES %%% =========== %%% %%% Clears all results of previous compilations. clear_rules :- retractall(non_chain_rule(_,_)), retractall(chain_rule(_,_,_)), retractall(chained(_,_)). %%% COMPILE_RULES %%% ============= %%% %%% Fail loop iterates over rules, compiling them and asserting the %%% results. At the end, completes the computation of the chained %%% relation. compile_rules :- clear_rules, % get rid of old results (LHS ---> RHS), % pick up a rule convert_to_list(RHS, ListRHS, []), % convert RHS to list format compile_rule(LHS, ListRHS, Rule), % compile the rule format('~w~n', [Rule]), assertz(Rule), % assert the compiled version fail. % next compile_rules :- complete_chains. % compute trans. closure of chained %%% COMPILE_RULE %%% ============ %%% %%% Compiles an individual rule. %%% LHS ==> uncompiled lhs category %%% RHS ==> list of uncompiled rhs categories %%% Rule <== compiled rule %%% Chain rules compile_rule(Cat, RHS, chain_rule(node(Cat,P0,P), CompiledRHS, Head)) :- cat_semantics(Cat, Sem), % extract semantics of LHS % find a head of the rule while computing compiled rhs extract_head(Sem, RHS, Head, CompiledRHS, P0, P), !, % head found cat_syntax(Cat, HighSyn), node_syntax(Head, LowSyn), % add an immediate chained relation, succeeding always add(chained(LowSyn, HighSyn), always). %%% Non-chain rules compile_rule(Syn/Sem, RHS, non_chain_rule(node(Syn/Sem,P0,P), CompiledRHS)) :- % fell through cut; no head found; just compile the rhs compileRHS(RHS, CompiledRHS, P0, P). %%% EXTRACT_HEAD %%% ============ %%% %%% Finds the semantic head of a rule RHS, compiling the RHS as it %%% goes. %%% LHSem ==> semantics of rule lhs %%% RHS ==> list of uncompiled rhs categories %%% Head <== node for semantic head extracted %%% CompRHS <== list of compiled RHS nodes except for the semantic %%% head %%% P0, P ==> diff. list for string covered by CompRHS extract_head(LHSem, [Syn/Sem | Rest], node(Syn/Sem, P0, P1), CompiledRest, P0, P) :- % first element in the list is the semantic head Sem == LHSem, !, % compile the rest of the RHS without looking for heads. compileRHS(Rest, CompiledRest, P1, P). extract_head(LHSem, [Symbol | Rest], Head, CompiledRest, P0, P) :- % first element of RHS is not the semantic head; compile it normally compile_symbol(Symbol, CompiledRest, CompiledRest0, P0, P1), % keep looking for the semantic head extract_head(LHSem, Rest, Head, CompiledRest0, P1, P). %extract_head(_LHSem, [], _Head, _Comp, _P0, _P) :- % % never found a head % fail. %%% COMPILERHS %%% ========== %%% %%% Compiles the RHS of a rule without looking for and extracting a %%% semantic head. compileRHS([], [], P, P). compileRHS([Symbol | Rest], CompiledRest, P0, P) :- compile_symbol(Symbol, CompiledRest, CompiledRest0, P0, P1), compileRHS(Rest, CompiledRest0, P1, P). %%% COMPILE_SYMBOL %%% ============== %%% %%% Compiles a single RHS element, converting categories to nodes, %%% placing terminal strings in-line in the string positions. compile_symbol(NT, [node(NT, P0, P)|Rest], Rest, P0, P) :- ( var(NT) ; NT = _/_ ), !. compile_symbol({Goals}, [{Goals}|Rest], Rest, P, P) :- !. compile_symbol(Ts, Rest, Rest, P0, P) :- append(Ts, P, P0). %%% COMPLETE_CHAINS %%% =============== %%% %%% Complete the chained relation by adding the transitive closure. complete_chains :- % get the set of chained relations findall(Low-High, chained(Low, High), Initial), % get an empty queue of unprocessed chained pairs start_queue(Q0), % add all the initial chained pairs enqueue_list(Initial, Q0, Q), % complete all pairs in the queue complete_chains(Q). %%% Q ==> queue of unprocessed chained pairs complete_chains(Q) :- empty_queue(Q). complete_chains(Q0) :- dequeue(Q0, Pair, Q1), % pop a pair % extend all existing pairs in the db with the popped one, adding % them to the queue as well extend_pair(Pair, Q1, Q), complete_chains(Q). %%% EXTEND_PAIR %%% =========== %%% %%% Extend all existing chained pairs in the db with a chosen one, %%% asserting the new ones (if necessary) and adding them to the %%% queue of unprocessed pairs as well. extend_pair(Low-Mid, Q0, Q) :- findall(NewLow-NewHigh, extension(Low, Mid, NewLow, NewHigh), Pairs), enqueue_list(Pairs, Q0, Q). %%% EXTENSION %%% ========= %%% %%% Extends a single chained pair (Mid-High) by a given one %%% (Low-Mid), adding it to the db after weakening it (to guarantee %%% termination). extension(Low, Mid, NewLow, NewHigh) :- chained(Mid, High), weaken(Low-High, NewLow-NewHigh), add(chained(NewLow,NewHigh),ifnew). /*---------------------------------------------------------------------- Database Manipulations ----------------------------------------------------------------------*/ %%% ADD %%% === %%% %%% Adds Fact to the database unless a more general fact is already %%% there. Also deletes any less general facts. Fails if the fact %%% is not added unless Success is the constant 'always'. add(Fact, Success) :- ( known(Fact) -> Success = always ; delete_less_general_than(Fact), format('Added: ~w~n', [Fact]), assertz(Fact) ). %%% KNOWN %%% ===== %%% %%% Succeeds if Fact is subsumed by a fact in the db. known(Fact) :- fact_template(Fact, Fact0), Fact0, subsumes(Fact0, Fact). %%% DELETE_LESS_GENERAL_THAN %%% ======================== %%% %%% Removes from the db any facts less general than Fact. delete_less_general_than(Fact) :- fact_template(Fact, Fact0), clause(Fact0, true, Ref), subsumes(Fact, Fact0), erase(Ref), fail. delete_less_general_than(_). %%% FACT_TEMPLATE %%% ============= %%% %%% Builds a term Template with the same main functor and arity as %%% Fact. fact_template(Fact, Template) :- functor(Fact, F, N), functor(Template, F, N). /*---------------------------------------------------------------------- Generator Interpreter ----------------------------------------------------------------------*/ %%% GEN %%% === %%% %%% Generate a String matching the category Cat. gen(Cat, String) :- cat_semantics(Cat,Sem), numbervars(Sem,0,_), generate(node(Cat,String,[])). %%% GENERATE %%% ======== %%% %%% Generate by finding a derivation for the Node, filling in the %%% string positions in the node as a consequence. generate({Goals}) :- !, % cut is only for efficiency Goals. generate(Node) :- % find a non-chain rule with the same semantics as Node applicable_non_chain_rule(Node, LowerNode, RHS), % generate all subconstituents of the lower node generate_rhs(RHS), % generate stuff on the path of chain rules from the lower node to % the top connect(LowerNode, Node). %%% CONNECT %%% ======= %%% %%% Connects a lower node to a higher node through a series of chain %%% rules. connect(Node0, Node) :- unify(Node0, Node). connect(LowNode, TopNode) :- applicable_chain_rule(LowNode, MidNode, TopNode, RHS), generate_rhs(RHS), connect(MidNode, TopNode). %%% APPLICABLE_NON_CHAIN_RULE %%% ========================= %%% %%% Rule LowerNode ---> RHS is such that LowerNode and Node have %%% matching semantics and LowerNode might be connectable to Node %%% via chain rules. applicable_non_chain_rule(Node, LowerNode, RHS) :- node_semantics(Node, Sem), node_semantics(LowerNode, Sem), % find a non-chain rule with the same semantics as the node non_chain_rule(LowerNode0, RHS), unify(LowerNode, LowerNode0), % make sure its LHS can be chained up to the Node chained_nodes(LowerNode, Node). %%% APPLICABLE_CHAIN_RULE %%% ===================== %%% %%% Rule with lhs MidNode, semantic head LowNode, and remaining rhs %%% RHS is a chain rule such that MidNode might be connectable to %%% TopNode via chain rules. applicable_chain_rule(LowNode, MidNode, TopNode, RHS) :- chain_rule(MidNode, RHS, LowNode0), unify(LowNode, LowNode0), chained_nodes(MidNode, TopNode). %%% GENERATE_RHS %%% ============ %%% %%% Generate for a whole list of nodes. The threading will %%% concatenate the strings. generate_rhs([]). generate_rhs([First | Rest]) :- generate(First), generate_rhs(Rest). %%% CHAINED_NODES %%% ============= %%% %%% Two nodes are chained if their syntax parts are in the chained %%% relation computed in the compilation process, or are identical. %%% (The reflexive case is n't included in the compilation. chained_nodes(LowNode, HighNode) :- node_syntax(LowNode, LowSyn), node_syntax(HighNode, HighSyn), ( unify(LowSyn, HighSyn) ; chained(LowSyn0, HighSyn0), unify(LowSyn0, LowSyn), unify(HighSyn0, HighSyn) ). /*---------------------------------------------------------------------- Utilities ----------------------------------------------------------------------*/ %%% CONVERT_TO_LIST %%% =============== %%% %%% Converts a tree of elements built with the comma operator to a %%% flat list. convert_to_list(AB, L0, L) :- nonvar(AB), AB = (A, B), !, convert_to_list(A, L0, L1), convert_to_list(B, L1, L). convert_to_list(A, [A | L], L). %%% APPEND %%% ====== append([], L, L). append([A | L0], L1, [A | L]) :- append(L0, L1, L). %%% SHUFFLE %%% ======= shuffle([], [], []). shuffle([Elem|LeftList], RightList, [Elem|List]) :- shuffle(LeftList, RightList, List). shuffle(LeftList, [Elem|RightList], [Elem|List]) :- shuffle(LeftList, RightList, List). %%% LIST %%% ==== list([]). list([_A|B]) :- list(B). %%% SUBSUMES %%% ======== subsumes(General, Specific) :- \+ \+ ( numbervars(Specific, 0, _), General = Specific). /*---------------------------------------------------------------------- Sample Grammar ----------------------------------------------------------------------*/ sentence/decl(S) ---> s(finite, []-[], [])/S. sentence/imp(S) ---> vp(nonfinite,[np(_,[]-[], [])/you], []-[], [])/S. s(Form, G0-G, Store)/quant(Q,X,R,S) ---> s(Form, G0-G, [qterm(Q,X,R)|Store])/S. s(Form, G0-G, Store)/S ---> Subj, vp(Form,[Subj], G0-G, Store)/S. vp(Form,Subcat,G0-G, Store)/S ---> vp(Form,[Compl|Subcat], G0-G, Store)/S, Compl. vp(Form,[Subj],G0-G, Store)/S ---> vp0(Form,[Subj], G0-G, Store0)/VP, adv0(VP, Store0, Store)/S. adv0(VP, Store0, Store)/quant(Q,X,R,S) ---> adv0(VP, Store0, [qterm(Q,X,R)|Store])/S. adv0(VP, Store, Store)/S ---> adv(VP)/S. np(Agr, G0-G0, Store)/NP ---> det(Agr,Var,N, Store)/NP, nbar(Agr,Var)/N. nbar(Agr,Var)/NBar ---> n(Agr,Var)/NBar. nbar(Agr,Var)/NBar ---> nbar(Agr,Var)/NBar0, relcl(Agr,Var,NBar0)/NBar. relcl(Agr,Var,NBar0)/and(NBar0,S) ---> comp/_Comp, s(finite, [np(Agr)/Var]-[], [])/S. relcl(Agr,Var,NBar0)/and(NBar0,S) ---> comp/_Comp, vp0(finite, [np(Agr, []-[], [])/Var], []-[], [])/S. vp0(Form, Subcat, Gs, Store)/quant(Q,X,R,S) ---> vp0(Form, Subcat, Gs, [qterm(Q,X,R)|Store])/S. vp0(Form, Subcat, Gs, Store)/VP ---> vp(Form, Subcat, Gs, Store)/VP. np(Agr, [np(Agr)/Sem|X]-X, [])/Sem ---> []. /*---------------------------------------------------------------------- Lexicon ----------------------------------------------------------------------*/ vp(finite,[np(_, G0-G, SO)/O, np(3-sing, G0-G0, SS)/S], G0-G, SVP)/ love(S,O) ---> [loves], {shuffle(SS, SO, SVP)}. vp(finite,[np(_, G0-G, SO)/O, lex/up, np(3-sing, G0-G0, SS)/S], G0-G, SVP)/ call_up(S,O) ---> [calls], {shuffle(SS, SO, SVP)}. vp(finite,[np(_, G0-G, SO)/O, np(3-sing,G0-G0, SS)/S], G0-G, SVP)/ hate(S,O) ---> [hates], {shuffle(SS, SO, SVP)}. vp(nonfinite,[np(_, G0-G, SO)/O, np(_, G0-G0, SS)/S], G0-G, SVP)/hate(S,O) ---> [hate], {shuffle(SS, SO, SVP)}. vp(finite,[np(_, G0-G, SO)/O, np(_Num-pl, G0-G0, SS)/S], G0-G, SVP)/ hate(S,O) ---> [hate], {shuffle(SS, SO, SVP)}. vp(finite,[np(_, G0-G, SO)/O, np(1-sing, G0-G0, SS)/S], G0-G, SVP)/ hate(S,O) ---> [hate], {shuffle(SS, SO, SVP)}. vp(finite,[np(3-sing, G0-G0, SS)/S], G0-G0, SS)/leave(S) ---> [leaves]. vp(finite,[np(_, G0-G0, SS)/S], G0-G0, SS)/leave(S) ---> [left]. vp(finite,[np(_, G0-G, SO)/O, np(3-sing,G0-G0, SS)/S], G0-G, SVP)/ eat(S,O) ---> [eats], {shuffle(SS, SO, SVP)}. vp(finite,[np(3-sing, G0-G0, SS)/S], G0-G0, SS)/eat(S,_) ---> [eats]. np(1-sing, G0-G0, [])/self ---> [i]. np(3-sing, G0-G0, [])/mary ---> [mary]. np(3-sing, G0-G0, [])/john ---> [john]. np(3-sing, G0-G0, [])/sonny ---> [sonny]. np(3-sing, G0-G0, [])/cait ---> [cait]. np(3-pl, G0-G0, [])/crims ---> [criminals]. adv(VP)/pass(VP) ---> [passionately]. adv(VP)/quick(VP) ---> [quickly]. adv(VP)/poss(VP) ---> [possibly]. comp/that ---> [that]. comp/who ---> [who]. det(3-sing,X,P,[qterm(every,X,P)])/X ---> [every]. det(3-sing,X,P,[qterm(some,X,P)])/X ---> [some]. det(3-sing,X,P,[qterm(some,X,P)])/X ---> [a]. n(3-sing,X)/man(X) ---> [man]. n(3-sing,X)/crim(X) ---> [criminal]. n(3-sing,X)/cop(X) ---> [detective]. lex/Word ---> [Word]. /*---------------------------------------------------------------------- Test Examples ------------------------------------------------------------------------ gen(sentence/decl(quick(call_up(sonny,cait))), St). gen(sentence/imp(hate(you,crims)), St). gen(sentence/decl(quant(every,x,and(cop(x),love(x,cait)),hate(x,sonny))), St). gen(sentence/decl(quant(every,x,and(cop(x),love(cait,x)),hate(x,sonny))), St). gen(sentence/decl(poss(quant(every,x,and(cop(x),love(cait,x)),hate(x,sonny)))), St). | ?- gen(sentence/decl(quick(call_up(sonny,cait))), St). St = [sonny,calls,cait,up,quickly] ; no | ?- gen(sentence/imp(hate(you,crims)),St). St = [hate,criminals] ; no | ?- gen(sentence/decl(quant(every,x,and(cop(x),love(x,cait)),hate(x,sonny))), St). St = [every,detective,that,loves,cait,hates,sonny] ; St = [every,detective,who,loves,cait,hates,sonny] ; no | ?- gen(sentence/decl(quant(every,x,and(cop(x),love(cait,x)),hate(x,sonny))), St). St = [every,detective,that,cait,loves,hates,sonny] ; St = [every,detective,who,cait,loves,hates,sonny] ; no ----------------------------------------------------------------------*/ ........................................................................ bfque.pl ........................................................................ /*********************************************************************** Breadth-First Queue Data Structures Fernando C. N. Pereira ************************************************************************ COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. Copyright 1987 by Fernando C. N. Pereira Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both the copyright notice and this permission notice and warranty disclaimer appear in supporting documentation, and that the name of the author, Fernando C. N. Pereira, not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. The author disclaims all warranties with regard to this software, including all implied warranties of merchantability and fitness. In no event shall the author be liable for any special, indirect or consequential damages or any damages whatsoever resulting from loss of use, data or profits, whether in an action of contract, negligence or other tortious action, arising out of or in connection with the use or performance of this software. ***********************************************************************/ :- mode start_queue(-). start_queue(Empty-Empty). :- mode empty_queue(+). empty_queue(Front-Back) :- var(Front). :- mode dequeue(+,-,-). dequeue(Front-Back,Element,Rest-Back) :- nonvar(Front), Front = [Element|Rest]. :- mode enqueue(+,+,-). enqueue(Front-[Element|Back],Element,Front-Back). :- mode enqueue_list(+,+,-). enqueue_list([],Queue,Queue). enqueue_list([Item|Items],Queue0,Queue) :- enqueue(Queue0,Item,Queue1), enqueue_list(Items,Queue1,Queue). ........................................................................ weaken.pl ........................................................................ /*********************************************************************** Weakening of Terms Fernando C. N. Pereira ************************************************************************ COPYRIGHT NOTICE, LICENSE AND DISCLAIMER. Copyright 1987 by Fernando C. N. Pereira Permission to use, copy, modify, and distribute this software and its documentation for any purpose and without fee is hereby granted, provided that the above copyright notice appear in all copies and that both the copyright notice and this permission notice and warranty disclaimer appear in supporting documentation, and that the name of the author, Fernando C. N. Pereira, not be used in advertising or publicity pertaining to distribution of the software without specific, written prior permission. The author disclaims all warranties with regard to this software, including all implied warranties of merchantability and fitness. In no event shall the author be liable for any special, indirect or consequential damages or any damages whatsoever resulting from loss of use, data or profits, whether in an action of contract, negligence or other tortious action, arising out of or in connection with the use or performance of this software. ***********************************************************************/ weaken(Strong,Weak) :- weaken(Strong,Weak,[]). weaken(X,X,_) :- var(X). weaken(A,A,_) :- atomic(A). weaken(Strong, Weak, Path) :- nonvar(Strong), functor(Strong, F, N), N>0, ( member((F,N), Path) -> true ; functor(Weak, F, N), weaken_args(N, Strong, Weak, [(F,N)|Path]) ). weaken_args(0,_,_,_). weaken_args(N,Strong,Weak,Path) :- N>0, arg(N,Strong,StrongArg), arg(N,Weak,WeakArg), weaken(StrongArg,WeakArg,Path), N1 is N-1, weaken_args(N1,Strong,Weak,Path). member(X,[X|_]). member(X,[_|L]) :- member(X,L).