1:- module(pac, [ 2 befun/0, efun/0, 3 bekind/1, bekind/2, ekind/0, 4 betrs/1, etrs/0, 5 nopac/1, 6 eval/2, eval/3, 7 expand_pac/2, 8 expand_arg/5, 9 expand_arg_assert/2, expand_arg_compile/2, 10 expand_basic_phrase/4, 11 expand_basic_phrase/5, 12 expand_core/5, 13 expand_exp/7, expand_exp/8, 14 expand_fun/2, expand_goal/5, 15 expand_kind_rule/5, flip_list/3, expand_phrase/5, 16 compile_kind_rule/6, 17 expand_query/3, goal_to_pred/5, 18 partial_args_match/2, 19 phrase_to_pred/5, regex/3, 20 new_pacref/3 21 ]). 22 23:- use_module(pac(reduce)). 24:- use_module(pac(basic)). 25:- use_module(pac('expand-etc')). 26:- use_module(pac('anti-subst')). 27:- use_module(pac('odict-expand')). 28:- use_module(pac(op)). 29:- use_module(pac('expand-word')). 30:- use_module(library(gensym)). 31:- meta_predicate user:maplist(). 32usermaplist(_). 33 34maplist_assert([]). 35maplist_assert([X|Y]) :- assert_one(X), 36 maplist_assert(Y). 37% 38assert_one(A:(B,C)) :-!, assert_one(A:B), 39 assert_one(A:C). 40assert_one(A) :- assert(A). 41 42% For expanding toplevel queries to assert into the user module. 43assert_in_user([]). 44assert_in_user([X|Y]) :- assert_in_user_one(X), 45 assert_in_user(Y). 46% 47assert_in_user_one(M:(B,C)) :- !, 48 assert_in_user_one(M:B), 49 assert_in_user_one(M:C). 50assert_in_user_one((B,C)) :- !, 51 assert_in_user_one(B), 52 assert_in_user_one(C). 53assert_in_user_one(M:(H:-B)):-!, assert(user: :- M:B). 54assert_in_user_one((M:H):-B):-!, assert(user: :- M:B). 55assert_in_user_one(H:-B) :-!, assert(user: :- ). 56assert_in_user_one(_:H) :-!, assert(user:). 57assert_in_user_one(H) :- assert(user:). 58 59% 2011 April, June, Kuniaki Mukai 60% 2012 March, April 61% 2014 June, September 62% 2015 February 63 64% ?- flip_list([1,2], [a,b], R). 65% ?- flip_list([2,1], [a,b], R). 66% ?- flip_list([3,2,1], [a,b,c], R). 67% 68flip_list([],_,[]). 69flip_list([I|Is],X,[J|Js]):- 70 nth1(I, X, J), 71 flip_list(Is, X, Js). 72 73 74% [2015/03/01] Argument order of expand_exp was changed by swap_args_of. 75 76:- use_module(pac('odict-attr')). 77:- use_module(pac('odict-expand')). 78 79:- meta_predicate(bekind()). 80:- meta_predicate(bekind(,)). 81:- meta_predicate(let(,,)). 82:- meta_predicate(let_exp(,,)). 83 84% compiles clauses in X. 85pac_compile_aux_clauses(X) :- compile_aux_clauses(X). 86 87 /************************* 88 * regex * 89 *************************/
94% ?- regex(w(".*"), "abc", R). 95% ?- regex(w("."), "abc", R). 96% ?- regex(wl(".*"), "abc", R). 97% ?- regex(wl(".*", A), "abc", R). 98% ?- regex((w(+char(lower), A), w(+char(digit), B)), `abc123`, Y). 99% ?- regex(w(+char(lower) + +char(digit), B), `abc123`, Y). 100% ?- regex(w(*(char(lower)) + *(char(digit))), 'abc123', Y). 101% ?- regex(w(+char(lower) + +char(digit)), "abc123", Y). 102% ?- regex(w(+char(lower) + +char(digit), B), "abc123", Y). 103% ?- regex(w(+char(lower) + +char(digit), B, C), "abc123", Y). 104% 105regex(X, Y, Z) :- once(expand_phrase(X, [], G, P, [])), 106 maplist(expand_dict_clause, P, Aux), 107 maplist_assert(Aux), 108 ( is_list(Y) -> phrase(G, Y, Z) 109 ; atomic(Y) -> 110 string_codes(Y, Y0), 111 phrase(G, Y0, Z0), 112 string_codes(Z, Z0) 113 ). 114 115% ?- expand_query(user, maplist(pred([a]), [A]), G), call(G). 116% ?- expand_query(pac, call(pred([a]), X), G), call(G). 117 118 /*************************************************** 119 * managing begin-block of KIND definitions * 120 ***************************************************/ 121 122save_back_quotes_flag :- current_prolog_flag(back_quotes, X), 123 nb_setval(back_quotes_flag, X), 124 set_prolog_flag(back_quotes, symbol_char). 125 126restore_back_quotes_flag :- nb_getval(back_quotes_flag, X), 127 set_prolog_flag(back_quotes, X).
131bekind(X) :- bekind(X, []).
135bekind(M:X, Opts) :-
136 nb_setval(pac_block, kind),
137 nb_setval(pac_defsort_name, M:X),
138 nb_setval(begin_options, Opts),
139 nb_setval(rules, []),
140 save_back_quotes_flag.145ekind :- 146 end_kind_basic, 147 nb_setval(pac_defsort_name, []), 148 nb_setval(rules, []), 149 nb_setval(pac_block, []), 150 restore_back_quotes_flag. 151% 152end_kind_basic :- nb_getval(begin_options, Opts), 153 ( memberchk(stop, Opts) 154 -> EndOpts = [X= quote(X)] 155 ; EndOpts = [] 156 ), 157 end_kind_basic(EndOpts). 158 159% 160end_kind_basic(EndOpts) :- 161 nb_current(pac_defsort_name, F), !, 162 nb_getval(rules, Rs), 163 once(kind_term(F, F1)), 164 append(EndOpts, Rs, Ts), 165 reverse(Ts, R0s), 166 nb_getval(begin_options, Opts), 167 ( memberchk(nonvar, Opts) 168 -> R1s = [( A = [] :- var(A), !, fail)|R0s] 169 ; R1s = R0s 170 ), 171 maplist(expand_kind_rule(F1, Opts), R1s, R2s), 172% maplist(writeln, R2s), 173 ignore(pac_compile_aux_clauses(R2s)). 174 175 176% 177make_clause(sgn(F, N), (A = '`'(A)) :- true) :- 178 functor(A, F, N). 179make_clause(F/N, C) :- 180 make_clause(sgn(F, N), C). 181make_clause(A, (X = '`'(X)) :- B) :- 182 complete_args(A, [X], B).
188 :- meta_predicate betrs(). 189 :- meta_predicate betrs(,). 190 191betrs(X) :- betrs(X, []). 192% 193betrs(X, Opts) :- 194 nb_setval(pac_block, trs), 195 nb_setval(pac_defsort_name, X), 196 nb_setval(begin_options, Opts), 197 nb_setval(rules, []), 198 save_back_quotes_flag.
204etrs :- 205 end_trs_basic, 206 nb_setval(pac_defsort_name, []), 207 nb_setval(rules, []), 208 nb_setval(pac_block, []), 209 restore_back_quotes_flag. 210 211% 212end_trs_basic :- 213 nb_current(pac_defsort_name, F), !, 214 nb_getval(rules, Rs), 215 reverse(Rs, R0s), 216 pac_etc:etc_trs(F, R0s, [], _, R1s, []), 217 ignore(pac_compile_aux_clauses(R1s)). 218% 219end_trs_basic(_).
223befun :- nb_setval(pac_defsort_name, fun), 224 nb_setval(pac_block, fun), 225 nb_setval(begin_options, []), 226 nb_setval(rules, []), 227 save_back_quotes_flag. 228 229% Toy version for arithmetic-like functional programming. 230% :- befun. 231% A1 = B1. 232% .... 233% An = Bn. 234% :- efun. 235 236efun :- nb_current(pac_defsort_name, fun), 237 nb_getval(rules, Rs), 238 reverse(Rs, R0s), 239 maplist(expand_fun, R0s, R1s), 240 ignore(pac_compile_aux_clauses(R1s)), 241 nb_setval(pac_defsort_name, []), 242 nb_setval(pac_block, []), 243 nb_setval(rules, []), 244 restore_back_quotes_flag. 245 246% ?- expand_fun(f(a,1)= g(a,a), Code). 247%@ Code = (f(a, 1, _A):-(a(_B), a(_C)), g(_B, _C, _A)). 248% ?- expand_fun(xadd(X+Y) = plus(xadd(X), xadd(Y)), R). 249%@ R = (xadd(X+Y, _A):-(xadd(X, _B), xadd(Y, _C)), plus(_B, _C, _A)). 250 251expand_fun(( H = B ), ( H0 :- G )):- 252 complete_args(H, [V], H0), 253 once(expand_fun(B, G, V)). 254% 255expand_fun({G}, (call(G) -> V = 1; V = 0), V). 256expand_fun(if(E, E1, E2), 257 (F, (V == 1 -> F1, W = V1; F2, W = V2)), 258 W) :- 259 expand_fun(E, F, V), 260 expand_fun(E1, F1, V1), 261 expand_fun(E2, F2, V2). 262expand_fun(is(X), V is X, V). 263expand_fun(B, G, V) :- once(args_inside_out(B, B0)), 264 once(expand_exp(B0, =, V, [], G, P, [])), 265 ( P \== [] -> throw(error(expand_fun(B))); true ).
273% ?- args_inside_out(1, X). 274% ?- args_inside_out(A, X). 275% ?- args_inside_out([1,2], X). 276% ?- args_inside_out(quote(a), X). 277% ?- args_inside_out(user:f(a, b), X). 278% ?- args_inside_out(user:f(1, b), X). 279 280% ?- args_inside_out(append([a, b], [c, d]), Exp), eval(Exp, V, [run]). 281% ?- args_inside_out(append(append([a, a], [b, b]), append([c, c], [d, d])), Exp), eval(Exp, V, [run]). 282%@ Exp = @(@(:(append), @(@(:(append), [a, a]), [b, b])), @(@(:(append), [c, c]), [d, d])), 283%@ V = [a, a, b, b, c, c, d, d] . 284 285is_vnl(X):- var(X); number(X); X = []; X = [_|_]. 286 287% 288args_inside_out(B, B) :- is_vnl(B). 289args_inside_out(quote(B), quote(B)). 290args_inside_out(@@(A), @@(A)). 291args_inside_out('`'(A),'`'(A)). 292args_inside_out(::(S, B), ::(S, B)). 293args_inside_out(@(A, B), @(A, B)). 294args_inside_out(B, G) :- 295 ( B = M:B0 -> F0 = M:F 296 ; B0 = B, 297 F0 = (:F) 298 ), 299 B0 =.. [F|As], 300 maplist(args_inside_out, As, Cs), 301 args_inside_out(F0, Cs, G). 302% 303args_inside_out(F, [], F). 304args_inside_out(F, [A|B], G) :- args_inside_out(F@A, B, G). 305 306 /********************************************** 307 * expand conditional equations (KIND) * 308 **********************************************/ 309 310% ?- kind_term(m:f//2, T). 311% ?- kind_term(m:f, T). 312% ?- kind_term(f//2, T). 313kind_term(M:(F//N), M:FN) :- !, functor(FN, F, N). 314kind_term(F//N, FN) :- !, functor(FN, F, N). 315kind_term(X, X). 316 317% ?- pass_kind_args(m:f(A), with(B, b), R). 318% ?- pass_kind_args(f(A), with(B, b), R). 319% ?- pass_kind_args(m:f(A), with([B], b), R). 320% ?- pass_kind_args(f(a,b,c), with([A, B], f(A, B)), R). 321% ?- pass_kind_args(f(a,b,c), with([A, B, C], [C, A, B]), R). 322 323pass_kind_args(_:X, Y, Z) :-!, pass_kind_args(X, Y, Z). 324pass_kind_args(X, Y, Z) :- X =..[_|Args], 325 unify_kind_args(Args, Y, Z). 326% 327unify_kind_args(_, R, R) :- var(R), !. 328unify_kind_args(Args, with(Y, Z), Z):-!, 329 ( is_list(Y) -> Parameters = Y % is_list must be used here. 330 ; Parameters = [Y] 331 ), 332 append(Parameters, _, Args). % passing args from left. 333unify_kind_args(_, R, R). 334 335% ?- expand_kind_rule(s(U), [], (A*A)= with(M, A+M), Y). 336% ?- expand_kind_rule(m:s(A), [], a = b, Y). 337% ?- expand_kind_rule(s(A), [], a = b, Y). 338% ?- expand_kind_rule(s(A), [], a = b, Y). 339% ?- expand_kind_rule(s(A), [], (a = b):-true, Y). 340% ?- expand_kind_rule(s(A), [], (a = b):-c, Y). 341% ?- expand_kind_rule(set(A), [], user, (1, 2) = 3, Y). 342% ?- expand_kind_rule(set(A), [], user, &(1, 2) = 3+4, Y). 343% ?- expand_kind_rule(tm:set,[flip([2,1])],(_13664=[]:-tm:var(_13664),!), Y). 344 345% ?- compile_kind_rule(tm:set,[flip([2,1])],(_13664=[]:-tm:var(_13664),!), Y, P, []). 346 347expand_kind_rule(S, _, sgn(Sgn, A, F), Y) :-!, 348 sgn_to_kind(Sgn, A, F, L = R), 349 expand_kind_rule(S, L, R, true, Y). 350expand_kind_rule(S, Options, X, Y) :- 351 ( X = (Head :- Body) -> true 352 ; Head = X, 353 Body = true 354 ), 355 ( Head = (L = R) 356 -> expand_kind_rule(S, L, R, Body, Y0), 357 ( S= _:S0 -> true 358 ; S0 = S 359 ), 360 functor(S0, F, _), 361 ( memberchk(flip(Flip), Options) 362 -> flip_clause(F, Flip, Y0, Y) 363 ; Y = Y0 364 ) 365 ; expand_only_goal(X, [], Y) 366 ).
True if a given kind (a named group of conditional equations) rule
(L = R :- G)
is converted to an equivelnt clause C.
Simplest usage:
379% ?- expand_kind_rule(word_am, X + Y, :am_concat@X@Y, true, H :- G). 380% ?- expand_kind_rule(word_am, X + Y, xargs([A, B, C] :- am_concat(A, B, C))@X@Y, true, H:-G). 381% ?- expand_kind_rule(w, a, :(xargs([A, B, C] :- f@X@Y)), true, H:-G). 382% ?- expand_kind_rule(w, a, (:xargs([A,V] :- f(A,V)))@X, true, H:-G). 383% ?- expand_kind_rule(w, a, (xargs([A,V] :- f(A,V)))@X, true, H:-G). 384% ?- expand_kind_rule(w, a, b, true, H :- G). 385% ?- expand_kind_rule(w, a, b@c, true, H :- G). 386% ?- expand_kind_rule(w, a, b@c, true, H :- G). 387% ?- expand_kind_rule(w, a, b, true, H :- G). 388% ?- expand_kind_rule(cond(A), X, with(S, S::X), true, R). 389% ?- expand_kind_rule(cond(A), X;Y, (;) @X @ '`'(Y), true, R). 390% 391expand_kind_rule(F, _, _, _, _) :- var(F), throw('variable kind 3'). 392expand_kind_rule(F, L, R, B, Cl):- nonvar(L), L= with(As, L0), !, 393 expand_kind_rule(F, L0, with(As, R), B, Cl). 394expand_kind_rule(F, L, R, Body, H:-G):- 395 ( Body = true -> B = (!) 396 ; B = Body 397 ), 398 once(expand_goal(B, [], B0, P, P0)), 399 slim_exp_goal(B0, B1), 400 copy_term(F, F0), 401 once(complete_args(F0, [L, V], H)), 402 once(pass_kind_args(F0, R, R0)), 403 once(expand_exp(R0, F0, V, [], R1, P0, [])), 404 slim_exp_goal((B1, R1), G), 405 ignore(pac_compile_aux_clauses(P)). 406 407% ?- expand_exp(1, f(A), V, [], E, P, []). 408% ?- expand_exp(M, f(A), V, [], E, P, []). 409% ?- expand_kind_rule(a(M), b, with(A, c(A)), d, Cl). 410% ?- nopac(pac:expand_kind_rule(a, b, @(pred([A,B]),b), d, Cl)). 411 412 /**************************************** 413 * compile a conditional equation * 414 ****************************************/ 415 416% ?- compile_kind_rule(s, [], a = b, Y, P, Q). 417% ?- compile_kind_rule(s, [], a = b:-true, Y, P, Q). 418% ?- compile_kind_rule(s, [flip([2,1])], a = b:-true, Y, P, Q). 419 420compile_kind_rule(S, _, sgn(Sgn, A, F), Y, P, Q) :-!, 421 sgn_to_kind(Sgn, A, F, L = R), 422 compile_kind_rule(S, L, R, true, Y, P, Q). 423compile_kind_rule(S, Options, X, Y, P, Q) :- 424 ( X = (Head :- Body) -> true 425 ; Head = X, 426 Body = true 427 ), 428 ( Head = (L = R) 429 -> once(compile_kind_rule(S, L, R, Body, Y0, P, Q)), 430 functor(S, F, _), 431 ( memberchk(flip(Flip), Options) 432 -> flip_clause(F, Flip, Y0, Y) 433 ; Y = Y0 434 ) 435 ; expand_only_goal(X, [], Y) 436 ). 437 438% ?- compile_kind_rule(s, a, b, true, Y, P, []). 439compile_kind_rule(F, _, _, _, _, _, _) :- var(F), !, throw('variable kind 3'). 440compile_kind_rule(F, L, R, B, Cl, P, Q) :- nonvar(L), L=with(As, L0), !, 441 compile_kind_rule(F, L0, with(As, R), B, Cl, P, Q). 442compile_kind_rule(F, L, R, Body, (H :- G), P, Q):- 443 ( Body = true -> B = (!) 444 ; B = Body 445 ), 446 once(expand_goal(B, [], B0, P, P0)), 447 slim_exp_goal(B0, B1), 448 copy_term(F, F0), 449 once(complete_args(F0, [L, V], H)), 450 once(pass_kind_args(F0, R, R0)), 451 once(expand_exp(R0, F0, V, [], R1, P0, Q)), 452 slim_exp_goal((B1, R1), G). 453 454% ?- sgn_to_kind([], 0, [], E). 455% ?- sgn_to_kind(f, 3, g, E). 456% 457sgn_to_kind(S, 0, F, S = quote(F)):-!. 458sgn_to_kind(S, N, F, L = R):- length(As, N), 459 L =.. [S|As], 460 mk_right(:(F), As, R). 461% 462mk_right(H, [], H). 463mk_right(R, [X|Xs], R0):- mk_right(R@X, Xs, R0). 464 465 /******************************************* 466 * expansion of pac macros (top) * 467 *******************************************/
471% X is expanded to Y. 472% 473expand_pac(X, _) :- none_pac_term(X), !, fail. 474expand_pac(X, []) :- nb_current(pac_block, Block), 475 Block \== [], 476 !, 477 ( Block == kind 478 -> nb_current(pac_defsort_name, F), 479 strip_module(F, M, _), 480 once(expand_only_goal(X, M, X0)) 481 ; X0 = X 482 ), 483 nb_getval(rules, Rs), 484 nb_setval(rules, [X0|Rs]). 485expand_pac(X, Y) :- once(expand_clause(X, Y)). 486 487% 488none_pac_term(X) :- var(X). 489none_pac_term(begin_of_file). 490none_pac_term(:-(_)). 491none_pac_term(end_of_file). 492 493% 494expand_only_goal(H :- B, M, H:-B0):- !, 495 once(expand_goal(B, M, B0, P, [])), 496 ignore(pac_compile_aux_clauses(P)). 497expand_only_goal(H, _, H).
504% ?- expand_query(user, maplist(pred([a]), [X,Y]), G), call(G). 505% ?- expand_query(user, maplist(pred([{a:1}]), [X,Y]), G), call(G). 506% ?- expand_query(user, X={a:1}, G), call(G). 507% ?- expand_query(pac, maplist(pred([a]), [X,Y]), G), call(G). 508% ?- expand_query(pac, dict(phrase(append@[a,b], [c,d], [])), G). 509 510% Open dict aware query expansion. 511% ?- expand_query(user, dict(phrase(append@[a,b], [c,d], X)), R). 512 513% ?- phrase(append([a,b]), [c,d], X). 514% ?-let(F, fun([X] >> (append@[a,b]@X))), phrase(F, [c,d], Y). 515% ?-let(F, fun([X] >> (:append@[a,b]@X))), phrase(F, [c,d], Y). 516% ?-let(F, fun([X] >> (append@[a,b]@X))), phrase(F, [c,d], Y). 517% ?-let(F, fun([X] >> (append@[a,b]@X))), eval(F@[c,d], U). 518% ?-let(F, fun([X] >> (append@[a,b]@X))), eval(:(F@[c,d]), U). 519% ?-let(F, fun([X] >> (append@[a,b]@X))), eval((:F)@[c,d], U). 520% ?-eval(:(:(fun([X] >> (append@[a,b]@X)))@[c,d]), U). 521 522expand_query(_, [], []). 523expand_query(M, M:[X|Y], M:[X|Y]). 524expand_query(M, X, Y) :- 525 once(expand_goal(X, M, Y, Z, [])), 526 assert_in_user(Z). 527 528 /************************ 529 * displaying pac * 530 ************************/
show(pred([X, X])).
?- show(phrase(w("."))).
?- show(phrase(wl("[a-zA-Z]+", A, []))).
?- show(phrase(wl("[^a-zA-Z]+", A, []))).
?- show(phrase(wl("[^b-wB-W]+", A, []))).540% ?- time(pac:(call(pred([1]), A))). 541% ?- time(call(pred([1]), A)). 542% ?- show(nopac(call(pred([X]), 1))). 543 544show(X) :- let(F, X, Y), show(F, Y). 545 546show(F, Y) :- 547 predsort(compare_clause, Y, Y0), 548 maplist(copy_term, Y0, Y1), 549 numbervars(F, 0, _, [singletons(true)]), 550 write(F), 551 once(show_where_clause(Y1)). 552% 553show_where_clause([]). 554show_where_clause(Y) :- write(', where\n'), 555 maplist(numbervars_write(0), Y). 556 557% ?- show_clause(a:-b). 558% ?- show_clause(a(X):-maplist(pred([1]), X)). 559show_clause(X):- pac_listing:expand_clause_slim(X, [H|Y]), 560 numbervars_write(0, H), 561 show_where_clause(Y). 562 563% ?- numbervars(f(X,Y), 0, _), term_string(f(X,Y), R, [numbervars(true)]).
569% ?- show_exp(a). 570% ?- show_exp(pred([1])). 571% ?- show_exp(X\X). 572% ?- show(X\X). 573% ?- show_exp(:(X\X)@ :(hello)). 574% ?- eval(:(X\X) @ :(hello), V). 575% ?- eval(:(X\X) @ (hello), V). 576% ?- eval((X\X) @ quote(hello), V). 577% ?- eval((X\X) @ hello, V). 578show_exp(E) :- 579 expand_exp(E, =, V, [], G, P, []), 580 maplist(copy_term, P, P0), 581 numbervars((V,G), 0, _, [singletons(true)]), 582 show_val_with_goal(V, G), 583 show_where_clause(P0). 584% 585show_val_with_goal(V,true) :- write(V). 586show_val_with_goal(V, G) :- write(V), 587 write(" with "), 588 write(G). 589 590% ?- show_phrase(w(".***********")). 591% ?- show_phrase(wl("[^b-wB-W]+", A, [])). 592% ?- show_phrase(wl("[^\s\n\t\r]++++++++", A, [])). 593% ?- show_phrase(wl("[^\s\n\t\r]++++++++++++++++++", A, [])). 594% ?- show_phrase(wl("[^\s\n\t\r]++++++++++++++++++++++++", A, [])). 595% ?- show_phrase(wl("[^\s\n\t\r]+++++++++++++++++++++++++++++++++++", A, [])). 596% ?- show_phrase(wl("[^\s\n\t\r]++++++++++++++", A, [])). 597% ?- show_phrase(wl("[^\s\n\t\r]++++++++++++", A, [])). 598% ?- show_am("[^\s\n\t\r]++++++++"). 599% ?- show_am("[^\s\n\t\r]******************************+"). 600% ?- show_phrase(wl("[^\s\n\t\r]", A, [])). 601% ?- show_phrase(wl("[^\s\n\t\r]", A, [])). 602% ?- show_phrase(wl("[\s\n\t\r]+", A, [])). 603% ?- show_phrase(wl("[\s\n\t\r]+++", A, [])). 604% ?- show_phrase(wl("[\s\n\t\r]+++++++++", A, [])). 605% ?- show_phrase(wl("[a-zA-Z]++++++++++************", A, [])). 606% ?- show_phrase(wl("[^a-zA-Z]++++++++++************++", A, [])). 607% ?- show_phrase(wl("[^a-zA-Z]++++++++++************+++++++", A, [])). 608% ?- show_phrase(wl("[^a-zA-Z]" ^ (>=(5)), A, [])). 609% ?- show_phrase(wl("[^a-zA-Z]" ^ (3-5), A, [])). 610% ?- show_am("[^a-zA-Z]" ^ (3-5)). 611% ?- show_am("a" ^ (3-5)). 612% ?- show_am("ab" ^ (3-5)).
618show_phrase(P) :- show(phrase(P)). 619 620% ?- phrase_to_pred(apply(f), user, X, P, []). 621% ?- phrase_to_pred(w(*(.)), user, X, P, []). 622% ?- phrase_to_pred((a,b), user, X, P, []). 623phrase_to_pred(X, M, [U,V] :- G, P, Q):- 624 once(expand_phrase(X, M, G0, P, P0)), 625 dcg_translate_rule('DUMMY' --> G0, 'DUMMY'(U, V) :- G1), 626 once(expand_goal(G1, M, G, P0, Q)). 627 628% ?- expand_pac_pipe((a,b), [], user, R, P, []). 629% ?- expand_pac_pipe((a(A),b(B)), [A,B], user, R, P, []). 630expand_pac_pipe(Pipe, Globals, M, Ref, P, Q) :- 631 phrase_to_pred(Pipe, M, Pac, P, P0), 632 expand_core(pred(Globals, Pac), M, Ref, P0, Q). 633 634% ?- goal_to_pred(call([V,V], [X,_]), [], U, P, []). 635% ?- goal_to_pred(call(pred([V,V]), [X,_]), [], U, P, []). 636goal_to_pred(G, M, FVs :- Body, P, Q):- once(expand_arg(G, M, Body, P, Q)), 637 term_variables(Body, FVs). 638 639numbervars_write(N, C) :- numbervars(C, N, _, [singletons(true)]), writeln(C). 640% 641numbervars_writeq(N, C) :- numbervars(C, N, _, [singletons(true)]), writeq(C), nl. 642% 643compare_clause(C, X, Y) :- strip_module(X, _, H0:- _), 644 strip_module(Y, _, K0 :- _), 645 strip_module(H0, _, H), 646 strip_module(K0, _, K), 647 functor(H, FH, _), 648 functor(K, FK, _), 649 compare(C0, FH, FK), 650 change_order(C0, C). 651 652% 653change_order(<, >). 654change_order(>, <). 655change_order(=, <). 656 657 /******************* 658 * using pac * 659 *******************/
665:- meta_predicate user:let(, ). 666 667userlet(F, X) :- let(F, X, Y), 668 maplist(expand_dict_clause, Y, Aux), 669 maplist_assert(Aux). 670usershow(X):- show(X). 671usershow_phrase(X):- show_phrase(X). 672usershow_exp(X):- show_exp(X).
680% 681let(Y, M:X, Z) :- once(expand_arg(X, M, Y, Z, [])). 682 683% ?- pac:expand_core(pred(F, ([X] :- f(X)) & ([A]:- g(A))), [], G, P, []). 684%! let_exp(-X:var, +E:exp) is det 685% 686% True if X is unified with expanded exp E. 687 688let_exp(X, E) :- let_exp(E, X, Y), 689 maplist(expand_dict_clause, Y, Aux), 690 maplist_assert(Aux).
697let_exp(E, M:X, Y) :- expand_exp(E, =, M, X, Y, []). 698 699 /************************************** 700 * Recognize block structures * 701 * for possible use in the future * 702 **************************************/ 703% 704begin_end(kind, bekind(_), ekind). 705begin_end(kind, bekind(_, _), ekind). 706begin_end(trs, betrs(_), etrs). 707begin_end(fun, befun(_), efun). 708 709% ?- structured_pac([ :- betrs(a),b,c,:-etrs], Y). 710% ?- structured_pac([ :- bekind(a),b,c,:-ekind], Y). 711structured_pac(X, Y) :- structured_pac(Y, X, []). 712% 713structured_pac([], [], []). 714structured_pac([A|As], X, Y):- 715 structured_pac_one(A, X, X0), 716 structured_pac(As, X0, Y). 717% 718structured_pac_one(block(Kind, B, A), [ :- B|X], Y):- 719 begin_end(Kind, B, Endname), !, 720 structured_pac_block(Endname, A, X, Y). 721structured_pac_one(A, [A|X], X). 722 723% 724structured_pac_block(End, [], [ :- End|X], X):-!. 725structured_pac_block(End, [X|R],[X|Y], Z) :- 726 structured_pac_block(End, R, Y, Z). 727 728 /************************************************** 729 * Eliminte pacs from a clause recursively. * 730 **************************************************/
735% ?- expand_clause(a :- call(pred([X]:-write(X)), hello), L). 736%@ L = (user:a:-pac:'pac#51'(hello)). 737 738expand_clause(X, Y) :- prolog_load_context(module, M), 739 expand_clause(X, M, [Y|R], []), 740 !, 741 ignore(pac_compile_aux_clauses(R)). 742% 743attach_prefix_to_clause(M, A :- B, (M:A) :- (M:B)):-!. 744attach_prefix_to_clause(M, A, M:A). 745% 746expand_sgn(A, S/N-F, [T, R]:-(EvalArgs, apply(F0, YsR))) :- !, 747 expand_arg_assert(F, F0), 748 length(Xs, N), 749 T =..[S|Xs], 750 expand_sgn_calls(Xs, A, Ys, EvalArgs), 751 append(Ys, [R], YsR). 752expand_sgn(A, S-F, R) :- expand_sgn(A, S/0-F, R). 753 754% 755expand_sgn_calls([], _, [], true). 756expand_sgn_calls([X|Xs], A, [Y|Ys], (call(A, X, Y), Rest)) :- 757 expand_sgn_calls(Xs, A, Ys, Rest).
763% ?- expand_clause(a --> (X\X), R). 764% ?- expand_clause(a --> (X\X), R). 765% ?- expand_clause((a --> b,c), R). 766% ?- expand_clause(a --> w(".*"), R). 767% ?- expand_clause((a --> w(".*"), (X\[X,X])), R). 768% ?- expand_clause(a --> [a,b], R). 769% ?- expand_clause(a --> w(*char(kanji)), R). 770% ?- expand_clause(a({b:1}) --> [], R). 771% ?- expand_clause(a({b:1}) --> c({d:2}), R). 772 773% a tiny helper for updating module prefix 774update_prefix(M, N, N0) :- 775 ( M == [] 776 -> N0 = N 777 ; N0 = M 778 ). 779% 780sgn_subst(A+B, A0+B0, F) :- sgn_subst(A,A0,F), sgn_subst(B, B0,F). 781sgn_subst(A*B, A0*B0, F) :- sgn_subst(A,A0,F), sgn_subst(B, B0,F). 782sgn_subst(\(A,B), \(A0,B0), F) :- sgn_subst(A, A0, F), sgn_subst(B, B0, F). 783sgn_subst(A, A, _) :- is_list(A), !. 784sgn_subst(sgn(A), A, _) :- !. 785sgn_subst(A, A0, F) :- call(F, A, A0). 786 787% ?- zip_algebra(([a-1]+[b-2])\ [b-2], R). 788zip_algebra(A+B, C) :- zip_algebra(A, A0), 789 zip_algebra(B, B0), 790 append(A0, B0, C). 791zip_algebra(\(A, B), C) :- zip_algebra(A, A0), 792 zip_algebra(B, B0), 793 subtract(A0, B0, C). 794zip_algebra(A * B, C) :- zip_algebra(A, A0), 795 zip_algebra(B, B0), 796 intersection(A0, B0, C). 797zip_algebra(X, X). 798 799% ?- phrase_ref(A, (a,b(A),c), P). 800% ?- phrase_ref_show(A, (a,b(A),c), P). 801% ?- phrase_list_ref(A, [a,b(A),c], P). 802% ?- phrase_list_ref_show(A, [a,b(A),c], P). 803 804% Expand an phrase and return the ref handle 805 806% ?- trace, pac:phrase_ref([A,B], (append(A), append(B)), G). 807phrase_ref(X, Y, X0) :- translate_phrase_to_clause(X, Y, X0, Cs), 808 maplist(expand_dict_clause, Cs, Aux), 809 maplist_assert(Aux). 810 811% ?- phrase_ref_show([A,B], (append(A), append(B)), G). 812phrase_ref_show(X, Y, X0) :- translate_phrase_to_clause(X, Y, X0, Cs), 813 show(X0, Cs).
820% ?- translate_phrase_to_clause([A,B], (append(A), append(B)), G, Cs), 821% maplist(assert, Cs), A=[a,b], B=[c,d], call(G, [1,2], V). 822% ?- translate_phrase_to_clause([A,B], (append(A), append(B)), G, Cs). 823 824translate_phrase_to_clause(Globals, Phrase, PhraseRef, Cs) :- 825 once(expand_phrase(Phrase, [], Phrase0, Aux, [])), 826 new_pac_name(Pname), 827 canonical_global(Globals, Canonical_Globals), 828 make_ref(Canonical_Globals, Pname, PhraseRef), 829 dcg_translate_rule(PhraseRef --> Phrase0, C), 830 expand_clause(C, C0s), 831 append([C0s], Aux, Cs). 832 833% 834make_ref([], R, R) :- !. 835make_ref(X, R, R0) :- complete_args(R, X, R0). 836 837% Expand an phrase of the list form and return the ref handle 838phrase_list_ref(X, Y, X0) :- period_to_comma(Y, Y0), 839 phrase_ref(X, Y0, X0). 840% 841phrase_list_ref_show(X, Y, X0) :- period_to_comma(Y, Y0), 842 phrase_ref_show(X, Y0, X0). 843 844% ?- module(pac). 845% ?- period_to_comma([a,b,c], R). 846period_to_comma([X], X). 847period_to_comma([X, Y|Z], (X,R)) :- period_to_comma([Y|Z], R). 848 849% for not expansion as builtin dicts. (To be revised. ) 850is_role(role(X, Y), X, Y). 851is_role(P, X, Y) :- P=..[(.), X, Y].
Simples usage:
?- pac:expand_goal((call(pred([a]), X), write(X)), user, G, L, []).
G = (user:'pred#2'(X), user:write(X)),
L = [ (user:'pred#2'(a) :- true)]
863% ?- expand_goal((call([X]\[X,X],1, V), Y=V), user, G, L, []). 864 865expand_goal(X, _, X, P, P) :- var(X),!. 866expand_goal(M:X, N, Y, P, Q) :-!, update_prefix(M, N, N0), 867 expand_goal(X, N0, Y, P, Q). 868expand_goal((X,Y), M, (X0, Y0), P, Q) :-!, 869 expand_goal(X, M, X0, P, P0), 870 expand_goal(Y, M, Y0, P0, Q). 871expand_goal((X;Y), M, (X0;Y0), P, Q) :-!, 872 expand_goal(X, M, X0, P, P0), 873 expand_goal(Y, M, Y0, P0, Q). 874expand_goal((X->Y), M, (X0->Y0), P, Q) :-!, 875 expand_goal(X, M, X0, P, P0), 876 expand_goal(Y, M, Y0, P0, Q). 877expand_goal(if(A, B, C), M, Y, P, Q) :-!, once(expand_goal_if_cond(A, A0)), 878 expand_goal((A0->B;C), M, Y, P, Q). 879expand_goal(if(A, B), M, Y, P, Q) :-!, expand_goal(if(A,B,true), M, Y, P, Q). 880expand_goal(??(A), _, true, P, P) :-!, once(A). 881expand_goal(\+(X), M, \+(Y), P, Q) :-!, expand_goal(X, M, Y, P, Q). 882expand_goal(nopac(X), _M, X, P, P). 883expand_goal(X@Y, M, G, P, Q) :-!, expand_atmark_goal(X@Y, M, G, P, Q). 884expand_goal(X, M, MX, P, P) :- is_list(X), !, 885 attach_prefix(M, X, MX). 886expand_goal(X, M, G, P, Q) :- once(expand_basic(X, M, G, P, Q)). 887 % For not loading files. 888 889% 890expand_atmark_goal(X@Y, Mod, G, P, Q):- 891 expand_exp(X@Y, [], =, G_atomic, Mod, G_aux, P, Q), 892 slim_goal((G_aux, G_atomic), G). 893 894% For var X, if(X, A, B) => (X==true -> A; B) 895% otherwise, if(X, A, B) => (X -> A; B). 896% tiny optimization to prevent from (call(<module-ref>:X) -> A; B). 897expand_goal_if_cond(X, X == true) :- var(X), !. 898expand_goal_if_cond(X, X). 899 900% 901expand_phrase_list([], _, [], P, P):-!. 902expand_phrase_list([A|Xs], M, [A|Ys], P, Q) :- var(A),!, 903 expand_phrase_list(Xs, M, Ys, P, Q). 904expand_phrase_list([phrase(A, B)|Xs], M, [Y|Ys], P, Q) :-!, 905 once(expand_core(phrase(A, B), M, Y, P, R)), 906 expand_phrase_list(Xs, M, Ys, R, Q). 907expand_phrase_list([phrase(A)|Xs], M, [Y|Ys], P, Q) :-!, 908 once(expand_core(phrase([], A), M, Y, P, R)), 909 expand_phrase_list(Xs, M, Ys, R, Q). 910expand_phrase_list([A|Xs], M, [X0|Ys], P, Q) :- 911 once(expand_phrase(A, M, X0, P, R)), 912 expand_phrase_list(Xs, M, Ys, R, Q).
Simplest usage:
?- expand_core(pred([X, Y] :- X\==Y), user, G, P, []).
G = user:'pred#1',
P = [ (user:'pred#1'(X, Y) :- user: (X\==Y))]
924% ?- expand_core(X\(X\X), user, R, P, []). 925% ?- expand_core(X\ (X\X), user, R, P, []). 926% ?- expand_core(X\ :(X\X), user, R, P, []). 927% ?- expand_core(X\X, user, R, P, []). 928% ?- let(H, rec(F, [], ([[],X,X] :- true)&([[X|Y],Z,[X|U]]:- call(F, Y, Z, U)))), eval(:H@[1,2]@[3,4], R). 929 930% ?- call(pipe((=, =, =)), hello, X). 931% ?- maplist(pipe((=, =, =)), [a,b,c], X). 932% ?- maplist(pipe((pipe((=, =)), =)), [hello], X). 933% ?- maplist(pipe([A, B], (append([A]), append([B]))), [[1],[2],[3]], R), A = hello, B=world. 934 935% [2015/04/02] added mutual recursion with globals. 936 937% ?- maplist(new_pac_name, [A,B]). 938% ?- let(H, rec(F, [], ([[],X,X] :- true)&([[X|Y],Z,[X|U]]:- call(F, Y, Z, U)))), eval(:H@[1,2]@[3,4], R). 939 940% mrec test. 941% ?- let(H, mrec([F = [1]])), call(H, X). 942% ?- let(P, mrec([A], [ F = ([X]:- call(A, X))])), 943% let(A, pred([hello])), call(P, Ans). 944% ?- let(P, mrec(A, [ F = ([X]:- call(A, X))])), A = (=(3)), call(P, R). 945% ?- let(M, mrec([F = ([X]:- X=1)])), call(M, Ans). 946% ?- let(M, mrec([G], [F = ([X]:- call(G, X))])), 947% let(G, pred([3])), call(M, Ans). 948% ?- let(M, mrec([F = ([X]:- X=1)])), call(M, A). 949% ?- let(M, mrec([F = ([1] & [2])])), call(M, A). 950% ?- let(M, mrec([F = ([1] & [2] & ([X]:- X =3))])), call(M, A). 951% ?- let(M, mrec([F = ([1] & [2] & ([A]:- call(pred([I, I]), 3, A)))])), call(M, R). 952 953expand_core(pred(Global, Cs), M, G, P, Q) :-!, 954 ( var(G) -> 955 once(new_pac_name(Global, FC)), 956 attach_prefix(M, FC, G) 957 ; true 958 ), 959 once(expand_pac_clauses(Cs, M, G, P, Q)). 960expand_core(pred(Cs), M, G, P, Q) :-!, 961 expand_core(pred([], Cs), M, G, P, Q). 962expand_core(global(C, Cs), M, G, P, Q) :-!, 963 expand_core(pred(C, Cs), M, G, P, Q). 964expand_core(mrec(C, Defs), M, A, P, Q) :- Defs=[A = _|_], 965 term_variables(C, Vs), 966 maplist(mrec_pred_new_name(Vs), Defs), 967 expand_mrec_system(Defs, M, P, Q). 968expand_core(mrec(Defs), M, G, P, Q) :-!, 969 expand_core(mrec([], Defs), M, G, P, Q). 970expand_core(rec(F, C, Cs), M, G, P, Q) :-!, 971 expand_core(mrec(C, [ F = Cs ]), M, G, P, Q). 972expand_core(rec(F, Cs), M, G, P, Q) :-!, 973 expand_core(mrec([], [ F = Cs ]), M, G, P, Q). 974expand_core(flip(Is, A), M, G, P, Q) :-!, 975 expand_flip(Is, A, M, G, P, Q). 976expand_core(flip(A), M, G, P, Q) :-!, 977 expand_core(flip([2,1],A), M, G, P, Q). 978expand_core(E, M, G, P, Q) :- normal_fun(E, =, E0), !, 979 expand_fun_to_pred(E0, M, G, P, Q). 980 981% ?- eval(flip(is)@(1+2)@V, G), call(G). 982% ?- eval(flip([2,1], is)@(1+2)@V, G), call(G). 983% ?- eval(:flip([2,1], is)@(1+2), V). 984% ?- eval(answer@(:flip([2,1], is)@(1+2)), V). 985% ?- expand_flip([2,1], is, user, G, P, []). 986% ?- eval(flip([2,1], append(A))@[a,b,c,d]@V, G), call(G), A=[a,b]. 987% ?- eval(flip([2,1], append([A,B]))@[A,B,c,d]@V, G), call(G), A=[a,b]. 988% ?- eval(flip([2,1], pred(D, [X,Y]:- append(D, X, Y)))@[A,B,c,d]@V, G), 989% call(G), D = [a,b]. 990 991userflip(Is, A, B):- expand_flip(Is, A, user, B, P, []), 992 maplist(assert, P). 993% 994userflip(A, B):- flip([2,1], A, B). 995 996expand_flip(Is, A, M, G, P, Q):- 997 expand_arg(A, M, A0, P, P0), 998 term_variables(A0, Vs), 999 length(Is, N), 1000 length(Xs, N), 1001 flip_list(Is, Xs, Ys), 1002 expand_core(pred(Vs, Xs:- apply(A0, Ys)), M, G, P0, Q). 1003% 1004expand_pac_rule_body(_, [], [], P, P):-!. 1005expand_pac_rule_body(M, [H :- B|Ns],[H:-B0|N0s], P, Q):- 1006 once(expand_goal(B, M, B0, P, P0)), 1007 expand_pac_rule_body(M, Ns, N0s, P0, Q). 1008% 1009recursive_pac_name([], F = _) :-!, new_pac_name(F). 1010recursive_pac_name(C, F = _) :- new_pac_name(F0), 1011 complete_args(F0, [C], F). 1012% 1013mrec_pred_new_name(Vs, X = _):- new_pac_name(P), 1014 ( Vs=[] -> X = P 1015 ; Vs=[V] -> X =.. [P, V] 1016 ; X =..[P, Vs] 1017 ). 1018% 1019expand_mrec_pred(Cs, M, A, P, Q) :-!, 1020 attach_prefix(M, A, G), 1021 expand_pac_clauses(Cs, M, G, P, Q). 1022 1023expand_mrec_system(G, [A = E|Es], M, P, Q):- 1024 expand_mrec_system([A = (G=>E)|Es], M, P, Q). 1025% 1026expand_mrec_system([], _, P, P). 1027expand_mrec_system([A = Pred|R], M, P, Q) :- 1028 expand_mrec_pred(Pred, M, A, P, P0), 1029 expand_mrec_system(R, M, P0, Q). 1030 1031% 1032expand_pred_to_ref(pred(Cs), M, PacRef, P, Q) :-!, 1033 expand_pac_clauses(Cs, M, PacRef, P, Q). 1034expand_pred_to_ref(Cs, M, PacRef, P, Q) :- 1035 expand_pac_clauses(Cs, M, PacRef, P, Q). 1036% 1037expand_pac_clauses(Cs, M, PacRef, P, Q) :- 1038 flat(&, Cs, Ds), 1039 maplist(canonical_pred, Ds, Ns), 1040 expand_pac_rule_body(M, Ns, Ns0, P, P0), 1041 maplist(slim_clause(PacRef), Ns0, Es), 1042 append(Es, Q, P0). 1043 1044funs_to_preds(A&B, S, M, A0&B0, P, Q) :-!, 1045 funs_to_preds(A, S, M, A0, P, P0), 1046 funs_to_preds(B, S, M, B0, P0, Q). 1047funs_to_preds(A, S, M, A0, P, Q) :- once(fun_to_pred(A, S, M, A0, P, Q)). 1048 1049% 1050fun_to_pred(A >> R, S, M, G, P, Q) :- \+ is_list(A),!, 1051 fun_to_pred([A] >> R, S, M, G, P, Q). 1052fun_to_pred(L >> R, S, M, L0 :- R0, P, Q):- append(L, [V], L0), 1053 once(expand_exp(R, [], S, V, M, R0, P, Q)). 1054 1055% 1056slim_clause(MFC, Xs :- B, H:-B0):- once(complete_args(MFC, Xs, H)), 1057 reduce:slim_goal(B, B0). 1058 1059% 1060canonical_pred(X, Y) :- 1061 ( is_list(X) -> Y = (X:-true) 1062 ; nonvar(X), X = (H:- _), is_list(H) -> Y = X 1063 ; throw('invalid pred clause'(X)) 1064 ). 1065% 1066gensym_pac_name(N) :- nb_current(pac_name_prefix, N), 1067 N \== [], 1068 !. 1069gensym_pac_name('pac#'). 1070% 1071new_pac_name(N) :- var(N), !, 1072 gensym_pac_name(G), 1073 gensym(G, N). 1074new_pac_name(_). 1075 1076% ?- new_pac_name(a+b, R). 1077% ?- new_pac_name(A, R). 1078% ?- new_pac_name(A*B, R). 1079new_pac_name(Global, PacRef) :- new_pac_name(Global, _, PacRef). 1080% 1081new_pac_name(_, _, PacRef) :- nonvar(PacRef), !. 1082new_pac_name(Global, Name, PacRef) :- term_variables(Global, Vs), 1083 canonical_global(Vs, Vs0), 1084 new_pac_name(Name), 1085 ( Vs0 = [] -> 1086 PacRef = Name 1087 ; Vs0 = [A] -> 1088 PacRef =.. [Name, A] 1089 ; PacRef =.. [Name, Vs0] 1090 ).
p(A) when A is the unique varaible in Gp([A1,...,An]) when A1, ..., An are all distinct
variables occurring in G.1100% ?- new_pacref(A+B, P, R). 1101% ?- new_pacref(A + A, P, R). 1102% ?- new_pacref(a+b, P, R). 1103new_pacref(G, PredName, Ref):- term_variables(G, Vs), 1104 new_pac_name(PredName), 1105 ( Vs = [] -> Ref = PredName 1106 ; Vs = [V] -> Ref =.. [PredName, V] 1107 ; Ref =.. [PredName, Vs] 1108 ). 1109 1110% 1111canonical_global(X, X):-is_list(X), !. 1112canonical_global(X, [X]). 1113 1114% expand_arglist/6. 1115expand_arglist([], _, [], true, P, P):-!. 1116expand_arglist([A|As], M, [B|Bs],(H,H0), P, Q) :-!, expandable_meta_arg(A), 1117 once(expand_meta_arg(A, M, B, H, P, P0)), 1118 expand_arglist(As, M, Bs, H0, P0, Q). 1119expand_arglist([A|As], M, [A|Bs], H, P, Q) :- 1120 expand_arglist(As, M, Bs, H, P, Q). 1121 1122% expand_arglist/5 1123expand_arglist([], _, [], P, P):-!. 1124expand_arglist([A|As], M, [B|Bs], P, Q) :- expandable_meta_arg(A),!, 1125 once(expand_arg(A, M, B, P, P0)), 1126 expand_arglist(As, M, Bs, P0, Q). 1127expand_arglist([A|As], M, [A|Bs], P, Q) :- 1128 expand_arglist(As, M, Bs, P, Q). 1129 1130% Variables and applications are not expandable. 1131expandable_meta_arg(A) :- nonvar(A), \+ number(A). 1132 1133% ?- call([X]\ (:X@ 1), =, V). 1134% ?- call([X]\ (X@ 1), =, V). 1135% ?- call(fun([X]-> (:X@ 1)), =, V). 1136% ?- call(fun([X]-> (X@ 1)), =, V). 1137 1138% ?- meta_call(f([1,?,?]), f([a,b,c]), A, B, Y, U, V). 1139meta_call(I, X, A, B, Y, SF, SFV) :- I =..[F,I0], 1140 X=..[_, X0], 1141 Y=..[F, Y0], 1142 once(collect_calls(I0, X0, Y0, A, B, SF, SFV)). 1143 1144% ?- pac:collect_calls([1, ?, ?], [a, b, c], A, B, C, D, E). 1145collect_calls(_, [], [], [], [], [], []):-!. 1146collect_calls([:|X], [A|Y], [B|Z], [A|U], [B|V], P, Q) :-!, 1147 collect_calls(X, Y, Z, U, V, P, Q). 1148collect_calls([^|X], [A|Y], [B|Z], [A|U], [B|V], P, Q) :-!, 1149 collect_calls(X, Y, Z, U, V, P, Q). 1150collect_calls([//|X], [A|Y], [B|Z], U, V, [A|P],[B|Q]) :-!, 1151 collect_calls(X, Y, Z, U, V, P, Q). 1152collect_calls([N|X], [A|Y], [B|Z], [A|U], [B|V], P, Q) :- integer(N),!, 1153 collect_calls(X, Y, Z, U, V, P, Q). 1154collect_calls([_|X], [A|Y], [A|Z], U, V, P, Q) :- 1155 collect_calls(X, Y, Z, U, V, P, Q). 1156 1157 /*********************** 1158 * expand phrase * 1159 ***********************/
Simplest usage:
?- expand_phrase((pred([X, f(X)]), pred(U, g(U))), user, G, L, []).
G = (user:'pred#3', user:'pred#4'(U)),
L = [ (user:'pred#3'(X, f(X)) :- true), (user:'pred#4'(U, g(U)):-true)] .
1171% ?- expand_phrase((call([X]\[X,X],1, V), Y=V), user, G, L, []). 1172% ?- expand_phrase(w(".*"), user, G, L, []). 1173% ?- expand_phrase(wl(".*"), user, G, L, []). 1174% ?- expand_phrase(maplist(phrase(wl(".*"))), user, G, L, []). 1175% ?- phrase(append@[a], [b,c], R). 1176% ?- phrase(pred([X,Y] :- append([a], X, Y)), [b,c], R). 1177% ?- phrase(fun([X] -> :append([a, b], X)), [c,d], R). 1178% ?- phrase(pred([X, Y] :- append([a,b])@X@Y), [c, d], R). 1179% ?- let(F, pred([X,Y,Z] :- append(X, Y, Z))), phrase(F@[a], [b,c], V). 1180% ?- let(F, (pred([X,Y,Z] :- append(X, Y, Z)))). 1181% ?- let(F, pred([X,Y,Z] :- append(X, Y, Z))), phrase(F@[a], [b,c], V). 1182 1183expand_phrase(X, _, X, P, P) :- var(X), !. 1184expand_phrase(M:X, N, Y, P, Q) :-!, update_prefix(M, N, N0), 1185 expand_phrase(X, N0, Y, P, Q). 1186expand_phrase((X,Y), M, (X0, Y0), P, Q) :-!, 1187 expand_phrase(X, M, X0, P, P0), 1188 expand_phrase(Y, M, Y0, P0, Q). 1189expand_phrase((X|Y), M, G, P, Q) :-!, expand_phrase((X;Y), M, G, P, Q). 1190expand_phrase((X;Y), M, (X0;Y0), P, Q) :-!, 1191 expand_phrase(X, M, X0, P, P0), 1192 expand_phrase(Y, M, Y0, P0, Q). 1193expand_phrase((X->Y), M, (X0->Y0), P, Q) :-!, 1194 expand_phrase(X, M, X0, P, P0), 1195 expand_phrase(Y, M, Y0, P0, Q). 1196expand_phrase(\+(X), M, \+(Y), P, Q) :-!, expand_phrase(X, M, Y, P, Q). 1197expand_phrase({E}, M, {E0}, P, Q) :-!, once(expand_goal(E, M, E0, P, Q)). 1198expand_phrase(X@Y, M, ({H}, G), P, Q) :-!, 1199 expand_meta_arg(X@Y, M, G, H, P, Q). 1200expand_phrase(X, _, X, P, P) :- is_list(X), !. % for not loading files. 1201expand_phrase(X, _, Y, P, P) :- string(X), !, string_codes(X, Y). 1202expand_phrase(bind(X), M, bind(Y), P, Q) :- !, % for bind_bind 1203 expand_phrase(X, M, Y, P, Q). 1204expand_phrase(shift(X), _, {shift(Y)}, P, Q) :-!, 1205 expand_arg(X, [], Y, P, Q). 1206expand_phrase(sed(X), M, Y, P, Q) :-!, must_be(nonvar, X), 1207 expand_sed(X, [F, W, A]), 1208 !, 1209 expand_recognize_act(F, W, A, M, Y, P, Q). 1210expand_phrase(X, M, G, P, Q) :- once(expand_basic_phrase(X, M, G, P, Q)). 1211 1212% ?- expand_basic_phrase(maplist(maplist(phrase(wl(".")))), user, G, P, []). 1213 1214% Let ^ and >> be associative with each other. 1215expand_sed((F^W)>>A, [F, W, A]). 1216expand_sed(F^(W >> A), [F, W, A]). 1217expand_sed(W >> A, [[], W, A]). 1218expand_sed(s/Regex/S, [[], w(Regex),S]). 1219expand_sed(sl/Regex/S, [[], wl(Regex), S]). 1220expand_sed(a/Regex/B, [[], w(Regex, X), (X + B)]). 1221expand_sed(al/Regex/B, [[], wl(Regex, X), (X + B)]). 1222expand_sed(b/Regex/B, [[], w(Regex, X), (B + X)]). 1223expand_sed(bl/Regex/B, [[], wl(Regex, X), (B + X)]). 1224expand_sed(d/Regex, X) :- expand_sed(s/Regex/ "", X). 1225expand_sed(dl/Regex, X) :- expand_sed(sl/Regex/ "", X). 1226expand_sed(w/Regex/Before/After, [[], w(Regex, X), (Before + X + After)]). 1227expand_sed(wl/Regex/Before/After, [[], wl(Regex, X), (Before + X + After)]). 1228 1229% ?- expand_phrase(bind(a), [], G, P, []). 1230warning_w(E) :- write( 'non ground compound regex found: '), 1231 writeln(E). 1232 1233% ?- expand_phrase(w("a+b"), user, G, P, []). 1234% ?- expand_phrase(w("a"), user, G, P, []). 1235% ?- expand_phrase(w("aa"), user, G, P, []). 1236% ?- expand_w("a", user, _G5350, _G5351, []). 1237 1238expand_basic_phrase(X, Y, Z, U) :- 1239 once(expand_basic_phrase(X, Y, Z, U, [])). 1240 1241% 1242expand_basic_phrase(w(E), _, w(E), P, P) :- var(E), !. 1243expand_basic_phrase(w(E), M, Y, P, Q) :-!, 1244 expand_w(E, M, Y, P, Q). 1245expand_basic_phrase(w(E, A), M, Y, P, Q) :-!, 1246 expand_w(E, A, [], M, Y, P, Q). 1247expand_basic_phrase(w(E, A, B), M, Y, P, Q) :-!, 1248 expand_w(E, A, B, M, Y, P, Q). 1249expand_basic_phrase(wl(E), _, wl(E), P, P) :- var(E), !. 1250expand_basic_phrase(wl(E), M, Y, P, Q) :-!, 1251 expand_wl(E, M, Y, P, Q). 1252expand_basic_phrase(wl(E, A), M, Y, P, Q) :-!, 1253 expand_wl(E, A, [], M, Y, P, Q). 1254expand_basic_phrase(wl(E, A, B), M, Y, P, Q) :-!, 1255 expand_wl(E, A, B, M, Y, P, Q). 1256expand_basic_phrase(S::E, M, F, P, R) :-!, 1257 once(expand_exp(E, S, V, M, G, P, Q)), 1258 term_variables(S-E, Vs), 1259 once(expand_core(pred(Vs, [V] :- G), M, F, Q, R)). 1260expand_basic_phrase(X, M, G, P, Q) :- once(expand_basic(X, M, G, P, Q)). 1261 1262% ?- expand_basic(maplist(phrase(wl("."))), user, G, P, []). 1263% ?- expand_basic(maplist(=(a), []), user, G, P, []). 1264% ?- expand_basic_phrase(maplist(phrase(wl("."))), user, G, P, []). 1265% ?- predicate_property(profile(a=b), meta_predicate(P)). 1266% ?- predicate_property(call(a=b, b), meta_predicate(P)). 1267% ?- predicate_property(call(a=b, b,c), meta_predicate(P)). 1268% ?- expand_basic(maplist(phrase(=), [[a]], R), user, G, P, []). 1269% ?- expand_basic(maplist(phrase(wl(".")), [[a]], R), user, G, P, []). 1270% ?- expand_basic(maplist(phrase(wl(".")), [[a]], R), user, G, P, []). 1271% ?- predicate_property(xxx:maplist(phrase(=), X, Y), meta_predicate(U)). 1272 1273% ?- expand_basic(call(X, Y), user, G, P, []). 1274% ?- expand_basic(setup_call_cleanup(X, Y, Z), user, G, P, []). 1275% ?- expand_basic(setup_call_cleanup(pred([]):-true, Y, Z), user, G, P, []). 1276 1277expand_basic(E, M, G, P, Q) :- expand_core(E, M, G, P, Q) 1278 ; expand_etc(E, M, G, P, Q) 1279 ; expand_atomic_goal(E, M, E0, H, P, P0), 1280 expand_meta_args(E0, M, G0, P0, Q), 1281 slim_goal((H, G0), G). 1282 1283% ?- meta_property(user:call(A@B, C), U). 1284% ?- expand_meta_args(user:call(X@Y), user, U, P, []). 1285expand_meta_args(X, _, X, P, P) :- var(X), !. 1286expand_meta_args(M:X, _, Y, P, Q) :-!, expand_meta_args(X, M, Y, P, Q). 1287expand_meta_args((X,Y), M, (X0, Y0), P, Q) :- !, 1288 expand_meta_args(X, M, X0, P, P0), 1289 expand_meta_args(Y, M, Y0, P0, Q). 1290expand_meta_args((X;Y), M, (X0;Y0), P, Q) :-!, 1291 expand_meta_args(X, M, X0, P, P0), 1292 expand_meta_args(Y, M, Y0, P0, Q). 1293expand_meta_args(E, M, G, P, Q):- 1294 meta_property(M:E, U), 1295 !, 1296 U=..[_|As], 1297 E=..[E0|Bs], 1298 expand_meta_arg_list(As, Bs, M, Cs, Aux, P, Q), 1299 G0=..[E0|Cs], 1300 slim_goal((Aux, M:G0), G). 1301expand_meta_args(E, M, Em, P, P):-attach_prefix(M, E, Em). 1302% 1303indicator_for_meta(:):-!. 1304indicator_for_meta(A):- integer(A). 1305% 1306expand_meta_arg_list([], _, _, [], true, P, P):-!. 1307expand_meta_arg_list([A|As], [B|Bs], M, [C|Cs], (Pre, Pre0), P, Q):- 1308 indicator_for_meta(A), 1309 expand_meta_arg(B, M, C, Pre, P, P0), !, 1310 expand_meta_arg_list(As, Bs, M, Cs, Pre0, P0, Q). 1311expand_meta_arg_list([_|As], [B|Bs], M, [B|Cs], Pre, P, Q):- 1312 expand_meta_arg_list(As, Bs, M, Cs, Pre, P, Q). 1313% 1314 :- meta_predicate expand_arg_assert(, ). 1315 :- meta_predicate expand_arg_compile(, ). 1316expand_arg_assert(X, Y) :- expand_arg(X, [], Y, P, []), 1317 ignore(maplist(assert, P)). 1318% 1319expand_arg_compile(X, Y) :- expand_core(X, [], Y, P, []), 1320 ignore(pac_compile_aux_clauses(P)). 1321% 1322expand_meta_arg(X, _, X, true, P, P) :- var(X), !. 1323expand_meta_arg(M:X, _, M:X, true, P, P) :- var(X), !. % ad hoc ? 1324expand_meta_arg(X@Y, M, U, H, P, Q) :-!, 1325 expand_exp(X@Y, [], =, U, M, H, P, Q). 1326expand_meta_arg(M:X, N, Y, H, P, Q) :-!, update_prefix(M, N, N0), 1327 expand_meta_arg(X, N0, Y, H, P, Q). 1328expand_meta_arg(X, _, Y, true, P, P) :- (string(X); is_list(X)), !, Y = X. 1329expand_meta_arg((X,Y), M, (X0, Y0), (G0, H0), P, Q) :-!, 1330 expand_meta_arg(X, M, X0, G0, P, P0), 1331 expand_meta_arg(Y, M, Y0, H0, P0, Q). 1332expand_meta_arg(X, M, Z, true, P, Q) :- once(expand_basic(X, M, Z, P, Q)). 1333 1334% ?- eval(:(fun([X]>>X)) @2, R). 1335% ?- eval(:pred([X,X]) @2, R). 1336% ?- pac:expand_exp(fun([X]>>X), [], =, U, user, H, P, []). 1337expand_arg(X, _, X, P, P) :- var(X), !. 1338expand_arg(X, M, G, P, Q) :- 1339 ( expand_meta_arg(X, M, G, H, P, Q), 1340 H = true 1341 -> true 1342 ; throw('NON ATOMIC meta argument found.') 1343 ). 1344% 1345canonical_exp(X) :- ( number(X); string(X); is_list(X) ).
options in O:
goal(G) : G is a goal whose execution gives the value V of
the expression E.pac(X-Y): generated helper predicates in the form of d-list X-Y.inside_out(true/false) : if true given, subterms of E
run(true/false): 'true' is default, and then run the goal G.
1360% ?- maplist((pred([a])), [X,Y]).
1361% ?- eval(append([a,b],[c,d]), V).
1362% ?- E=1, eval(E, V).
1363% ?- E =append([a,b],[c,d]), eval(:E, V).
1364% ?- E =append([a,b],[c,d]), eval(E, V).
1365% ?- E =append([a,b],[c,d]), eval(E, V, [goal(G)]).
1366% ?- E =append([a,b],[c,d]), eval(E, V, [goal(G)]), call(G).
1367% ?- eval(xargs(fun([a,b]>>p(X,Y))), V).
1368% ?- eval(xargs([a,b]>>p(X,Y)), V).
options in O:
goal(G) : G is a goal whose execution gives the value V of
the expression E.pac(X-Y): generated helper predicates in the form of d-list X-Y.inside_out(true/false) : if true given, subterms of E
run(true/false): 'true' is default, and then run the goal G.val(V) : V is to be unified with the value of E.1386eval(E, V):- context_module(M), 1387 expand_exp(E, =, V, M, G, P, []), !, 1388 maplist_assert(P), 1389 call(G). 1390% 1391eval(E, V, Opts):- eval_options(Opts, K, M, P, G), 1392 expand_exp(E, K, V, M, G, P, []), !, 1393 maplist_assert(P), 1394 ( ( memberchk(run, Opts); memberchk(run(true), Opts)) 1395 -> call(G) 1396 ; true 1397 ). 1398% 1399eval_options(Opts, K, M, P, G):- 1400 ( memberchk(kind(K), Opts) -> true 1401 ; K = (=) 1402 ), 1403 ( memberchk(module(M), Opts) -> true 1404 ; context_module(M) 1405 ), 1406 ( memberchk(aux(P), Opts) -> true 1407 ; true 1408 ), 1409 ( memberchk(goal(G), Opts) -> true 1410 ; true 1411 ). 1412 1413% 1414assert_dlist(P) :- var(P), !. 1415assert_dlist([]). 1416assert_dlist([C|P]) :- assert_one(C), 1417 assert_dlist(P). 1418 1419% 1420expand_dict_clause_olist(P0, P) :- var(P0), !, P = P0. 1421expand_dict_clause_olist([], []) :- !. 1422expand_dict_clause_olist([C|Cs], [D|Ds]) :- 1423 expand_dict_clause(C, D), 1424 expand_dict_clause_olist(Cs, Ds). 1425 1426% 1427unify_options([], _). 1428unify_options([A|R], Options) :- memberchk(A, Options), !, 1429 unify_options(R, Options). 1430unify_options([_|R], Options) :- unify_options(R, Options). 1431 1432 /************************************************** 1433 * expanding limited functional expressions * 1434 **************************************************/
1439% 1440% True if G is a goal such that execution of G 1441% unifies a term U with the value of expression E, 1442% where H is the helper predidates for G generated as 1443% a difference list P with a tail Q, i.e, append(H, Q, P) is true. 1444% Typically atomic subgoals of G are of the form M:S(A, B). 1445% expand_exp/7 is used when compiling an equations in a kind, 1446% a set of equations, to a clause of the predicate M:S/2. 1447% 1448% Simplest usage: 1449% ?- expand_exp(f(a), k, V, m, G, P, []). 1450% G = m:k(f(a), V), 1451% P = []. 1452% 1453% ?- expand_exp(f(a), call, V, m, G, P, []). 1454% G = m:f(a, V), 1455% P = []. 1456% 1457% ?- expand_exp(=(hello), call, V, user, G, P, []). 1458% G = user: (hello=V), 1459% P = []. 1460% 1461% Features: 1462% 1. PAC/Lambda/Kind are macros expanded on loading. 1463% 2. The sorted expression `(S :: E) = V' is eqivalent to `S(E, V)'. 1464% 3. Backquote '`' is for quoting term. 1465% 4. no special runtime predicate is necessary. 1466% 5. Arguments (in @ ) is evaluated before call. 1467% 6. let/2 for dynamic compiling pacs. 1468 1469% ?- expand_exp(misc:set(pow@A), =, E, [], G, P, []), write(G), A = [1,2], call(G). 1470 1471% ?- expand_exp(f(a)@b, =, V, m, G, P, []). 1472% ?- expand_exp(append(a)@b@c, =, V, m, G, P, []). 1473% ?- expand_exp((misc:set):: (pow@A), =, E, [], G, P, []), A = [1,2], call(G). 1474% ?- expand_exp(misc:set(pow(A)), =, E, [], G, P, []), A = [1,2], call(G). 1475% ?- expand_exp(misc:set::pow@A, =, E, [], G, P, []), A = [1,2], call(G). 1476% ?- expand_exp((X\X), =, V, user, G, P, []). 1477% ?- expand_exp(X\(X\X), =, V, user, G, P, []). 1478% ?- expand_exp(pow@[1,2], set, E, [], X, P, []). 1479% ?- expand_exp('`'(pow)@[1,2], set, E, [], X, P, []). 1480% ?- expand_exp(pow@[1,2], misc:set, E, [], X, P, []), call(X). 1481% ?- expand_exp(pow(pow([1,2])), misc:set, E, [], X, P, []), call(X). 1482% ?- expand_exp(pow@(pow([1,2])), misc:set, E, [], X, P, []), call(X). 1483% ?- expand_exp(pow@(pow@[1,2]), misc:set, E, [], X, P, []), call(X). 1484% ?- expand_exp('`'(pow)@(pow@[1,2]), misc:set, E, [], X, P, []), call(X). 1485% ?- expand_exp(:ff(a), word_am, V, user, G, P, []). 1486% ?- expand_exp((math:powerset)@A, set, V, misc, G, P, []). 1487% ?- expand_exp(1, [], set, V, user, G, P, []). 1488% ?- expand_exp(X, [], set, V, user, G, P, []). 1489% ?- expand_exp(X, [], call, V, user, G, P, []). 1490% ?- expand_exp(pow, [a], set, V, user, G, P, []). 1491% ?- expand_exp(append, [[a],[b]], call, V, user, G, P, []), call(G). 1492% ?- expand_exp(:append, [a,b], set, V, user, G, P, []). 1493% ?- expand_exp(append, [a,b], set, V, user, G, P, []). 1494% ?- expand_exp(m:append, [a,b], set, V, user, G, P, []). 1495% ?- expand_exp(quote(append), [a,b], call, V, user, G, P, []). 1496% ?- expand_exp('`'(append(x)), [a,b], call, V, user, G, P, []). 1497% ?- expand_exp(pred([X,X,X]), [a,b], call, V, user, G, P, []). 1498% ?- expand_exp(pred([X,Y,X+Y]), [a,b], call, V, user, G, P, []). 1499% ?- expand_exp(a@b, [], set, V, user, G, P, []). 1500% ?- expand_exp(a@b, [1, 2], set, V, user, G, P, []). 1501% ?- expand_exp(append@[a,b]@[c,d], call, V, user, G, P, []), call(G). 1502% ?- expand_exp(F@X@Y, call, V, user, G, P, []). 1503% ?- expand_exp(F@X@Y, set, V, user, G, P, []). 1504% ?- expand_exp(F@ X @ Y, call, V, user, G, P, []). 1505% ?- expand_exp(F@ (S @ X)@ (T@ Y), call, V, user, G, P, []). 1506% ?- expand_exp(F@ (S @ X)@ (T@ Y), set, V, user, G, P, []). 1507% ?- expand_exp(F@ (S @ X)@ (T@ Y), Unknown, V, user, G, P, []). 1508% ?- nopac( expand_exp((pred([X,Y,Z]))@a@b, [], set, V, user, G, P, [])). 1509% ?- expand_exp(([X]\X)@2, [], set, V, user, G, P, []). 1510% ?- expand_exp('`'(and)@(imply@X@Y)@(imply@Y@X), [], macro, V, user, G, P, []). 1511% ?- expand_exp(:union, [a, b], set, V, user, G, P, []). 1512% ?- expand_exp((:union)@a, [], set, V, user, G, P, []). 1513% ?- expand_exp(a, call, V, user, G, P, []). 1514% ?- expand_exp(A, call, V, user, G, P, []). 1515% ?- expand_exp(A@a, call, V, user, G, P, []). 1516% ?- expand_exp(A@a, set, V, user, G, P, []). 1517% ?- expand_exp(A@a, S, V, user, G, P, []). 1518% ?- expand_exp({a:1}, [], =, V, [], G, P, []). 1519% ?- expand_exp({b:{a:1}}, [], =, V, [], G, P, []). 1520% ?- expand_exp(:F, [], call, V, [], G, P, []). 1521 1522% ?- eval((:), X). % to get the current module prefix 1523% ?- eval((::), X). % to get the current kind prefix 1524% ?- eval(a@(::)@(:), V). 1525% ?- eval(f@(a@(::)@(:)), V). 1526 1527% expand_exp/7 1528expand_exp(E, S, U, M, G, P, Q):- 1529 once(expand_exp(E, [], S, U, M, G, P, Q)). 1530 1531% expand_exp/8 1532expand_exp(E, L, S, V, M, G, P, P):- var(E), !, 1533 expand_exp_var(L, E, S, V, M, G). 1534expand_exp(E, _, _, E, _, true, P, P):- canonical_exp(E), !. 1535expand_exp(E, L, _, G, M, true, P, Q):- expand_core(E, M, E0, P, Q), !, 1536 complete_args(E0, L, G). 1537expand_exp(::(S, E), L, _, V, M, G, P, Q):-!, 1538 expand_exp(E, L, S, V, M, G, P, Q). 1539expand_exp(::, _, S, S, _,true, P, P):- !. 1540expand_exp(@(E, E0), L, S, V, M, H, P, Q):- !, 1541 eliminate_atmark(E, [E0], [F|L0]), 1542 expand_exp_list(L0, S, L1, M, G, P, P0), 1543 append(L1, L, L2), 1544 expand_exp(F, L2, S, V, M, G1, P0, Q), 1545 slim_exp_goal((G, G1), H). 1546expand_exp(@(E), L, S, V, M, H, P, Q):- !, 1547 expand_exp(E, [], S, E0, M, H0, P, P0), 1548 expand_exp(E0, L, S, V, M, H1, P0, Q), 1549 slim_exp_goal((H0, H1), H). 1550expand_exp(@@(E), _, S, E0, M, H, P, P):- !, 1551 copy_term(E, E0), 1552 term_variables(E, Vs), 1553 term_variables(E0, V0s), 1554 maplist(make_kind_call(S, M), Vs, V0s, Calls), 1555 list_to_comma(Calls, H0), 1556 slim_exp_goal(H0, H). 1557expand_exp($(E), L, S, V, M, H, P, Q):-!, 1558 call(E, E0), 1559 expand_exp(E0, L, S, V, M, H, P, Q). 1560expand_exp(quote(E), L, _S, E0, _, true, P, P):-!, 1561 ( var(E) -> E0 = E; complete_args(E, L, E0) ). 1562expand_exp('`'(E), L, S, V, M, G, P, Q):-!, 1563 expand_exp(quote(E), L, S, V, M, G, P, Q). 1564expand_exp(:, _, _, M, M, true, P, P):-!. % get the current module prefix. 1565expand_exp(:(E), L, _, V, M, G, P, Q):-!, 1566 expand_exp(E, [], =, E0, M, G0, P, Q), 1567 append(L, [V], L0), 1568 complete_args(M:E0, L0, G1), 1569 slim_exp_goal((G0, G1), G). 1570expand_exp(M:E, L, _, M:E0, _, G, P, Q):-!, 1571 expand_exp(E, L, =, E0, M, G, P, Q). 1572expand_exp(#(E), L, S, V, M, G, P, Q):-!, 1573 expand_exp(E, [], S, E0, M, G0, P, P0), 1574 expand_exp(E0, L, S, V, M, G1, P0, Q), 1575 slim_exp_goal((G0, G1), G). 1576expand_exp(xargs(PredFun), L, S, V, M, G, P, Q):-!, 1577 expand_xargs(PredFun, L, S, V, M, G, P, Q). 1578expand_exp({X}, _L, _S, V, M, G, P, Q):-!, 1579 ( chk_odict 1580 -> anti_subst({X}, V, Aux), 1581 anti_subst:expand_aux(Aux, M, G, P, Q) 1582 ; V = {X}, G=true, Q = P 1583 ). 1584expand_exp(X, _, S, V, M, H, P, Q):- is_role(X, A, B), !, 1585 expand_dict_access(A, S, V0, M, H0, P, P0), 1586 expand_dict_access(V0, B, S, V, M, H1, P0, Q), 1587 slim_exp_goal((H0, H1), H). 1588expand_exp(E, L, S, V, M, G, P, P):- S == call, !, 1589 attach_prefix(M, E, E0), 1590 append(L, [V], L0), 1591 complete_args(E0, L0, G). 1592expand_exp(E, L, S, V, _, true, P, P):- S == (=), !, 1593 complete_args(E, L, V). 1594expand_exp(E, L, S, V, M, G, P, P):- 1595 attach_prefix(M, S, S0), 1596 complete_args(E, L, E0), 1597 complete_args(S0, [E0, V], G). 1598% 1599expand_xargs(Params :- Goal, Args, _, V, M, G, P, Q):-!, 1600 append(Args, _, Params), 1601 last(Params, V), % last argument is for output. 1602 expand_goal(Goal, M, G, P, Q). 1603expand_xargs(Fun, Args, _, V, M, G, P, Q):- 1604 normal_fun(Fun, =, fun(_, _, Params>>Exp)), 1605 append(Args, Args0, Params), 1606 expand_exp(Exp, Args0, =, V, M, G, P, Q). 1607 1608% 1609normal_fun(fun(X\E), S, fun(S, [], X>>E)). 1610normal_fun(fun(X->E), S, fun(S, [], X>>E)). 1611normal_fun(fun(X>>E), S, fun(S, [], X>>E)). 1612normal_fun(fun(S, A, Funs), _, fun(S, A, Funs)). 1613normal_fun(fun(A, Funs), S, fun(S, A, Funs)). 1614normal_fun(X\E, S, fun(S, [], X>>E)). 1615normal_fun(X>>E, S, fun(S, [], X>>E)). 1616 1617% 1618expand_fun_to_pred(fun(S, A, Funs), M, G, P, Q) :- 1619 funs_to_preds(Funs, S, M, Clauses, P, P0), 1620 expand_core(pred(A, Clauses), M, G, P0, Q). 1621 1622% expand_dict_access 1623% /7. 1624% ?- pac:expand_dict_access(role(X, a), =, V, user, H, P, []). 1625% ?- pac:expand_dict_access(role(role(X,a), b), =, V, user, H, P, []). 1626% ?- pac:expand_dict_access(role(X, a(k)), =, V, user, H, P, []). 1627% ?- pac:expand_dict_access(role(X, role(Y, a)), =, V, user, H, P, []). 1628expand_dict_access(X, S, V, M, H, P, Q):- nonvar(X), is_role(X, A, B), !, 1629 expand_dict_access(A, S, V0, M, H0, P, P0), 1630 expand_dict_access(V0, B, S, V, M, H1, P0, Q), 1631 slim_exp_goal((H0, H1), H). 1632expand_dict_access(X, S, D, M, H, P, Q):- expand_exp(X, S, D, M, H, P, Q). 1633% /8. 1634expand_dict_access(X, R, S, V, M, H, P, Q):- nonvar(R), is_role(R, _, _), !, 1635 expand_dict_access(R, S, V0, M, H0, P, P0), 1636 expand_dict_access(X, V0, S, V, M, H1, P0, Q), 1637 slim_exp_goal((H0, H1), H). 1638expand_dict_access(X, K, _, V, _M, H, P, Q):- 1639 expand_exp(K, =, K0, [], H0, P, Q), 1640 slim_goal((H0, role(K0, X, V)), H). 1641 1642% 1643expand_role_list(Y, S, Path, M, H, P, Q):- nonvar(Y), is_role(Y, Y1, Y2), !, 1644 expand_role_list(Y1, S, Path1, M, H1, P, P0), 1645 expand_role_list(Y2, S, Path2, M, H2, P0, Q), 1646 slim_exp_goal((H1, H2, append(Path1, Path2, Path)), H). 1647expand_role_list(Y, S, [V], M, H, P, Q):- 1648 expand_exp(Y, S, V, M, H, P, Q). 1649 1650% 1651expand_exp_list([], _, [], _ , true, P, P). 1652expand_exp_list([E|L], S, [E0|L0], M, (G, G0), P, Q):- 1653 expand_exp_arg(E, S, E0, M, G, P, R), 1654 expand_exp_list(L, S, L0, M, G0, R, Q). 1655 1656% expand_exp_var/6 1657expand_exp_var([], E, S, V, M, call(M:S, E, V)):-!. 1658expand_exp_var(L, E, S, V, M, '$kind'(S, E, L, V, M)). 1659 1660 1661% ?- eval((E::Pow)@A, X, [goal(G)]), Pow = pow, E=misc:set, A=[a,b], call(G). 1662 1663% Run time for eval. 1664user'$kind'(S, E, L, V, M):- 1665 ( ( nonvar(S); nonvar(E); nonvar(M) ) -> 1666 complete_args(E, L, E0), 1667 call(M:S, E0, V) 1668 ; throw(uninstantiated_variable_with('$kind')) 1669 ). 1670% 1671 1672expand_exp_arg(E, S, U, M, G, P, Q) :- 1673 once(expand_exp_basic_arg(E, S, U, M, G, P, Q)). 1674expand_exp_arg(E, S, U, M, G, P, Q) :- 1675 once(expand_exp(E, [], S, U, M, G, P, Q)). 1676 1677% 1678expand_exp_basic_arg(E, S, U, M, G, P, P):- var(E), !, 1679 ( ( S = call; S = (=) ) 1680 -> U = E, 1681 G = true 1682 ; attach_prefix(M, S, S0), 1683 complete_args(S0, [E,U], G) 1684 ). 1685expand_exp_basic_arg(E, _, E, _, true, P, P):- canonical_exp(E), !. 1686expand_exp_basic_arg(E, _, U, M, true, P, Q):- 1687 once( expand_core(E, M, U, P, Q) 1688 ; expand_etc(E, M, U, P, Q) 1689 ). 1690% 1691eliminate_atmark(E, L, [E|L]):- var(E). 1692eliminate_atmark(@(E,E0), L, L0):- eliminate_atmark(E, [E0|L], L0). 1693eliminate_atmark(E, L, [E|L]). 1694 1695% some tiny runtime. 1696list_to_comma([X,Y|Z], (X, U)):- list_to_comma([Y|Z], U). 1697list_to_comma([X], X). 1698list_to_comma([], true). 1699 1700% 1701nopac(X):- call(X). % to prevent from pac-expansion 1702 1703% 1704flat(X, Y, Z):- once(flat(X, Y, Z, [])). 1705% 1706flat(_, A, [A|P], P):- var(A). 1707flat(;, A;B, P, Q):- flat(;, A, P, P0), 1708 flat(;, B, P0, Q). 1709flat(&, A&B, P, Q):- flat(&, A, P, P0), 1710 flat(&, B, P0, Q). 1711flat(_, A, [A|P], P). 1712 1713% 1714attach_prefix_head(M, X:-Y, MX:-Y):- 1715 attach_prefix(M, X, MX). 1716 1717% ?- pac_to_pred([X], U). 1718pac_to_pred(X, _):- var(X), throw(pac_syntax_error(X)). 1719pac_to_pred(H:-G, [P, F, G]):- pac_to_pred_head(H, [P,F]). 1720pac_to_pred(H, [P, F,true]):- pac_to_pred_head(H, [P,F]). 1721 1722% 1723pac_to_pred_head(P, _):- var(P), throw(pac_syntax_error(P)). 1724pac_to_pred_head(P, [P, []]):- is_list(P). 1725pac_to_pred_head(P, _) :- throw(pac_syntax_error(P)). 1726 1727% ?- meta_property(maplist(0), I). 1728% ?- meta_property(xxx:maplist(=(0), _), I). 1729meta_property([]:E, I):-!, meta_property(E, I). 1730meta_property(E, I) :- predicate_property(E, meta_predicate(I)). 1731 1732% 1733slim_exp_goal(G, G0):- once(slim_exp_aux(G, G1)), 1734 reduce:slim_goal(G1, G0). 1735% 1736slim_exp_aux(M:A, M:B):- slim_exp_aux(A, B). 1737slim_exp_aux((X=Y), true):- X==Y. 1738slim_exp_aux((H,G), (H0, G0)):- slim_exp_aux(H, H0), 1739 slim_exp_aux(G, G0). 1740slim_exp_aux(X, G):- X =.. [xargs, Pred |Args], 1741 pass_xargs(Pred, Args, G). 1742slim_exp_aux(H, H). 1743 1744% ?- pass_xargs([X,Y]:- a(X,Y), [1], G). 1745% ?- pass_xargs([X,Y]:- pred(X, [U]:-a(X,Y)), [1], G). 1746 1747pass_xargs(Ps :- Body, Args, G):-!, 1748 append(Args, _, Ps), 1749 slim_exp_goal(Body, G). 1750pass_xargs(Ps, Args, true):- is_list(Ps),!, 1751 append(Args, _, Ps). 1752pass_xargs(F, [A, B], G):- complete_args(F, [B, A], G). 1753 1754% 1755make_kind_call(S, M, V, U, call(M:S, V, U)). 1756% 1757make_kind_list(_, _, [], [], _, true, P, P). 1758make_kind_list(F, S, [V|Vs], [U|Us], M, (G, U=U0, Gs), P, Q):- 1759 once(expand_exp(F@V, S, U0, M, G, P, P0)), 1760 make_kind_list(F, S, Vs, Us, M, Gs, P0, Q). 1761 1762 1763% ?- trace, binary_flip(a=b, X). 1764 1765% 1766partial_args_match([],_). 1767partial_args_match(_,[]). 1768partial_args_match([A|As],[A|Bs]):- partial_args_match(As, Bs). 1769 1770% % Tiny helpers 1771% zip([A|B], [C|D], [A-C|R]):- zip(B, D, R). 1772% zip([], [], []). 1773 1774% ?- flip_clause(f, [], f, X). 1775% ?- flip_clause(f, [1,2], f(a,b), X). 1776% ?- flip_clause(f, [2,1], f(a,b), X). 1777% ?- flip_clause(f, [1,3,2], f(a,b,c), X). 1778% ?- flip_clause(f, [1,3,2],(f(a,b,c):- true, g(a), f(x, y, z)), X). 1779 1780flip_clause(F, P, T, T0):- 1781 walk_term(T, T0, flip_functor_args(F, P)). 1782% 1783flip_functor_args(F, P, T, T0):- 1784 T =.. [F|As], 1785 length(P, N), 1786 length(As, N), 1787 flip_list(P, As, Bs), 1788 T0 =.. [F|Bs]. 1789flip_functor_args(_, _, T, T). 1790 1791% ?- walk_term((a,b), X, =). 1792% ?- walk_term(a:-b, X, =). 1793% ?- walk_goal(a:-b, X, =). 1794walk_term(A, A, _) :- var(A). 1795walk_term(M:A, M:B, F):- walk_term(A, B, F). 1796walk_term(H:-B, H0:-B0, F):- walk_term(H, H0, F), once(walk_goal(B, B0, F)). 1797walk_term(A, A0, F):- call(F, A, A0). 1798 1799% ?- walk_goal((a,b), X, =). 1800walk_goal(A,A,_) :- var(A). 1801walk_goal((A0,B0), (A,B), F) :- walk_goal(A0, A, F), walk_goal(B0, B, F). 1802walk_goal((A0;B0), (A,B), F) :- walk_goal(A0, A, F), walk_goal(B0, B, F). 1803walk_goal((A0->B0), (A->B), F) :- walk_goal(A0, A, F), walk_goal(B0, B, F). 1804walk_goal(\+(A0), \+(A), F) :- walk_goal(A0, A, F). 1805walk_goal(M:A, M:A0, F):- walk_goal(A, A0, F). 1806walk_goal(A, A0, F):- call(F, A, A0), !