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
    7% :- module(cil).
    8% ?- debug.
    9% ?- X={a:1}.
   10% ?- X={a:{}}.
   11% ?- X={a:1}, Y={a:1}.
   12% ?- X={a:1}, Y={a:1}, X=Y.
   13% ?- X={a:1}, X={b:2}.
   14% ?- X={a:1}, X={b:2}, Ans=X.a.
   15% ?- X={a:1}, X.a=Ans, X={a:1}, X={a:2}.  % <= shoud be ERROR
   16% ?- 1=X.a.b, X={a:{b:A}}.
   17% ?- {}=X.a.b, X={a:{b:A}}, Ans=X.a.b.
   18
   19% Example use of the iterm
   20% ?-  U= {a:X,  b:f(X, X)}, X = hello, Ans = U.b.
   21% ?-  U= {a:X,  b:X.c.d}, X={c:{d:hello}}, Ans= U.b.
   22% ?-  U= {a:f(X.a(I))}, X={a(1):1, a(2):hello, a(3):3}, Ans=X.a(I), I=2.
   23% ?-  U= {a:f(X.a, X.b)}, X={a:hello, b:world}, Ans=U.a.
   24% ?-  U= {a:f(X.a)}, X={a:hello, b:world}, Ans=U.a.
   25% ?-  U= {a:f(X.a, X.b)}, X={a:hello, b:world}, Ans=U.a, Ans0=X.b.
   26% ?-  U= {a:f(X.a, X.b)}, X={a:hello, b:world}, Ans=U.a, Ans0=X.b, btree_to_odict(U, D).
   27
   28aa({a:1, b:2, c:3}).
   29% ?- aa(X), Ans=X.a, B=X.b.
   30
   31put_attr(X,A):- put_attr(X, cil, A).
   32get_attr(X,A):- get_attr(X, cil, A).
   33
   34	/*******************************
   35	*         PTQ sample runs      *
   36	*******************************/
   37
   38% ?- debug.
   39% ?- run_samples.
   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
   47%
   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	/************************************
   65	*           For ptq testing.	    *
   66	************************************/
   67%
   68ptq(S, F)  :- ptq(s, S, F).
   69%
   70ptq(C, S, F) :- ptq(C, S, F, V),
   71				call(V, R),
   72			    writeln(V),
   73			    format("Ans = ~w.\n", [R]).
   74%
   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
   80% ?- ptq(s, [every, man,  is, every, man], [man(j)]).
   81% ?- ptq(s, [every, man,  is, every, man], [man(j), man(k)]).
   82% ?- ptq(s, [a, man,  is, every, man], [man(j), man(k)]).
   83% ?- ptq(s, [a, man, finds, every, man], [man(j), man(k), find(j, k)]).
   84% ?- ptq(s, [a, man,  walks], [man(j), walk(j)]).
   85% ?- ptq(s, [every, man, finds, every, man], [man(j), man(k), find(j, j), find(j, k)]).
   86% ?- ptq(s, [john, walks], [walk(j)]).
   87% ?- ptq(s, [john, is, a, man], [man(j), is(j, j)]).
   88% ?- ptq(s, [john, finds, john], [find(j, m)]).
   89% ?- ptq(s, [john, finds, a,  unicorn], [find(j, u), unicorn(u), man(m), walk(m)]).
   90% ?- ptq(s, [every, man, walks], [man(j), walk(j)]).
   91% ?- ptq(s, [every, man, finds, a,  unicorn], [find(m, u), unicorn(u), man(m), walk(m)]).
   92% ?- ptq(vp, [finds, a,  man], [man(k), man(m), find(m, k), find(k, k)]).
   93% ?- ptq(vp, [finds, john], [find(j, j)]).
   94% ?- ptq(vp, [finds, every, man], [man(j), man(k), find(j, j), find(j, k)]).
   95% ?- ptq(vp, [is, a, man], [man(j)])
   96% ?- ptq(vp, [is, john], [man(j)])
   97% ?- ptq(np, [a, man], [man(j), man(k), man(l)]).
   98% ?- ptq(np, [every, man], [man(k), man(m), find(m, k), find(k, k)]).
   99
  100% ?- trace, ptq(np, [every, man], [man(k)]).
  101% ?- ptq(determiner, [a], [man(j), walk(j)]).
  102% ?- ptq(tv, [find], [find(j, k), find(l, m)]).
  103% ?- ptq(pn, [john], [man(x),find(j,x),walk(j)]).
  104% ?- trace, ptq(cn, [unicorn], [unicorn(u)]).
  105% ?- dict(unicorn, Y), A=Y.cat.
  106
  107	/******************************************
  108	*            A simple subset of PTQ       *
  109	******************************************/
  110% Sentence
  111s({ sem:truth(in(VP.sem, NP.sem)) }) -->
  112	np(NP),  vp(VP), { NP.agree = VP.agree }.
  113
  114% Noun phrase
  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
  122% Verb phrase
  123vp(ITV)  --> itv(ITV).
  124vp({ sem:inverse_image(rel_to_fun(TV.sem), NP.sem),
  125    agree:TV.agree }) --> tv(TV), np(NP).
  126
  127% Intransitive verb
  128itv(A) --> dict(itv, A).
  129% Transitive verb
  130tv(A) --> dict(tv, A).
  131% Common noun
  132cn(A) --> dict(cn, A).
  133% Proper name
  134pn(A) --> dict(pn, A).
  135%
  136determiner(A) --> dict(det, A).
  137
  138%
  139dict(Cat, A) --> [X], { dict(X, A), A.cat=Cat }.
  140
  141% Agreement feature 1
  142agree_3s({ per:3, num:s }).		% ex. walks
  143
  144% Agreement feature 2
  145agree_n3s({ per:X, num:Y }):-	% ex. walk
  146	when((nonvar(X), nonvar(Y)),
  147		 member(X-Y, [	1-s, 1-p,
  148						2-s, 2-p,
  149							 3-p ])).
  150
  151% Dit
  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
  174% pronoun. Not used yet.
  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
  189%
  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 }).
  199%
  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 }).
  209%
  210dict(a,		{ sem:quant(a),
  211			 cat:det }).
  212dict(every, {  sem:quant(every),
  213			 cat:det }).
  214
  215	/**************************************************
  216	*        Interpreting semantic expressions.       *
  217	**************************************************/
  218
  219% ?- eval(pred(walk/1), world([i, j], [walk(i), walk(j)]),  S).
  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
  237%
  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
  253%
  254eval_arg(_, X, X):- var(X),!.
  255eval_arg(W, X, Y):- eval(X, W, Y).
  256
  257%
  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
  268%
  269ind(I, _, I).
  270
  271% ?- eval_boole(truth(not(true)), _, X).
  272% ?- eval_boole(truth(not(true)), _, X).
  273% ?- eval_boole(or(1=2, 2=1), _, X).
  274% ?- eval_boole(imply(1=2, 2=1), _, X).
  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
  288%
  289eval_not(X, M, V):- eval_boole(X, M, U),
  290					   ( U== true -> V = false
  291					   ; V = true
  292					   ).
  293
  294%
  295eval_and(X, Y, M, V):- eval_boole(X, M, U),
  296						  ( U == false -> V=false
  297						  ; eval_boole(Y, M, V)
  298						  ).
  299
  300%
  301check_truth(X, true) :-  call(X), !.
  302check_truth(_, false).
  303
  304% ?- basic_ext(pred(love/2),world(_, [love(c,b), love(a,b)]),  X).
  305%@ X = [a-b, c-b].
  306% ?- basic_ext(pred(walk/1), world(_, [walk(a)]),  X).
  307%@ X = [a].
  308% ?- basic_ext(pred(is/2), world([a,b], [walk(a)]),  X).
  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
  326% ?- eval_quant(a, world([1,2],_),  R).
  327%@ R = [[1]-[1], [1]-[1, 2], [1, 2]-[1], [1, 2]-[1, 2], [1, 2]-[2], [2]-[1, 2], [2]-[2]].
  328% ?- eval_quant(every, world([1,2], _),  R).
  329%@ R = [[]-[], []-[1], []-[1, 2], []-[2], [1]-[1], [1]-[1, 2], [1|...]-[1|...], [...]-[...|...], ... - ...].
  330
  331eval_quant(Q, world(D, _), R):- eval_quant_(Q, D, R0), sort_pairs(R0, R).
  332
  333%
  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
  353% ?- individuals([f(a);g(b)], S).
  354%@ S = [a, b].
  355
  356individuals(F, S):- maplist(atoms,F,F1),
  357	append(F1, F2),
  358	sort(F2,S).
  359
  360%
  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	/*****************************************
  370	*                Helper predicates       *
  371	*****************************************/
  372
  373pair(A-B, A, B).
  374% pair(A=B, A, B).
  375% pair(A:B, A, B).
  376
  377% ?- rel_to_fun([a-b, x-y, a-c, x-z], R).
  378%@ R = [x-[y, z], a-[b, c]].
  379% ?- rel_to_fun([a=b, x-y, a=c, x-z], R).
  380%@ R = [x-[y, z], a-[b, c]].
  381% ?- rel_to_fun([a-c, x-y, a-b, x-z], R).
  382%@ R = [x-[y, z], a-[b, c]].
  383% ?- rel_to_fun([a:c, x-y, a=b, x:z], R).
  384%@ R = [x-[y, z], a-[b, c]].
  385
  386rel_to_fun(X, Y):- rel_to_fun(X, Y, sort_right).
  387%
  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
  392%
  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		).
  399%
  400sort_right([], []).
  401sort_right([L-R|M], [L-R0|M0]):-
  402	sort(R, R0),
  403	sort_right(M, M0).
  404
  405% ?-  powerset([a,b], X).
  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
  413%
  414powerset([], _, X, X).
  415powerset([X|R], A, S, Y):- powerset(R, A, [[A|X]|S], Y).
  416
  417% ?- filter(world([a,b,c,d], _), [c], R, mapsort).
  418% ?- filter(world([a,b,c,d],_ ), [c], F,  []).
  419% ?- filter(world([a,b,c,d],_ ), [c], R).
  420
  421filter(W, D,  F):- filter(W, D, F, mapsort).
  422
  423%
  424filter(W, D, F, []):- !, filter_(W, D, F).
  425filter(W, D, F, G):-  filter_(W, D, F0),
  426	  call(G, F0, F).
  427%
  428filter_(world(X, _), D, F):- subtract(X, D, Y),
  429	powerset(Y, P),
  430	maplist(append(D), P, F).
  431
  432%
  433mapsort(X, Y):- maplist(sort, X, Y0),
  434				sort(Y0, Y).
  435
  436% ?- principal_filter([a,b,c], b, X).
  437% ?- principal_filter([a,b,c], b, X, []).
  438
  439principal_filter(D, A, PF):- principal_filter(D, A, PF, mapsort).
  440%
  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).
  444%
  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
  451%
  452cons(X,Y,[X|Y]).
  453
  454%
  455meet(X, Y):- member(A, X), member(A, Y).
  456
  457% ?- image([a-v, b-u], [a,b], S).
  458image(F, X, S):- fun_image(X, F, S0, []),
  459				 sort(S0, S).
  460
  461%
  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
  467% ?- inverse([a-x, b-y], R).
  468inverse([], []).
  469inverse([X-Y|R], [Y-X|R0]):-
  470	inverse(R, R0).
  471
  472% ?- inverse_image([a-x, b-y, c-y, d-z], [x, y], U).
  473inverse_image(F, Y, U):-
  474	inverse_image(F, Y, V, []),
  475	sort(V, U).
  476%
  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
  483% From SWI-Prolog mailing list.
  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    )