1:- module(pac_etc, [expand_etc/5, etc/6, sed/3, sed/4]). 2 3:- use_module(pac(op)). 4:- use_module(pac(reduce)). 5:- use_module(pac(basic)). 6:- use_module(pac(meta)). 7:- use_module(pac('expand-pac')). 8 9:- discontiguous etc/5. % [2017/04/08] 10:- discontiguous etc/6. % [2017/04/12] 11 12:- op(1000, xfy, &). 13:- op(700, xfx, :=). 14:- op(600, yfx, ..). 15 16 17 /************************** 18 * some tiny helpers * 19 **************************/ 20% 21free_variables(E, E0, Vs):- term_variables(E, U), 22 term_variables(E0, V), 23 subtract_memq(V, U, NewVs), 24 subtract_memq(U, NewVs, Vs). 25 26% 27subtract_memq([], _, []). 28subtract_memq([X|Xs], Y, Z):- memq(X, Y), !, 29 subtract_memq(Xs, Y, Z). 30subtract_memq([X|Xs], Y, [X|Z]):- subtract_memq(Xs, Y, Z). 31% 32pre_expand_arg(F, M, G, Vs, P, Q):- 33 ( nonvar(F) -> expand_arg(F, M, G, P, Q), 34 term_variables(G, Vs) 35 ; Q = P, 36 G = F, 37 Vs = [G] 38 ). 39 40 /******************** 41 * expand_etc * 42 ********************/
phrase --- hybrid regular expressions in DCG phrases for --- control predicate 'for' foldl --- foldl ( 'foldl' is builtin in SWI-Prolog) foldr --- foldr repeat --- repeat iterate --- repeat action until final. while --- while statement until --- until statement sed --- unix-like sed command based on the hybrid regualar expressions.
60expand_etc(E, M, G, P, Q):- E=..[K|Args],
61 once(etc(K, Args, M, G, P, Q)).
69% etc(call)//N and etc(apply)//N were removed. 70 71% ?- apply(pred([A,B,C]:- plus(A,B,C)), [1,2,X]). 72% ?- iff(member(X, [3,1,2]), member(X, [1,2,3])). 73% ?- call(iff(member(X, [3,3,1,2])), member(X, [1,2,3])). 74% ?- M1 = member(X, [3,3,1,2]), M2 = member(X, [1,2,3]), call(iff(M1, M2)). 75% ?- M1 = member(X, [3,3,1,2]), M2 = member(X, [1,2,3]), iff(M1, M2). 76% 77etc(iff, [C0, C1], M, G, P, Q) :- !, 78 expand_arg(C0, M, D0, P, P0), 79 expand_arg(C1, M, D1, P0, Q), 80 G = \+( (D0,\+D1) ; (D1, \+D0)). 81etc(iff, [C], M, meta:iff(D), P, Q):- 82 expand_arg(C, M, D, P, Q). 83etc(iff, [], _, meta:iff, P, P). 84 85% 86etc(unless, [C, B], M, (Not_C -> B0; true), P, Q):- 87 expand_arg(\+(C), M, Not_C, P, P0), 88 expand_arg(B, M, B0, P0, Q). 89 90 /************************ 91 * eval/eval_term * 92 ************************/ 93% Compile an expression to a goal. 94etc(eval, [E, V], M, G, P, Q) :- pac:expand_exp(E, [], =, V, M, G, P, Q). 95% 96etc(eval_term, [E, V], M, G, P, Q) :- pac:args_inside_out(E, E0), 97 pac:expand_exp(E0, [], =, V, M, G, P, Q). 98 99 /**************** 100 * phrase * 101 ****************/ 102 103% ?- etc_phrase([(a,b)], user, G, P, []). 104% ?- etc_phrase([w("a")], user, G, P, []). 105etc(phrase, [X|As], _, G, P, P):- var(X), !, complete_args(phrase, [X|As], G). 106etc(phrase, [X|As], M, G, P, Q):- !, etc_phrase([X|As], M, G, P, Q). 107% 108etc_phrase([X|As], M, G, P, Q):- term_variables(X, H), 109 phrase_to_pred(X, M, [U, V]:- Body, P, P0), 110 expand_core(pred(H, [U,V]:- Body), M, G0, P0, Q), 111 complete_args(G0, As, G). 112 113 /************* 114 * sed * 115 *************/ 116 117% ?- phrase(sed(s/ "e"/ "yyzz"), `ae`, R), basic:smash(R). 118% ?- phrase(sed(sl/ "e"/ "yyzz"), `ae`, R), basic:smash(R). 119% ?- phrase(sed(s/ "a" / =([])), `abacad`, R). 120% ?- sed(pred([X,[X|Y], Y]), `abc`, A). 121% ?- pac_word:let_sed(X, (a/"."/"x")), call(X, `abc`, Y). 122% ?- pac_word:let_sed(X, (b/"."/"x")), call(X, `abc`, Y). 123% ?- pac_word:let_sed(X, (s/"."/"x")), call(X, `abc`, Y). 124% ?- pac_word:let_sed(X, (s/".."/[])), call(X, `abc`, Y). 125% ?- pac_word:let_sed(S, "a">>"b"), call(S, `abcb`, R). 126% ?- sed(a/"b"/"c", `abcb`, R), basic:smash(R). 127% ?- sed(a/"b+"/"c", `abcb`, R), basic:smash(R). 128% ?- sed(b/"b"/"c", `abc`, R), basic:smash(R). 129% ?- pac_etc:etc(sed, ["a">>"b", `abcb`, R], user, G, L, []). 130% ?- pac_etc:etc(sed, [f], user, G, L, []). 131 132etc(sed, [S|R], _, G, P, P):- var(S), !, 133 complete_args(sed(S), R, G). 134etc(sed, [S|R], M, G, P, Q):- pac:expand_sed(S, [F, W, A]), !, 135 pac:expand_recognize_act(F, W, A, M, G0, P, Q), 136 complete_args(G0, R, G). 137etc(sed, [S|R], M, G, P, Q):- 138 expand_arg(S, M, S0, P, Q), 139 complete_args(sed(S0), R, G). 140% 141etc(d_sed, [S|R], _, G, P, P):- var(S), !, 142 complete_args(d_sed(S), R, G). 143etc(d_sed, [S|R], M, G, P, Q):- pac:expand_sed(S, [F, W, A]), !, 144 pac:expand_recognize_act(F, W, A, M, G0, P, Q), 145 complete_args(G0, R, G). 146etc(d_sed, [S|R], M, G, P, Q):- expand_arg(S, M, S0, P, Q), 147 complete_args(d_sed(S0), R, G). 148% 149:- meta_predicate sed( , , ). 150sed(G, X, Y) :- sed(G, Y, X, []). 151% 152:- meta_predicate sed( , , , ). 153sed(G, [U|V], X, Y) :- call(G, U, X, Z), !, sed(G, V, Z, Y). 154sed(G, [U|V], [U|X], Y) :-!, sed(G, V, X, Y). 155sed(G, [U|V], acc(A, [U|X]), Y) :-!, sed(G, V, acc(A, X), Y). 156sed(_, acc(A), acc(A, []), []). 157sed(_, [], [], []). 158 159% D-list version of sed 160% ?- d_sed(pred([[X|A], A, [X|Y], Y]), `abc`, A). 161:- meta_predicate d_sed( , , ). 162:- meta_predicate d_sed( , , , , ). 163 164d_sed(G, X, Y) :- d_sed(G, Y, [], X, []). 165% 166d_sed(G, X, Y, A, B):- call(G, X, X0, A, A0), !, 167 d_sed(G, X0, Y, A0, B). 168d_sed(G, [U|X], Y, [U|A], B):- d_sed(G, X, Y, A, B). 169d_sed(G, [U|X], Y, acc(M, [U|A]), B):- d_sed(G, X, Y, acc(M, A), B). 170d_sed(_, X, X, [], []). 171d_sed(_, [acc(M)|X], X, acc(M,[]), []). 172 173 /*************************************** 174 * Term rewriting system (Naive) * 175 ***************************************/ 176% ?- module(pac). 177% ?- pac_etc:etc(trs, [[a=b]], user, G, P, []), 178% maplist(assert, P), !, call(G, a, Out). 179% ?- pac_etc:etc_trs(trs, [(A,B)=(A,C) :- B=C], user,G, P, []), 180% maplist(assert, P), call(G, (a, b), X). 181 182etc(trs, [R|As], M, G, P, Q):- 183 etc_trs(_Trs, R, M, G0, P, Q), 184 complete_args(G0, As, G). 185% 186etc_trs(Trs, R, M, G, P, Q):- 187 (R = Vs^Rules -> true 188 ; Vs = [], 189 Rules = R 190 ), 191 maplist(make_rewrite_pred(Basic_rule_name), Rules, Preds), 192 list_to_ampersand(Preds, Amps), 193 expand_core(rec(Basic_rule_name, Vs, Amps), M, G0, P, P0), 194 expand_core( 195 rec(Trs, Vs, 196 ([X, Y]:- call(G0, X, X0), !, 197 call(Trs, X0, Y)) 198 & 199 ([X, X]) 200 ), 201 M, G, P0, Q). 202 203% 204make_rewrite_pred(_, A = B, [A,B]):-!. 205make_rewrite_pred(R, (A = B :- Eqs), [A,B]:- G0) :- 206 make_rewrite_cond(Eqs, R, G0). 207 208% 209make_rewrite_cond((X, Y), R, (X0, Y0)):- 210 make_rewrite_cond(X, R, X0), 211 make_rewrite_cond(Y, R, Y0). 212make_rewrite_cond((X; Y), R, (X0; Y0)):- 213 make_rewrite_cond(X, R, X0), 214 make_rewrite_cond(Y, R, Y0). 215make_rewrite_cond(U=V, R, call(R, U, V)). 216make_rewrite_cond(G, _, G). 217 218% ?- pac_etc:list_to_ampersand([a,b,c], R). 219list_to_ampersand([], []). 220list_to_ampersand([X], X). 221list_to_ampersand([X,Y|Z], &(X, U)):- list_to_ampersand([Y|Z], U). 222% 223etc(head_sed, [E|As], M, H, P, Q) :- 224 pac:expand_sed(E, [F, W, A]), 225 pac_word:expand_head_sed(F, W, A, M, G0, P, P0), 226 pac:expand_core(pred(F, [In, Out]:- once(call(G0, Out, In, []); Out=In)), 227 M, H0, P0, Q), 228 complete_args(H0, As, H). 229 /*************** 230 * foldl * 231 ***************/ 232% ?- foldl(plus, [1,2,3,4,5,6,7,8,9,10], 0, R). 233% ?- foldl(plus, [1, 2, 3], 0, R). 234etc(foldl, [F|Args], _, Foldl, P, P):- var(F),!, 235 complete_args(foldl, [F|Args], Foldl). 236etc(foldl, [F|Args], M, G, P, Q):- 237 expand_arg(F, M, F0, P, P0), 238 term_variables(F0, Vs), 239 expand_core( 240 rec(R, Vs, 241 [[], X, X] 242 & 243 ([[A|As], X, Y]:- 244 call(F0, A, X, X0), 245 call(R, As, X0, Y))), 246 M, G0, P0, Q), 247 complete_args(G0, Args, G). 248etc(foldl, [], _, foldl, P, P). 249 250 /*************** 251 * foldr * 252 ***************/ 253% ?- foldr(pred([X, U, [X|U]]), [a,b,c], [], R). 254% ?- foldr(plus, [1, 2, 3], R, 0). 255% ?- F = plus, foldr(F, [1, 2, 3], R, 0). 256% ?- foldr(pred([X, Y, Z]:- plus(X, Z, Y)), [1, 2, 3], R, 0). 257% ?- foldr(pred([X, Y, Z]:- plus(X, Z, Y)), [1, 2, 3], R, 0). 258etc(foldr, [F|Args],_, meta:Foldr, P, P):- var(F), 259 complete_args(foldr, [F|Args], Foldr). 260etc(foldr, [F|Args], M, G, P, Q):- 261 expand_arg(F, M, F0, P, P0), 262 term_variables(F0, Vs), 263 expand_core( 264 rec(R, Vs, 265 [[], X, X] 266 & ([[A|As], X, Y]:- 267 call(F0, A, X0, Y), 268 call(R, As, X, X0))), 269 M, G0, P0, Q), 270 complete_args(G0, Args, G). 271etc(foldr, [], _, foldr, P, P). 272 273 274 /************* 275 * for * 276 *************/ 277% ?- for(1..3, writeln). 278% ?- time(for(..(1,10), pred([X]:- write(X)))). 279% ?- time(for(..(1, 5+5), pred([X]:- write(X)))). 280% ?- for(..(1,10), pred([X]:- write(X))). 281% ?- for(1-10, write). 282% ?- Sum=sum(0), profile( 283% for( ..(1,100_000_000), 284% pred(Sum, [I]:- ( arg(1, Sum, S), Si is S+I, setarg(1, Sum, Si))))). 285%@ Sum = sum(5000000050000000). 286% ?- Sum=sum(0), time( 287% for( ..(1,100_000_000), 288% pred(Sum, [I]:- ( arg(1, Sum, S), Si is S+I, setarg(1, Sum, Si))))). 289% ?- pac:show(for(1..10, pred([X]:- write(X)))). 290% ?- pac:show(for(1..10, write)). 291% ?- F = write, A=1, B=10, for(A..B, F). 292% ?- F = write, A=1, B=10, pac:show(for(A..B, F)). 293 294etc(for, [Iexp, F], M, G, P, Q):-!, int_intervalval_exp(Iexp, I, J), 295 etc_for([I, J, F], M, G, P, Q). 296% 297int_intervalval_exp(E, I, J):- var(E), !, E = ..(I,J). 298int_intervalval_exp(E, I, J):- once(E= ..(L, R); E= -(L, R)), 299 ( ground(L) -> I is L 300 ; I = L 301 ), 302 ( ground(R) -> J is R 303 ; J = R 304 ). 305% 306etc_for([I, J, F], _, meta:for(I, J, F), P, P):- var(F), !. 307etc_for([I, J, F], M, G, P, Q):- 308 expand_arg(F, M, F0, P, P0), 309 term_variables(F0, Vs), 310 ( integer(J) 311 -> Plist=[A], 312 Qlist = [I], 313 Rlist = [A0], 314 Check = (A>J) 315 ; Plist=[A,B], 316 Qlist=[I,J], 317 Rlist = [A0, B], 318 Check = (A>B) 319 ), 320 CALL =..[call, R|Rlist], 321 expand_core( 322 rec(R, Vs, 323 (Plist:- Check, !) 324 & (Plist:- call(F, A), A0 is A + 1, CALL) 325 ), 326 M, G0, P0, Q), 327 complete_args(G0, Qlist, G). 328 329 330 /**************** 331 * repeat * 332 ****************/ 333% ?- repeat(between(1, 3, I), writeln(I)). 334% ?- repeat(3, writeln(hello)). 335% ?- repeat(between(1, 5, J), writeln(J)). 336% ?- repeat(0, write(.)). 337% ?- call_with_time_limit(5, repeat(fail, write(.))). 338% ?- repeat(100, write(.)). 339% ?- repeat(10-8, write(.)). 340% ?- repeat(10 mod 3, write(.)). 341% ?- R is 10//2, G= write(.), repeat(R, G). 342% ?- R = 10//2, G= write(.), repeat(R, G). 343% ?- call_with_time_limit(0.01, time(repeat(repeat, writeln(.)))). 344% ?- show(repeat(repeat, writeln(.))). 345 346etc(repeat, As, M, G, P, Q):- etc_repeat(As, M, G, P, Q), !. 347% 348etc_repeat([Rep, Goal], _, G, P, P):- ( var(Rep); var(Goal) ), !, 349 G = meta:repeat(Rep, Goal). 350etc_repeat([Rep, Goal], M, G, P, Q):- meta:repeat_cond(Rep, Cond), !, 351 expand_goal((Cond, Goal, fail; true), M, G, P, Q). 352 353% % NOT FAST !! (Copy_term seems better). 354% etc(foreach, [Gen, Con, Vs, Ws], M, G, P, Q):- 355% pac:expand_core(pred([Vs, Ws]:- Con), M, F, P, P0), 356% G0 = 357% ( Stash = '$STASH'(_), 358% nb_setarg(1, Stash, Ws), 359% ( call(Gen), 360% arg(1, Stash, U), 361% once(call(F, Vs, U)), 362% nb_setarg(1, Stash, U), 363% fail 364% ; arg(1, Stash, Ws) 365% ) 366% ), 367% expand_goal(G0, M, G, P0, Q). 368 369 370% ?- show( fold(I, between(1, 10, I), plus, 0, S)). 371% ?- time( fold(I, between(1, 100000, I), plus, 0, S)). 372% ?- N = 3, numlist(1, N, Ns), time(fold(M, append(M, _, Ns), pred([X, Y, Z]:- append(X, Y, Z)), [], S)). 373% ?- N = 3, numlist(1, N, Ns), time(fold(M, append(M, _, Ns), append, [], S)). 374% ?- use_module(pac(basic)). 375% ?- N = 3, numlist(1, N, Ns), time(fold(M, member(M, Ns), cons, [], S)). 376% ?- N = 3, numlist(1, N, Ns), time(fold(M, member(M, Ns), append, [], S)). 377% ?- N = 3, A = append, E = member(M, Ns), numlist(1, N, Ns), time(fold(M, member(M, Ns), append, [], S)). 378% 379etc(fold, As, M, G, P, Q):-!, etc_fold(As, M, G, P, Q). 380 381etc_fold([Arg, Gen, Act|As], _, G, P, P):- (var(Gen), var(Act)), !, 382 complete_args(meta:fold(Arg, Gen, Act), As, G). 383etc_fold([Arg, Gen, Act, X, Y], M, G, P, Q):-!, 384 expand_arg(Act, M, Act0, P, P0), 385 expand_goal(Gen, M, Gen0, P0, P1), 386 expand_goal(( Acc = '$acc'(X), 387 ( Gen0, 388 arg(1, Acc, U), 389 call(Act0, Arg, U, V), 390 nb_setarg(1, Acc, V), 391 fail 392 ; arg(1, Acc, Y) 393 ) 394 ), 395 M, G, P1, Q). 396 397% ?- A = acc(0), fold(M, member(M, [1,2,3]), pred([I, X]:- (arg(1, X, V), U is I + V, nb_setarg(1, X, U))), A). 398etc_fold([Arg, Gen, Act, X], M, G, P, Q):-!, 399 expand_arg(Act, M, Act0, P, P0), 400 expand_goal(Gen, M, Gen0, P0, P1), 401 expand_goal(( ( Gen0, 402 call(Act0, Arg, X), 403 fail 404 ; true 405 ) 406 ), 407 M, G, P1, Q). 408 409% ?- fold(M, member(M, [1,2,3]), writeln). 410% ?- fold(M, member(M, [1,2,3]), X^(Y is X*X, writeln(Y))). 411% ?- Gen = member(M, [1,2,2]), Con = writeln, fold(M, Gen, Con). 412% ?- fold(M, member(M, [1,2,3]), I^(J is I*I, writeln(J))). 413% ?- N is 10^8, time(fold(J, between(1, N, J), X^(X=X))). 414% ?- N is 10^9, time(fold(J, between(1, N, J), X^(X=X))). 415%@ % 2,000,000,001 inferences, 49.470 CPU in 49.519 seconds (100% CPU, 40428767 Lips) 416 417etc_fold([X, Gen, X^Act], M, G, P, Q):-!, 418 expand_goal(Gen, M, Gen0, P, P1), 419 expand_goal(( Gen0, 420 Act, 421 fail 422 ; true 423 ), 424 M, G, P1, Q). 425etc_fold([X, Gen, Act], M, G, P, Q):- 426 expand_arg(Act, M, Act0, P, P0), 427 expand_goal(Gen, M, Gen0, P0, P1), 428 expand_goal(( Gen0, 429 call(Act0, X), 430 fail 431 ; true 432 ), 433 M, G, P1, Q). 434 435 436 /******************************* 437 * unary/binary foldnum * 438 *******************************/ 439% ?- foldnum(plus, 1-10, 0, X). 440% ?- foldnum(pred([X,Y,Z]:- Z is X*Y), 1-4, 1, R). 441% ?- foldnum(pred([X,Y,Z]:- Z is X*Y), 1-1000, 1, R). 442% ?- F = plus, foldnum(F, 1-100, 0, R). 443% ?- N=100, functor(A, #, N), 444% forall(between(1, N, I), nb_setarg(I, A, I)), 445% foldnum(pred(A, ([J, C, D]:- arg(J, A, Aj), D is C * Aj) ), 446% 1 - N, 1, S). 447 448etc(foldnum, [F|As], _, meta:G, P, P):- var(F), !, 449 complete_args(foldnum, [F|As], G). 450etc(foldnum, [F, IntExp|As], M, G, P, Q):- 451 int_intervalval_exp(IntExp, I, J), 452 expand_arg(F, M, F0, P, P0), 453 term_variables([I, J, F0], Vs), 454 expand_core( 455 rec(R, Vs, 456 ([A, U, U]:- A>J, !) 457 & 458 ([A, U, V]:- call(F, A, U, U0), 459 A0 is A + 1, 460 call(R, A0, U0, V))), 461 M, G0, P0, Q), 462 complete_args(G0, [I|As], G). 463 464 /**************************** 465 * fold_paths_of_term * 466 ****************************/ 467% ?- fold_paths_of_term(pred([A,[A|B], B]), f(1,2), X, []). 468etc(fold_paths_of_term, [F|As], _, meta:G, P, P):- var(F), !, 469 complete_args(fold_paths_of_term, [F|As], G). 470etc(fold_paths_of_term, [F|Args], M, G, P, Q):- 471 expand_arg(F, M, F0, P, P0), 472 term_variables(F0, Vs), 473 expand_core(mrec(Vs, [ 474 _Entry = ([T, X, Y]:- call(Fold_4, [[T]], [], X, Y)), 475 Fold_4 = 476 &( ([[], _, X, X]:-!), 477 ([[Ts|L], Path, X, Y]:- 478 ( Ts==[] 479 -> call(Fold_4, L, Path, X, Y) 480 ; Ts=[T|Rs], 481 call(Fold_5, T, [Rs|L], Path, X, Y) 482 ))), 483 Fold_5 = 484 &( ([T, Ls, Path, X, Y]:- atomic(T), !, 485 call(F, [T|Path], X, Xtp), 486 call(Fold_4, Ls, Path, Xtp, Y) ), 487 ([T, Ls, Path, X, Y]:- T=..[Ft, At|As], 488 call(Fold_5, At, [As|Ls], [Ft|Path], X, Y) 489 )) 490 ]), 491 M, G0, P0, Q), 492 complete_args(G0, Args, G). 493 494 /******************* 495 * fold_args * 496 *******************/ 497% ?- fold_args(plus, f(1,2,3,4), 0, S). 498% ?- F=plus, fold_args(F, f(1,2,3,4), 0, S). 499% ?- fold_args(pred([X, Y, Z]:- Z is X + Y), f(1,2,3,4), 0, S). 500etc(fold_args, [F|As], _, meta:G, P, P):- var(F), !, 501 complete_args(fold_args, [F|As], G). 502etc(fold_args, [F|As], M, G, P, Q):- 503 expand_arg(F, M, F0, P, P0), 504 term_variables(F0, Vs), 505 expand_core( 506 mrec(Vs, [ _Entry = ( [V, A, B]:- 507 functor(V, _, Nv), 508 call(Fold_args, 1, Nv, V, A, B)), 509 Fold_args = 510 &( ([I, Nv, _, A, A]:- I > Nv, !), 511 ([I, Nv, V, A, B]:- 512 arg(I, V, Vi), 513 call(F, Vi, A, Ai), 514 I1 is I + 1, 515 call(Fold_args, I1, Nv, V, Ai, B))) 516 ]), 517 M, G0, P0, Q), 518 complete_args(G0, As, G). 519 520 521 522 /***************** 523 * mapterm * 524 *****************/ 525 526% ?- mapterm(=, f(a, b), Out). 527%@ Out = f(a, b). 528% ?- mapterm(pred([a,b]), f(a,a), R). 529%@ R = f(b, b). 530% ?- mapterm(mapterm(pred([a,b])), f(g(a,a), h(a,a)), R). 531%@ R = f(g(b, b), h(b, b)). 532% ?- mapterm(pred([A, [A,A]]), f(a,b), Out). 533%@ Out = f([a, a], [b, b]). 534% ?- F = pred([A, [A,A]]), mapterm(F, f(a,b), Out). 535%@ F = update_link:'pac#16', 536%@ Out = f([a, a], [b, b]). 537%@ F = update_link:'pac#13', 538%@ Out = f([a, a], [b, b]). 539 540% etc(mapterm, [F|As], _, meta:G, P, P):- var(F), !, 541% complete_args(mapterm, [F|As], G). 542% etc(mapterm, [F|As], M, G, P, Q):- 543% expand_arg(F, M, F0, P, P0), 544% term_variables(F0, Vs), 545% expand_core( 546% mrec(Vs, [ _Entry = pred(( [A, B]:- 547% functor(A, Fa, Na), 548% functor(B, Fa, Na), 549% call(Mapterm, Na, A, B))), 550% Mapterm = pred( ([0, _, _]:- !) 551% & 552% ([I, A, B]:- 553% arg(I, A, Ai), 554% arg(I, B, Bi), 555% call(F, Ai, Bi), 556% J is I - 1, 557% call(Mapterm, J, A, B))) 558% ]), 559% M, G0, P0, Q), 560% complete_args(G0, As, G). 561 562% ?- mapterm_rec(=, f(a, b), Out). 563%@ Out = f(a, b). 564% ?- mapterm_rec(pred([a, b]), f(a, b), Out). 565%@ Out = f(b, b). 566% ?- mapterm_rec(pred([a, b]), f(g(a), h(a,b)), Out). 567%@ Out = f(g(b), h(b, b)). 568% ?- show(mapterm_rec(pred([a, b]), f(g(a), h(a,b)), Out)). 569 570etc(mapterm_rec, [F|As], _, meta:G, P, P):- var(F), !, 571 complete_args(mapterm_rec, [F|As], G). 572etc(mapterm_rec, [F|As], M, G, P, Q):- 573 expand_arg(F, M, F0, P, P0), 574 term_variables(F0, Vs), 575 expand_core( 576 mrec(Vs, [ Entry = ( [A, B]:- 577 functor(A, Fa, Na), 578 functor(B, Fa, Na), 579 call(Mapterm_rec, Na, A, B)), 580 Mapterm_rec = ( ([0, _, _]:- !) 581 & ([I, A, B]:- 582 arg(I, A, Ai), 583 arg(I, B, Bi), 584 ( call(F0, Ai, Bi)-> true 585 ; atomic(Ai) -> Bi = Ai 586 ; call(Entry, Ai, Bi) 587 ), 588 J is I - 1, 589 call(Mapterm_rec, J, A, B) 590 ) 591 ) 592 ]), 593 M, G0, P0, Q), 594 complete_args(G0, As, G). 595 596 /*************************** 597 * recursive maplist * 598 ***************************/ 599 600% ?- show(maplist_rec(plus(1), [0,1,2], Out)). 601% ?- N = 1000, K=1000, numlist(1, N, Ns), length(Ks, K), 602% maplist(=(Ns), Ks), time(maplist_rec(plus(1), Ks, Out)). 603 604etc(maplist_rec, [F|As], _, meta:G, P, P):- var(F), !, 605 complete_args(maplist_rec, [F|As], G). 606etc(maplist_rec, [F|As], M, G, P, Q):- 607 expand_arg(F, M, F0, P, P0), 608 term_variables(F0, Vs), 609 expand_core( 610 mrec(Vs, [ Main = ( [[], []] 611 & ([[X|Xs], [Y|Ys]]:- 612 ( X = [_|_] % for fast is_list(X) 613 -> call(Main, X, Y) 614 ; call(F0, X, Y) 615 ), 616 call(Main, Xs, Ys) 617 ) 618 ) 619 ]), 620 M, G0, P0, Q), 621 complete_args(G0, As, G). 622 623 624 /***************** 625 * maprows * 626 *****************/ 627% ?- qcompile(zdd(zdd)), module(zdd). 628% (inner_prod is missing.) 629% ?- maprows(zdd:inner_prod(f(1,2)), m(f(1,2), f(3,4)), B). 630% ?- maprows(zdd:inner_prod(f(1,2)), m(f(1,2,3), f(3,4,5)), B). 631etc(maprows, [F|As], _, meta:G, P, P):- var(F), !, 632 complete_args(maprows, [F|As], G). 633etc(maprows, [F|As], M, G, P, Q):- 634 expand_arg(F, M, F0, P, P0), 635 term_variables(F0, Vs), 636 expand_core( 637 mrec(Vs, [ _Entry = ( ([A, A]:- atom(A), !) 638 & ([A, B]:- arg(1, A, A1), 639 functor(A1, Fa, Na), 640 functor(B, Fa, Na), 641 call(Maprows, Na, A, B)) 642 ), 643 Maprows = ( ([0, _, _]:- !) 644 & ([I, A, B]:- arg(I, B, Bi), 645 call(F, I, A, Bi), 646 J is I - 1, 647 call(Maprows, J, A, B)) 648 ) 649 ]), 650 M, G0, P0, Q), 651 complete_args(G0, As, G). 652 653 654 /***************** 655 * mapargs * 656 *****************/ 657% now a SWI library. 658% ?- Y = f(1, 2), mapargs(=, count(2, 1, 1), f(a,b), Y). 659% ?- Y = f(1, 2), mapargs(=, count(1, 2, 2), f(a,b), Y). 660% ?- Y = f(1, 2), mapargs(=, count(1, 1, 2), f(a,b), Y). 661% etc(mapargs, [F|As], _, meta:G, P, P):- var(F), !, 662% complete_args(mapargs, [F|As], G). 663% etc(mapargs, [F|As], M, G, P, Q):- 664% expand_arg(F, M, F0, P, P0), 665% term_variables(F0, Vs), 666% expand_core( mrec(Vs, 667% [ _Entry = pred( 668% ( [count(N, I, J), A, B]:- 669% call(Mapargs, N, I, J, A, B))), 670% Mapargs = pred( 671% ([0, _, _, _, _]:-!) 672% & ([N, I, J, A, B]:- 673% arg(I, A, Ai), 674% call(F, Ai, Bj), 675% setarg(J, B, Bj), 676% N1 is N-1, 677% I1 is I+1, 678% J1 is J+1, 679% call(Mapargs, N1, I1, J1, A, B))) 680% ]), 681% M, G0, P0, Q), 682% complete_args(G0, As, G). 683 684 685 /***************************** 686 * while/until/iterate * 687 *****************************/ 688 689% ?- until( pred([s(I, _)]:- I>10), 690% pred(([s(I, X), s(J, Y)]:- J is I+1, Y is J*X, writeln(Y))), s(1,1), R). 691% ?- let(S, pred(([s(I, X), s(J, Y)]:- J is I+1, Y is J*X, writeln(Y)))), 692% let(Fin, pred([s(I, _)]:- I>10)), 693% until(Fin, S, s(1,1), R). 694etc(until, [Fin, S|Args], M, meta:G, P, Q):- (var(Fin); var(S)), !, 695 expand_arg(Fin, M, Fin0, P, P0), 696 expand_arg(S, M, S0, P0, Q), 697 complete_args(until, [Fin0, S0|Args], G). 698etc(until, [Fin, S|Args], M, G, P, Q):- 699 pre_expand_arg(Fin, M, F0, VsF, P, P_), 700 pre_expand_arg(S, M, S0, VsS, P_, P0), 701 union(VsF, VsS, Vs), 702 expand_core( 703 rec(Rec, Vs, 704 ([X, Y]:- 705 call(S0, X, X0), 706 ( call(F0, X0) -> Y = X0 707 ; call(Rec, X0, Y) 708 ) 709 ) 710 ), 711 M, G0, P0, Q), 712 complete_args(G0, Args, G). 713 714 715% ?- A = 5, 716% iterate( pred(A, 717% ( [ s(X, Y), s(X0, Y0) ] :- X<A, !, X0 is X+1, Y0 is X*Y ) 718% & [ U, stop(U)] ) , 719% s(1,1), R). 720 721% ?- let(F, iterate(pred(A, 722% ( [ s(X, Y), s(X0, Y0) ] :- X<A, !, X0 is X+1, Y0 is X*Y ) 723% & [ U, stop(U)] ))), 724% A = 5, 725% call(F, s(1,1), R). 726 727etc(iterate, [S|Args], M, meta:G, P, Q):- var(S), !, 728 expand_arg(S, M, S0, P, Q), 729 complete_args(iterate, [S0|Args], G). 730etc(iterate, [S|Args], M, G, P, Q):- 731 pre_expand_arg(S, M, S0, Vs, P, P0), 732 expand_core( 733 rec(Rec, Vs, 734 ( [stop(X), X]:-! ) & 735 ( [X, Y]:- call(S0, X, X0), !, call(Rec, X0, Y) )), 736 M, G0, P0, Q), 737 complete_args(G0, Args, G). 738 739% ?- while(pred([s(X)]:- X < 10), pred(([s(X),s(Y)]:- writeln(X), 740% Y is X + 1)), s(0), R). 741% ?- let(Fin, pred([s(X)]:- X < 10)), 742% let(S, pred(([s(X),s(Y)]:- writeln(X), Y is X + 1))), 743% while(Fin, S, s(0), R). 744etc(while, [Fin, S|Args], M, meta:G, P, Q):- (var(Fin); var(S)), !, 745 expand_arg(Fin, M, Fin0, P, P0), 746 expand_arg(S, M, S0, P0, Q), 747 complete_args(while, [Fin0, S0|Args], G). 748etc(while, [Fin, S|Args], M, G, P, Q):- 749 pre_expand_arg(Fin, M, F0, VsF, P, P_), 750 pre_expand_arg(S, M, S0, VsS, P_, P0), 751 union(VsF, VsS, Vs), 752 expand_core( 753 rec(Rec, Vs, 754 ([X, Y]:- ( call(F0, X) 755 -> call(S0, X, X0), 756 call(Rec, X0, Y) 757 ; Y = X 758 ) 759 ) 760 ), 761 M, G0, P0, Q), 762 complete_args(G0, Args, G). 763 764 /*************** 765 * xargs * 766 ***************/ 767 768etc(xargs, Args, M, G, P, Q):- etc_xargs(Args, M, G, P, Q). 769% 770etc_xargs([], M, G, P, P):- complete_args(M:call, [], G). 771etc_xargs([F|Args], M, G, P, P):- var(F), !, 772 complete_args(M:F, Args, G). 773etc_xargs([F|Args], M, G, P, Q):- 774 ( F = (Head:- Body) 775 -> pac:expand_goal(Body, M, G0, P, Q), 776 pac:slim_exp_goal((pac:partial_args_match(Head, Args), G0), G) 777 ; ( F = (_Head -> _Body) 778 -> pac:expand_exp(F, Args, call, _V , M, G, P, Q) 779 ; Args = [A1,A2|Rest], 780 etc_xargs([[A1, A2|Rest] :- apply(F, [A2, A1|Rest])], M, G, P, Q) 781 ) 782 ). 783 784 /***************** 785 * cputime * 786 *****************/ 787 788% ?- pac_etc:etc(cputime, [3, A=b, T], user, G, P, []). 789% ?- nopac(meta:cputime(3000000, (b_setval(a,b),b_getval(a,B)), T)). 790% ?- pac_etc:cputime(3000000, (b_setval(a,b),b_getval(a,B)), T). 791 792etc(cputime, [], _, meta:cputime, P, P):-!. 793etc(cputime, [N], _, meta:cputime(N), P, P):-!. 794etc(cputime, [N, Goal|Args], _, meta:G, P, P):- var(Goal),!, 795 complete_args(cputime(N, Goal), Args, G). 796etc(cputime, [Count, Goal|Args], M, G, P, Q):- 797 goal_to_pred(Goal, M, Vs:-Goal0, P, P1), 798 expand_core( 799 mrec(Vs, 800 [ _Top = pred(([N, T]:- writeln("running compiled cputime/3 ... "), 801 call(Repeat, N, 0.00, T))), 802 Repeat = pred( ( [0, T, T]) 803 & ( [N, T, T0]:- succ(N0, N), 804 call(Cputime, S), 805 T1 is T + S, 806 call(Repeat, N0, T1, T0))), 807 Cputime = pred(( [T]:- statistics(cputime, T0), 808 call(Goal0), 809 statistics(cputime, T1), 810 T is T1-T0)) 811 ]), M, G0, P1, Q), 812 complete_args(G0, [Count|Args], G). 813 814 815 /***************** 816 * collect * 817 *****************/ 818% ?- collect(integer, [1,a,2,b], X). 819etc(collect, [], _, basic:collect, P, P):- !. % collect/3 is a meta-predicate 820etc(collect, [F|Args], _, basic:Collect, P, P):- var(F), !, 821 Collect=..[collect, F|Args]. 822etc(collect, [F], M, G, P, Q):- !, 823 etc_collect(F, M, G, P, Q). 824etc(collect, [F, X], M, G, P, Q):- !, 825 etc_collect(F, M, G0, P, Q), 826 complete_args(G0, [X], G). 827etc(collect, [F, X, V], M, G, P, Q):- !, 828 etc_collect(F, M, G0, P, Q), 829 complete_args(G0, [X, V], G). 830% 831etc_collect(F, M, G, P, Q):- !, 832 expand_arg(F, M, F0, P, P0), 833 term_variables(F0, F, Vs), 834 expand_core( 835 rec(R, Vs, 836 ( [[A|As], S] :- 837 ( call(F0, A) 838 -> S = [A|S0] 839 ; S = S0 840 ), 841 call(R, As, S0) ) 842 & ( [[], []] :- true ) 843 ), 844 M, G, P0, Q). 845 846 /********************** 847 * maplist_opp * 848 **********************/ 849 850% ?- maplist_opp([=, =, =], a, X). 851% ?- Fs = [=, =, =], maplist_opp(Fs, a, X). 852% ?- maplist_opp([plus(1), plus(2), plus(3)], 0, X). 853% ?- maplist_opp([pred([X,Y]:-plus(X,10,Y)), 854% pred([X,Y]:-plus(X,20,Y))], 1, U). 855 856etc(maplist_opp, [L|R], M, meta:Call_maplist_opp, P, Q):- 857 map_arg_list(L, M, L0, P, Q), 858 Call_maplist_opp=..[maplist_opp, L0|R]. 859 860% ?-pac_etc:map_arg_list([a,b,c], [], L, P, []). 861map_arg_list(A, _, A, P, P):-var(A),!. 862map_arg_list([A|As], M, [A0|As0], P, Q):- 863 expand_arg(A, M, A0, P, P0), 864 map_arg_list(As, M, As0, P0, Q). 865map_arg_list([], _, [], P, P). 866 867 /********************** 868 * term_rewrite * 869 **********************/ 870 871 872% ?- show(term_rewrite(pred([a,b]), {*,+,-}, a+b, X)). 873% ?- term_rewrite(pred([a,b]), \+ (*), a+b, X). 874% ?- term_rewrite(pred([a,b]), \+ (*), a+b*c, X). 875% ?- term_rewrite(pred([a,b]), \+ (*), a*c+b*c, X). 876% ?- call(term_rewrite(pred([a,b]), \+ (*)), a*c+b*c, X). 877% 878etc(term_rewrite, [R, E|Args], M, Call, P, Q):- ground(R), ground(E), !, 879 misc:expand_sgn_brace(E, E0), 880 expand_arg(R, M, R0, P, P0), 881 expand_core( 882 pred(([X, Y]:- reduce:subtree(E0, X, Y, S, S0), 883 nonvar(S), 884 call(R0, S, S0))), 885 M, Reduce_one, P0, P1), 886 expand_core( 887 rec(Reduce, 888 ([X, Y]:- 889 call(Reduce_one, X, X0), 890 !, 891 call(Reduce, X0, Y)) 892 & [X, X]), 893 M, G, P1, Q), 894 complete_args(G, Args, Call). 895etc(term_rewrite, [R, E|Args], _, Call, P, P):- 896 complete_args(reduce:term_rewrite(R, E), Args, Call). 897 898 899% A termplate for etc plug-in 900% 901% etc(pacmap, [F|Args], _, Maplist, P, P):- var(F), !, 902% Maplist=..[maplist, F|Args]. 903% etc(pacmap, [F|Args], M, G, P, Q):- 904% expand_arg(F, M, F0, P, P0), 905% free_variables(F0, F, Vs), 906% length(Args, N), 907% length(EmptyLists, N), 908% maplist(=([]), EmptyLists), 909% length(Params, N), 910% maplist(cons, Cars, Cdrs, Params), 911% Call1 =..[call, F0|Cars], 912% Call2 =..[call, R|Cdrs], 913% expand_core( 914% rec(R, Vs, 915% EmptyLists & 916% ( Params :- Call1, Call2 ) 917% ), 918% M, G0, P0, Q), 919% complete_args(G0, Args, G). 920% etc(pacmap, [], _, maplist, P, P). % maplist is a builtin. 921 922%@ true.