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