/* A BOTTOM-UP (DATA-DRIVEN) PATTERN-MATCHING PARSER */

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

 

:- style_check(-singleton).

 

:- [fgetsen,prpr].

 

:- op(800,xfx,--->).

 

 

/* start the whole thing */

 

go :- gets,run,!,fail.

go :- clear,go.

 

/* getting the sentence  from the user and computing the string positions */

 

gets :- getsentence(S,user),

        process(S,0).

 

 

/* each word in the list is assigned a starting and an ending position */

 

     process([Head|Tail],Pos):-

                 Posand1 is Pos + 1,

                 recorda(pos,position(Pos,Posand1,Head),_),

                 process(Tail,Posand1).

 

/* position of the last word indicates string end */

 

     process([],X) :-  recorda(fin,fin(X),_).

    

 

/* pattern-directed meta-interpreter */

/* run is rerun until it fails being unable to find new R->C_A pairs */

 

run :-  Rule_name ---> Condition_Action,

        testexec(Condition_Action),

        run.

 

testexec([]).

testexec([First|Rest]) :-

                       call(First),

                       testexec(Rest).

 

% testexec is simply a list traversal with execution of each element as Prolog goal

 

/* utility predicates */

 

build(Box,Data) :- not(recorded(Box,Data,_)), recorda(Box,Data,_).

known(Box,Data) :- recorded(Box,Data,_).

 

 

/* the lexicon */

 

lex(verbintr,thinks,[vintr(thinks)],sing).

lex(verbintr,think,[vintr(think)],plural).

lex(verbintr,thought,[vintr(thought)],_).

 

lex(verbtr,reads,[vtr(reads)],sing).

lex(verbtr,read,[vtr(read)],plural).

lex(verbtr,read,[vtr(read)],_).

lex(verbtr,considered,[vtr(considered)],_).

lex(verbtr,made,[vtr(made)],_).

lex(verbtr,make,[vtr(make)],plural).

lex(verbtr,makes,[vtr(makes)],sing).

lex(verbtr,considers,[vtr(considers)],sing).

lex(verbtr,consider,[vtr(consider)],plural).

lex(verbtr,likes,[vtr(likes)],sing).

lex(verbtr,like,[vtr(like)],plural).

lex(verbtr,liked,[vtr(liked)],_).

 

lex(vcomp,considered,[vcomp(considered)],_).

lex(vcomp,consider,[vcomp(consider)],plural).

lex(vcomp,considers,[vcomp(considers)],sing).

 

lex(determiner,a,[det(a)],sing).

lex(determiner,the,[det(the)],_).

lex(determiner,an,[det(an)],sing).

lex(determiner,some,[det(some)],_).

lex(determiner,any,[det(any)],_).

 

lex(noun,man,[n(man)],sing).

lex(noun,book,[n(book)],sing ).

lex(noun,claim,[n(claim)],sing).

lex(noun,oversimplification,[n(oversimplification)],sing). 

lex(noun,woman,[n(woman)],sing).

lex(noun,men,[n(men)],plural).

lex(noun,books,[n(books)],plural).

lex(noun,claims,[n(claims)],plural).

lex(noun,oversimplifications,[n(oversimplifications)],plural). 

lex(noun,women,[n(women)],plural).

              

lex(sentnoun,claim,[sentn(claim)],sing). 

lex(sentnoun,claims,[sentn(claims)],plural).  

                                  

lex(coord,and,[coord(and)]).

 

 

/* the grammar */

 

 

/* LEXICAL PREDICATES */

 

 

/* the apostrophe ( in genitives ) */

 

apo ---> [known(pos,position(A,B,s)),

          build(apo,apo(A,B))].

 

/* nouns */

 

noun ---> [known(pos,position(A,B,Noun)),

            lex(noun,Noun,Tree,Number),

            build(noun,noun(A,B,Tree,Number))].

 

/* determiners */

 

det ---> [known(pos,position(A,B,Det)),

           lex(determiner,Det,Tree,Number),

           build(det,det(A,B,Tree,Number))].

 

/* sentential nouns */

 

sentnoun ---> [known(pos,position(A,B,Sn)),

               lex(sentnoun,Sn,Tree,Number),

               build(sentnoun,sentnoun(A,B,Tree,Number))].

 

/* intransitive verbs --> vps */

 

iv ---> [known(pos,position(A,B,Vi)),

         lex(verbintr,Vi,Tree,Number),

         build(vp,vp(A,B,[vp,Tree],Number))].

 

/* transitive verbs */

 

tv --->[known(pos,position(A,B,Vtr)),

        lex(verbtr,Vtr,Treeverb,Number),

        build(verbtr,verbtr(A,B,Treeverb,Number))].

 

/* vcomps */

 

vcomp ---> [known(pos,position(A,B,Vcomp)),

            lex(vcomp,Vcomp,Treeverb,Number),

            build(vcomp,vcomp(A,B,Treeverb,Number))].

 

