1:- module(langsem,[]). 2:- use_module(util(math)). 3:- use_module(pac(op)). 4:- use_module(pac(basic)). 5
7
8val(X, Y):- pac:eval(X, Y).
9
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
35
37test :- repeat,
38 (sample(X), writeln(X), write('=> '),
39 (montague(X, Y)-> writeln(Y); writeln( '** fail **')),
40 fail
41 ; true ), !.
42
46
47sample(filter([j], [j,u])).
48sample(currify([(a,b)])).
49sample(a([j,u])).
50sample(unicorn).
51sample(find).
52sample(currify(a([j,u]))).
53sample(value(currify(a([j,u])), unicorn)).
54sample(currify(find)).
55sample(value(currify(a([j,u])), unicorn)).
56sample(value @ currify(a([j,u])) @ unicorn).
57sample(inverse(currify(find), (value @ currify(a([j,u])) @ unicorn))).
58sample(member(inverse(currify(find), (value @currify(a([j,u])) @ unicorn)), filter([j], [j, u]))).
59sample(member(inverse(currify(find), value(currify(a([j,u])), unicorn)), filter([j], [j, u]))).
60
62test(Query, YesNo):- D = [j,u],
63 J = filter([j],D),
64 A = a(D),
65 AC = currify(A),
66 U = unicorn,
67 AUnicorn = (@(AC,U)),
68 Love = love,
69 LoveC = currify(Love),
70 Inv = inverse(LoveC,AUnicorn),
71 Query = member(Inv,J),
72 val(Query, YesNo).
73
75member(X, Y, true):-member(X,Y),!.
76member(_, _, false).
77
82
83field(R, F):- findall(X,
84 ( member((A,B), R),
85 ( X = A
86 ; X = B
87 )
88 ),
89 F0),
90 sort(F0, F).
92value(F, A, V):- member((A,V), F).
93
96values(X, R, Vs):- findall(V, member((X, V), R), Vs0),
97 sort(Vs0, Vs).
98
100currify(R, C):- field(R, F),
101 findall((X, Ys),
102 ( member(X, F),
103 values(X, R, Ys)
104 ),
105 C0),
106 sort(C0, C).
108compose(X, Y, V):- join(X, Y, V).
109
111join(X, Y, V):-
112 findall((A,C),
113 ( member((A,B), X),
114 member((B,C), Y)
115 ),
116 V0),
117 sort(V0, V).
118
120inverse(F, R, S):-
121 findall(X,
122 ( member(Y, R),
123 member((X,Y), F)
124 ),
125 S0),
126 sort(S0, S).
127
129meet(X,Y):- member(A,X), member(A,Y).
131have(X, Y, true):- member(Y, X), !.
132have(_, _, false).
133
135a(D, R):- powerset(D, PowD),
136 findall((X,Y),
137 ( member(X,PowD),
138 member(Y,PowD),
139 meet(X,Y)
140 ),
141 R0),
142 sort(R0, R).
143 144love([(j,u)]).
146find([(j,u)]).
148unicorn([u]).
149
160montague(X, Y):- montague_main(X, Z), term_string(Z, Y).
162montague_main(X, X):- (var(X); integer(X); is_list(X)), !.
163montague_main(X, Y):- elim_atmark(X, X0),
164 montague_args(X0, U),
165 ( montague_basic(U, Y) -> true
166 ; call(U, Y)
167 ).
169montague_args([F|As], V):-
170 montague_args(F, F0),
171 maplist(montague_main, As, Bs),
172 reduce:complete_args(F0, Bs, V).
173
175montague_args(F, G):- nonvar(F),
176 F=..[H|As],
177 maplist(montague_main, As, Bs),
178 G=..[H|Bs].
179
182elim_atmark(X, [X]):- var(X), !.
183elim_atmark(X@Y, Z):- !, elim_atmark(X, U),
184 append(U, [Y], Z).
185elim_atmark(X, [X])