1:- module(meta,
2 [foldr/4, iterate/3,
3 for/3, foldnum/4,
4 fold/3, fold/4, fold/5,
5 mapterm_rec/3,
6 maplist_opp/3,
7 repeat/2, monad/3, time/3,
8 until/4, while/4,
9 iff/2, cputime/1, cputime/0
10 ]
11 ). 12
13:- use_module(pac(op)). 14
21user:local(X):- copy_term(X, Y), call(Y).
22user:local(X,A):- copy_term(X, Y), call(Y,A).
23user:local(X,A,B):- copy_term(X, Y), call(Y,A,B).
24user:local(X,A,B,C):- copy_term(X, Y), call(Y,A,B,C).
25user:local(X,A,B,C,D):- copy_term(X, Y), call(Y,A,B,C,D).
26user:local(X,A,B,C,D,E):- copy_term(X, Y), call(Y,A,B,C,D,E).
27
30iff(C0, C1) :- \+( (C0,\+C1) ; (C1, \+C0)).
31
37
38user:flip_call(G) :- flip_call([2,1], G). 40user:flip_call(Is, G):- flip_call(Is, G, G0), call(G0).
41
43flip_call(Is, M:X, M:Y):-!, flip_call(Is, X, Y).
44flip_call(Is, X, Y):- length(Is, N),
45 functor(X, F, N),
46 functor(Y, F, N),
47 flip_call(Is, 1, X, Y).
48
50flip_call([], _, _, _).
51flip_call([I|Is], J, X, Y):-
52 arg(J, X, A),
53 arg(I, Y, A),
54 !,
55 J0 is J + 1,
56 flip_call(Is, J0, X, Y).
57
58:- meta_predicate foldr(3, ?, ?, ?). 59foldr(_, [], X, X):-!.
60foldr(F, [A|L], X, Y):- call(F, A, Y, Y0), foldr(F, L, X, Y0).
61
69fold_paths_of_term(G, T, X, Y):- fold_paths_of_term([[T]], [], X, Y, G).
71fold_paths_of_term([], _, X, X, _):-!.
72fold_paths_of_term([Ts|L], P, X, Y, G):-
73 ( Ts==[]
74 -> fold_paths_of_term(L, P, X, Y, G)
75 ; Ts=[T|Rs],
76 fold_paths_of_term(T, [Rs|L], P, X, Y, G)
77 ).
79fold_paths_of_term(T, Ls, P, X, Y, G):- atomic(T), !,
80 call(G, [T|P], X, Xtp),
81 fold_paths_of_term(Ls, P, Xtp, Y, G).
82fold_paths_of_term(T, Ls, P, X, Y, G):- T=..[F,A|As],
83 fold_paths_of_term(A, [As|Ls], [F|P], X, Y, G).
84
87fold_args(F, V, A, B):-
88 fold_args(1, F, V, A, B).
90fold_args(I, F, V, A, B):- arg(I, V, Vi), !,
91 call(F, Vi, A, Ai),
92 I1 is I+1,
93 fold_args(I1, F, V, Ai, B).
94fold_args(_I, _F, _V, _A, _B).
95
98
104
105
117
118
120callargs(F, A):- callargs(1, F, A).
122
123callargs(I, F, A):- arg(I, A, Ai), !,
124 call(F, Ai),
125 J is I+1,
126 callargs(J, F, A).
127callargs(_, _, _).
128
129
133
146
148
149
151scanargs(F, A, B):- ( var(A)
152 -> functor(B, C, N),
153 functor(A, C, N)
154 ; functor(A, C, N),
155 functor(B, C, N)
156 ),
157 scanargs(1, N, F, A, B).
159scanargs(I, N, _, _, _):- I > N, !.
160scanargs(I, N, F, A, B):- arg(I, A, Ai),
161 arg(I, B, Bi),
162 call(F, I, Ai, Bi),
163 J is I +1,
164 scanargs(J, N, F, A, B).
165
167scanargs(F, A):- functor(A, _, N),
168 scanargs_(1, N, F, A).
170scanargs_(I, N, _, _):- I > N, !.
171scanargs_(I, N, F, A):- arg(I, A, Ai),
172 call(F, I, Ai),
173 J is I + 1,
174 scanargs_(J, N, F, A).
175
176
178setargs(F, A, B):- functor(A, C, N),
179 ( var(B)
180 -> functor(B, C, N)
181 ; true
182 ),
183 setargs(1, N, F, A, B).
185setargs(I, N, _, _, _):- I > N, !.
186setargs(I, N, F, A, B):- arg(I, A, Ai),
187 call(F, I, Ai, Bi),
188 setarg(I, B, Bi),
189 J is I + 1,
190 setargs(J, N, F, A, B).
191
193setargs(F, A):- functor(A, _, N),
194 setargs_(1, N, F, A).
196setargs_(I, N, _, _):- I > N, !.
197setargs_(I, N, F, A):- arg(I, A, Ai),
198 call(F, I, Ai, Bi),
199 setarg(I, A, Bi),
200 J is I + 1,
201 setargs_(J, N, F, A).
202
207maprows(_, A, A):- atom(A), !.
208maprows(F, A, B):- arg(1, A, A1),
209 functor(A1, Fa, Na),
210 functor(B, Fa, Na),
211 maprows(Na, F, A, B).
213maprows(0, _, _, _):-!.
214maprows(I, F, A, B):- arg(I, B, Bi),
215 call(F, I, A, Bi),
216 J is I - 1,
217 maprows(J, F, A, B).
218
220until(F, S, X, Y):- call(S, X, X0),
221 ( call(F, X0) -> Y = X0
222 ; until(F, S, X0, Y)
223 ).
225iterate(_, stop(X), X):-!.
226iterate(S, X, Y):- call(S, X, X0),
227 iterate(S, X0, Y).
228
229while(F, S, X, Y):-
230 ( call(F, X) ->
231 call(S, X, X0),
232 while(F, S, X0, Y)
233 ; Y = X
234 ).
235
240
246
247:- meta_predicate for(?, 1). 248for(I..J, F):-!, for(I, J, F).
249for(I-J, F):-for(I, J, F).
250
252for(I, J, _):- I>J, !.
253for(I, J, F):- call(F, I), !,
254 I0 is I + 1,
255 for(I0, J, F).
256
261
262:- meta_predicate foldnum(3, ?, ?, ?). 263foldnum(F, I-J, U, V):-!, foldnum(I, J, U, V, F).
264foldnum(F, I..J, U, V):- foldnum(I, J, U, V, F).
266foldnum(I, J, U, U, _):- I>J, !.
267foldnum(I, J, U, V, F):- call(F, I, U, U0),
268 K is I + 1,
269 foldnum(K, J, U0, V, F).
270
272maplist_opp([F|Fs], X, [FX|Y]):- call(F, X, FX), !,
273 maplist_opp(Fs, X, Y).
274maplist_opp([], _, []).
275
277:- meta_predicate map(2, ?, ?). 278map(P) --> maplist(phrase(P)).
280:- meta_predicate phrase_list(2, ?, ?). 281phrase_list(P) --> maplist(phrase(P)).
282
286:- meta_predicate repeat(?, 0). 287repeat(1, G):-!, call(G).
288repeat(N, G):- simple_int_exp(N), !,
289 N0 is N,
290 (between(1, N0, _), call(G), fail; true).
291repeat(P, G):- (call(P), call(G), fail) ; true.
293repeat_cond(N, between(1, N0, _)):- simple_int_exp(N), !, N0 is N.
294repeat_cond(X, X).
296simple_int_exp(N):- integer(N).
297simple_int_exp(E):- ground(E),
298 functor(E, F, _),
299 memberchk(F, [+,-,^,mod, //]).
300
307
308
309:- meta_predicate time(0, ?). 310time(G, T):- time(G, T0, T1), T is T1-T0.
312time(G, T, T0):- statistics(cputime, T),
313 call(G),
314 statistics(cputime, T0).
315
323:- meta_predicate cputime(?, 0, ?). 325cputime(N, G, T):- writeln("Running pac runtime library cputime/3... "),
326 cputime(N, G, 0.00, T).
328cputime(0, _G, T, T).
329cputime(N, G, T, T0):- succ(N0, N),
330 cputime_for_step(G, S),
331 T1 is T + S,
332 cputime(N0, G, T1, T0).
334cputime_for_step(G, T):-
335 statistics(cputime, T0),
336 call(G),
337 statistics(cputime, T1),
338 T is T1-T0.
340cputime:- statistics(cputime, T), b_setval(cputime, T).
341cputime(T):- statistics(cputime, Stop), b_getval(cputime, Start), T is Stop - Start.
342
346
348:- meta_predicate monad(:, ?, ?). 349monad(G, X, Y):- once(ml:bind_context(G, (X, []), (Y, _))).
350
352:- meta_predicate mapterm_rec(2, ?, ?). 353mapterm_rec(F, A, B):- functor(A, Fa, Na),
354 functor(B, Fa, Na),
355 mapterm_rec(F, Na, A, B).
357mapterm_rec(_, 0, _, _):-!.
358mapterm_rec(F, I, A, B):- arg(I, A, Ai), arg(I, B, Bi),
359 ( call(F, Ai, Bi) -> true
360 ; atomic(Ai) -> Bi = Ai
361 ; mapterm_rec(F, Ai, Bi)
362 ),
363 J is I - 1,
364 mapterm_rec(F, J, A, B).
365
367:- meta_predicate maplist_rec(2, ?, ?). 368maplist_rec(_, [], []):-!.
369maplist_rec(F, [X|Xs], [Y|Ys]):-
370 ( X = [_|_]
371 -> maplist_rec(F, X, Y)
372 ; call(F, X, Y)
373 ),
374 maplist_rec(F, Xs, Ys).
375
378cons(X, Y, [X|Y]).
379
380:- meta_predicate fold(?, :, :, ?, ?). 381fold(V, G, A, X, Y):- Acc = '$ACC'(X),
382 ( call(G),
383 arg(1, Acc, U),
384 call(A, V, U, W),
385 nb_setarg(1, Acc, W),
386 fail
387 ; arg(1, Acc, Y)
388 ).
389
391test_add_to_acc(X, Acc):- arg(1, Acc, V),
392 V0 is X + V,
393 nb_setarg(1, Acc, V0).
394
395:- meta_predicate fold(?, :, :, ?). 396fold(V, G, Fun, X):-
397 ( call(G),
398 call(Fun, V, X),
399 fail
400 ; true
401 ).
402
405:- meta_predicate fold(?, :, ?). 406fold(V, G, V^Act):-!,
407 ( call(G),
408 call(Act),
409 fail
410 ; true
411 ).
412fold(V, G, A):-
413 ( call(G),
414 call(A, V),
415 fail
416 ; true
417 ).
418
441
442det_foreach(Gen, Con):- term_variables(Gen, Vs),
443 sort(Vs, Vs0),
444 term_variables(Con, Ws),
445 sort(Ws, Ws0),
446 ord_subtr_var(Ws0, Vs0, Ws1),
447 once(foreach_by_copy(Gen, Con, Vs0, Ws1)).
449foreach(Gen, Con, Vs, Ws):- once(foreach_by_copy(Gen, Con, Vs, Ws)).
450
452foreach_by_copy(A, B, Vs, Ws):-
453 findall(Vs, A, Sol),
454 copy_of_goal(Sol, Vs, Ws, B, Cs),
455 maplist(call, Cs).
457copy_of_goal([], _, _, _, []).
458copy_of_goal([A|As], Vs, Ws, B, [G|Gs]):-
459 copy_term(Vs+Ws+B, A+Ws+G),
460 copy_of_goal(As, Vs, Ws, B, Gs).
462ord_subtr_var([], _, []):-!.
463ord_subtr_var(X, [], X):-!.
464ord_subtr_var([X|Xs], [Y|Ys], Zs):- X==Y, !,
465 ord_subtr_var(Xs, Ys, Zs).
466ord_subtr_var([X|Xs], [Y|Ys], [X|Zs]):- X@<Y, !,
467 ord_subtr_var(Xs, [Y|Ys], Zs).
468ord_subtr_var(Xs, [_|Ys], Zs):- ord_subtr_var(Xs, Ys, Zs).
469
470 473
486