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