1:- module(ptqfrag, []). 2term_expansion --> pac:expand_pac.
3:- use_module(library(clpfd)). 4
5role(X, Y, Z):- user:role(X, Y, Z).
6
10
12
19
33
43
44put_attr(X,A):- put_attr(X, cil, A).
45get_attr(X,A):- get_attr(X, cil, A).
46
47 50
51
53
54run_samples :- sample(S), format("~w.\n",[S]),
55 once(call(ptqfrag:S, X)),
56 once(call(ptqfrag:X, V)),
57 format("Ans = ~w.~n",[V]), fail.
58run_samples:- nl.
59
61sample(ptq(s, [john, is, a, man], [man(j),find(j,j)])).
62sample(ptq(s, [every, man, is, john], [man(j),find(j,j)])).
63sample(ptq(s, [every, man, is, john], [man(j),man(k)])).
64sample(ptq(s, [every, man, finds, every, man], [man(j), man(k), find(j,j)])).
65sample(ptq(pn, [john], [])).
66sample(ptq(np, [a, unicorn], [male(j),male(b),female(m),unicorn(u), find(m,u),walk(j),walk(b),walk(m)])).
67sample(ptq(s, [a, unicorn, walks], [male(j),male(b),female(m),unicorn(u), find(m,u),walk(j),walk(b),walk(m)])).
68sample(ptq(vp, [find, a, unicorn], [male(j),male(b),female(m),unicorn(u), find(m,u),walk(j),walk(b),walk(m)])).
69sample(ptq(s, [john,finds, a, unicorn], [male(j),male(b),female(m),unicorn(u), find(m,u),walk(j),walk(b),walk(m)])).
70sample(ptq(tv, [find], [man(a),find(j,a),walk(j)])).
71sample(ptq(itv, [walk], [man(a),find(j,a),walk(j)])).
72sample(ptq(vp, [find, a, unicorn], [unicorn(a),find(j,a),walk(j)])).
73sample(ptq(s, [john, walks], [man(a),find(j,a),walk(j)])).
74sample(ptq(s, [every, man, walks], [man(a),find(j,a),walk(j)])).
75sample(ptq(s, [every, man, walks], [man(j),find(j,a),walk(j)])).
76
77 81ptq(S, F) :- ptq(s, S, F).
83ptq(C, S, F) :- ptq(C, S, F, V),
84 call(V, R),
85 writeln(V),
86 format("Ans = ~w.\n", [R]).
88ptq(P, S, F, Fun):- call(P, E, S, []),
89 individuals(F, Inds),
90 Fun = eval_ptq(E.sem, world(Inds, F)).
91ptq(_,_,_,'** syntax error ').
92
112
118
119 122
124s({ sem:truth(in(VP.sem, NP.sem)) }) -->
125 np(NP), vp(VP), { NP.agree = VP.agree }.
126
128np({ sem:app(rel_to_fun(Det.sem), CN.sem),
129 agree:CN.agree }) --> determiner(Det), cn(CN).
130np({ sem:principal_filter(PN.sem),
131 agree:PN.agree,
132 cat: PN.cat }
133 ) --> pn(PN).
134
136
138
139vp(ITV) --> itv(ITV).
140vp({ sem:inverse_image(rel_to_fun(TV.sem), NP.sem),
141 agree:TV.agree }) --> tv(TV), np(NP).
142
144itv(A) --> dict(itv, A).
146tv(A) --> dict(tv, A).
148cn(A) --> dict(cn, A).
150pn(A) --> dict(pn, A).
152determiner(A) --> dict(det, A).
153
155dict(Cat, A) --> [X], { dict(X, A), A.cat=Cat }.
156
158agree_3s({ per:3, num:s }). 159
161agree_n3s({ per:X, num:Y }):- 162 when((nonvar(X), nonvar(Y)),
163 member(X-Y, [ 1-s, 1-p,
164 2-s, 2-p,
165 3-p ])).
166
168dict(walk, { sem:predicate(walk/1),
169 agree:X,
170 cat:itv }):- agree_n3s(X).
171dict(walks, { sem:predicate(walk/1),
172 agree:X,
173 cat:itv }):- agree_3s(X).
174dict(is, { sem:predicate(is/2),
175 agree:X,
176 cat:tv }):- agree_3s(X).
177dict(find, { sem:predicate(find/2),
178 agree:X,
179 cat:tv }):- agree_n3s(X).
180dict(finds, { sem:predicate(find/2),
181 agree:X,
182 cat:tv }):- agree_3s(X).
183dict(kick, { sem:predicate(kick/2),
184 agree:X,
185 cat:tv }):- agree_n3s(X).
186dict(kicks, { sem:predicate(kick/2),
187 agree:X,
188 cat:tv }):- agree_3s(X).
189
191dict(i, { agree:{ per:1, num:s },
192 cat:prn }).
193dict(we,{ agree:{ per:1, num:p },
194 cat:prn }).
195dict(you, { agree:{ per:2, num:X },
196 cat:prn }):-
197 when(nonvar(X), member(X, [s, p])).
198dict(he, { agree:{ per:3, num:s },
199 cat:prn }).
200dict(she, { agree:{ per:3, num:s },
201 cat:prn }).
202dict(they, { agree:{ per:3, num:p },
203 cat:prn }).
204
206dict(john, { sem: ind(j),
207 agree:{ per:3, num:s },
208 cat:pn }).
209dict(bill, { sem:ind(b),
210 agree:{ per:3, num:s },
211 cat:pn }).
212dict(mary, { sem: ind(m),
213 agree:{ per:3, num:s },
214 cat:pn }).
216dict(unicorn, { sem:predicate(unicorn/1),
217 agree:{ per:3, num:s },
218 cat:cn }).
219dict(man, { sem:predicate(man/1),
220 agree:{ per:3, num:s },
221 cat:cn }).
222dict(woman, { sem:predicate(woman/1),
223 agree:{ per:3, num:s },
224 cat:cn }).
226dict(a, { sem:quant(a),
227 cat:det }).
228dict(every, { sem:quant(every),
229 cat:det }).
230
231 234
238
240
241eval_ptq(truth(X), W, S) :- eval_boole(X, W, S).
242eval_ptq(asis(X), _, X) :- !. 243eval_ptq(if(X, Y, Z), W, S):-
244 eval_boole(X, W, B),
245 ( B==true -> eval_ptq(Y, W, S)
246 ; eval_ptq(Z, W, S)
247 ).
248eval_ptq(app(F, A), W, V):- !,
249 eval_ptq(F, W, F0),
250 eval_ptq(A, W, A0),
251 memberchk(A0-V, F0).
252eval_ptq(call(X), _, _):- !, once(X).
253eval_ptq(X, W, S) :- is_boole(X), !,
254 eval_boole(X, W, S).
255eval_ptq(L, _, L):- (L==[]; L=[_|_]), !.
256eval_ptq(X, W, S) :- eval_atom(X, W, S), !.
257
259eval_atom(predicate(X), W, S) :- !, basic_ext(predicate(X), W, S).
260eval_atom(ind(X), _, [X]) :- !.
261eval_atom(filter(S), W, V) :- !, eval_ptq(S, W, V0),
262 filter(W, V0, V).
263eval_atom(principal_filter(S), W, V) :- !,
264 ( S = ind(J) -> Ind=J
265 ; Ind = S
266 ),
267 filter(W, [Ind], V).
268eval_atom(quant(Q), W, V) :- !, eval_quant(Q, W, V).
269eval_atom(X, W, Y):- X=..[F|As],
270 maplist(eval_arg(W), As, Bs),
271 G=..[F|Bs],
272 call(G, Y).
273
275eval_arg(_, X, X):- var(X),!.
276eval_arg(W, X, Y):- eval_ptq(X, W, Y).
277
279is_boole(truth(_)).
280is_boole(true).
281is_boole(false).
282is_boole(and(_,_)).
283is_boole(or(_,_)).
284is_boole(implry(_,_)).
285is_boole(not(_,_)).
286is_boole(in(_,_)).
287is_boole(=(_,_)).
288
290ind(I, _, I).
291
296
297eval_boole(true, _, true).
298eval_boole(false, _, false).
299eval_boole(and(X,Y), M, V):-eval_and(X, Y, M, V).
300eval_boole(or(X,Y), M, V):-eval_boole(not(and(not(X), not(Y))), M, V).
301eval_boole(not(X), M, V):- eval_not(X, M, V).
302eval_boole(imply(X,Y), M, V):-eval_boole(or(not(X), Y), M, V).
303eval_boole(in(X,Y), M, V):- eval_ptq(X, M, X0),
304 eval_ptq(Y, M, Y0),
305 check_truth(member(X0, Y0), V).
306eval_boole(truth(X), W, V):- eval_boole(X, W, V).
307eval_boole(X, _, V):- check_truth(X, V).
308
310eval_not(X, M, V):- eval_boole(X, M, U),
311 ( U== true -> V = false
312 ; V = true
313 ).
314
316eval_and(X, Y, M, V):- eval_boole(X, M, U),
317 ( U == false -> V=false
318 ; eval_boole(Y, M, V)
319 ).
320
322check_truth(X, true) :- call(X), !.
323check_truth(_, false).
324
328
329basic_ext(predicate(P/N), DB, E):-!, basic_ext(P/N, DB, E).
330basic_ext(P/1, world(_,F), E):-!,
331 T =..[P, X],
332 ( setof(X, member(T, F), E) -> true
333 ; E = []
334 ).
335basic_ext(is/2, world(D, _), E):-!,
336 ( setof(X-X, member(X, D), E) -> true
337 ; E = []
338 ).
339basic_ext(P/2, world(_,F), E):-!,
340 T =..[P, X, Y],
341 ( setof(X-Y, member(T, F), E) -> true
342 ; E = []
343 ).
344
347eval_quant(Q, world(D, _), R):- eval_quant_(Q, D, R0), sort_pairs(R0, R).
348
350sort_pairs([X-Y|R], [X0-Y0|R0]):- sort(X, X0), sort(Y, Y0),
351 sort_pairs(R, R0).
352sort_pairs([],[]).
353
354eval_quant_(a, D, R):- !,
355 ( powerset(D, D0),
356 maplist(sort, D0, PowD),
357 setof(X-Y, (member(X,PowD), member(Y,PowD), meet(X,Y)), R)
358 -> true
359 ; R=[]
360 ).
361eval_quant_(every, D, R):- !,
362 ( powerset(D,D0),
363 maplist(sort, D0, PowD),
364 setof(X-Y, (member(X,PowD), member(Y,PowD), subset(X,Y)), R)
365 -> true
366 ; R=[]
367 ).
368
370
371individuals(F, S):- maplist(atoms,F,F1),
372 append(F1, F2),
373 sort(F2,S).
374
376atoms(X,[X]):-atomic(X),!.
377atoms(X,Y):- is_list(X),!,
378 maplist(atoms, X, Z),
379 append(Z, Y).
380atoms(X,Y):- X=..[_|A],
381 maplist(atoms, A, B),
382 append(B, Y).
383
384 387
388pair(A-B, A, B).
389pair(A=B, A, B).
390pair(A:B, A, B).
391
396
397rel_to_fun(X, Y):- rel_to_fun(X, Y, sort_right).
399rel_to_fun(X, Y, []):-!, rel_to_fun_(X, [], Y).
400rel_to_fun(X, Y, G):- rel_to_fun_(X, [], Y0),
401 call(G, Y0, Y).
402
404rel_to_fun_([], X, X).
405rel_to_fun_([P|R], X, Y):- pair(P, A, B),
406 ( select(A-M, X, X0)
407 -> rel_to_fun_(R, [A-[B|M]|X0], Y)
408 ; rel_to_fun_(R, [A-[B]|X], Y)
409 ).
411sort_right([], []).
412sort_right([L-R|M], [L-R0|M0]):-
413 sort(R, R0),
414 sort_right(M, M0).
415
417powerset(X, Y):- powerset(X, [[]], Y).
418
419powerset([], X, X).
420powerset([A|R], X, Y):-
421 powerset(X, A, X, X0),
422 powerset(R, X0, Y).
423
425powerset([], _, X, X).
426powerset([X|R], A, S, Y):- powerset(R, A, [[A|X]|S], Y).
427
431
432filter(W, D, F):- filter(W, D, F, mapsort).
433
435filter(W, D, F, []):- !, filter_(W, D, F).
436filter(W, D, F, G):- filter_(W, D, F0),
437 call(G, F0, F).
439filter_(world(X, _), D, F):- subtract(X, D, Y),
440 powerset(Y, P),
441 maplist(append(D), P, F).
442
444mapsort(X, Y):- maplist(sort, X, Y0),
445 sort(Y0, Y).
446
449
450principal_filter(D, A, PF):- principal_filter(D, A, PF, mapsort).
452principal_filter(D, A, PF, []):- !, principal_filter_(D, A, PF).
453principal_filter(D, A, PF, G):- principal_filter_(D, A, PF0),
454 call(G, PF0, PF).
456principal_filter_(D, A, PF):- select(A, D, D0), !,
457 powerset(D0, PD),
458 maplist(cons(A), PD, PF0),
459 maplist(sort, PF0, PF).
460principal_filter_(_, _, []).
461
463cons(X,Y,[X|Y]).
464
466meet(X, Y):- member(A, X), member(A, Y).
467
469image(F, X, S):- fun_image(X, F, S0, []),
470 sort(S0, S).
471
473fun_image([], _, S, S).
474fun_image([X|Y], F, [X0|S], T):- memberchk(X-X0, F), !,
475 fun_image(Y, F, S, T).
476fun_image([_|Y], F, S, T):- fun_image(Y, F, S, T).
477
479inverse([], []).
480inverse([X-Y|R], [Y-X|R0]):-
481 inverse(R, R0).
482
484inverse_image(F, Y, U):-
485 inverse_image(F, Y, V, []),
486 sort(V, U).
488inverse_image([], _, U, U).
489inverse_image([X-Y|Fs], P, [X|U], V):- memberchk(Y, P), !,
490 inverse_image(Fs, P, U, V).
491inverse_image([_|Fs], P, U, V):-
492 inverse_image(Fs, P, U, V).
493
495term_size(Term, Size) :-
496 setup_call_cleanup(
497 (
498 current_prolog_flag(gc, Bool),
499 set_prolog_flag(gc, false)
500 ),
501 (
502 statistics(globalused, Used0),
503 duplicate_term(Term, _TermCp),
504 statistics(globalused, Used1),
505 Size is Used1 - Used0
506 ),
507 set_prolog_flag(gc, Bool)
508 )