1:-module(lambda,[pac_calc/2, pac_lisp/2]). 2:- use_module(library(apply)). 3:- use_module(library(gensym)). 4:- use_module(pac(op)). 5 6% pac_calc/2 7% ?- pac_calc(X\X, V). 8% ?- pac_calc((X\X)@1, V). 9% ?- pac_calc((X\X)@(Y\Y), V). 10% ?- pac_calc((X\X)@(Y\Y)@(Z\Z), V). 11% ?- pac_calc((X\X)@(Y\Y)@(Z\Z)@hello, V). 12% ?- pac_calc(X^((X\X)@1), V). 13% ?- pac_calc((X\X)@(X\X)@hello, V). 14% ?- pac_calc((X\X)@(X\X), V). 15 16pac_calc(X, Y):- pac_calc(X, [], Y, _). 17 18pac_calc(X, F, Y, G):- pac_calc_one(X, F, X0, F0), !, 19 pac_calc(X0, F0, Y, G). 20pac_calc(X, F, X, F). 21 22pac_calc_one(X, F, Y, G):- 23 subtree([(@), (\)/2, (^)/2], X, Y, S, T), 24 clause(pac_calc_rule(S0, F, T, G), Body), 25 subsumes_term(S0, S), 26 S=S0, 27 call(Body). 28 29%% 30pac_calc_rule(F^M, F0, M, G):- term_variables((F, F0), G). 31pac_calc_rule((P\M)@A, G, N, G):- copy_term((G,P,M), (G,A,N)).
36% ?- pac_lisp([append, [a], []], V). 37% ?- pac_lisp([append, [a,b], [c,d]], V). 38% ?- pac_lisp([not, t], R). 39% ?- pac_lisp([not, []], R). 40 41pac_lisp(E, V):- pac_lisp(E, V, []). 42 43pac_lisp([], [], _):-!. 44pac_lisp([quote, A|_], A, _):-!. 45pac_lisp(A^E, V, B):- !, term_variables((A, B), C), pac_lisp(E, V, C). 46pac_lisp([(Xs\E)|L], V, A):- !, pac_lisp_(L, L0, A), 47 copy_term((A, Xs, E), (A, L0, F)), 48 pac_lisp(F, V, A). 49pac_lisp([=, X, Y], R, A):- !, pac_lisp(X, U, A), 50 pac_lisp(Y, V, A), 51 ( U==V -> R=t; R=[]). 52pac_lisp([if, C, X|Ys], V, A):- !, pac_lisp(C, B, A), 53 ( B\==[] 54 -> pac_lisp(X, V, A) 55 ; pac_lisp_(Ys, Zs, A), 56 last(Zs, V) 57 ). 58pac_lisp([and|L], V, A):-!,pac_lisp_and(L,V,A). 59 60pac_lisp([F|L], V, A):- defun(F, G), !, pac_lisp([G|L], V, A). 61pac_lisp(X, X, _):- !. 62 63% 64pac_lisp_([], [], _). 65pac_lisp_([E|Es], [V|Vs], A):- pac_lisp(E, V, A), 66 pac_lisp_(Es, Vs, A). 67 68% 69pac_lisp_and([], t, _):- !. 70pac_lisp_and([H|M], V, A):- pac_lisp(H, U, A), U==t, !, 71 pac_lisp_and(M, V, A). 72pac_lisp_and(_, [], _). 73 74%%%% basics for list processing 75defun(car, [[X|_]]\ X). 76defun(cdr, [[_|X]]\ X). 77defun(cons, [X,Y]\ [X|Y]). 78defun(not, [X]\[if, [=, X,[]], t, []]). 79defun(append, [X,Y]\[if, [=, X, []], Y, 80 [cons, [car, X], [append, [cdr, X], Y]]]). 81 82 83% ?- length(L, 3), maplist(st([X], X=1), L). 84% ?- call(st([X], X=1), A). 85% ?- call(st([X,Y], (X=1, Y=X)), A, B). 86% ?- maplist(st([X], [X], X=1), [A,B]). 87% ?- maplist(st([a(X)], [X], X=1), [A, B]). 88% ?- length(L, 3), maplist(st([a(X)], [X], X=1), L). 89% ?- length(L, 3), Y=5, maplist(st([a(X, Y)], [Y], X=1), L). 90% ?- call(st([B], [], call(st([A], [], A=1), B)), Z), Z). 91% ?- maplist(st([B], [], call(st([A], [], A=1), B)), [Z1, Z2, Z3]). 92% ?- maplist(st([B], [], maplist(st([B0, B1], [], B0=B1), [1,2,3], B)), [Z1, Z2, Z3]). 93% ?- maplist(st([A], [], maplist(st([B0, B1], [], B0=B1), [1,2,3], A)), Cs). 94% ?- length(Cs, 2), P = hi, maplist(st([A], [P], maplist(st([B0, B1], [P], B0=(B1, P)), A, [1,2,3])), Cs). 95% ?- time(1000000, maplist(lambda:(X\Y\Z\append(X, Y, Z)), [[1]],[[2]], _), T). 96% ?- time(1000000, eval(ap::maplist(append, [[1]],[[2]]), _), T). 97 98% internal_lambda(X\\Y, st(Xs, Ps, Y0)):- !, eval:cast_to_list(X, Xs), 99% internal_lambda(Y, st(_, Ps, Y0)). 100% internal_lambda(^^(X,Y), st([], Ps, Y)):- !, eval:cast_to_list(X, Ps). 101% internal_lambda(X\Y, st(Xs, Ps, Y0)):- !, internal_lambda(X\Y, Xs, Ps, Y0). 102% internal_lambda(X^Y, st(Xs, Ps, Y0)):- !, internal_lambda(X^Y, Xs, Ps, Y0). 103 104% internal_lambda(Y, st([], [], Y)). 105 106% internal_lambda(A, Xs, Ps, Y):- internal_lambda(A, [], [], X0s, Ps, Y), 107% reverse(X0s, Xs). 108 109% internal_lambda(X\Y, Xs, Ps, Ys, Qs, Y0):-!, 110% internal_lambda(Y, [X|Xs], Ps, Ys, Qs, Y0). 111% internal_lambda(X^Y, Xs, Ps, Ys, Qs, Y0):- !, 112% internal_lambda(Y, Xs, [X|Ps], Ys, Qs, Y0). 113% internal_lambda(Y, Xs, Ys, Xs, Ys, Y). 114 115% % lambda_expansion(X, _):- writeln(X), fail. 116% lambda_expansion(X, X):- (var(X); atomic(X)), !. 117% lambda_expansion(X\\Y, Z):- internal_lambda(X\\Y, S), lambda_expansion(S, Z). 118% lambda_expansion(^^(X,Y), Z):- internal_lambda(^^(X, Y), S), lambda_expansion(S, Z). 119% lambda_expansion(X\Y, Z):- !, internal_lambda(X\Y, Xs, Ps, Y0), 120% lambda_expansion(st(Xs, Ps, Y0), Z). 121% lambda_expansion(X^Y, Z):- !, internal_lambda(X^Y, Xs, Ps, Y0), 122% lambda_expansion(st(Xs, Ps, Y0), Z). 123% lambda_expansion(st(X, Body), Y):-!, 124% lambda_expansion(st(X, [], Body), Y). 125% lambda_expansion(st(Xs, Ps, Body), Y):-!, 126% lambda_expansion(Body, Body0), 127% gensym('$st', Pred), 128% H=..[Pred, Ps|Xs], 129% assert(H:-Body0), 130% Y=..[Pred, Ps]. 131% lambda_expansion(M, M0):- M=..[F|As], 132% maplist(lambda_expansion, As, Bs), 133% M0=..[F|Bs]. 134 135% goal_expansion(X, Y):- lambda_expansion(X, Y). 136 137% % term_expansion(X, Y):- lambda_expansion(X, Y). 138 139% % sample uses of st/2, st/3. 140% % ?- eval(maplist(l\ maplist(i\ nth1(i,l), [2,1,1]), [[a,b],[b,c]]), X). 141% % Not work because of another meaning of \ 142% % ?- csv_column_extract([3, 1], [[a,b,c],[c,d,e],[f,g,h]], Rs). 143 144% csv_column_extract_ulrich(Indexes, Raws, New_raws):- 145% maplist(Raw\New_raw\ 146% (Indexes^maplist(Index\Elem\ 147% (Raw^nth1(Index, Raw, Elem)), 148% Indexes, New_raw)), 149% Raws, New_raws). 150 151% csv_column_extract(Indexes, Raws, New_raws):- 152% maplist(st([Raw, New_raw], [Indexes], 153% maplist(st([Index, Elem], [Raw], 154% nth1(Index, Raw, Elem)), 155% Indexes, New_raw)), Raws, New_raws). 156 157% csv_column_extract_me(Indexes, Raws, New_raws):- 158% maplist([Raw, New_raw]\\ 159% (Indexes^maplist( 160% [Index, Elem]\\ 161% (Raw^nth1(Index, Raw, Elem)), 162% Indexes, New_raw)), 163% Raws, New_raws). 164 165% %% some tiny 166% list_lambda :- predicate_property(X, dynamic), 167% functor(X, F, _), 168% atom_concat('$st', _, F), 169% listing(F), 170% fail; true.