2/* @(#)scopes.pl	24.1 2/24/88 */
    3
    4/* 
    5	Copyright 1986, Fernando C.N. Pereira and David H.D. Warren,
    6
    7			   All Rights Reserved
    8*/
    9clausify(question(V0,P),(answer(V):-B)) :-
   10   quantify(P,Quants,[],R0),
   11   split_quants(question(V0),Quants,HQuants,[],BQuants,[]),
   12   chain_apply(BQuants,R0,R1),
   13   head_vars(HQuants,B,R1,V,V0).
   14
   15quantify(quant(Det,X,Head,Pred,Args,Y),Above,Right,true) :-
   16   close_tree(Pred,P2),
   17   quantify_args(Args,AQuants,P1),
   18   split_quants(Det,AQuants,Above,[Q|Right],Below,[]),
   19   pre_apply(Head,Det,X,P1,P2,Y,Below,Q).
   20quantify(conj(Conj,LPred,LArgs,RPred,RArgs),Up,Up,P) :-
   21   close_tree(LPred,LP0),
   22   quantify_args(LArgs,LQs,LP1),
   23   chain_apply(LQs,(LP0,LP1),LP),
   24   close_tree(RPred,RP0),
   25   quantify_args(RArgs,RQs,RP1),
   26   chain_apply(RQs,(RP0,RP1),RP),
   27   conj_apply(Conj,LP,RP,P).
   28quantify(pred(Subj,Op,Head,Args),Above,Right,P) :-
   29   quantify(Subj,SQuants,[],P0),
   30   quantify_args(Args,AQuants,P1),
   31   split_quants(Op,AQuants,Up,Right,Here,[]),
   32   list_conc(SQuants,Up,Above),
   33   chain_apply(Here,(P0,Head,P1),P2),
   34   op_apply(Op,P2,P).
   35quantify(~P,Q,Q,P).
   36quantify(P&Q,Above,Right,(S,T)) :-
   37   quantify(Q,Right0,Right,T),
   38   quantify(P,Above,Right0,S).
   39   
   40head_vars([],P,P,L,L0) :-
   41   strip_types(L0,L).
   42head_vars([Quant|Quants],(P,R0),R,[X|V],V0) :-
   43   extract_var(Quant,P,X),
   44   head_vars(Quants,R0,R,V,V0).
   45
   46strip_types([],[]).
   47strip_types([_-X|L0],[X|L]) :-
   48   strip_types(L0,L).
   49
   50extract_var(quant(_,_-X,P,_-X),P,X).
   51
   52chain_apply(Q0,P0,P) :-
   53   sort_quants(Q0,Q,[]),
   54   chain_apply0(Q,P0,P).    
   55
   56chain_apply0([],P,P).
   57chain_apply0([Q|Quants],P0,P) :-
   58   chain_apply0(Quants,P0,P1),
   59   det_apply(Q,P1,P).
   60
   61quantify_args([],[],true).
   62quantify_args([Arg|Args],Quants,(P,Q)) :-
   63   quantify_args(Args,Quants0,Q),
   64   quantify(Arg,Quants,Quants0,P).
   65
   66pre_apply(~Head,set(I),X,P1,P2,Y,Quants,Quant) :-
   67   indices(Quants,I,Indices,RestQ),
   68   chain_apply(RestQ,(Head,P1),P),
   69   setify(Indices,X,(P,P2),Y,Quant).
   70pre_apply(~Head,Det,X,P1,P2,Y,Quants,quant(Det,X,(P,P2),Y)) :-
   71 ( unit_det(Det);
   72   index_det(Det,_)),
   73   chain_apply(Quants,(Head,P1),P).
   74pre_apply(apply(F,P0),Det,X,P1,P2,Y,
   75      Quants0,quant(Det,X,(P3,P2),Y)) :-
   76   but_last(Quants0,quant(lambda,Z,P0,Z),Quants),
   77   chain_apply(Quants,(F,P1),P3).
   78pre_apply(aggr(F,Value,L,Head,Pred),Det,X,P1,P2,Y,Quants,
   79      quant(Det,X,
   80            (S^(setof(Range:Domain,P,S),
   81                aggregate(F,S,Value)),P2),Y)) :-
   82   close_tree(Pred,R),
   83   complete_aggr(L,Head,(R,P1),Quants,P,Range,Domain).
   84
   85but_last([X|L0],Y,L) :-
   86   but_last0(L0,X,Y,L).
   87
   88but_last0([],X,X,[]).
   89but_last0([X|L0],Y,Z,[Y|L]) :-
   90   but_last0(L0,X,Z,L).
   91
   92close_tree(T,P) :-
   93   quantify(T,Q,[],P0),
   94   chain_apply(Q,P0,P).
   95
   96meta_apply(~G,R,Q,G,R,Q).
   97meta_apply(apply(F,(R,P)),R,Q0,F,true,Q) :-
   98   but_last(Q0,quant(lambda,Z,P,Z),Q).
   99
  100indices([],_,[],[]).
  101indices([Q|Quants],I,[Q|Indices],Rest) :-
  102   open_quant(Q,Det,_,_,_),
  103   index_det(Det,I),
  104   indices(Quants,I,Indices,Rest).
  105indices([Q|Quants],I,Indices,[Q|Rest]) :-
  106   open_quant(Q,Det,_,_,_),
  107   unit_det(Det),
  108   indices(Quants,I,Indices,Rest).
  109
  110setify([],Type-X,P,Y,quant(set,Type-([]:X),true:P,Y)).
  111setify([Index|Indices],X,P,Y,Quant) :-
  112   pipe(Index,Indices,X,P,Y,Quant).
  113
  114pipe(quant(int_det(_,Z),Z,P1,Z),
  115      Indices,X,P0,Y,quant(det(a),X,P,Y)) :-
  116   chain_apply(Indices,(P0,P1),P).
  117pipe(quant(index(_),_-Z,P0,_-Z),Indices,Type-X,P,Y,
  118      quant(set,Type-([Z|IndexV]:X),(P0,P1):P,Y)) :-
  119   index_vars(Indices,IndexV,P1).
  120
  121index_vars([],[],true).
  122index_vars([quant(index(_),_-X,P0,_-X)|Indices],
  123      [X|IndexV],(P0,P)) :-
  124   index_vars(Indices,IndexV,P).
  125
  126complete_aggr([Att,Obj],~G,R,Quants,(P,R),Att,Obj) :-
  127   chain_apply(Quants,G,P).
  128complete_aggr([Att],Head,R0,Quants0,(P1,P2,R),Att,Obj) :-
  129   meta_apply(Head,R0,Quants0,G,R,Quants),
  130   set_vars(Quants,Obj,Rest,P2),
  131   chain_apply(Rest,G,P1).
  132complete_aggr([],~G,R,[quant(set,_-(Obj:Att),S:T,_)],
  133      (G,R,S,T),Att,Obj).
  134
  135set_vars([quant(set,_-(I:X),P:Q,_-X)],[X|I],[],(P,Q)).
  136set_vars([],[],[],true).
  137set_vars([Q|Qs],[I|Is],R,(P,Ps)) :-
  138   open_quant(Q,Det,X,P,Y),
  139   set_var(Det,X,Y,I), !,
  140   set_vars(Qs,Is,R,Ps).
  141set_vars([Q|Qs],I,[Q|R],P) :-
  142   set_vars(Qs,I,R,P).
  143
  144set_var(Det,_-X,_-X,X) :-
  145   setifiable(Det).
  146
  147sort_quants([],L,L).
  148sort_quants([Q|Qs],S,S0) :-
  149   open_quant(Q,Det,_,_,_),
  150   split_quants(Det,Qs,A,[],B,[]),
  151   sort_quants(A,S,[Q|S1]),
  152   sort_quants(B,S1,S0).
  153
  154split_quants(_,[],A,A,B,B).
  155split_quants(Det0,[Quant|Quants],Above,Above0,Below,Below0) :-
  156   compare_dets(Det0,Quant,Above,Above1,Below,Below1),
  157   split_quants(Det0,Quants,Above1,Above0,Below1,Below0).
  158
  159compare_dets(Det0,Q,[quant(Det,X,P,Y)|Above],Above,Below,Below) :-
  160   open_quant(Q,Det1,X,P,Y),
  161   governs(Det1,Det0), !,
  162   bubble(Det0,Det1,Det).
  163compare_dets(Det0,Q0,Above,Above,[Q|Below],Below) :-
  164   lower(Det0,Q0,Q).
  165
  166open_quant(quant(Det,X,P,Y),Det,X,P,Y).
  167
  168% =================================================================
  169% Determiner Properties
  170
  171index_det(index(I),I).
  172index_det(int_det(I,_),I).
  173
  174unit_det(set).
  175unit_det(lambda).
  176unit_det(quant(_,_)).
  177unit_det(det(_)).
  178unit_det(question(_)).
  179unit_det(id).
  180unit_det(void).
  181unit_det(not).
  182unit_det(generic).
  183unit_det(int_det(_)).
  184unit_det(proportion(_)).
  185
  186det_apply(quant(Det,Type-X,P,_-Y),Q0,Q) :-
  187   apply(Det,Type,X,P,Y,Q0,Q).
  188
  189apply(generic,_,X,P,X,Q,X^(P,Q)).
  190apply(proportion(_Type-V),_,X,P,Y,Q,
  191      S^(setof(X,P,S),
  192         N^(numberof(Y,(one_of(S,Y),Q),N),
  193            M^(cardinality(S,M),ratio(N,M,V))))).
  194apply(id,_,X,P,X,Q,(P,Q)).
  195apply(void,_,X,P,X,Q,X^(P,Q)).
  196apply(set,_,Index:X,P0,S,Q,S^(P,Q)) :-
  197   apply_set(Index,X,P0,S,P).
  198apply(int_det(Type-X),Type,X,P,X,Q,(P,Q)).
  199apply(index(_),_,X,P,X,Q,X^(P,Q)).
  200apply(quant(Op,N),Type,X,P,X,Q,R) :-
  201   value(N,Type,Y),
  202   quant_op(Op,Z,Y,numberof(X,(P,Q),Z),R).
  203apply(det(Det),_,X,P,Y,Q,R) :-
  204   apply0(Det,X,P,Y,Q,R).
  205
  206apply0(Some,X,P,X,Q,X^(P,Q)) :-
  207   some(Some).
  208apply0(All,X,P,X,Q,\+X^(P,\+Q)) :-
  209   all(All).
  210apply0(no,X,P,X,Q,\+X^(P,Q)).
  211apply0(notall,X,P,X,Q,X^(P,\+Q)).
  212
  213quant_op(same,X,X,P,P).
  214quant_op(Op,X,Y,P,X^(P,F)) :-
  215   quant_op(Op,X,Y,F).
  216
  217quant_op(not+more,X,Y,X=<Y).
  218quant_op(not+less,X,Y,X>=Y).
  219quant_op(less,X,Y,X<Y).
  220quant_op(more,X,Y,X>Y).
  221
  222value(wh(Type-X),Type,X).
  223value(nb(X),_,X).
  224
  225all(all).
  226all(every).
  227all(each).
  228all(any).
  229
  230some(a).
  231some(the(sg)).
  232some(some).
  233
  234apply_set([],X,true:P,S,setof(X,P,S)).
  235apply_set([I|Is],X,Range:P,S,
  236      setof([I|Is]:V,(Range,setof(X,P,V)),S)).
  237
  238
  239governs(Det,set(J)) :-
  240   index_det(Det,I),
  241   I \== J.
  242governs(Det0,Det) :-
  243   index_det(Det0,_),
  244 ( index_det(Det,_);
  245   Det=det(_);
  246   Det=quant(_,_)).
  247governs(_,void).
  248governs(_,lambda).
  249governs(_,id).
  250governs(det(each),question([_|_])).
  251governs(det(each),det(each)).
  252governs(det(any),not).
  253governs(quant(same,wh(_)),Det) :-
  254   weak(Det).
  255
  256governs(det(Strong),Det) :-
  257   strong0(Strong),
  258   weak(Det).
  259
  260strong(det(Det)) :-
  261   strong0(Det).
  262
  263strong0(each).
  264strong0(any).
  265
  266weak(det(Det)) :-
  267   weak0(Det).
  268weak(quant(_,_)).
  269weak(index(_)).
  270weak(int_det(_,_)).
  271weak(set(_)).
  272weak(int_det(_)).
  273weak(generic).
  274weak(proportion(_)).
  275
  276weak0(no).
  277weak0(a).
  278weak0(all).
  279weak0(some).
  280weak0(every).
  281weak0(the(sg)).
  282weak0(notall).
  283
  284lower(question(_),Q,quant(det(a),X,P,Y)) :-
  285   open_quant(Q,det(any),X,P,Y), !.
  286lower(_,Q,Q).
  287
  288setifiable(generic).
  289setifiable(det(a)).
  290setifiable(det(all)).
  291
  292% =================================================================
  293% Operators (currently, identity, negation and 'and')
  294
  295op_apply(id,P,P).
  296op_apply(not,P,\+P).
  297
  298bubble(not,det(any),det(every)) :- !.
  299bubble(_,D,D).
  300
  301
  302conj_apply(and,P,Q,(P,Q))