1:- module(langsem,[]). 2:- use_module(util(math)). 3:- use_module(pac(op)). 4:- use_module(pac(basic)). 5
8
9val(X, Y):- pac:eval(X, Y).
10
21individuals([j,m,u]).
23montague_basic(Ind, Ind):-individuals(D), memq(Ind, D), !.
24montague_basic(unicorn, [u]):-!.
25montague_basic(find, [(j, u)]):-!.
26montague_basic(powerset(X), P) :- !, math:powerset(X, P).
27montague_basic(filter(A, B), F):- !, math:filter(B, A, F).
28montague_basic(currify(A), C):- !, currify(A, C).
29montague_basic(a, A):-!, individuals(D), a(D, A).
30montague_basic(value(R, X), V):- !, value(R, X, V).
31montague_basic(inverse(F, Y), X):- !, inverse(F, Y, X).
32montague_basic(member(X, Y), R):- !, member(X, Y, R).
33
36
37test :- repeat,
38 (sample(X), writeln(X), write('=> '),
39 (montague(X, Y)-> writeln(Y); writeln( '** fail **')),
40 fail
41 ; true ), !.
42
47
48sample(filter([j], [j,u])).
49sample(currify([(a,b)])).
50sample(a([j,u])).
51sample(unicorn).
52sample(find).
53sample(currify(a([j,u]))).
54sample(value(currify(a([j,u])), unicorn)).
55sample(currify(find)).
56sample(value(currify(a([j,u])), unicorn)).
57sample(value @ currify(a([j,u])) @ unicorn).
58sample(inverse(currify(find), (value @ currify(a([j,u])) @ unicorn))).
59sample(member(inverse(currify(find), (value @currify(a([j,u])) @ unicorn)), filter([j], [j, u]))).
60sample(member(inverse(currify(find), value(currify(a([j,u])), unicorn)), filter([j], [j, u]))).
61
63
64test(Query, YesNo):- D = [j,u],
65 J = filter([j],D),
66 A = a(D),
67 AC = currify(A),
68 U = unicorn,
69 AUnicorn = (@(AC,U)),
70 Love = love,
71 LoveC = currify(Love),
72 Inv = inverse(LoveC,AUnicorn),
73 Query = member(Inv,J),
74 val(Query, YesNo).
75
77member(X, Y, true):-member(X,Y),!.
78member(_, _, false).
79
83
84field(R, F):- setof(A, B^(member((A,B), R); member((B, A), R)), F), !.
85field(_, []).
86
89
90value(F, A, V):- memberchk((A,V), F).
92values(X, R, Vs):- setof(V, member((X, V), R), Vs), !.
93values(_, _, []).
95currify(R, C):- field(R, S),
96 ( setof((X, Ys), (member(X, S), values(X, R, Ys)), C)
97 -> true
98 ; C = []
99 ).
101compose(X, Y, V):- join(X, Y, V).
103join(X, Y, V):-
104 ( setof((A, B), C^(member((A,C),X), member((C,B),Y)), V)
105 -> true
106 ; V = []
107 ).
108
111
112inverse(F, R, S):-
113 ( setof(X, Y^(member(Y, R),member((X, Y), F)), S)
114 -> true
115 ; S = []
116 ).
117
119meet(X,Y):- member(A,X), member(A,Y).
121have(X, Y, true):- member(Y, X), !.
122have(_, _, false).
123
125a(D, R):-( powerset(D, PowD),
126 setof((X,Y),
127 (member(X,PowD),member(Y,PowD), meet(X,Y)),
128 R)
129 -> true
130 ; R=[]
131 ).
133love([(j,u)]).
135find([(j,u)]).
137unicorn([u]).
138
149
150montague(X, X):- (var(X); integer(X); is_list(X)), !.
151montague(X, Y):- elim_atmark(X, X0),
152 montague_args(X0, U),
153 ( montague_basic(U, Y) -> true
154 ; call(U, Y)
155 ).
157montague_args([F|As], V):-
158 montague_args(F, F0),
159 maplist(montague, As, Bs),
160 reduce:complete_args(F0, Bs, V).
161
163montague_args(F, G):- nonvar(F),
164 F=..[H|As],
165 maplist(montague, As, Bs),
166 G=..[H|Bs].
167
170elim_atmark(X, [X]):- var(X), !.
171elim_atmark(X@Y, Z):- !, elim_atmark(X, U),
172 append(U, [Y], Z).
173elim_atmark(X, [X])