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(_, end_of_file, end_of_file). 524expand_query(M, M:[X|Y], M:[X|Y]). 525expand_query(M, X, Y) :- 526 once(expand_goal(X, M, Y, Z, [])), 527 assert_in_user(Z). 528 529 /************************ 530 * displaying pac * 531 ************************/
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, []))).541% ?- time(pac:(call(pred([1]), A))). 542% ?- time(call(pred([1]), A)). 543% ?- show(nopac(call(pred([X]), 1))). 544 545show(X) :- let(F, X, Y), show(F, Y). 546 547show(F, Y) :- 548 predsort(compare_clause, Y, Y0), 549 maplist(copy_term, Y0, Y1), 550 numbervars(F, 0, _, [singletons(true)]), 551 write(F), 552 once(show_where_clause(Y1)). 553% 554show_where_clause([]). 555show_where_clause(Y) :- write(', where\n'), 556 maplist(numbervars_write(0), Y). 557 558% ?- show_clause(a:-b). 559% ?- show_clause(a(X):-maplist(pred([1]), X)). 560show_clause(X):- pac_listing:expand_clause_slim(X, [H|Y]), 561 numbervars_write(0, H), 562 show_where_clause(Y). 563 564% ?- numbervars(f(X,Y), 0, _), term_string(f(X,Y), R, [numbervars(true)]).
570% ?- show_exp(a). 571% ?- show_exp(pred([1])). 572% ?- show_exp(X\X). 573% ?- show(X\X). 574% ?- show_exp(:(X\X)@ :(hello)). 575% ?- eval(:(X\X) @ :(hello), V). 576% ?- eval(:(X\X) @ (hello), V). 577% ?- eval((X\X) @ quote(hello), V). 578% ?- eval((X\X) @ hello, V). 579show_exp(E) :- 580 expand_exp(E, =, V, [], G, P, []), 581 maplist(copy_term, P, P0), 582 numbervars((V,G), 0, _, [singletons(true)]), 583 show_val_with_goal(V, G), 584 show_where_clause(P0). 585% 586show_val_with_goal(V,true) :- write(V). 587show_val_with_goal(V, G) :- write(V), 588 write(" with "), 589 write(G). 590 591% ?- show_phrase(w(".***********")). 592% ?- show_phrase(wl("[^b-wB-W]+", 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_phrase(wl("[^\s\n\t\r]++++++++++++", A, [])). 599% ?- show_am("[^\s\n\t\r]++++++++"). 600% ?- show_am("[^\s\n\t\r]******************************+"). 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("[\s\n\t\r]+++++++++", A, [])). 606% ?- show_phrase(wl("[a-zA-Z]++++++++++************", A, [])). 607% ?- show_phrase(wl("[^a-zA-Z]++++++++++************++", A, [])). 608% ?- show_phrase(wl("[^a-zA-Z]++++++++++************+++++++", A, [])). 609% ?- show_phrase(wl("[^a-zA-Z]" ^ (>=(5)), A, [])). 610% ?- show_phrase(wl("[^a-zA-Z]" ^ (3-5), A, [])). 611% ?- show_am("[^a-zA-Z]" ^ (3-5)). 612% ?- show_am("a" ^ (3-5)). 613% ?- show_am("ab" ^ (3-5)).
619show_phrase(P) :- show(phrase(P)). 620 621% ?- phrase_to_pred(apply(f), user, X, P, []). 622% ?- phrase_to_pred(w(*(.)), user, X, P, []). 623% ?- phrase_to_pred((a,b), user, X, P, []). 624phrase_to_pred(X, M, [U,V] :- G, P, Q):- 625 once(expand_phrase(X, M, G0, P, P0)), 626 dcg_translate_rule('DUMMY' --> G0, 'DUMMY'(U, V) :- G1), 627 once(expand_goal(G1, M, G, P0, Q)). 628 629% ?- expand_pac_pipe((a,b), [], user, R, P, []). 630% ?- expand_pac_pipe((a(A),b(B)), [A,B], user, R, P, []). 631expand_pac_pipe(Pipe, Globals, M, Ref, P, Q) :- 632 phrase_to_pred(Pipe, M, Pac, P, P0), 633 expand_core(pred(Globals, Pac), M, Ref, P0, Q). 634 635% ?- goal_to_pred(call([V,V], [X,_]), [], U, P, []). 636% ?- goal_to_pred(call(pred([V,V]), [X,_]), [], U, P, []). 637goal_to_pred(G, M, FVs :- Body, P, Q):- once(expand_arg(G, M, Body, P, Q)), 638 term_variables(Body, FVs). 639 640numbervars_write(N, C) :- numbervars(C, N, _, [singletons(true)]), writeln(C). 641% 642numbervars_writeq(N, C) :- numbervars(C, N, _, [singletons(true)]), writeq(C), nl. 643% 644compare_clause(C, X, Y) :- strip_module(X, _, H0:- _), 645 strip_module(Y, _, K0 :- _), 646 strip_module(H0, _, H), 647 strip_module(K0, _, K), 648 functor(H, FH, _), 649 functor(K, FK, _), 650 compare(C0, FH, FK), 651 change_order(C0, C). 652 653% 654change_order(<, >). 655change_order(>, <). 656change_order(=, <). 657 658 /******************* 659 * using pac * 660 *******************/
666:- meta_predicate user:let(, ). 667 668userlet(F, X) :- let(F, X, Y), 669 maplist(expand_dict_clause, Y, Aux), 670 maplist_assert(Aux). 671usershow(X):- show(X). 672usershow_phrase(X):- show_phrase(X). 673usershow_exp(X):- show_exp(X).
681% 682let(Y, M:X, Z) :- once(expand_arg(X, M, Y, Z, [])). 683 684% ?- pac:expand_core(pred(F, ([X] :- f(X)) & ([A]:- g(A))), [], G, P, []). 685%! let_exp(-X:var, +E:exp) is det 686% 687% True if X is unified with expanded exp E. 688 689let_exp(X, E) :- let_exp(E, X, Y), 690 maplist(expand_dict_clause, Y, Aux), 691 maplist_assert(Aux).
698let_exp(E, M:X, Y) :- expand_exp(E, =, M, X, Y, []). 699 700 /************************************** 701 * Recognize block structures * 702 * for possible use in the future * 703 **************************************/ 704% 705begin_end(kind, bekind(_), ekind). 706begin_end(kind, bekind(_, _), ekind). 707begin_end(trs, betrs(_), etrs). 708begin_end(fun, befun(_), efun). 709 710% ?- structured_pac([ :- betrs(a),b,c,:-etrs], Y). 711% ?- structured_pac([ :- bekind(a),b,c,:-ekind], Y). 712structured_pac(X, Y) :- structured_pac(Y, X, []). 713% 714structured_pac([], [], []). 715structured_pac([A|As], X, Y):- 716 structured_pac_one(A, X, X0), 717 structured_pac(As, X0, Y). 718% 719structured_pac_one(block(Kind, B, A), [ :- B|X], Y):- 720 begin_end(Kind, B, Endname), !, 721 structured_pac_block(Endname, A, X, Y). 722structured_pac_one(A, [A|X], X). 723 724% 725structured_pac_block(End, [], [ :- End|X], X):-!. 726structured_pac_block(End, [X|R],[X|Y], Z) :- 727 structured_pac_block(End, R, Y, Z). 728 729 /************************************************** 730 * Eliminte pacs from a clause recursively. * 731 **************************************************/
736% ?- expand_clause(a :- call(pred([X]:-write(X)), hello), L). 737%@ L = (user:a:-pac:'pac#51'(hello)). 738 739expand_clause(X, Y) :- prolog_load_context(module, M), 740 expand_clause(X, M, [Y|R], []), 741 !, 742 ignore(pac_compile_aux_clauses(R)). 743% 744attach_prefix_to_clause(M, A :- B, (M:A) :- (M:B)):-!. 745attach_prefix_to_clause(M, A, M:A). 746% 747expand_sgn(A, S/N-F, [T, R]:-(EvalArgs, apply(F0, YsR))) :- !, 748 expand_arg_assert(F, F0), 749 length(Xs, N), 750 T =..[S|Xs], 751 expand_sgn_calls(Xs, A, Ys, EvalArgs), 752 append(Ys, [R], YsR). 753expand_sgn(A, S-F, R) :- expand_sgn(A, S/0-F, R). 754 755% 756expand_sgn_calls([], _, [], true). 757expand_sgn_calls([X|Xs], A, [Y|Ys], (call(A, X, Y), Rest)) :- 758 expand_sgn_calls(Xs, A, Ys, Rest).
764% ?- expand_clause(a --> (X\X), R). 765% ?- expand_clause(a --> (X\X), R). 766% ?- expand_clause((a --> b,c), R). 767% ?- expand_clause(a --> w(".*"), R). 768% ?- expand_clause((a --> w(".*"), (X\[X,X])), R). 769% ?- expand_clause(a --> [a,b], R). 770% ?- expand_clause(a --> w(*char(kanji)), R). 771% ?- expand_clause(a({b:1}) --> [], R). 772% ?- expand_clause(a({b:1}) --> c({d:2}), R). 773 774% a tiny helper for updating module prefix 775update_prefix(M, N, N0) :- 776 ( M == [] 777 -> N0 = N 778 ; N0 = M 779 ). 780% 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,B), \(A0,B0), F) :- sgn_subst(A, A0, F), sgn_subst(B, B0, F). 784sgn_subst(A, A, _) :- is_list(A), !. 785sgn_subst(sgn(A), A, _) :- !. 786sgn_subst(A, A0, F) :- call(F, A, A0). 787 788% ?- zip_algebra(([a-1]+[b-2])\ [b-2], R). 789zip_algebra(A+B, C) :- zip_algebra(A, A0), 790 zip_algebra(B, B0), 791 append(A0, B0, C). 792zip_algebra(\(A, B), C) :- zip_algebra(A, A0), 793 zip_algebra(B, B0), 794 subtract(A0, B0, C). 795zip_algebra(A * B, C) :- zip_algebra(A, A0), 796 zip_algebra(B, B0), 797 intersection(A0, B0, C). 798zip_algebra(X, X). 799 800% ?- phrase_ref(A, (a,b(A),c), P). 801% ?- phrase_ref_show(A, (a,b(A),c), P). 802% ?- phrase_list_ref(A, [a,b(A),c], P). 803% ?- phrase_list_ref_show(A, [a,b(A),c], P). 804 805% Expand an phrase and return the ref handle 806 807% ?- trace, pac:phrase_ref([A,B], (append(A), append(B)), G). 808phrase_ref(X, Y, X0) :- translate_phrase_to_clause(X, Y, X0, Cs), 809 maplist(expand_dict_clause, Cs, Aux), 810 maplist_assert(Aux). 811 812% ?- phrase_ref_show([A,B], (append(A), append(B)), G). 813phrase_ref_show(X, Y, X0) :- translate_phrase_to_clause(X, Y, X0, Cs), 814 show(X0, Cs).
821% ?- translate_phrase_to_clause([A,B], (append(A), append(B)), G, Cs), 822% maplist(assert, Cs), A=[a,b], B=[c,d], call(G, [1,2], V). 823% ?- translate_phrase_to_clause([A,B], (append(A), append(B)), G, Cs). 824 825translate_phrase_to_clause(Globals, Phrase, PhraseRef, Cs) :- 826 once(expand_phrase(Phrase, [], Phrase0, Aux, [])), 827 new_pac_name(Pname), 828 canonical_global(Globals, Canonical_Globals), 829 make_ref(Canonical_Globals, Pname, PhraseRef), 830 dcg_translate_rule(PhraseRef --> Phrase0, C), 831 expand_clause(C, C0s), 832 append([C0s], Aux, Cs). 833 834% 835make_ref([], R, R) :- !. 836make_ref(X, R, R0) :- complete_args(R, X, R0). 837 838% Expand an phrase of the list form and return the ref handle 839phrase_list_ref(X, Y, X0) :- period_to_comma(Y, Y0), 840 phrase_ref(X, Y0, X0). 841% 842phrase_list_ref_show(X, Y, X0) :- period_to_comma(Y, Y0), 843 phrase_ref_show(X, Y0, X0). 844 845% ?- module(pac). 846% ?- period_to_comma([a,b,c], R). 847period_to_comma([X], X). 848period_to_comma([X, Y|Z], (X,R)) :- period_to_comma([Y|Z], R). 849 850% for not expansion as builtin dicts. (To be revised. ) 851is_role(role(X, Y), X, Y). 852is_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)]
864% ?- expand_goal((call([X]\[X,X],1, V), Y=V), user, G, L, []). 865 866expand_goal(X, _, X, P, P) :- var(X),!. 867expand_goal(M:X, N, Y, P, Q) :-!, update_prefix(M, N, N0), 868 expand_goal(X, N0, Y, P, Q). 869expand_goal((X,Y), M, (X0, Y0), P, Q) :-!, 870 expand_goal(X, M, X0, P, P0), 871 expand_goal(Y, M, Y0, P0, Q). 872expand_goal((X;Y), M, (X0;Y0), P, Q) :-!, 873 expand_goal(X, M, X0, P, P0), 874 expand_goal(Y, M, Y0, P0, Q). 875expand_goal((X->Y), M, (X0->Y0), P, Q) :-!, 876 expand_goal(X, M, X0, P, P0), 877 expand_goal(Y, M, Y0, P0, Q). 878expand_goal(if(A, B, C), M, Y, P, Q) :-!, once(expand_goal_if_cond(A, A0)), 879 expand_goal((A0->B;C), M, Y, P, Q). 880expand_goal(if(A, B), M, Y, P, Q) :-!, expand_goal(if(A,B,true), M, Y, P, Q). 881expand_goal(??(A), _, true, P, P) :-!, once(A). 882expand_goal(\+(X), M, \+(Y), P, Q) :-!, expand_goal(X, M, Y, P, Q). 883expand_goal(nopac(X), _M, X, P, P). 884expand_goal(X@Y, M, G, P, Q) :-!, expand_atmark_goal(X@Y, M, G, P, Q). 885expand_goal(X, M, MX, P, P) :- is_list(X), !, 886 attach_prefix(M, X, MX). 887expand_goal(X, M, G, P, Q) :- once(expand_basic(X, M, G, P, Q)). 888 % For not loading files. 889 890% 891expand_atmark_goal(X@Y, Mod, G, P, Q):- 892 expand_exp(X@Y, [], =, G_atomic, Mod, G_aux, P, Q), 893 slim_goal((G_aux, G_atomic), G). 894 895% For var X, if(X, A, B) => (X==true -> A; B) 896% otherwise, if(X, A, B) => (X -> A; B). 897% tiny optimization to prevent from (call(<module-ref>:X) -> A; B). 898expand_goal_if_cond(X, X == true) :- var(X), !. 899expand_goal_if_cond(X, X). 900 901% 902expand_phrase_list([], _, [], P, P):-!. 903expand_phrase_list([A|Xs], M, [A|Ys], P, Q) :- var(A),!, 904 expand_phrase_list(Xs, M, Ys, P, Q). 905expand_phrase_list([phrase(A, B)|Xs], M, [Y|Ys], P, Q) :-!, 906 once(expand_core(phrase(A, B), M, Y, P, R)), 907 expand_phrase_list(Xs, M, Ys, R, Q). 908expand_phrase_list([phrase(A)|Xs], M, [Y|Ys], P, Q) :-!, 909 once(expand_core(phrase([], A), M, Y, P, R)), 910 expand_phrase_list(Xs, M, Ys, R, Q). 911expand_phrase_list([A|Xs], M, [X0|Ys], P, Q) :- 912 once(expand_phrase(A, M, X0, P, R)), 913 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))]
925% ?- expand_core(X\(X\X), user, R, P, []). 926% ?- expand_core(X\ (X\X), user, R, P, []). 927% ?- expand_core(X\ :(X\X), user, R, P, []). 928% ?- expand_core(X\X, user, R, P, []). 929% ?- let(H, rec(F, [], ([[],X,X] :- true)&([[X|Y],Z,[X|U]]:- call(F, Y, Z, U)))), eval(:H@[1,2]@[3,4], R). 930 931% ?- call(pipe((=, =, =)), hello, X). 932% ?- maplist(pipe((=, =, =)), [a,b,c], X). 933% ?- maplist(pipe((pipe((=, =)), =)), [hello], X). 934% ?- maplist(pipe([A, B], (append([A]), append([B]))), [[1],[2],[3]], R), A = hello, B=world. 935 936% [2015/04/02] added mutual recursion with globals. 937 938% ?- maplist(new_pac_name, [A,B]). 939% ?- let(H, rec(F, [], ([[],X,X] :- true)&([[X|Y],Z,[X|U]]:- call(F, Y, Z, U)))), eval(:H@[1,2]@[3,4], R). 940 941% mrec test. 942% ?- let(H, mrec([F = [1]])), call(H, X). 943% ?- let(P, mrec([A], [ F = ([X]:- call(A, X))])), 944% let(A, pred([hello])), call(P, Ans). 945% ?- let(P, mrec(A, [ F = ([X]:- call(A, X))])), A = (=(3)), call(P, R). 946% ?- let(M, mrec([F = ([X]:- X=1)])), call(M, Ans). 947% ?- let(M, mrec([G], [F = ([X]:- call(G, X))])), 948% let(G, pred([3])), call(M, Ans). 949% ?- let(M, mrec([F = ([X]:- X=1)])), call(M, A). 950% ?- let(M, mrec([F = ([1] & [2])])), call(M, A). 951% ?- let(M, mrec([F = ([1] & [2] & ([X]:- X =3))])), call(M, A). 952% ?- let(M, mrec([F = ([1] & [2] & ([A]:- call(pred([I, I]), 3, A)))])), call(M, R). 953 954expand_core(pred(Global, Cs), M, G, P, Q) :-!, 955 ( var(G) -> 956 once(new_pac_name(Global, FC)), 957 attach_prefix(M, FC, G) 958 ; true 959 ), 960 once(expand_pac_clauses(Cs, M, G, P, Q)). 961expand_core(pred(Cs), M, G, P, Q) :-!, 962 expand_core(pred([], Cs), M, G, P, Q). 963expand_core(global(C, Cs), M, G, P, Q) :-!, 964 expand_core(pred(C, Cs), M, G, P, Q). 965expand_core(mrec(C, Defs), M, A, P, Q) :- Defs=[A = _|_], 966 term_variables(C, Vs), 967 maplist(mrec_pred_new_name(Vs), Defs), 968 expand_mrec_system(Defs, M, P, Q). 969expand_core(mrec(Defs), M, G, P, Q) :-!, 970 expand_core(mrec([], Defs), M, G, P, Q). 971expand_core(rec(F, C, Cs), M, G, P, Q) :-!, 972 expand_core(mrec(C, [ F = Cs ]), M, G, P, Q). 973expand_core(rec(F, Cs), M, G, P, Q) :-!, 974 expand_core(mrec([], [ F = Cs ]), M, G, P, Q). 975expand_core(flip(Is, A), M, G, P, Q) :-!, 976 expand_flip(Is, A, M, G, P, Q). 977expand_core(flip(A), M, G, P, Q) :-!, 978 expand_core(flip([2,1],A), M, G, P, Q). 979expand_core(E, M, G, P, Q) :- normal_fun(E, =, E0), !, 980 expand_fun_to_pred(E0, M, G, P, Q). 981 982% ?- eval(flip(is)@(1+2)@V, G), call(G). 983% ?- eval(flip([2,1], is)@(1+2)@V, G), call(G). 984% ?- eval(:flip([2,1], is)@(1+2), V). 985% ?- eval(answer@(:flip([2,1], is)@(1+2)), V). 986% ?- expand_flip([2,1], is, user, G, P, []). 987% ?- eval(flip([2,1], append(A))@[a,b,c,d]@V, G), call(G), A=[a,b]. 988% ?- eval(flip([2,1], append([A,B]))@[A,B,c,d]@V, G), call(G), A=[a,b]. 989% ?- eval(flip([2,1], pred(D, [X,Y]:- append(D, X, Y)))@[A,B,c,d]@V, G), 990% call(G), D = [a,b]. 991 992userflip(Is, A, B):- expand_flip(Is, A, user, B, P, []), 993 maplist(assert, P). 994% 995userflip(A, B):- flip([2,1], A, B). 996 997expand_flip(Is, A, M, G, P, Q):- 998 expand_arg(A, M, A0, P, P0), 999 term_variables(A0, Vs), 1000 length(Is, N), 1001 length(Xs, N), 1002 flip_list(Is, Xs, Ys), 1003 expand_core(pred(Vs, Xs:- apply(A0, Ys)), M, G, P0, Q). 1004% 1005expand_pac_rule_body(_, [], [], P, P):-!. 1006expand_pac_rule_body(M, [H :- B|Ns],[H:-B0|N0s], P, Q):- 1007 once(expand_goal(B, M, B0, P, P0)), 1008 expand_pac_rule_body(M, Ns, N0s, P0, Q). 1009% 1010recursive_pac_name([], F = _) :-!, new_pac_name(F). 1011recursive_pac_name(C, F = _) :- new_pac_name(F0), 1012 complete_args(F0, [C], F). 1013% 1014mrec_pred_new_name(Vs, X = _):- new_pac_name(P), 1015 ( Vs=[] -> X = P 1016 ; Vs=[V] -> X =.. [P, V] 1017 ; X =..[P, Vs] 1018 ). 1019% 1020expand_mrec_pred(Cs, M, A, P, Q) :-!, 1021 attach_prefix(M, A, G), 1022 expand_pac_clauses(Cs, M, G, P, Q). 1023 1024expand_mrec_system(G, [A = E|Es], M, P, Q):- 1025 expand_mrec_system([A = (G=>E)|Es], M, P, Q). 1026% 1027expand_mrec_system([], _, P, P). 1028expand_mrec_system([A = Pred|R], M, P, Q) :- 1029 expand_mrec_pred(Pred, M, A, P, P0), 1030 expand_mrec_system(R, M, P0, Q). 1031 1032% 1033expand_pred_to_ref(pred(Cs), M, PacRef, P, Q) :-!, 1034 expand_pac_clauses(Cs, M, PacRef, P, Q). 1035expand_pred_to_ref(Cs, M, PacRef, P, Q) :- 1036 expand_pac_clauses(Cs, M, PacRef, P, Q). 1037% 1038expand_pac_clauses(Cs, M, PacRef, P, Q) :- 1039 flat(&, Cs, Ds), 1040 maplist(canonical_pred, Ds, Ns), 1041 expand_pac_rule_body(M, Ns, Ns0, P, P0), 1042 maplist(slim_clause(PacRef), Ns0, Es), 1043 append(Es, Q, P0). 1044 1045funs_to_preds(A&B, S, M, A0&B0, P, Q) :-!, 1046 funs_to_preds(A, S, M, A0, P, P0), 1047 funs_to_preds(B, S, M, B0, P0, Q). 1048funs_to_preds(A, S, M, A0, P, Q) :- once(fun_to_pred(A, S, M, A0, P, Q)). 1049 1050% 1051fun_to_pred(A >> R, S, M, G, P, Q) :- \+ is_list(A),!, 1052 fun_to_pred([A] >> R, S, M, G, P, Q). 1053fun_to_pred(L >> R, S, M, L0 :- R0, P, Q):- append(L, [V], L0), 1054 once(expand_exp(R, [], S, V, M, R0, P, Q)). 1055 1056% 1057slim_clause(MFC, Xs :- B, H:-B0):- once(complete_args(MFC, Xs, H)), 1058 reduce:slim_goal(B, B0). 1059 1060% 1061canonical_pred(X, Y) :- 1062 ( is_list(X) -> Y = (X:-true) 1063 ; nonvar(X), 1064 ( X = (H:- B) 1065 ; X = (H >> B) % [2025/05/29] 1066 ), 1067 is_list(H) -> Y = (H:- B) 1068 ; throw('syntax error in closure'(X)) 1069 ). 1070% 1071gensym_pac_name(N) :- nb_current(pac_name_prefix, N), 1072 N \== [], 1073 !. 1074gensym_pac_name('pac#'). 1075% 1076new_pac_name(N) :- var(N), !, 1077 gensym_pac_name(G), 1078 gensym(G, N). 1079new_pac_name(_). 1080 1081% ?- new_pac_name(a+b, R). 1082% ?- new_pac_name(A, R). 1083% ?- new_pac_name(A*B, R). 1084new_pac_name(Global, PacRef) :- new_pac_name(Global, _, PacRef). 1085% 1086new_pac_name(_, _, PacRef) :- nonvar(PacRef), !. 1087new_pac_name(Global, Name, PacRef) :- term_variables(Global, Vs), 1088 canonical_global(Vs, Vs0), 1089 new_pac_name(Name), 1090 ( Vs0 = [] -> 1091 PacRef = Name 1092 ; Vs0 = [A] -> 1093 PacRef =.. [Name, A] 1094 ; PacRef =.. [Name, Vs0] 1095 ).
p(A) when A is the unique varaible in Gp([A1,...,An]) when A1, ..., An are all distinct
variables occurring in G.1105% ?- new_pacref(A+B, P, R). 1106% ?- new_pacref(A + A, P, R). 1107% ?- new_pacref(a+b, P, R). 1108new_pacref(G, PredName, Ref):- term_variables(G, Vs), 1109 new_pac_name(PredName), 1110 ( Vs = [] -> Ref = PredName 1111 ; Vs = [V] -> Ref =.. [PredName, V] 1112 ; Ref =.. [PredName, Vs] 1113 ). 1114 1115% 1116canonical_global(X, X):-is_list(X), !. 1117canonical_global(X, [X]). 1118 1119% expand_arglist/6. 1120expand_arglist([], _, [], true, P, P):-!. 1121expand_arglist([A|As], M, [B|Bs],(H,H0), P, Q) :-!, expandable_meta_arg(A), 1122 once(expand_meta_arg(A, M, B, H, P, P0)), 1123 expand_arglist(As, M, Bs, H0, P0, Q). 1124expand_arglist([A|As], M, [A|Bs], H, P, Q) :- 1125 expand_arglist(As, M, Bs, H, P, Q). 1126 1127% expand_arglist/5 1128expand_arglist([], _, [], P, P):-!. 1129expand_arglist([A|As], M, [B|Bs], P, Q) :- expandable_meta_arg(A),!, 1130 once(expand_arg(A, M, B, P, P0)), 1131 expand_arglist(As, M, Bs, P0, Q). 1132expand_arglist([A|As], M, [A|Bs], P, Q) :- 1133 expand_arglist(As, M, Bs, P, Q). 1134 1135% Variables and applications are not expandable. 1136expandable_meta_arg(A) :- nonvar(A), \+ number(A). 1137 1138% ?- call([X]\ (:X@ 1), =, V). 1139% ?- call([X]\ (X@ 1), =, V). 1140% ?- call(fun([X]-> (:X@ 1)), =, V). 1141% ?- call(fun([X]-> (X@ 1)), =, V). 1142 1143% ?- meta_call(f([1,?,?]), f([a,b,c]), A, B, Y, U, V). 1144meta_call(I, X, A, B, Y, SF, SFV) :- I =..[F,I0], 1145 X=..[_, X0], 1146 Y=..[F, Y0], 1147 once(collect_calls(I0, X0, Y0, A, B, SF, SFV)). 1148 1149% ?- pac:collect_calls([1, ?, ?], [a, b, c], A, B, C, D, E). 1150collect_calls(_, [], [], [], [], [], []):-!. 1151collect_calls([:|X], [A|Y], [B|Z], [A|U], [B|V], P, Q) :-!, 1152 collect_calls(X, Y, Z, U, V, P, Q). 1153collect_calls([^|X], [A|Y], [B|Z], [A|U], [B|V], P, Q) :-!, 1154 collect_calls(X, Y, Z, U, V, P, Q). 1155collect_calls([//|X], [A|Y], [B|Z], U, V, [A|P],[B|Q]) :-!, 1156 collect_calls(X, Y, Z, U, V, P, Q). 1157collect_calls([N|X], [A|Y], [B|Z], [A|U], [B|V], P, Q) :- integer(N),!, 1158 collect_calls(X, Y, Z, U, V, P, Q). 1159collect_calls([_|X], [A|Y], [A|Z], U, V, P, Q) :- 1160 collect_calls(X, Y, Z, U, V, P, Q). 1161 1162 /*********************** 1163 * expand phrase * 1164 ***********************/
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)] .
1176% ?- expand_phrase((call([X]\[X,X],1, V), Y=V), user, G, L, []). 1177% ?- expand_phrase(w(".*"), user, G, L, []). 1178% ?- expand_phrase(wl(".*"), user, G, L, []). 1179% ?- expand_phrase(maplist(phrase(wl(".*"))), user, G, L, []). 1180% ?- phrase(append@[a], [b,c], R). 1181% ?- phrase(pred([X,Y] :- append([a], X, Y)), [b,c], R). 1182% ?- phrase(fun([X] -> :append([a, b], X)), [c,d], R). 1183% ?- phrase(pred([X, Y] :- append([a,b])@X@Y), [c, d], R). 1184% ?- let(F, pred([X,Y,Z] :- append(X, Y, Z))), phrase(F@[a], [b,c], V). 1185% ?- let(F, (pred([X,Y,Z] :- append(X, Y, Z)))). 1186% ?- let(F, pred([X,Y,Z] :- append(X, Y, Z))), phrase(F@[a], [b,c], V). 1187 1188expand_phrase(X, _, X, P, P) :- var(X), !. 1189expand_phrase(M:X, N, Y, P, Q) :-!, update_prefix(M, N, N0), 1190 expand_phrase(X, N0, Y, P, Q). 1191expand_phrase((X,Y), M, (X0, Y0), P, Q) :-!, 1192 expand_phrase(X, M, X0, P, P0), 1193 expand_phrase(Y, M, Y0, P0, Q). 1194expand_phrase((X|Y), M, G, P, Q) :-!, expand_phrase((X;Y), M, G, P, Q). 1195expand_phrase((X;Y), M, (X0;Y0), P, Q) :-!, 1196 expand_phrase(X, M, X0, P, P0), 1197 expand_phrase(Y, M, Y0, P0, Q). 1198expand_phrase((X->Y), M, (X0->Y0), P, Q) :-!, 1199 expand_phrase(X, M, X0, P, P0), 1200 expand_phrase(Y, M, Y0, P0, Q). 1201expand_phrase(\+(X), M, \+(Y), P, Q) :-!, expand_phrase(X, M, Y, P, Q). 1202expand_phrase({E}, M, {E0}, P, Q) :-!, once(expand_goal(E, M, E0, P, Q)). 1203expand_phrase(X@Y, M, ({H}, G), P, Q) :-!, 1204 expand_meta_arg(X@Y, M, G, H, P, Q). 1205expand_phrase(X, _, X, P, P) :- is_list(X), !. % for not loading files. 1206expand_phrase(X, _, Y, P, P) :- string(X), !, string_codes(X, Y). 1207expand_phrase(bind(X), M, bind(Y), P, Q) :- !, % for bind_bind 1208 expand_phrase(X, M, Y, P, Q). 1209expand_phrase(shift(X), _, {shift(Y)}, P, Q) :-!, 1210 expand_arg(X, [], Y, P, Q). 1211expand_phrase(sed(X), M, Y, P, Q) :-!, must_be(nonvar, X), 1212 expand_sed(X, [F, W, A]), 1213 !, 1214 expand_recognize_act(F, W, A, M, Y, P, Q). 1215expand_phrase(X, M, G, P, Q) :- once(expand_basic_phrase(X, M, G, P, Q)). 1216 1217% ?- expand_basic_phrase(maplist(maplist(phrase(wl(".")))), user, G, P, []). 1218 1219% Let ^ and >> be associative with each other. 1220expand_sed((F^W)>>A, [F, W, A]). 1221expand_sed(F^(W >> A), [F, W, A]). 1222expand_sed(W >> A, [[], W, A]). 1223expand_sed(s/Regex/S, [[], w(Regex),S]). 1224expand_sed(sl/Regex/S, [[], wl(Regex), S]). 1225expand_sed(a/Regex/B, [[], w(Regex, X), (X + B)]). 1226expand_sed(al/Regex/B, [[], wl(Regex, X), (X + B)]). 1227expand_sed(b/Regex/B, [[], w(Regex, X), (B + X)]). 1228expand_sed(bl/Regex/B, [[], wl(Regex, X), (B + X)]). 1229expand_sed(d/Regex, X) :- expand_sed(s/Regex/ "", X). 1230expand_sed(dl/Regex, X) :- expand_sed(sl/Regex/ "", X). 1231expand_sed(w/Regex/Before/After, [[], w(Regex, X), (Before + X + After)]). 1232expand_sed(wl/Regex/Before/After, [[], wl(Regex, X), (Before + X + After)]). 1233 1234% ?- expand_phrase(bind(a), [], G, P, []). 1235warning_w(E) :- write( 'non ground compound regex found: '), 1236 writeln(E). 1237 1238% ?- expand_phrase(w("a+b"), user, G, P, []). 1239% ?- expand_phrase(w("a"), user, G, P, []). 1240% ?- expand_phrase(w("aa"), user, G, P, []). 1241% ?- expand_w("a", user, _G5350, _G5351, []). 1242 1243expand_basic_phrase(X, Y, Z, U) :- 1244 once(expand_basic_phrase(X, Y, Z, U, [])). 1245 1246% 1247expand_basic_phrase(w(E), _, w(E), P, P) :- var(E), !. 1248expand_basic_phrase(w(E), M, Y, P, Q) :-!, 1249 expand_w(E, M, Y, P, Q). 1250expand_basic_phrase(w(E, A), M, Y, P, Q) :-!, 1251 expand_w(E, A, [], M, Y, P, Q). 1252expand_basic_phrase(w(E, A, B), M, Y, P, Q) :-!, 1253 expand_w(E, A, B, M, Y, P, Q). 1254expand_basic_phrase(wl(E), _, wl(E), P, P) :- var(E), !. 1255expand_basic_phrase(wl(E), M, Y, P, Q) :-!, 1256 expand_wl(E, M, Y, P, Q). 1257expand_basic_phrase(wl(E, A), M, Y, P, Q) :-!, 1258 expand_wl(E, A, [], M, Y, P, Q). 1259expand_basic_phrase(wl(E, A, B), M, Y, P, Q) :-!, 1260 expand_wl(E, A, B, M, Y, P, Q). 1261expand_basic_phrase(S::E, M, F, P, R) :-!, 1262 once(expand_exp(E, S, V, M, G, P, Q)), 1263 term_variables(S-E, Vs), 1264 once(expand_core(pred(Vs, [V] :- G), M, F, Q, R)). 1265expand_basic_phrase(X, M, G, P, Q) :- once(expand_basic(X, M, G, P, Q)). 1266 1267% ?- expand_basic(maplist(phrase(wl("."))), user, G, P, []). 1268% ?- expand_basic(maplist(=(a), []), user, G, P, []). 1269% ?- expand_basic_phrase(maplist(phrase(wl("."))), user, G, P, []). 1270% ?- predicate_property(profile(a=b), meta_predicate(P)). 1271% ?- predicate_property(call(a=b, b), meta_predicate(P)). 1272% ?- predicate_property(call(a=b, b,c), meta_predicate(P)). 1273% ?- expand_basic(maplist(phrase(=), [[a]], R), user, G, P, []). 1274% ?- expand_basic(maplist(phrase(wl(".")), [[a]], R), user, G, P, []). 1275% ?- expand_basic(maplist(phrase(wl(".")), [[a]], R), user, G, P, []). 1276% ?- predicate_property(xxx:maplist(phrase(=), X, Y), meta_predicate(U)). 1277 1278% ?- expand_basic(call(X, Y), user, G, P, []). 1279% ?- expand_basic(setup_call_cleanup(X, Y, Z), user, G, P, []). 1280% ?- expand_basic(setup_call_cleanup(pred([]):-true, Y, Z), user, G, P, []). 1281 1282expand_basic(E, M, G, P, Q) :- expand_core(E, M, G, P, Q) 1283 ; expand_etc(E, M, G, P, Q) 1284 ; expand_atomic_goal(E, M, E0, H, P, P0), 1285 expand_meta_args(E0, M, G0, P0, Q), 1286 slim_goal((H, G0), G). 1287 1288% ?- meta_property(user:call(A@B, C), U). 1289% ?- expand_meta_args(user:call(X@Y), user, U, P, []). 1290expand_meta_args(X, _, X, P, P) :- var(X), !. 1291expand_meta_args(M:X, _, Y, P, Q) :-!, expand_meta_args(X, M, Y, P, Q). 1292expand_meta_args((X,Y), M, (X0, Y0), P, Q) :- !, 1293 expand_meta_args(X, M, X0, P, P0), 1294 expand_meta_args(Y, M, Y0, P0, Q). 1295expand_meta_args((X;Y), M, (X0;Y0), P, Q) :-!, 1296 expand_meta_args(X, M, X0, P, P0), 1297 expand_meta_args(Y, M, Y0, P0, Q). 1298expand_meta_args(E, M, G, P, Q):- 1299 meta_property(M:E, U), 1300 !, 1301 U=..[_|As], 1302 E=..[E0|Bs], 1303 expand_meta_arg_list(As, Bs, M, Cs, Aux, P, Q), 1304 G0=..[E0|Cs], 1305 slim_goal((Aux, M:G0), G). 1306expand_meta_args(E, M, Em, P, P):-attach_prefix(M, E, Em). 1307% 1308indicator_for_meta(:):-!. 1309indicator_for_meta(A):- integer(A). 1310% 1311expand_meta_arg_list([], _, _, [], true, P, P):-!. 1312expand_meta_arg_list([A|As], [B|Bs], M, [C|Cs], (Pre, Pre0), P, Q):- 1313 indicator_for_meta(A), 1314 expand_meta_arg(B, M, C, Pre, P, P0), !, 1315 expand_meta_arg_list(As, Bs, M, Cs, Pre0, P0, Q). 1316expand_meta_arg_list([_|As], [B|Bs], M, [B|Cs], Pre, P, Q):- 1317 expand_meta_arg_list(As, Bs, M, Cs, Pre, P, Q). 1318% 1319 :- meta_predicate expand_arg_assert(, ). 1320 :- meta_predicate expand_arg_compile(, ). 1321expand_arg_assert(X, Y) :- expand_arg(X, [], Y, P, []), 1322 ignore(maplist(assert, P)). 1323% 1324expand_arg_compile(X, Y) :- expand_core(X, [], Y, P, []), 1325 ignore(pac_compile_aux_clauses(P)). 1326% 1327expand_meta_arg(X, _, X, true, P, P) :- var(X), !. 1328expand_meta_arg(M:X, _, M:X, true, P, P) :- var(X), !. % ad hoc ? 1329expand_meta_arg(X@Y, M, U, H, P, Q) :-!, 1330 expand_exp(X@Y, [], =, U, M, H, P, Q). 1331expand_meta_arg(M:X, N, Y, H, P, Q) :-!, update_prefix(M, N, N0), 1332 expand_meta_arg(X, N0, Y, H, P, Q). 1333expand_meta_arg(X, _, Y, true, P, P) :- (string(X); is_list(X)), !, Y = X. 1334expand_meta_arg((X,Y), M, (X0, Y0), (G0, H0), P, Q) :-!, 1335 expand_meta_arg(X, M, X0, G0, P, P0), 1336 expand_meta_arg(Y, M, Y0, H0, P0, Q). 1337expand_meta_arg(X, M, Z, true, P, Q) :- once(expand_basic(X, M, Z, P, Q)). 1338 1339% ?- eval(:(fun([X]>>X)) @2, R). 1340% ?- eval(:pred([X,X]) @2, R). 1341% ?- pac:expand_exp(fun([X]>>X), [], =, U, user, H, P, []). 1342expand_arg(X, _, X, P, P) :- var(X), !. 1343expand_arg(X, M, G, P, Q) :- 1344 ( expand_meta_arg(X, M, G, H, P, Q), 1345 H = true 1346 -> true 1347 ; throw('NON ATOMIC meta argument found.') 1348 ). 1349% 1350canonical_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.
1365% ?- maplist((pred([a])), [X,Y]).
1366% ?- eval(append([a,b],[c,d]), V).
1367% ?- E=1, eval(E, V).
1368% ?- E =append([a,b],[c,d]), eval(:E, V).
1369% ?- E =append([a,b],[c,d]), eval(E, V).
1370% ?- E =append([a,b],[c,d]), eval(E, V, [goal(G)]).
1371% ?- E =append([a,b],[c,d]), eval(E, V, [goal(G)]), call(G).
1372% ?- eval(xargs(fun([a,b]>>p(X,Y))), V).
1373% ?- 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.1391eval(E, V):- context_module(M), 1392 expand_exp(E, =, V, M, G, P, []), !, 1393 maplist_assert(P), 1394 call(G). 1395% 1396eval(E, V, Opts):- eval_options(Opts, K, M, P, G), 1397 expand_exp(E, K, V, M, G, P, []), !, 1398 maplist_assert(P), 1399 ( ( memberchk(run, Opts); memberchk(run(true), Opts)) 1400 -> call(G) 1401 ; true 1402 ). 1403% 1404eval_options(Opts, K, M, P, G):- 1405 ( memberchk(kind(K), Opts) -> true 1406 ; K = (=) 1407 ), 1408 ( memberchk(module(M), Opts) -> true 1409 ; context_module(M) 1410 ), 1411 ( memberchk(aux(P), Opts) -> true 1412 ; true 1413 ), 1414 ( memberchk(goal(G), Opts) -> true 1415 ; true 1416 ). 1417 1418% 1419assert_dlist(P) :- var(P), !. 1420assert_dlist([]). 1421assert_dlist([C|P]) :- assert_one(C), 1422 assert_dlist(P). 1423 1424% 1425expand_dict_clause_olist(P0, P) :- var(P0), !, P = P0. 1426expand_dict_clause_olist([], []) :- !. 1427expand_dict_clause_olist([C|Cs], [D|Ds]) :- 1428 expand_dict_clause(C, D), 1429 expand_dict_clause_olist(Cs, Ds). 1430 1431% 1432unify_options([], _). 1433unify_options([A|R], Options) :- memberchk(A, Options), !, 1434 unify_options(R, Options). 1435unify_options([_|R], Options) :- unify_options(R, Options). 1436 1437 /************************************************** 1438 * expanding limited functional expressions * 1439 **************************************************/
1444% 1445% True if G is a goal such that execution of G 1446% unifies a term U with the value of expression E, 1447% where H is the helper predidates for G generated as 1448% a difference list P with a tail Q, i.e, append(H, Q, P) is true. 1449% Typically atomic subgoals of G are of the form M:S(A, B). 1450% expand_exp/7 is used when compiling an equations in a kind, 1451% a set of equations, to a clause of the predicate M:S/2. 1452% 1453% Simplest usage: 1454% ?- expand_exp(f(a), k, V, m, G, P, []). 1455% G = m:k(f(a), V), 1456% P = []. 1457% 1458% ?- expand_exp(f(a), call, V, m, G, P, []). 1459% G = m:f(a, V), 1460% P = []. 1461% 1462% ?- expand_exp(=(hello), call, V, user, G, P, []). 1463% G = user: (hello=V), 1464% P = []. 1465% 1466% Features: 1467% 1. PAC/Lambda/Kind are macros expanded on loading. 1468% 2. The sorted expression `(S :: E) = V' is eqivalent to `S(E, V)'. 1469% 3. Backquote '`' is for quoting term. 1470% 4. no special runtime predicate is necessary. 1471% 5. Arguments (in @ ) is evaluated before call. 1472% 6. let/2 for dynamic compiling pacs. 1473 1474% ?- expand_exp(misc:set(pow@A), =, E, [], G, P, []), write(G), A = [1,2], call(G). 1475 1476% ?- expand_exp(f(a)@b, =, V, m, G, P, []). 1477% ?- expand_exp(append(a)@b@c, =, V, m, G, P, []). 1478% ?- expand_exp((misc:set):: (pow@A), =, E, [], G, P, []), A = [1,2], call(G). 1479% ?- expand_exp(misc:set(pow(A)), =, E, [], G, P, []), A = [1,2], call(G). 1480% ?- expand_exp(misc:set::pow@A, =, E, [], G, P, []), A = [1,2], call(G). 1481% ?- expand_exp((X\X), =, V, user, G, P, []). 1482% ?- expand_exp(X\(X\X), =, V, user, G, P, []). 1483% ?- expand_exp(pow@[1,2], set, E, [], X, P, []). 1484% ?- expand_exp('`'(pow)@[1,2], set, E, [], X, P, []). 1485% ?- expand_exp(pow@[1,2], misc:set, E, [], X, P, []), call(X). 1486% ?- expand_exp(pow(pow([1,2])), misc:set, E, [], X, P, []), call(X). 1487% ?- expand_exp(pow@(pow([1,2])), misc:set, E, [], X, P, []), call(X). 1488% ?- expand_exp(pow@(pow@[1,2]), misc:set, E, [], X, P, []), call(X). 1489% ?- expand_exp('`'(pow)@(pow@[1,2]), misc:set, E, [], X, P, []), call(X). 1490% ?- expand_exp(:ff(a), word_am, V, user, G, P, []). 1491% ?- expand_exp((math:powerset)@A, set, V, misc, G, P, []). 1492% ?- expand_exp(1, [], set, V, user, G, P, []). 1493% ?- expand_exp(X, [], set, V, user, G, P, []). 1494% ?- expand_exp(X, [], call, V, user, G, P, []). 1495% ?- expand_exp(pow, [a], set, V, user, G, P, []). 1496% ?- expand_exp(append, [[a],[b]], call, V, user, G, P, []), call(G). 1497% ?- expand_exp(:append, [a,b], set, V, user, G, P, []). 1498% ?- expand_exp(append, [a,b], set, V, user, G, P, []). 1499% ?- expand_exp(m:append, [a,b], set, V, user, G, P, []). 1500% ?- expand_exp(quote(append), [a,b], call, V, user, G, P, []). 1501% ?- expand_exp('`'(append(x)), [a,b], call, V, user, G, P, []). 1502% ?- expand_exp(pred([X,X,X]), [a,b], call, V, user, G, P, []). 1503% ?- expand_exp(pred([X,Y,X+Y]), [a,b], call, V, user, G, P, []). 1504% ?- expand_exp(a@b, [], set, V, user, G, P, []). 1505% ?- expand_exp(a@b, [1, 2], set, V, user, G, P, []). 1506% ?- expand_exp(append@[a,b]@[c,d], call, V, user, G, P, []), call(G). 1507% ?- expand_exp(F@X@Y, call, V, user, G, P, []). 1508% ?- expand_exp(F@X@Y, set, V, user, G, P, []). 1509% ?- expand_exp(F@ X @ Y, call, V, user, G, P, []). 1510% ?- expand_exp(F@ (S @ X)@ (T@ Y), call, V, user, G, P, []). 1511% ?- expand_exp(F@ (S @ X)@ (T@ Y), set, V, user, G, P, []). 1512% ?- expand_exp(F@ (S @ X)@ (T@ Y), Unknown, V, user, G, P, []). 1513% ?- nopac( expand_exp((pred([X,Y,Z]))@a@b, [], set, V, user, G, P, [])). 1514% ?- expand_exp(([X]\X)@2, [], set, V, user, G, P, []). 1515% ?- expand_exp('`'(and)@(imply@X@Y)@(imply@Y@X), [], macro, V, user, G, P, []). 1516% ?- expand_exp(:union, [a, b], set, V, user, G, P, []). 1517% ?- expand_exp((:union)@a, [], set, V, user, G, P, []). 1518% ?- expand_exp(a, call, V, user, G, P, []). 1519% ?- expand_exp(A, call, V, user, G, P, []). 1520% ?- expand_exp(A@a, call, V, user, G, P, []). 1521% ?- expand_exp(A@a, set, V, user, G, P, []). 1522% ?- expand_exp(A@a, S, V, user, G, P, []). 1523% ?- expand_exp({a:1}, [], =, V, [], G, P, []). 1524% ?- expand_exp({b:{a:1}}, [], =, V, [], G, P, []). 1525% ?- expand_exp(:F, [], call, V, [], G, P, []). 1526 1527% ?- eval((:), X). % to get the current module prefix 1528% ?- eval((::), X). % to get the current kind prefix 1529% ?- eval(a@(::)@(:), V). 1530% ?- eval(f@(a@(::)@(:)), V). 1531 1532% expand_exp/7 1533expand_exp(E, S, U, M, G, P, Q):- 1534 once(expand_exp(E, [], S, U, M, G, P, Q)). 1535 1536% expand_exp/8 1537expand_exp(E, L, S, V, M, G, P, P):- var(E), !, 1538 expand_exp_var(L, E, S, V, M, G). 1539expand_exp(E, _, _, E, _, true, P, P):- canonical_exp(E), !. 1540expand_exp(E, L, _, G, M, true, P, Q):- expand_core(E, M, E0, P, Q), !, 1541 complete_args(E0, L, G). 1542expand_exp(::(S, E), L, _, V, M, G, P, Q):-!, 1543 expand_exp(E, L, S, V, M, G, P, Q). 1544expand_exp(::, _, S, S, _,true, P, P):- !. 1545expand_exp(@(E, E0), L, S, V, M, H, P, Q):- !, 1546 eliminate_atmark(E, [E0], [F|L0]), 1547 expand_exp_list(L0, S, L1, M, G, P, P0), 1548 append(L1, L, L2), 1549 expand_exp(F, L2, S, V, M, G1, P0, Q), 1550 slim_exp_goal((G, G1), H). 1551expand_exp(@(E), L, S, V, M, H, P, Q):- !, 1552 expand_exp(E, [], S, E0, M, H0, P, P0), 1553 expand_exp(E0, L, S, V, M, H1, P0, Q), 1554 slim_exp_goal((H0, H1), H). 1555expand_exp(@@(E), _, S, E0, M, H, P, P):- !, 1556 copy_term(E, E0), 1557 term_variables(E, Vs), 1558 term_variables(E0, V0s), 1559 maplist(make_kind_call(S, M), Vs, V0s, Calls), 1560 list_to_comma(Calls, H0), 1561 slim_exp_goal(H0, H). 1562expand_exp($(E), L, S, V, M, H, P, Q):-!, 1563 call(E, E0), 1564 expand_exp(E0, L, S, V, M, H, P, Q). 1565expand_exp(quote(E), L, _S, E0, _, true, P, P):-!, 1566 ( var(E) -> E0 = E; complete_args(E, L, E0) ). 1567expand_exp('`'(E), L, S, V, M, G, P, Q):-!, 1568 expand_exp(quote(E), L, S, V, M, G, P, Q). 1569expand_exp(:, _, _, M, M, true, P, P):-!. % get the current module prefix. 1570expand_exp(:(E), L, _, V, M, G, P, Q):-!, 1571 expand_exp(E, [], =, E0, M, G0, P, Q), 1572 append(L, [V], L0), 1573 complete_args(M:E0, L0, G1), 1574 slim_exp_goal((G0, G1), G). 1575expand_exp(M:E, L, _, M:E0, _, G, P, Q):-!, 1576 expand_exp(E, L, =, E0, M, G, P, Q). 1577expand_exp(#(E), L, S, V, M, G, P, Q):-!, 1578 expand_exp(E, [], S, E0, M, G0, P, P0), 1579 expand_exp(E0, L, S, V, M, G1, P0, Q), 1580 slim_exp_goal((G0, G1), G). 1581expand_exp(xargs(PredFun), L, S, V, M, G, P, Q):-!, 1582 expand_xargs(PredFun, L, S, V, M, G, P, Q). 1583expand_exp({X}, _L, _S, V, M, G, P, Q):-!, 1584 ( chk_odict 1585 -> anti_subst({X}, V, Aux), 1586 anti_subst:expand_aux(Aux, M, G, P, Q) 1587 ; V = {X}, G=true, Q = P 1588 ). 1589expand_exp(X, _, S, V, M, H, P, Q):- is_role(X, A, B), !, 1590 expand_dict_access(A, S, V0, M, H0, P, P0), 1591 expand_dict_access(V0, B, S, V, M, H1, P0, Q), 1592 slim_exp_goal((H0, H1), H). 1593expand_exp(E, L, S, V, M, G, P, P):- S == call, !, 1594 attach_prefix(M, E, E0), 1595 append(L, [V], L0), 1596 complete_args(E0, L0, G). 1597expand_exp(E, L, S, V, _, true, P, P):- S == (=), !, 1598 complete_args(E, L, V). 1599expand_exp(E, L, S, V, M, G, P, P):- 1600 attach_prefix(M, S, S0), 1601 complete_args(E, L, E0), 1602 complete_args(S0, [E0, V], G). 1603% 1604expand_xargs(Params :- Goal, Args, _, V, M, G, P, Q):-!, 1605 append(Args, _, Params), 1606 last(Params, V), % last argument is for output. 1607 expand_goal(Goal, M, G, P, Q). 1608expand_xargs(Fun, Args, _, V, M, G, P, Q):- 1609 normal_fun(Fun, =, fun(_, _, Params>>Exp)), 1610 append(Args, Args0, Params), 1611 expand_exp(Exp, Args0, =, V, M, G, P, Q). 1612 1613% 1614normal_fun(fun(X\E), S, fun(S, [], X>>E)). 1615normal_fun(fun(X->E), S, fun(S, [], X>>E)). 1616normal_fun(fun(X>>E), S, fun(S, [], X>>E)). 1617normal_fun(fun(S, A, Funs), _, fun(S, A, Funs)). 1618normal_fun(fun(A, Funs), S, fun(S, A, Funs)). 1619normal_fun(X\E, S, fun(S, [], X>>E)). 1620normal_fun(X>>E, S, fun(S, [], X>>E)). 1621 1622% 1623expand_fun_to_pred(fun(S, A, Funs), M, G, P, Q) :- 1624 funs_to_preds(Funs, S, M, Clauses, P, P0), 1625 expand_core(pred(A, Clauses), M, G, P0, Q). 1626 1627% expand_dict_access 1628% /7. 1629% ?- pac:expand_dict_access(role(X, a), =, V, user, H, P, []). 1630% ?- pac:expand_dict_access(role(role(X,a), b), =, V, user, H, P, []). 1631% ?- pac:expand_dict_access(role(X, a(k)), =, V, user, H, P, []). 1632% ?- pac:expand_dict_access(role(X, role(Y, a)), =, V, user, H, P, []). 1633expand_dict_access(X, S, V, M, H, P, Q):- nonvar(X), is_role(X, A, B), !, 1634 expand_dict_access(A, S, V0, M, H0, P, P0), 1635 expand_dict_access(V0, B, S, V, M, H1, P0, Q), 1636 slim_exp_goal((H0, H1), H). 1637expand_dict_access(X, S, D, M, H, P, Q):- expand_exp(X, S, D, M, H, P, Q). 1638% /8. 1639expand_dict_access(X, R, S, V, M, H, P, Q):- nonvar(R), is_role(R, _, _), !, 1640 expand_dict_access(R, S, V0, M, H0, P, P0), 1641 expand_dict_access(X, V0, S, V, M, H1, P0, Q), 1642 slim_exp_goal((H0, H1), H). 1643expand_dict_access(X, K, _, V, _M, H, P, Q):- 1644 expand_exp(K, =, K0, [], H0, P, Q), 1645 slim_goal((H0, role(K0, X, V)), H). 1646 1647% 1648expand_role_list(Y, S, Path, M, H, P, Q):- nonvar(Y), is_role(Y, Y1, Y2), !, 1649 expand_role_list(Y1, S, Path1, M, H1, P, P0), 1650 expand_role_list(Y2, S, Path2, M, H2, P0, Q), 1651 slim_exp_goal((H1, H2, append(Path1, Path2, Path)), H). 1652expand_role_list(Y, S, [V], M, H, P, Q):- 1653 expand_exp(Y, S, V, M, H, P, Q). 1654 1655% 1656expand_exp_list([], _, [], _ , true, P, P). 1657expand_exp_list([E|L], S, [E0|L0], M, (G, G0), P, Q):- 1658 expand_exp_arg(E, S, E0, M, G, P, R), 1659 expand_exp_list(L, S, L0, M, G0, R, Q). 1660 1661% expand_exp_var/6 1662expand_exp_var([], E, S, V, M, call(M:S, E, V)):-!. 1663expand_exp_var(L, E, S, V, M, '$kind'(S, E, L, V, M)). 1664 1665 1666% ?- eval((E::Pow)@A, X, [goal(G)]), Pow = pow, E=misc:set, A=[a,b], call(G). 1667 1668% Run time for eval. 1669user'$kind'(S, E, L, V, M):- 1670 ( ( nonvar(S); nonvar(E); nonvar(M) ) -> 1671 complete_args(E, L, E0), 1672 call(M:S, E0, V) 1673 ; throw(uninstantiated_variable_with('$kind')) 1674 ). 1675% 1676 1677expand_exp_arg(E, S, U, M, G, P, Q) :- 1678 once(expand_exp_basic_arg(E, S, U, M, G, P, Q)). 1679expand_exp_arg(E, S, U, M, G, P, Q) :- 1680 once(expand_exp(E, [], S, U, M, G, P, Q)). 1681 1682% 1683expand_exp_basic_arg(E, S, U, M, G, P, P):- var(E), !, 1684 ( ( S = call; S = (=) ) 1685 -> U = E, 1686 G = true 1687 ; attach_prefix(M, S, S0), 1688 complete_args(S0, [E,U], G) 1689 ). 1690expand_exp_basic_arg(E, _, E, _, true, P, P):- canonical_exp(E), !. 1691expand_exp_basic_arg(E, _, U, M, true, P, Q):- 1692 once( expand_core(E, M, U, P, Q) 1693 ; expand_etc(E, M, U, P, Q) 1694 ). 1695% 1696eliminate_atmark(E, L, [E|L]):- var(E). 1697eliminate_atmark(@(E,E0), L, L0):- eliminate_atmark(E, [E0|L], L0). 1698eliminate_atmark(E, L, [E|L]). 1699 1700% some tiny runtime. 1701list_to_comma([X,Y|Z], (X, U)):- list_to_comma([Y|Z], U). 1702list_to_comma([X], X). 1703list_to_comma([], true). 1704 1705% 1706nopac(X):- call(X). % to prevent from pac-expansion 1707 1708% 1709flat(X, Y, Z):- once(flat(X, Y, Z, [])). 1710% 1711flat(_, A, [A|P], P):- var(A). 1712flat(;, A;B, P, Q):- flat(;, A, P, P0), 1713 flat(;, B, P0, Q). 1714flat(&, A&B, P, Q):- flat(&, A, P, P0), 1715 flat(&, B, P0, Q). 1716flat(_, A, [A|P], P). 1717 1718% 1719attach_prefix_head(M, X:-Y, MX:-Y):- 1720 attach_prefix(M, X, MX). 1721 1722% ?- pac_to_pred([X], U). 1723pac_to_pred(X, _):- var(X), throw(pac_syntax_error(X)). 1724pac_to_pred(H:-G, [P, F, G]):- pac_to_pred_head(H, [P,F]). 1725pac_to_pred(H, [P, F,true]):- pac_to_pred_head(H, [P,F]). 1726 1727% 1728pac_to_pred_head(P, _):- var(P), throw(pac_syntax_error(P)). 1729pac_to_pred_head(P, [P, []]):- is_list(P). 1730pac_to_pred_head(P, _) :- throw(pac_syntax_error(P)). 1731 1732% ?- meta_property(maplist(0), I). 1733% ?- meta_property(xxx:maplist(=(0), _), I). 1734meta_property([]:E, I):-!, meta_property(E, I). 1735meta_property(E, I) :- predicate_property(E, meta_predicate(I)). 1736 1737% 1738slim_exp_goal(G, G0):- once(slim_exp_aux(G, G1)), 1739 reduce:slim_goal(G1, G0). 1740% 1741slim_exp_aux(M:A, M:B):- slim_exp_aux(A, B). 1742slim_exp_aux((X=Y), true):- X==Y. 1743slim_exp_aux((H,G), (H0, G0)):- slim_exp_aux(H, H0), 1744 slim_exp_aux(G, G0). 1745slim_exp_aux(X, G):- X =.. [xargs, Pred |Args], 1746 pass_xargs(Pred, Args, G). 1747slim_exp_aux(H, H). 1748 1749% ?- pass_xargs([X,Y]:- a(X,Y), [1], G). 1750% ?- pass_xargs([X,Y]:- pred(X, [U]:-a(X,Y)), [1], G). 1751 1752pass_xargs(Ps :- Body, Args, G):-!, 1753 append(Args, _, Ps), 1754 slim_exp_goal(Body, G). 1755pass_xargs(Ps, Args, true):- is_list(Ps),!, 1756 append(Args, _, Ps). 1757pass_xargs(F, [A, B], G):- complete_args(F, [B, A], G). 1758 1759% 1760make_kind_call(S, M, V, U, call(M:S, V, U)). 1761% 1762make_kind_list(_, _, [], [], _, true, P, P). 1763make_kind_list(F, S, [V|Vs], [U|Us], M, (G, U=U0, Gs), P, Q):- 1764 once(expand_exp(F@V, S, U0, M, G, P, P0)), 1765 make_kind_list(F, S, Vs, Us, M, Gs, P0, Q). 1766 1767 1768% ?- trace, binary_flip(a=b, X). 1769 1770% 1771partial_args_match([],_). 1772partial_args_match(_,[]). 1773partial_args_match([A|As],[A|Bs]):- partial_args_match(As, Bs). 1774 1775% % Tiny helpers 1776% zip([A|B], [C|D], [A-C|R]):- zip(B, D, R). 1777% zip([], [], []). 1778 1779% ?- flip_clause(f, [], f, X). 1780% ?- flip_clause(f, [1,2], f(a,b), X). 1781% ?- flip_clause(f, [2,1], f(a,b), X). 1782% ?- flip_clause(f, [1,3,2], f(a,b,c), X). 1783% ?- flip_clause(f, [1,3,2],(f(a,b,c):- true, g(a), f(x, y, z)), X). 1784 1785flip_clause(F, P, T, T0):- 1786 walk_term(T, T0, flip_functor_args(F, P)). 1787% 1788flip_functor_args(F, P, T, T0):- 1789 T =.. [F|As], 1790 length(P, N), 1791 length(As, N), 1792 flip_list(P, As, Bs), 1793 T0 =.. [F|Bs]. 1794flip_functor_args(_, _, T, T). 1795 1796% ?- walk_term((a,b), X, =). 1797% ?- walk_term(a:-b, X, =). 1798% ?- walk_goal(a:-b, X, =). 1799walk_term(A, A, _) :- var(A). 1800walk_term(M:A, M:B, F):- walk_term(A, B, F). 1801walk_term(H:-B, H0:-B0, F):- walk_term(H, H0, F), once(walk_goal(B, B0, F)). 1802walk_term(A, A0, F):- call(F, A, A0). 1803 1804% ?- walk_goal((a,b), X, =). 1805walk_goal(A,A,_) :- var(A). 1806walk_goal((A0,B0), (A,B), F) :- walk_goal(A0, A, F), walk_goal(B0, B, F). 1807walk_goal((A0;B0), (A,B), F) :- walk_goal(A0, A, F), walk_goal(B0, B, F). 1808walk_goal((A0->B0), (A->B), F) :- walk_goal(A0, A, F), walk_goal(B0, B, F). 1809walk_goal(\+(A0), \+(A), F) :- walk_goal(A0, A, F). 1810walk_goal(M:A, M:A0, F):- walk_goal(A, A0, F). 1811walk_goal(A, A0, F):- call(F, A, A0), !