3
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
(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
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
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))