/* coordinator AND */

 

coordinator ---> [known(pos,position(A,B,And)),

                  lex(coord,And,Treeand),

                  build(coord,coord(A,B,Treeand))].

 

 

 

/* GRAMMAR PREDICATES */

 

 

/* DETERMINERS */

 

/* genitive as determiner : the man's book

   note that this creates left recursion,

   as the det starts with an np, and an np starts

   with a det */

 

gdet ---> [known(apo,apo(B,C)),

           known(np,np(A,B,Tree,Number)),

           build(det,det(A,C,[det,Tree],_))].

 

 

/* NPS */

 

/* simple nps with non-zero determiner*/

 

gnoun_nonzerodet ---> [known(det,det(A,B,Tree1,Number)),

                       known(noun,noun(B,C,Tree2,Number)),

                       build(np,np(A,C,[np,simplenp,Tree1,Tree2],Number))].

 

/* simple nps with zero det */

 

gnoun_zerodet ---> [known(noun,noun(A,B,Tree,plural)),

                    build(np,np(A,B,[np,simplenp,det(zero),Tree],plural))].

 

  

/* nps with sentential nouns and cplts */

 

gsentnoun ---> [known(sentnoun,sentnoun(B,C,Tree2,Number)),

                known(det,det(A,B,Tree1,Number)),

                known(s,s(C,D,Tree3,_)),

                build(np,np(A,D,[np,sententialnp,Tree1,Tree2,Tree3],Number))].

 

 

/* nps with relative clauses */

 

nprel ---> [known(det,det(A,B,Tree1,Number)),

            known(noun,noun(B,C,Tree2,Number)),

            known(relclause,relclause(C,D,Tree3)),

            build(np,np(A,D,[np,relclausenp,Tree1,Tree2,Tree3],Number))].

 

 

/* coordinated nps */

 

coordnps ---> [known(coord,coord(B,C,Tree2)),

               known(np,np(A,B,Tree1,Number1)),

               known(np,np(C,D,Tree3,Number3)),

               build(np,np(A,D,[np,Tree1,Tree2,Tree3],plural))].

 

 

/* VPS */

 

/* transitive vps */

 

vtrvps ---> [known(verbtr,verbtr(A,B,Treeverb,Number)),

             known(np,np(B,C,Treenp,Numbernp)),

             build(vp,vp(A,C,[vp,Treeverb,Treenp],Number))].

 

/* complex vps */

 

complexvps ---> [known(vcomp,vcomp(A,B,Treeverb,Number)),

                 known(np,np(B,C,Treenp1,Numbernp)),

                 known(np,np(C,D,Treenp2,Numbernp)),

                 build(vp,vp(A,D,[vp,Treeverb,Treenp1,Treenp2],Number))].

 

 

/* REL CLAUSES */

 

relative_clause ---> [known(det,det(A,B,Tree1,Number)),

                      known(noun,noun(B,C,Tree2,Number)),

                      known(verbtr,verbtr(C,D,Tree3,Number)),

                      build(relclause,relclause(A,D,[relclause,Tree1,Tree2,Tree3]))].

 

 

/* SENTENCES */

 

sentence ---> [ known(vp,vp(B,C,Treevp,Number)),

                known(np,np(A,B,Treenp,Number)),

                build(s,s(A,C,[s,Treenp,Treevp],sing))].

 

 

/* COORDINATED STRUCTURES */

 

coordstructures ---> [ known(coord,coord(B,C,Tree2)),

                       (X=verbtr;X=vcomp;X=vp;X=relclause;X=s),

                       Term1 =.. [X,A,B,Tree1,Number],

                       Term2 =.. [X,C,D,Tree3,Number],

                       Term3 =.. [X,A,D,[X,Tree1,Tree2,Tree3],Number],

                       known(X,Term1),

                       known(X,Term2),

                       build(X,Term3)].

 

 

/* outputting results ... */

 

output ---> [known(s,s(0,B,Tree,_)),

             known(fin,fin(B)),

             not(known(tree,tree(0,B,Tree))),

             nl,

             prpr(Tree,0),

             recorda(tree,tree(0,B,Tree),_),

             nl,

             write(' --- ANY KEY TO GO ON ---'),nl,

             get_single_char(_) ].

 

 

/* stopping ... */

 

stop ---> [known(pos,position(0,1,stop)),

           halt].

 

 

/* Clearing the database ... */

 

clear :-

       eraseall(pos),

       eraseall(fin),

       eraseall(tree),

       eraseall(s),

       eraseall(np),

       eraseall(vp),

       eraseall(verbintr),

       eraseall(verbtr),

       eraseall(coord),

       eraseall(det),

       eraseall(sentnoun),

       eraseall(noun),

       eraseall(vcomp),

       eraseall(relclause),

       eraseall(apo).

      

 eraseall(X) :-

     recorded(X,_,Ref),

     erase(Ref),

     fail.

    

 eraseall(_).        

 

/****************/