/*********************************************************************** DCG Compiler ***********************************************************************/ /*====================================================================== Operator Declarations ======================================================================*/ :- op(1200,xfx,'--->'). :- op(330, xfx, iz). :- op(320, xfx, of). :- op(310, xf, holds). :- op(300, fx, a). :- op(290, xfx, '\'). :- dynamic (--->)/2, parse/3, connect/3, leaf/3, lc/4. /*====================================================================== Compiler Driver ======================================================================*/ %%% compile %%% ======= %%% %%% Generates compiled clauses by partial execution of the DCG %%% metainterpreter below, and adds them to the Prolog database. compile :- program_clause(Clause), partially_execute(Clause, CompiledClause), add_rule(CompiledClause), fail. %%% add_rule(Clause) %%% ================ %%% %%% Clause ==> clause to be added to database after rewriting into %%% a normal form that changes calls to parse into %%% calls on particular nonterminals add_rule((Head :- Body)) :- write('Asserting "'), print((Head :- Body)), write('."'), nl, assert((Head :- Body)). /*====================================================================== Partial Execution of Prolog Programs ======================================================================*/ %%% partially_execute(Term, NewTerm) %%% ================================ %%% %%% Term ==> term encoding Prolog clause, literal list or literal %%% to be partially executed with respect to the program %%% clauses and auxiliary clauses given by program_clause %%% and clause predicates respectively. %%% NewTerm <== the partially executed term. %%% Partially executing a clause involves expanding the body. partially_execute((Head:-Body), (Head:-ExpandedBody)) :- !, partially_execute(Body, ExpandedBody). %%% Partially expanding a literal list involves conjoining the expansions %%% of the respective expansions. partially_execute((Literal, Rest), Expansion) :- !, % expand the first literal partially_execute(Literal, ExpandedLiteral), % and the rest of them partially_execute(Rest, ExpandedRest), % and conjoin the results conjoin(ExpandedLiteral, ExpandedRest, Expansion). %%% Partially executing an auxiliary literal involves replacing it with %%% the body of a matching clause (if there are any). partially_execute(Literal, Expansion) :- % if the literal should be partially executed aux_literal(Literal), % don't need to check for a match since if no compile-time match, % then no run-time match possible, except for the program clause % which isn't an aux_literal % and at least one rule matches % setof(Some, Literal^aclause(Literal, Some), [_Clause|_Others]), !, % then pick up any rule aclause(Literal, Body), % and expand its body partially_execute(Body, Expansion). %%% Partially executing a special literal involves executing it at run time. partially_execute(Literal, true) :- % if the literal should be fully executed special_literal(Literal), !, % then pick up any rule call(Literal). %%% Otherwise (if the literal is not an auxiliary literal or if no rules %%% match) we just leave it alone. partially_execute(Literal, Literal). /*---------------------------------------------------------------------- Utilities ----------------------------------------------------------------------*/ %%% conjoin(Conjunct1, Conjunct2, Conjunction) %%% ========================================== %%% %%% Conjunct1 ==> two terms to be conjoined %%% Conjunct2 ==> %%% Conjunction <== result of the conjunction %%% Conjoining a conjunction works just like concatenation (conc). conjoin((A,B), C, ABC) :- !, conjoin(B, C, BC), conjoin(A, BC, ABC). %%% Conjoining true and anything leaves the other conjunct unchanged. conjoin(true, A, A) :- !. conjoin(A, true, A) :- !. %%% Otherwise, use the normal comma conjunction operator. conjoin(A, C, (A,C)). %%% 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). %%% aclause(Head, Body) %%% =================== %%% %%% Head <== the head and body of a clause encoded with the unary %%% Body <== predicate `clause'; unit clauses can be encoded directly %%% with clause and the Body returned will be `true'. aclause(Head, Body) :- clause((Head:-Body)) ; (clause(Head), Body = true). /*====================================================================== Program to Partially Execute ======================================================================*/ /*---------------------------------------------------------------------- Control Information for Partial Executor ----------------------------------------------------------------------*/ aux_literal( (_ ---> _) ). aux_literal( parse_rest(_, _, _) ). aux_literal( word(_, _) ). aux_literal( nonterminal(_) ). aux_literal( get_lc(_,_,_,_) ). special_literal( (\+ _) ). special_literal( (_ = _) ). aux_literal( lex(_,_) ). aux_literal( _ iz _ ). aux_literal( xbar holds of _ ). aux_literal( case holds of _ ). aux_literal( theta holds of _ ). aux_literal( twobarsystem(_) ). /*---------------------------------------------------------------------- Left Corner DCG Metainterpreter to be Partially Executed Encoded form of Program 6.? ----------------------------------------------------------------------*/ program_clause(( connect(W, [W|R], R) :- true )). program_clause(( parse(Phrase, P0, P) :- leaf(SubPhrase, P0, P1), lc(SubPhrase, Phrase, P1, P) )). program_clause(( leaf(Cat, P0, P) :- connect(Word, P0, P), word(Word, Cat) )). program_clause(( leaf(Phrase, P0, P0) :- (Phrase ---> []) )). program_clause(( lc(Phrase, Phrase, P0, P0) :- true )). program_clause(( lc(SubPhrase, SuperPhrase, P0, P) :- (Phrase ---> Body), get_lc(Body, Constraints, SubPhrase, Rest), nonterminal(SubPhrase), Constraints, parse_rest(Rest, P0, P1), lc(Phrase, SuperPhrase, P1, P) )). clause(( parse_rest(Phrase, P0, P) :- (\+ Phrase = (_,_)), (\+ Phrase = {_}), (\+ Phrase = []), parse(Phrase, P0, P) )). clause(( parse_rest({Goals}, P0, P0) :- Goals )). clause(( parse_rest([], P0, P0) )). clause(( parse_rest((Phrase,Phrases), P0, P) :- parse_rest(Phrase, P0, P1), parse_rest(Phrases, P1, P) )). clause(( nonterminal(Phrase) :- \+ \+ ((_Head ---> Body), get_lc(Body, _, Phrase, _)) )). clause(( get_lc(({Constraints},LC,Rest), Constraints, LC, Rest) )). clause(( get_lc(({Constraints},LC), Constraints, LC, []) :- (\+ LC = (_,_)) )). clause(( get_lc((LC, Rest), true, LC, Rest) :- (\+ LC = {_}) )). clause(( get_lc(LC, true, LC, []) :- (\+ LC = (_,_)) )). nonterminal(Phrase) :- \+ \+ ((_Head ---> Body), get_lc(Body, _, Phrase, _)) . get_lc(({Constraints},LC,Rest), Constraints, LC, Rest) . get_lc(({Constraints},LC), Constraints, LC, []) :- (\+ LC = (_,_)) . get_lc((LC, Rest), true, LC, Rest) :- (\+ LC = {_}) . get_lc(LC, true, LC, []) :- (\+ LC = (_,_)) . /*---------------------------------------------------------------------- Sample Data for Program to Partially Execute: ----------------------------------------------------------------------*/ clause(( con(A) ---> {B iz head of A, none iz arg of A, none iz direction of A, xbar holds of A, % binding holds of A, case holds of A, theta holds of A}, con(B) )). clause(( con(A) ---> {C iz head of A, B iz arg of A, left iz direction of A, xbar holds of A, % binding holds of A, case holds of A, theta holds of A}, con(B), con(C) )). clause(( con(A) ---> {B iz head of A, C iz arg of A, right iz direction of A, xbar holds of A, % binding holds of A, case holds of A, theta holds of A}, con(B), con(C) )). clause(( xbar holds of P :- H iz head of P, C iz cat of P, C iz cat of H, s(B) iz bar of P, B iz bar of H, twobarsystem(P), W iz wh of P, W iz wh of H, A iz arg of P, s(s(0)) iz bar of A )). clause(( xbar holds of P :- H iz head of P, C iz cat of P, C iz cat of H, s(B) iz bar of P, B iz bar of H, twobarsystem(P), W iz wh of P, W iz wh of H, T iz theta of P, T iz theta of H, Case iz case of P, Case iz case of H, none iz arg of P )). clause(( twobarsystem(P) :- B iz bar of P, (B=0;B=s(0);B=s(s(0))) )). clause(( case holds of P :- H iz head of P, A iz arg of P, _C iz cat of A, D iz direction of P, _\[D-A|Cases] iz case of H, _\Cases iz case of P )). clause(( case holds of P :- H iz head of P, none iz arg of P, Cases iz case of P, Cases iz case of H )). clause(( theta holds of P :- H iz head of P, A iz arg of P, _C iz cat of A, D iz direction of P, _\[D-A|Thetas] iz theta of H, _\Thetas iz theta of P )). clause(( theta holds of P :- H iz head of P, none iz arg of P, Thetas iz theta of P, Thetas iz theta of H )). % binding holds of P :- ??? % info(Head, % Arg, % Direction, % cat(N, V), % Bar, % Case, % Theta, % Wh, % Index, % Empty) clause(( H iz head of info(H,_,_,_,_,_,_,_,_,_) )). clause(( A iz arg of info(_,A,_,_,_,_,_,_,_,_) )). clause(( D iz direction of info(_,_,D,_,_,_,_,_,_,_) )). clause(( C iz cat of info(_,_,_,C,_,_,_,_,_,_) )). clause(( B iz bar of info(_,_,_,_,B,_,_,_,_,_) )). clause(( C iz case of info(_,_,_,_,_,C,_,_,_,_) )). clause(( T iz theta of info(_,_,_,_,_,_,T,_,_,_) )). clause(( W iz wh of info(_,_,_,_,_,_,_,W,_,_) )). clause(( I iz index of info(_,_,_,_,_,_,_,_,I,_) )). clause(( E iz empty of info(_,_,_,_,_,_,_,_,_,E) )). clause(( N iz n of info(_,_,_,cat(N,_),_,_,_,_,_,_) )). clause(( V iz v of info(_,_,_,cat(_,V),_,_,_,_,_,_) )). clause(( A iz a xp :- s(s(0)) iz bar of A )). clause(( A iz a n :- plus iz n of A, minus iz v of A )). clause(( A iz a np :- A iz a n, A iz a xp )). clause(( A iz a v :- minus iz n of A, plus iz v of A )). clause(( A iz a vp :- A iz a v, A iz a xp )). % direction: left means arg on left % right right % case and theta are lists of D-Con % where D iz direction of arg and Con iz what kind of arg it iz % empty iff an empty category clause(( word(W, con(A)) :- lex(W, A), 0 iz bar of A )). clause(( A iz a proper_noun :- A iz a n, _\[] iz case of A, _\[] iz theta of A, minus iz empty of A, minus iz wh of A )). clause(( lex(john, A) :- A iz a proper_noun )). clause(( lex(mary, A) :- A iz a proper_noun )). clause(( A iz a finite_tv :- A iz a v, _\[right-Object, left-Subject] iz case of A, Object iz a np, Subject iz a np, acc\_ iz case of Object, nom\_ iz case of Subject, _\[right-Patient, left-Agent] iz theta of A, patient\_ iz theta of Patient, agent\_ iz theta of Agent )). clause(( lex(loves, A) :- A iz a finite_tv )). clause(( lex(saw, A) :- A iz a finite_tv )). /* lex(love, A) :- minus iz n of A, plus iz v of A, _\[right-Object] iz case of A, Object iz a np, acc\_ iz case of Object, _\[right-Patient, left-Agent] iz theta of A, patient\_ iz theta of Patient, agent\_ iz theta of Agent. lex(will, A) :- minus iz n of A, plus iz v of A, _\[left-Subject] iz case of A, Subject iz a np, nom\_ iz case of Subject. */ con(A) ---> {B iz head of A, none iz arg of A, none iz direction of A, xbar holds of A, % binding holds of A, case holds of A, theta holds of A}, con(B). con(A) ---> {C iz head of A, B iz arg of A, left iz direction of A, xbar holds of A, % binding holds of A, case holds of A, theta holds of A}, con(B), con(C). con(A) ---> {B iz head of A, C iz arg of A, right iz direction of A, xbar holds of A, % binding holds of A, case holds of A, theta holds of A}, con(B), con(C). xbar holds of P :- H iz head of P, C iz cat of P, C iz cat of H, s(B) iz bar of P, B iz bar of H, twobarsystem(P), W iz wh of P, W iz wh of H, A iz arg of P, s(s(0)) iz bar of A. xbar holds of P :- H iz head of P, C iz cat of P, C iz cat of H, s(B) iz bar of P, B iz bar of H, twobarsystem(P), W iz wh of P, W iz wh of H, T iz theta of P, T iz theta of H, Case iz case of P, Case iz case of H, none iz arg of P. twobarsystem(P) :- B iz bar of P, (B=0;B=s(0);B=s(s(0))). case holds of P :- H iz head of P, A iz arg of P, _C iz cat of A, D iz direction of P, _\[D-A|Cases] iz case of H, _\Cases iz case of P. case holds of P :- H iz head of P, none iz arg of P, Cases iz case of P, Cases iz case of H. theta holds of P :- H iz head of P, A iz arg of P, _C iz cat of A, D iz direction of P, _\[D-A|Thetas] iz theta of H, _\Thetas iz theta of P. theta holds of P :- H iz head of P, none iz arg of P, Thetas iz theta of P, Thetas iz theta of H. % binding holds of P :- ??? % info(Head, % Arg, % Direction, % cat(N, V), % Bar, % Case, % Theta, % Wh, % Index, % Empty) H iz head of info(H,_,_,_,_,_,_,_,_,_). A iz arg of info(_,A,_,_,_,_,_,_,_,_). D iz direction of info(_,_,D,_,_,_,_,_,_,_). C iz cat of info(_,_,_,C,_,_,_,_,_,_). B iz bar of info(_,_,_,_,B,_,_,_,_,_). C iz case of info(_,_,_,_,_,C,_,_,_,_). T iz theta of info(_,_,_,_,_,_,T,_,_,_). W iz wh of info(_,_,_,_,_,_,_,W,_,_). I iz index of info(_,_,_,_,_,_,_,_,I,_). E iz empty of info(_,_,_,_,_,_,_,_,_,E). N iz n of info(_,_,_,cat(N,_),_,_,_,_,_,_). V iz v of info(_,_,_,cat(_,V),_,_,_,_,_,_). portray(info(Head, Arg, Dir, cat(N,V), Bar, Case, Theta, Wh, Index, Empty)) :- cat_label(N,V,Bar, Cat), feature_list([head=Head, arg=Arg, dir=Dir, case=Case, theta=Theta, wh=Wh, index=Index, empty=Empty], List), print(Cat), print(List). cat_label(N, V, Bar, Cat) :- ( N==plus, V==minus, Bar==s(s(0)) ) -> Cat = np ; ( N==plus, V==minus, Bar==s(0) ) -> Cat = n1 ; ( N==plus, V==minus, Bar==0 ) -> Cat = n0 ; ( N==plus, V==minus ) -> Cat = n ; ( N==minus, V==plus, Bar==s(s(0)) ) -> Cat = vp ; ( N==minus, V==plus, Bar==s(0) ) -> Cat = v1 ; ( N==minus, V==plus, Bar==0 ) -> Cat = v0 ; ( N==minus, V==plus ) -> Cat = v ; ( Bar==s(s(0)) ) -> Cat = xp ; ( Bar==s(0) ) -> Cat = x1 ; ( Bar==0 ) -> Cat = x0 ; Cat = x . feature_list([], []). feature_list([_F=V|R], L) :- var(V), !, feature_list(R, L). feature_list([E|R], [E|L]) :- feature_list(R, L). A iz a xp :- s(s(0)) iz bar of A. A iz a n :- plus iz n of A, minus iz v of A. A iz a np :- A iz a n, A iz a xp. A iz a v :- minus iz n of A, plus iz v of A. A iz a vp :- A iz a v, A iz a xp. % direction: left means arg on left % right right % case and theta are lists of D-Con % where D iz direction of arg and Con iz what kind of arg it iz % empty iff an empty category word(W, con(A)) :- lex(W, A), 0 iz bar of A. A iz a proper_noun :- A iz a n, _\[] iz case of A, _\[] iz theta of A, minus iz empty of A, minus iz wh of A. lex(john, A) :- A iz a proper_noun. lex(mary, A) :- A iz a proper_noun. A iz a finite_tv :- A iz a v, _\[right-Object, left-Subject] iz case of A, Object iz a np, Subject iz a np, acc\_ iz case of Object, nom\_ iz case of Subject, _\[right-Patient, left-Agent] iz theta of A, patient\_ iz theta of Patient, agent\_ iz theta of Agent. lex(loves, A) :- A iz a finite_tv. lex(saw, A) :- A iz a finite_tv. /* lex(love, A) :- minus iz n of A, plus iz v of A, _\[right-Object] iz case of A, Object iz a np, acc\_ iz case of Object, _\[right-Patient, left-Agent] iz theta of A, patient\_ iz theta of Patient, agent\_ iz theta of Agent. lex(will, A) :- minus iz n of A, plus iz v of A, _\[left-Subject] iz case of A, Subject iz a np, nom\_ iz case of Subject. */ portray(info(Head, Arg, Dir, cat(N,V), Bar, Case, Theta, Wh, Index, Empty)) :- cat_label(N,V,Bar, Cat), feature_list([head=Head, arg=Arg, dir=Dir, case=Case, theta=Theta, wh=Wh, index=Index, empty=Empty], List), print(Cat), print(List). cat_label(N, V, Bar, Cat) :- ( N==plus, V==minus, Bar==s(s(0)) ) -> Cat = np ; ( N==plus, V==minus, Bar==s(0) ) -> Cat = n1 ; ( N==plus, V==minus, Bar==0 ) -> Cat = n0 ; ( N==plus, V==minus ) -> Cat = n ; ( N==minus, V==plus, Bar==s(s(0)) ) -> Cat = vp ; ( N==minus, V==plus, Bar==s(0) ) -> Cat = v1 ; ( N==minus, V==plus, Bar==0 ) -> Cat = v0 ; ( N==minus, V==plus ) -> Cat = v ; ( Bar==s(s(0)) ) -> Cat = xp ; ( Bar==s(0) ) -> Cat = x1 ; ( Bar==0 ) -> Cat = x0 ; Cat = x . feature_list([], []). feature_list([_F=V|R], L) :- var(V), !, feature_list(R, L). feature_list([E|R], [E|L]) :- feature_list(R, L). bench(Time) :- statistics(runtime,_), parse(_A, [john,loves,mary], []), statistics(runtime,[_,Time]).