1:- module(zlisp, []).    2
    3:- use_module(zdd('zdd-array')).    4:- use_module(zdd(zdd)).    5:- use_module(pac(op)).    6
    7		/*****************************************************************
    8		*     Basic Lisp functions in coterm algebra based on iterm/2    *
    9		*     ( Auxiliary term/2 for read/write S-expression )           *
   10		*                                                                *
   11		*     Experimental for only car, cdr, cons, conc,                *
   12		*     funcar ( = mapcar ), funconc (= mapconc ), flip.           *
   13		*****************************************************************/
   14
   15% ?- iterm(A, a).
   16% ?- cons(0, 1, Z).
   17% ?- cons(1, 1, Z).
   18% ?- cons(1, 1, Z), term(U, Z).
   19% ?- term(X, a*b*c), term(X, E).
   20
   21cons(_, 0, 0):-!.
   22cons(X, 1, X):-!.
   23cons(X, Y, Z):- iterm(Z, [X|Y]).
   24%
   25car(X, Y):- iterm(X, [Y|_]).
   26%
   27cdr(X, Y):- iterm(X, [_|Y]).
   28
   29% ?- term(I, [a,b,c]), val(mapcar(write, I), V), term(V, R).
   30
   31
   32% ?- numlist(1, 10, Ns),  maplist(pred([X, @X]), Ns, Ns0),
   33%  val(mapcar1(print_atom, list(Ns0)), V).
   34
   35% ?- term_index([a,b], X), car(X, Y), cdr(X, Z), term_index(A, X),
   36%	term_index(B, Y), term_index(C, Z).
   37
   38val(I, I):- integer(I), !.  % I>=0.
   39val(@(A), V):-!, iterm(V, A).
   40val(E, V):- val_basic(E, V), !.
   41val(E, V):-
   42	functor(E, F, N),
   43	functor(E0, F, N),
   44	val_args(1, E, E0),
   45	call(E0, V).
   46%
   47val_args(I, E, E0):- arg(I, E, A), !,
   48	val(A, V),
   49	arg(I, E0, V),
   50	J is + 1,
   51	val_args(J, E, E0).
   52val_args(_, _, _).
   53
   54%
   55val_basic([], 1):-!.
   56val_basic([A|As], X):-!, val(A, A0),
   57	val_basic(As, As0),
   58	iterm(X, [A0|As0]).
   59val_basic(X+Y, Z):-!, val(X, X0), val(Y, Y0),
   60	conc(X0, Y0, Z).
   61val_basic(setq(X, E), V):-!, val(E, V), set_memo(value(X)-V).
   62val_basic(var(X), V):-!, memo(value(X)-V).
   63val_basic(funcar(F, X), Y):-!, val(X, X0), funcar(F, X0, Y).
   64val_basic(funcar0(F, X), Y):-!, val(X, X0),	funcar0(F, X0, Y).
   65val_basic(funconc(F, X), Y):-!, val(X, X0), funconc(F, X0, Y).
   66val_basic(flip(A), V):-!,
   67	functor(A, F, 2),
   68	functor(B, F, 2),
   69	arg(1, A, X),
   70	arg(2, A, Y),
   71	arg(1, B, Y),
   72	arg(2, B, X),
   73	val(B, V).
   74
   75% ?- term(X, [a,b]), term(X, U), conc(X, X, Y), term(Y, Z).
   76conc(0, _, 0):-!.
   77conc(1, X, X):-!.
   78conc(_, 0, 0):-!.
   79conc(X, 1, X):-!.
   80conc(X, Y, Z):-iterm(X, T),
   81	(	T = [] -> Z = Y
   82	;	T = [Car|Cdr],
   83		conc(Cdr, Y, Y0),
   84		cons(Car, Y0, Z)
   85	).
   86
   87% ?- term(X, [a,b]), member(A, X, Y),
   88%	term(A, Aout), term(X, Xout), term(Y, Yout).
   89
   90member(X, Y, Z):- car(Y, X), cdr(Y, Z).
   91
   92% ?- term(X, [a,b]), term(A, c), funcar(cons(A), X, Y), term(Y, Yout).
   93%@ Yout = [[c|a], [c|b]].
   94% ?- term(X, [[a],[b]]), term(A, c), funcar(cons(A), X, Y), term(Y, Yout).
   95%@ Yout = [[c, a], [c, b]].
   96
   97funcar(_, X, X):- X<2, !.
   98funcar(F, X, Y):- iterm(X, T),
   99	(	T = [] -> Y = X
  100	;	T = [A|As],
  101		call(F, A, B),
  102		funcar(F, As, X0),
  103		cons(B, X0, Y)
  104	).
  105
  106% ?- term(X, [[a,b], a, b]), funcar0(iprint, X, Y).
  107funcar0(_, X, X):- X < 2, !.
  108funcar0(F, X, Y):- iterm(X, T),
  109	(	T = [] -> Y = 1
  110	;	T=[A|B], call(F, A) -> funcar0(F, B, Y)
  111	;	Y = 0
  112	).
  113%
  114iprint(I):- term(I, T), print(T), nl.
  115
  116
  117% ?- term(X, [a,b,c]), funconc(pred([U, V]:- conc(U, U, V)), X, Y),
  118%	term(Y, YOut), write(YOut).
  119
  120funconc(_, X, X):- X<2, !.
  121funconc(F, X, Y):- iterm(X, T),
  122	(	T = [] -> Y = X
  123	;	T = [A|X0],
  124		funconc(F, X0, X1),
  125		cons(A, X1, X2),
  126		call(F, X2, Y)
  127	)