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