1:- use_module(library(clpfd)). 2:- use_module('odict-attr'). 3:- use_module('odict-expand'). 4term_expansion --> odict_expand.
5user:expand_query(X, Y, Z, Z) :- odict_expand_goal(X, Y).
6
18
27
28aa({a:1, b:2, c:3}).
30
31put_attr(X,A):- put_attr(X, cil, A).
32get_attr(X,A):- get_attr(X, cil, A).
33
34 37
40
41run_samples :- sample(S), format("~w.\n",[S]),
42 once(call(S, X)),
43 once(call(X, V)),
44 format("Ans = ~w.~n",[V]), fail.
45run_samples:- nl.
46
48sample(ptq(s, [john, is, a, man], [man(j),find(j,j)])).
49sample(ptq(s, [every, man, is, john], [man(j),find(j,j)])).
50sample(ptq(s, [every, man, is, john], [man(j),man(k)])).
51sample(ptq(s, [every, man, finds, every, man], [man(j), man(k), find(j,j)])).
52sample(ptq(pn, [john], [])).
53sample(ptq(np, [a, unicorn], [male(j),male(b),female(m),unicorn(u), find(m,u),walk(j),walk(b),walk(m)])).
54sample(ptq(s, [a, unicorn, walks], [male(j),male(b),female(m),unicorn(u), find(m,u),walk(j),walk(b),walk(m)])).
55sample(ptq(vp, [find, a, unicorn], [male(j),male(b),female(m),unicorn(u), find(m,u),walk(j),walk(b),walk(m)])).
56sample(ptq(s, [john,finds, a, unicorn], [male(j),male(b),female(m),unicorn(u), find(m,u),walk(j),walk(b),walk(m)])).
57sample(ptq(tv, [find], [man(a),find(j,a),walk(j)])).
58sample(ptq(itv, [walk], [man(a),find(j,a),walk(j)])).
59sample(ptq(vp, [find, a, unicorn], [unicorn(a),find(j,a),walk(j)])).
60sample(ptq(s, [john, walks], [man(a),find(j,a),walk(j)])).
61sample(ptq(s, [every, man, walks], [man(a),find(j,a),walk(j)])).
62sample(ptq(s, [every, man, walks], [man(j),find(j,a),walk(j)])).
63
64 68ptq(S, F) :- ptq(s, S, F).
70ptq(C, S, F) :- ptq(C, S, F, V),
71 call(V, R),
72 writeln(V),
73 format("Ans = ~w.\n", [R]).
75ptq(P, S, F, Fun):- call(P, E, S, []),
76 individuals(F, Inds),
77 Fun = eval(E.sem, world(Inds, F)).
78ptq(_,_,_,'** syntax error ').
79
99
106
107 111s({ sem:truth(in(VP.sem, NP.sem)) }) -->
112 np(NP), vp(VP), { NP.agree = VP.agree }.
113
115np({ sem:app(rel_to_fun(Det.sem), CN.sem),
116 agree:CN.agree }) --> determiner(Det), cn(CN).
117np({ sem:principal_filter(PN.sem),
118 agree:PN.agree,
119 cat: PN.cat }
120 ) --> pn(PN).
121
123vp(ITV) --> itv(ITV).
124vp({ sem:inverse_image(rel_to_fun(TV.sem), NP.sem),
125 agree:TV.agree }) --> tv(TV), np(NP).
126
128itv(A) --> dict(itv, A).
130tv(A) --> dict(tv, A).
132cn(A) --> dict(cn, A).
134pn(A) --> dict(pn, A).
136determiner(A) --> dict(det, A).
137
139dict(Cat, A) --> [X], { dict(X, A), A.cat=Cat }.
140
142agree_3s({ per:3, num:s }). 143
145agree_n3s({ per:X, num:Y }):- 146 when((nonvar(X), nonvar(Y)),
147 member(X-Y, [ 1-s, 1-p,
148 2-s, 2-p,
149 3-p ])).
150
152dict(walk, { sem:pred(walk/1),
153 agree:X,
154 cat:itv }):- agree_n3s(X).
155dict(walks, { sem:pred(walk/1),
156 agree:X,
157 cat:itv }):- agree_3s(X).
158dict(is, { sem:pred(is/2),
159 agree:X,
160 cat:tv }):- agree_3s(X).
161dict(find, { sem:pred(find/2),
162 agree:X,
163 cat:tv }):- agree_n3s(X).
164dict(finds, { sem:pred(find/2),
165 agree:X,
166 cat:tv }):- agree_3s(X).
167dict(kick, { sem:pred(kick/2),
168 agree:X,
169 cat:tv }):- agree_n3s(X).
170dict(kicks, { sem:pred(kick/2),
171 agree:X,
172 cat:tv }):- agree_3s(X).
173
175dict(i, { agree:{ per:1, num:s },
176 cat:prn }).
177dict(we,{ agree:{ per:1, num:p },
178 cat:prn }).
179dict(you, { agree:{ per:2, num:X },
180 cat:prn }):-
181 when(nonvar(X), member(X, [s, p])).
182dict(he, { agree:{ per:3, num:s },
183 cat:prn }).
184dict(she, { agree:{ per:3, num:s },
185 cat:prn }).
186dict(they, { agree:{ per:3, num:p },
187 cat:prn }).
188
190dict(john, { sem: ind(j),
191 agree:{ per:3, num:s },
192 cat:pn }).
193dict(bill, { sem:ind(b),
194 agree:{ per:3, num:s },
195 cat:pn }).
196dict(mary, { sem: ind(m),
197 agree:{ per:3, num:s },
198 cat:pn }).
200dict(unicorn, { sem:pred(unicorn/1),
201 agree:{ per:3, num:s },
202 cat:cn }).
203dict(man, { sem:pred(man/1),
204 agree:{ per:3, num:s },
205 cat:cn }).
206dict(woman, { sem:pred(woman/1),
207 agree:{ per:3, num:s },
208 cat:cn }).
210dict(a, { sem:quant(a),
211 cat:det }).
212dict(every, { sem:quant(every),
213 cat:det }).
214
215 218
220eval(truth(X), W, S) :- eval_boole(X, W, S).
221eval(quote(X), _, X) :- !.
222eval(if(X, Y, Z), W, S):-
223 eval_boole(X, W, B),
224 ( B==true -> eval(Y, W, S)
225 ; eval(Z, W, S)
226 ).
227eval(app(F, A), W, V):- !,
228 eval(F, W, F0),
229 eval(A, W, A0),
230 memberchk(A0-V, F0).
231eval(call(X), _, _):- !, once(X).
232eval(X, W, S) :- is_boole(X), !,
233 eval_boole(X, W, S).
234eval(L, _, L):- (L==[]; L=[_|_]), !.
235eval(X, W, S) :- eval_atom(X, W, S), !.
236
238eval_atom(pred(X), W, S) :- !, basic_ext(pred(X), W, S).
239eval_atom(ind(X), _, [X]) :- !.
240eval_atom(filter(S), W, V) :- !, eval(S, W, V0),
241 filter(W, V0, V).
242eval_atom(principal_filter(S), W, V) :- !,
243 ( S = ind(J) -> Ind=J
244 ; Ind = S
245 ),
246 filter(W, [Ind], V).
247eval_atom(quant(Q), W, V) :- !, eval_quant(Q, W, V).
248eval_atom(X, W, Y):- X=..[F|As],
249 maplist(eval_arg(W), As, Bs),
250 G=..[F|Bs],
251 call(G, Y).
252
254eval_arg(_, X, X):- var(X),!.
255eval_arg(W, X, Y):- eval(X, W, Y).
256
258is_boole(truth(_)).
259is_boole(true).
260is_boole(false).
261is_boole(and(_,_)).
262is_boole(or(_,_)).
263is_boole(implry(_,_)).
264is_boole(not(_,_)).
265is_boole(in(_,_)).
266is_boole(=(_,_)).
267
269ind(I, _, I).
270
275
276eval_boole(true, _, true).
277eval_boole(false, _, false).
278eval_boole(and(X,Y), M, V):-eval_and(X, Y, M, V).
279eval_boole(or(X,Y), M, V):-eval_boole(not(and(not(X), not(Y))), M, V).
280eval_boole(not(X), M, V):- eval_not(X, M, V).
281eval_boole(imply(X,Y), M, V):-eval_boole(or(not(X), Y), M, V).
282eval_boole(in(X,Y), M, V):- eval(X, M, X0),
283 eval(Y, M, Y0),
284 check_truth(member(X0, Y0), V).
285eval_boole(truth(X), W, V):- eval_boole(X, W, V).
286eval_boole(X, _, V):- check_truth(X, V).
287
289eval_not(X, M, V):- eval_boole(X, M, U),
290 ( U== true -> V = false
291 ; V = true
292 ).
293
295eval_and(X, Y, M, V):- eval_boole(X, M, U),
296 ( U == false -> V=false
297 ; eval_boole(Y, M, V)
298 ).
299
301check_truth(X, true) :- call(X), !.
302check_truth(_, false).
303
309
310basic_ext(P/1, world(_,F), E):-!,
311 T =..[P, X],
312 ( setof(X, member(T, F), E) -> true
313 ; E = []
314 ).
315basic_ext(is/2, world(D, _), E):-!,
316 ( setof(X-X, member(X, D), E) -> true
317 ; E = []
318 ).
319basic_ext(P/2, world(_,F), E):-!,
320 T =..[P, X, Y],
321 ( setof(X-Y, member(T, F), E) -> true
322 ; E = []
323 ).
324basic_ext(pred(P/N), DB, E):- basic_ext(P/N, DB, E).
325
330
331eval_quant(Q, world(D, _), R):- eval_quant_(Q, D, R0), sort_pairs(R0, R).
332
334sort_pairs([X-Y|R], [X0-Y0|R0]):- sort(X, X0), sort(Y, Y0),
335 sort_pairs(R, R0).
336sort_pairs([],[]).
337
338eval_quant_(a, D, R):- !,
339 ( powerset(D, D0),
340 maplist(sort, D0, PowD),
341 setof(X-Y, (member(X,PowD), member(Y,PowD), meet(X,Y)), R)
342 -> true
343 ; R=[]
344 ).
345eval_quant_(every, D, R):- !,
346 ( powerset(D,D0),
347 maplist(sort, D0, PowD),
348 setof(X-Y, (member(X,PowD), member(Y,PowD), subset(X,Y)), R)
349 -> true
350 ; R=[]
351 ).
352
355
356individuals(F, S):- maplist(atoms,F,F1),
357 append(F1, F2),
358 sort(F2,S).
359
361atoms(X,[X]):-atomic(X),!.
362atoms(X,Y):- is_list(X),!,
363 maplist(atoms, X, Z),
364 append(Z, Y).
365atoms(X,Y):- X=..[_|A],
366 maplist(atoms, A, B),
367 append(B, Y).
368
369 372
373pair(A-B, A, B).
376
385
386rel_to_fun(X, Y):- rel_to_fun(X, Y, sort_right).
388rel_to_fun(X, Y, []):-!, rel_to_fun_(X, [], Y).
389rel_to_fun(X, Y, G):- rel_to_fun_(X, [], Y0),
390 call(G, Y0, Y).
391
393rel_to_fun_([], X, X).
394rel_to_fun_([P|R], X, Y):- pair(P, A, B),
395 ( select(A-M, X, X0)
396 -> rel_to_fun_(R, [A-[B|M]|X0], Y)
397 ; rel_to_fun_(R, [A-[B]|X], Y)
398 ).
400sort_right([], []).
401sort_right([L-R|M], [L-R0|M0]):-
402 sort(R, R0),
403 sort_right(M, M0).
404
406powerset(X, Y):- powerset(X, [[]], Y).
407
408powerset([], X, X).
409powerset([A|R], X, Y):-
410 powerset(X, A, X, X0),
411 powerset(R, X0, Y).
412
414powerset([], _, X, X).
415powerset([X|R], A, S, Y):- powerset(R, A, [[A|X]|S], Y).
416
420
421filter(W, D, F):- filter(W, D, F, mapsort).
422
424filter(W, D, F, []):- !, filter_(W, D, F).
425filter(W, D, F, G):- filter_(W, D, F0),
426 call(G, F0, F).
428filter_(world(X, _), D, F):- subtract(X, D, Y),
429 powerset(Y, P),
430 maplist(append(D), P, F).
431
433mapsort(X, Y):- maplist(sort, X, Y0),
434 sort(Y0, Y).
435
438
439principal_filter(D, A, PF):- principal_filter(D, A, PF, mapsort).
441principal_filter(D, A, PF, []):- !, principal_filter_(D, A, PF).
442principal_filter(D, A, PF, G):- principal_filter_(D, A, PF0),
443 call(G, PF0, PF).
445principal_filter_(D, A, PF):- select(A, D, D0), !,
446 powerset(D0, PD),
447 maplist(cons(A), PD, PF0),
448 maplist(sort, PF0, PF).
449principal_filter_(_, _, []).
450
452cons(X,Y,[X|Y]).
453
455meet(X, Y):- member(A, X), member(A, Y).
456
458image(F, X, S):- fun_image(X, F, S0, []),
459 sort(S0, S).
460
462fun_image([], _, S, S).
463fun_image([X|Y], F, [X0|S], T):- memberchk(X-X0, F), !,
464 fun_image(Y, F, S, T).
465fun_image([_|Y], F, S, T):- fun_image(Y, F, S, T).
466
468inverse([], []).
469inverse([X-Y|R], [Y-X|R0]):-
470 inverse(R, R0).
471
473inverse_image(F, Y, U):-
474 inverse_image(F, Y, V, []),
475 sort(V, U).
477inverse_image([], _, U, U).
478inverse_image([X-Y|Fs], P, [X|U], V):- memberchk(Y, P), !,
479 inverse_image(Fs, P, U, V).
480inverse_image([_|Fs], P, U, V):-
481 inverse_image(Fs, P, U, V).
482
484term_size(Term, Size) :-
485 setup_call_cleanup(
486 (
487 current_prolog_flag(gc, Bool),
488 set_prolog_flag(gc, false)
489 ),
490 (
491 statistics(globalused, Used0),
492 duplicate_term(Term, _TermCp),
493 statistics(globalused, Used1),
494 Size is Used1 - Used0
495 ),
496 set_prolog_flag(gc, Bool)
497 )