;;; semantic interpretation rules for natural language front end

:- prolog_language("pop11").

facet meaning, quant, adds, referent, subject, object;

vars copystar, sort_quants;

;;; The lowest level - word meanings

define adj_meaning(adj,r);
   vars x;
   if adj == "male" then
      [man ^r]
   elseif adj == "female" then
      [woman ^r]
   elseif adj == "childless" then
      gensym("X") -> x;
      [not [exists ^x [child ^r ^x] [true]]]
   elseif adj == [] then
      [object ^r]
   else
      mishap('Unknown adjective',[^adj])
   endif
enddefine;

define noun_meaning(noun,r);
   if noun == "monarch" then
      [monarch ^r]
   elseif noun == "king" then
      [and [monarch ^r] [man ^r]]
   elseif noun == "queen" then
      [and [monarch ^r] [woman ^r]]
   elseif noun == "man" then
      [man ^r]
   elseif noun == "woman" then
      [woman ^r]
   elseif noun == "person" then
      [person ^r]
   elseif noun == "date" then
      [date ^r]
   else
      mishap('Unknown noun',[^noun])
   endif
enddefine;

define verb_meaning(verb,s,o);
   if verb == "replaced" then
      [replaced ^s ^o]
   elseif verb == "was" then
      [= ^s ^o]
   elseif verb == "bore" then
      [child ^s ^o]
   elseif verb == "married" then
      [married ^s ^o]
   else mishap('Unknown verb',[^verb])
   endif
enddefine;

;;; Rules for more complex constituents

semrule sentence    [s ?np ?vp]
    referent(np) -> subject(vp);
    sort_quants([% quant(np), quant(vp), adds(vp) %]) -> meaning(self);
endsemrule;

semrule vp_trans    [vp ?v ?np]
    vars x;
    referent(np) -> x;
    subject(self) -> subject(v);
    x -> object(v);
    quant(np) -> quant(self);
    adds(v) -> adds(self);
endsemrule;

semrule snp         [snp ??adjs ?noun]
    vars adj, adjadds;
    [true] -> adjadds;
    for adj in adjs do
       referent(self) -> referent(adj);
       [and ^(adds(adj)) ^adjadds] -> adjadds;
    endfor;
    referent(self) -> referent(noun);
    [and ^(adds(noun)) ^adjadds] -> adds(self);
endsemrule;

semrule propn    [np [propn ??q [pn ?n]]]
    vars x, restric;
    gensym("X") -> x;
    x -> referent(self);
    [] -> adds(self);
    if q == [] then
       []
    else
       q(1) -> q;
       x -> referent(q);
       adds(q)
    endif -> restric;
    [the ^x [and ^restric [christian_name ^x ^n]] *] -> quant(self)
endsemrule;

semrule pron    [np [pron who]]
    vars x;
    gensym("X") -> x;
    x -> referent(self);
    [true] -> adds(self);
    [all ^x [and [person ^x] *] [printout ^x]] -> quant(self);
endsemrule;

;;; Each determiner needs a rule

semrule a        [np [det a] ?snp]
    vars x;
    gensym("X") -> x;
    x -> referent(self);
    x -> referent(snp);
    [exists ^x ^(adds(snp)) *] -> quant(self);
endsemrule;

semrule each        [np [det each] ?snp]
    vars x;
    gensym("X") -> x;
    x -> referent(self);
    x -> referent(snp);
    [all ^x ^(adds(snp)) *] -> quant(self);
endsemrule;

semrule which        [np [det which] ?snp]
    vars x;
    gensym("X") -> x;
    x -> referent(self);
    x -> referent(snp);
    [all ^x [and ^(adds(snp)) *] [printout ^x]]
-> quant(self);
endsemrule;

semrule adj [adj ?a]
   adj_meaning(a,referent(self)) -> adds(self);
endsemrule;

semrule noun [noun ?n]
    noun_meaning(n,referent(self)) -> adds(self);
endsemrule;

semrule verb [verb ?v]
    verb_meaning(v,subject(self),object(self)) -> adds(self);
endsemrule;

;;; Utilities for manipulating semantic interpretations
;;; SORT_QUANTS takes a list of quantified expressions and
;;; "sticks them together" by filling holes marked by "*"s

define copystar(list,filler);
   vars next;
    [% for next in list do
         if next.islist then copystar(next,filler)
         elseif next == "*" then filler
         else next
         endif
      endfor
   %]
enddefine;

define sort_quants(list) -> result;
   vars next;
   if list == [] then [] -> result
   else
      dest(list) -> list -> result;
      until list == [] do
         list.dest -> list -> next;
         copystar(result,next) -> result
      enduntil
   endif
enddefine;

;;; Interface to outside

define interpret(sentence);
   meaning(sentence)
enddefine;
