1:- module(zdd_array, [
    2			open_state/0, open_state/1, close_state/0, initial_basic_state/2
    3			,	open_basic_state/1, open_basic_state/2
    4			,	open_array/1, open_array/2, open_array_gvar/1, open_array_gvar/2
    5			,	open_array_hash/2
    6			,	open_vector/2
    7			,	open_hash/1, open_hash/2, open_hash_gvar/1, open_hash_gvar/2
    8			,	close_array/1
    9			,	memo/1, memo/2, memoq/1, init_memo_stack/0
   10			,	hash_memoadd/2, hash_memochk/2
   11			,	zdd_dict_memo/1, zdd_dict_memo/2
   12			,	get_assoc/2
   13			,	memo_index/2, key_assert/2, key_exists/2
   14			,	numbering/2, set_counter/1, set_counter/2
   15			,	biject/3
   16			,	push_memo/0, pop_memo/0
   17			,	use_memo/1, reset_memo_call/1
   18			,	open_memo/1, open_memo/2,  close_memo/1
   19			,   open_hash/2, close_hash/1, hash/3
   20			,	open_zdd_dict/0, open_zdd_dict/1, open_zdd_dict/2
   21			,	zdd_dict/3, zdd_dict/4
   22			,	set_memo/1, update_memo/2, dump_memo/0, dump_memo/1, dump_hash/1
   23			,	insert_memo/2
   24			,	unify_args/3, xarg/3, xarg/2, xsetarg/3, array_index/3
   25			,	add_child/2, add_child/3
   26			,	pred_memo_update/2
   27			,	cofact/2, cofact/3, index/3, term/2, show_array/0, show_state/0
   28			,	iterm/2, iterm/3, index/3, index_elem/3, iterm_hash/2
   29			,	iterm_hash/3
   30			,	slim_gc/2, pred_slim_gc/3, slim_iterm/3, slim_iterms/3]).   31
   32
   33:- use_module(zdd(zdd)).   34
   35%--------------------
   36default_asize(2).
   37default_hsize(2).
   38%--------------------
   39
   40atom_only(A, A0) :- ( compound(A) -> A0 = '.' ;  A0 = A).
   41%
   42user:portray(X)	:- compound(X), !,
   43	(	functor(X, s, N), N > 7 -> write('s(..)')
   44	;	functor(X, ctrl, N), N > 2 -> write('<ctrl>')
   45	;	compound_name_arguments(X, F, _),
   46		( F = (#) -> write(#(..))
   47		; F = call_continuation -> write(cont(..))
   48		)
   49	).
   50user:portray(X)	:- var(X), get_attr(X, zsat, _), !.
   51
   52% ?- zdd.
   53% ?- reset_memo_call(true).
   54
   55%
   56hash_key_count(H, C):- arg(1, H, C).
   57%
   58hash_key_count_set(H, C):-  setarg(1, H, C).
   59%
   60hash_bucket_count(H, C):- arg(2, H, C).
   61%
   62hash_bucket_count_set(H, C):- setarg(2, H, C).
   63%
   64hash_vector(H, V):- arg(3, H, V).
   65%
   66hash_vector_set(H, V):- setarg(3, H, V).
   67
   68%
   69check_rehash(H):- H = #(C, B, V),
   70		functor(V, _, N),
   71		(	C > B + N + N -> rehash(H)
   72		;	true
   73		).
   74
   75% check_rehash(H):- H = #(C, B, V),
   76% 		functor(V, _, N),
   77% 		(	C > B + 1.7 * N -> rehash(H)
   78% 		;	true
   79% 		).
   80
   81% ?- open_hash(2, H), hash(a, H, V), writeln(V), writeln(H),
   82%	V = 2, hash(a, H, U).
   83
   84hash(X, H, Val):-
   85	term_bucket_index(X, H, U, I),
   86	(	memberchk(X-V, U) -> Val = V   % X exists.
   87	;	hash_vector(H, Vec),
   88		setarg(I, Vec, [X-Val | U]),
   89		hash_key_count(H, C),
   90		C0 is C + 1,
   91		hash_key_count_set(H, C0),
   92		(	U =[] ->			% Count up for new bucket.
   93			arg(2, H, B),
   94			B0 is B + 1,
   95			setarg(2, H, B0)
   96		;	true				% fresh bucket for key X.
   97		),
   98		check_rehash(H)
   99	).
 hash_memochk(+X, +H)
true if X exists in the hash H, otherwise fails.
  104% ?- open_hash(4, H), write(H),  \+ hash_memochk(a, H),
  105%	hash_memoadd(a, H), write(H).
  106%@
  107%@ #(0,0,#([],[],[],[]))#(1,1,#([],[],[a],[]))
  108%@ H = #(..).
  109
  110hash_memochk(X-V, H):-!,
  111	term_bucket_index(X, H, U, _),
  112	memberchk(X-V, U).
  113hash_memochk(X, H):-
  114	term_bucket_index(X, H, U, _),
  115	memberchk(X, U).
 hash_memoadd(+X, +H) is det
add X to the hash table H. Remark: it does not check that X is not in H.
  122hash_memoadd(X, H):-
  123	(	X = Key-_ ->  true
  124	;	Key = X
  125	),
  126	term_bucket_index(Key, H, U, I),
  127	hash_vector(H, Vec),
  128	setarg(I, Vec, [X | U]),
  129	hash_key_count(H, C),
  130	C0 is C + 1,
  131	hash_key_count_set(H, C0),
  132	(	U =[] ->			% Count up for new bucket.
  133		arg(2, H, B),
  134		B0 is B + 1,
  135		setarg(2, H, B0)
  136	;	true				% fresh bucket for key X.
  137	),
  138	check_rehash(H).
  139
  140% ?- open_state.
  141% ?- open_state, push_memo, b_getval(zdd_ash, H), pop_memo.
  142% ?- open_state, close_state, show_state.
  143
  144%	Assuming a totally ordered set of atoms, a state is a collection of
  145%	families of (finite) sets of (finite) these atoms. In a state,
  146%	each family of sets (FOS) is given a unique nonnegative integer.
  147%	0 is reserved for the empty family {}, and 1 for {{}} = {0} = 1.
  148%	If a FOS F is neither 0 nor 1, there must
  149%	be the maximum atom A among those are an element of a set of F.
  150%	A is called the maximum atom of F. The maximum atom is defined neither for
  151%	0 nor 1. Throuhout successive updating process of a state, once the unique
  152%	id  of a FOS is created, this id is kept for the FOS henceforth.
  153%	`cofact/3` is the main bidirectional interface predicate on states to get
  154%	a FOS id (fact), and to store new FOS (cofact) in a state.
  155%	A nonnegative integer k is used for the FOS whose id is k, and vice versa.
 open_state is det
open a new state. ?- open_state, show_state, bdd_cons(I, a, 1), psa(I), bdd_cons(J, b, I), psa(J).
  162% ?- open_state, cofact(X, t(a,0,1)), show_state.
  163open_state :- open_state([]).
  164
  165%
  166open_state(Args) :- open_array_hash(Args, #(Array, Hash)),
  167	setarg(1, Array, 1),
  168	arg(2, Array, Vec),
  169	setarg(1, Vec, 0),
  170	( memberchk(zdd_compare(Compare), Args); default_compare(Compare)),
  171	( memberchk(extra(Extra), Args); 	Extra = [varnum-0, varzip-[]] ), !,
  172	nb_linkval(zdd_compare, Compare),
  173%	nb_linkval(zdd_node, Array),      % always work ??.
  174	nb_setval(zdd_node, Array),      % always work ??.
  175	nb_setval(zdd_hash, Hash),
  176	nb_linkval(zdd_extra, Extra),
  177	init_memo_stack.
  178
  179% ?- open_array_hash(X), write(X).
  180open_array_hash(ArrayHash):- open_array_hash([], ArrayHash).
  181
  182% ?- open_array_hash([hsize(8), asize(8)], X), write(X).
  183% ?- open_array_hash([hsize(2^8), asize(2^8)], X), write(X).
  184open_array_hash(Args, #(Array, Hash)):-
  185	(	memberchk(hsize(HsizeExp), Args) -> true
  186	;	default_hsize(HsizeExp)
  187	),
  188	(	memberchk(asize(AsizeExp), Args) -> true
  189	;	default_asize(AsizeExp)
  190	),
  191	Hsize is HsizeExp,
  192	Asize is AsizeExp,
  193	open_array(Asize, Array),
  194	open_hash(Hsize, Hash).
  195
  196% ?- set_counter(abc, 3), b_getval(abc, N).
  197set_counter(CounterName, N):- nb_setval(CounterName, N).
  198%
  199set_counter(CounterName):- set_counter(CounterName, 0).
  200
  201% Numbering objects:
  202% ?- set_counter(abc),numbering(abc(1), X).
  203% ?- set_counter(abc),numlist(1, 10, Ns), reverse(Ns, NsR),
  204%	maplist(pred(([X]:- numbering(abc(X),Y), writeln(X-Y))), NsR).
  205% ?- set_counter(abc), numlist(1, 10, Ns), append(Ns, Ns, WNs),
  206%	maplist(pred(([X]:- numbering(abc(X),Y), writeln(X-Y))), WNs).
  207% ?- N=100000, time((set_counter(abc), numlist(1, N, Ns), append(Ns, Ns, WNs),
  208%	maplist(pred([X]:- numbering(abc(X),Y)), WNs))).
  209
  210%
  211numbering(X, I):- memo(X-I),
  212	(	nonvar(I) -> true
  213	;	functor(X, CounterName, _),
  214		b_getval(CounterName, I0),
  215		I is I0 + 1,
  216		b_setval(CounterName, I)
  217	).
  218
  219% ?- open_array_hash(A), number_stamp(a, I, A).
  220% ?- open_array_hash(A), number_stamp(a, I, A), number_stamp(X, I, A).
  221% ?- open_array_hash(A), number_stamp(a, I, A), number_stamp(a, J, A).
  222% ?- open_array_hash(A),
  223%	number_stamp(a1, I1, A),
  224%	number_stamp(a2, I2, A),
  225%	number_stamp(a3, I3, A),
  226%	number_stamp(a4, I4, A),
  227%	number_stamp(a5, I5, A),
  228%	number_stamp(a6, I6, A),
  229%	number_stamp(a7, I7, A),
  230%	number_stamp(a8, I8, A),
  231%	number_stamp(a9, I9, A),
  232%	write(A).
  233number_stamp(X, I, #(A,H)):-
  234	(	nonvar(I) ->
  235		arg(2, A, V),
  236		arg(I, V, X)
  237	;	hash(X, H, I),
  238		(	nonvar(I) ->
  239			arg(2, A, V),
  240			arg(I, V, X)
  241		;	index(I, A, X)
  242		)
  243	).
  244
  245
  246		/******************
  247		*     zdd_dict    *
  248		******************/
  249
  250% ?- open_zdd_dict([], g), b_getval(g, S), write(S).
  251open_zdd_dict(Args, G) :- open_zdd_dict_args(Args, Dict), nb_linkval(G, Dict).
  252% ?- open_zdd_dict(g), b_getval(g, S), write(S).
  253open_zdd_dict(G) :- open_zdd_dict([hsize(32), asize(32)], G).
  254% ?- open_zdd_dict, b_getval(zdd_dict, S), write(S).
  255open_zdd_dict :- open_zdd_dict([hsize(32), asize(32)], zdd_dict).
  256
  257% ?- open_zdd_dict_args([], R), write(R).
  258open_zdd_dict_args(Args, #(#(1, Array),Hash) )	:-
  259	( memberchk(hsize(HsizeExp), Args); 	HsizeExp = 2 ), !,
  260	( memberchk(asize(VsizeExp), Args); 	VsizeExp = 2 ), !,
  261	Hsize is HsizeExp,
  262	Vsize is VsizeExp,
  263	functor(Array, #, Vsize),
  264	arg(1, Array, 0),	% so as open_state is.
  265	open_hash(Hsize, Hash).
  266
  267% ?- open_zdd_dict, zdd_dict_hash(a, b, I), zdd_dict_hash(a, Val, J).
  268zdd_dict_hash(Key, Val, I):- zdd_dict_hash(Key, Val, I, zdd_dict).
  269%
  270zdd_dict_hash(Key, Val, I, G):- b_getval(G, #(Array, Hash)),
  271	zdd_dict_hash(Key, Val, I, Array, Hash).
  272
  273% ?- open_zdd_dict(g), zdd_dict_hash(a, b, I, g), zdd_dict_hash(a, V, J, g).
  274zdd_dict_hash(Key, Val, I, Array, Hash):-
  275	hash(Key, Hash, I),			% check Key-I entry in H (hash)
  276	(	nonvar(I) ->			% Key already exists.
  277		arg(2, Array, Vec),
  278		arg(I, Vec, _-Val)
  279	;	index(I, Array, Key-Val)	% Key is new.
  280	).
  281
  282% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), Val).
  283% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), Val), Val=a.
  284% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), Val), Val=a, zdd_dict(I, X, R).
  285% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), Val), Val=a,
  286%	zdd_dict(J, t(b, I, I), Val2), zdd_dict(I, _, Val2).
  287% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), Val), Val=a,
  288%	zdd_dict(J, t(b, I, I), Val2), Val2=c,
  289%	zdd_dict(J, X, Val3),
  290%	zdd_dict(K, X, Val4).
  291% ?- open_zdd_dict, zdd_dict(I, t(a, 0, 1), hello), zdd_dict(I, T, Val).
  292
  293% A generaiization of the cofact using zdd as keys of dict.
  294zdd_dict(I, Key, Val):- zdd_dict(I, Key, Val, zdd_dict).
  295%
  296zdd_dict(I, Key, Val, Gvar):- b_getval(Gvar, #(Array, Hash)),
  297	zdd_dict(I, Key, Val, Array, Hash).
  298%
  299zdd_dict(I, Key, Val, Array, _):- nonvar(I), !,
  300	I > 1,
  301	arg(2, Array, Vec),
  302	arg(I, Vec, Key0-Val),
  303	(	Key0 = t(A,R) -> Key=t(A, 0, R)
  304	;   Key = Key0
  305	).
  306zdd_dict(I, t(A, L, R), Val, Array, Hash):-
  307	(	R = 0 ->		% Minato's rule
  308		L > 1,
  309		I = L,
  310		arg(2, Array, Vec),
  311		arg(L, Vec, _-Val)
  312	;	L = 0 ->
  313		zdd_dict_hash(t(A, R), Val, I, Array, Hash)
  314	;	zdd_dict_hash(t(A, L, R), Val, I, Array, Hash)
  315	).
  316
  317% ?- trace.
  318% ?- open_basic_state(G), iterm(I, a, G).
  319% ?- open_basic_state(G), iterm(I, a).
  320% ?- open_basic_state(G), iterm_hash(a, I, G), trace, iterm(X, I, G).
  321% ?- open_basic_state(G), b_getval(G, V), writeln(V).
  322% ?- open_basic_state(G), cofact(I, t(a, 0, 1), G), psa(I, G), psa(I, G).
  323% ?- open_basic_state(G), cofact(X, t(a,0,1), G), cofact(Y, t(b, X, X),G), psa(Y, G).
  324%
  325% ?- open_basic_state(G), cofact(X, t(a,0,1), G), cofact(Y, t(b, X, X), G),
  326%   cofact(Y, T, G), psa(Y, G).
  327
  328% ?- zdd.
  329% ?- X<<pow([a,b,c]), Y<<pow([b,c,d]), Z<<(X-Y), psa(Z), slim_gc(Z, U), psa(U).
  330% ?- open_basic_state(xxx), b_getval(xxx, Core), write(Core).
  331%@ #(#(1,#(0,_7144)),#(0,0,#([],[])))
  332%@ Core = #(..).
  333
  334open_basic_state(G)		 :- open_basic_state(G, []).
  335%
  336open_basic_state(G, Args) :-
  337	(	var(G) -> gensym(core, G)
  338	;	atom(G)
  339	),
  340	initial_basic_state(Args, BasicState),
  341	nb_linkval(G, BasicState).
  342
  343% ?- initial_basic_state([], X).
  344initial_basic_state(Args, #(#(1,Vector),Hash)):-
  345	(	memberchk(hsize(HsizeExp), Args); 	HsizeExp = 2 ), !,
  346	(	memberchk(asize(VsizeExp), Args); VsizeExp = 2 ), !,
  347	Hsize is HsizeExp,
  348	Vsize is VsizeExp,
  349	functor(Vector, #, Vsize),
  350	open_hash(Hsize, Hash),
  351	arg(1, Vector, 0).
  352%
  353open_array(Array):- default_asize(N),
  354	open_array(N, Array).
  355%
  356open_array(N, #(0, Vec)):- N > 0, functor(Vec, #, N).
  357
  358% ?- open_array_gvar(abc), b_getval(abc, X), writeln(X).
  359open_array_gvar(Gvar):- default_asize(N),
  360						open_array_gvar(Gvar, N).
  361%
  362open_array_gvar(Gvar, N):- N > 0, atom(Gvar),
  363	functor(Vec, #, N),
  364	nb_linkval(Gvar,  #(0, Vec)).
  365%
  366close_array(Gvar):- nb_getval(Gvar, A),
  367					close_vector(A),
  368					nb_setval(Gvar, []).
  369
  370show_state:-
  371	b_getval(zdd_hash, Hash),	writeln(zdd_hash = Hash),
  372	b_getval(zdd_node, Vector),	writeln(zdd_node = Vector),
  373	b_getval(zdd_compare, Compare), writeln(zdd_compare = Compare),
  374	b_getval(zdd_extra, Extra), writeln(zdd_extra = Extra),
  375	b_getval(zdd_hash, Buckets), writeln(zdd_hash = Buckets).
  376
  377		/***********************
  378		*     State globals    *
  379		* -------------------- *
  380		*     zdd_hash         *
  381		*     zdd_node          *
  382		*     zdd_extra        *
  383		*     zdd_compare      *
  384		***********************/
 memo_index(X) is det
X = E-V. E must be ground, whose main functor is used as a counter name. A unique integer for E is unified with V. This is handy and convenient to give a series of integer index to members of a family of ground terms. ?- zdd. ?- push_memo, pop_memo. ?- memo(a-1), push_memo, memo(a-2), memo(a-A), pop_memo, memo(a-B). ?- push_memo, memo(a-1), memo(a-Y), pop_memo, memo(a-2), memo(a-Z). ?- memo_index(x-I), memo_index(y-J), memo_index(x-K). ?- memo_index(a(1)-V), get_key(a, C). ?- memo_index(a(1)-V), memo_index(a(2)-U), get_key(a, C). ?- memo_index(a(1)-V), memo_index(a(2)-U), memo_index(a(2)-W), get_key(a, C). ?- memo_index(a(1), X), memo_index(b(3), W), memo_index(b(2), Y), memo_index(a(1), Z), memo_index(b(2), U).
  402memo_index(E-V):- memo(E-V), !,
  403	(	nonvar(V) -> true
  404	;	functor(E, CounterName, _),
  405		memo_index(CounterName, V)
  406	).
  407%
  408memo_index(Name, V0):-
  409	b_getval(zdd_extra, Extra),
  410	(	select(Name-V, Extra, Extra0) ->
  411		V0 is V+1
  412	;	Extra0 = Extra,
  413		V0 = 1
  414	),
  415	nb_linkval(zdd_extra, [Name-V0|Extra0]).
  416
  417
  418% Structure Sharing.
  419setarg_state_extra(X, Y):- arg(2, X, Extra), setarg(2, Y, Extra).
  420%
  421setarg_state_core(X, Y):- arg(1, X, Core), setarg(1, Y, Core).
  422%
  423default_compare(compare).
 show_array is det
The same as show_array(zdd_node). ! show_array(+G) is det. Print all triples in array bound to G.
  430% ?- zdd_eval(pow([a,b,c]), _), show_array.
  431% ?- open_state, zmod:zdd_eval(family([[a],[b],[c]]), X), show_array.
  432% ?- open_state, show_array.
  433
  434show_array:- show_array(zdd_node).
  435%
  436show_array(G) :- b_getval(G, Vec), show_vector(Vec).
  437
  438% ?- open_state, show_state.
  439show_vector(#(C, Vec)):-
  440		  forall(between(2, C, I),
  441				 (	arg(I, Vec, V), writeln(I=V))).
 close_state(+S) is det
Close the state S. Unused memory is expected to be freed (not sure).
  445close_state:-
  446	nb_linkval(zdd_hash, []),
  447	nb_linkval(zdd_node, []),
  448	nb_linkval(zdd_extra, []),
  449	nb_linkval(zdd_compare, []),
  450	nb_linkval(zdd_child, []).
  451%
  452:- meta_predicate use_memo(0).  453use_memo(Goal):- setup_call_cleanup(
  454				  push_memo,
  455				  call(Goal),
  456				  pop_memo
  457			  ).
  458
  459%
  460:- meta_predicate reset_memo_call(0).  461reset_memo_call(X):- setup_call_cleanup(
  462				  reset_memo,
  463				  call(X),
  464				  reset_memo
  465			  ).
  466%
  467init_memo_stack:- open_hash(64, H),
  468			nb_setval(zdd_hash, H),
  469			nb_setval(memo_stack, []).
  470%
  471reset_memo:- open_hash(64, H),
  472			nb_setval(zdd_hash, H).
  473
  474% push/pop memo
  475push_memo:- b_getval(zdd_hash, M),
  476			b_getval(memo_stack, Ms),
  477			b_setval(memo_stack, [M|Ms]),
  478			open_hash(64, H),
  479			b_setval(zdd_hash, H).
  480%
  481pop_memo:- b_getval(memo_stack, [M|Ms]),
  482 		 b_setval(zdd_hash, M),
  483		 b_setval(memo_stack, Ms).
  484
  485%
  486open_memo(Memo_name):- open_memo(Memo_name, 64).
  487%
  488open_memo(Memo_name, N):- N > 0,
  489	(	atom(Memo_name) -> true
  490	;	gensym(memo, Memo_name)
  491	),
  492	open_hash(N, Hash),
  493	nb_linkval(Memo_name, Hash).
  494
  495%
  496close_memo(Memo_name) :- nb_setval(Memo_name, []).
  497
  498% ?- zdd.
  499% ?- memo(a-1).
  500% ?- memo(a-1), memoq(a-1).
  501% ?- memo(a-1), memoq(a-X).  % false
  502% ?- memoq(a-X).  % false.
  503% ?- memo(a-1), memoq(a-X).	% false
  504% ?- memo(a-1), memo(a-X).
  505% ?- X<<pow(numlist(1, 1000)), card(X, C).
  506% ?- memo(a-1), memo(a-V), set_memo(a-2), memo(a-U).
  507% ?- set_memo(a-1), memo(a-X).
  508% ?- open_hash(2, H), hash(a, H, X), X=3, hash(a, H, Y).
  509
  510% Take time !!
  511% ?- open_hash(2, H), time(repeat(10^8, (hash(a, H, X), X=3, hash(a, H, Y)))).
  512%@ % 3,100,000,001 inferences, 204.420 CPU in 237.279 seconds (86% CPU, 15164854 Lips)
  513%@ H = #(..).
  514% ?- open_hash(2, H), hash(a, H, X), hash(a, H, Y), X==Y.
  515%!	memo(+P) is det.
  516%	P = X-V,
  517%	The input pair X-V is unified with with a member of a bucket of the hash
  518%	table of the state S. Otherwise, create a new entry for X-V.
  519
  520% ?- zdd.
  521memo(X-V):- b_getval(zdd_hash, H), !, hash(X, H, V).
  522
  523% ?- zdd.
  524zdd_dict_memo(X-V):- b_getval(zdd_dict, #(_, H)), !, hash(X, H, V).
 memo(+A, +G) is det
A = X-V. The input pair X-V is unified with with a member of a bucket of the hash table of the state S. Otherwise, create a new entry for X-V.
  531memo(X-V, G):- b_getval(G, H), !, hash(X, H, V).
  532
  533zdd_dict_memo(X-V, G):- b_getval(G, #(_, H)), !, hash(X, H, V).
  534
  535% ?- memo(a-Y), memo(a-R).
  536% ?- memo(a-Y), memo(a-R).
  537% ?- memo(a-1), memo(a-R).
  538% ?- set_memo(a-1), memo(a-Y), set_memo(a-V), memo(a-R), V=2.
  539
  540%	set_memo(X-V) is det.
  541%   Replace old X entry with X-V when X entry exists,
  542%	otherwise, simply create X-V entry.
  543
  544set_memo(X-V) :- b_getval(zdd_hash, H), hash_fresh_entry(X, V, _, H).
  545%
  546set_memo(X-V, G) :- b_getval(G, H), hash_fresh_entry(X, V, _, H).
  547
  548% ?- memo(a-1), update_memo(a-X, Y), memo(a-U).
  549% ?- memo(a-1), update_memo(a-X, Y).
  550% ?- memo(a-1).
  551% ?- memo(a-1), update_memo(a-X, Y), Y=2, memo(a-U).  % fail
 update_memo(U, +Old, +G) is det
U = X-FreshVar Replace X-Old entry with X-FreshVar entry when the former exists, otherwise simply create X-FreshVar entry with Old left uninstantiated.
  559% ?- memo(a-1), update_memo(a-X, Y), X=f(Y).
  560update_memo(X-FreshVar, OldVal):- % must_be(var, FreshVar),
  561	b_getval(zdd_hash, H),
  562	hash_fresh_entry(X, FreshVar, OldVal, H).
  563%
  564update_memo(X-FreshVar, OldVal, G):- %  must_be(var, FreshVar),
  565	b_getval(G, H),
  566	hash_fresh_entry(X, FreshVar, OldVal, H).
 insert_memo(+Key, +X) is det
Insert X in the zdd associated with the Key when the Key entry exists, otherwise the zdd is assumed to be 1.
  572% ?- insert_memo(abc(5), p(0,0)-p(1,0)), insert_memo(abc(5), p(1,1)-p(0,1)), memo(abc(5)-X), psa(X).
  573
  574insert_memo(Key, X):-
  575	update_memo(Key-New, Old),
  576	( var(Old) -> Old = 1		% empty set
  577	; true
  578	),
  579	zdd_insert(X, Old, New).
 pred_memo_update(+Pred, U) is det
U = K-V Replace the pair K-L0 with K-L, where L is obtained by applying Pred to V, L0, by calling Pred(V, L0, L).
  586:- meta_predicate pred_memo_update(3, ?).  587pred_memo_update(Pred, K-V):- update_memo(K-L, L0),
  588	call(Pred, V, L0, L).
  589%
  590:- meta_predicate pred_memo_update(3, ?, ?).  591pred_memo_update(Pred, K-V, G):- update_memo(K-L, L0, G),
  592	call(Pred, V, L0, L).
 memo_add_new(U) is det
U = K-V Insert V in the list associated with the key K only when V is new in the list. ?- memo_add_new(a-1), memo(a-X). ?- memo_add_new(a-1), memo_add_new(a-2), memo(a-X). ?- memo_add_new(a-1), memo_add_new(a-2), memo_add_new(a-1), memo(a-X).
  601memo_add_new(X):-  pred_memo_update(add_new, X).
 memo_add_new(U, G) is det
U = K-V Insert V in the list associated with the key K only when V is new in the list.
  608memo_add_new(X, G):- pred_memo_update(add_new, X, G).
  609
  610% ?- pred_memo_update(add_new, a-1), memo(a-X).
  611add_new(V, [], [V]):-!.
  612add_new(V, L0, L0):- memberchk(V, L0), !.
  613add_new(V, L0, [V|L0]).
  614
  615% ?- add_child(suc(a), 1), memo(suc(a)-X).
  616% ?- add_child(a, 1), add_child(a, 2), memo(a-X).
  617% ?- add_child(a, 1), add_child(a, 2), memochk_stack(a-X).
  618% ?- add_child(a, 1), add_child(a, 2), add_child(a, 1), memo(a-X).
  619% ?- numlist(1, 100000, Ns),
  620%	time(( maplist(pred([Child]:- add_child(a, Child)), Ns), memo(a-X))).
  621%@ % 2,300,011 inferences, 74.231 CPU in 74.334 seconds (100% CPU, 30985 Lips)
  622%@ Ns = [1, 2, 3, 4, 5, 6, 7, 8, 9|...],
  623%@ X = [100000, 99999, 99998, 99997, 99996, 99995, 99994, 99993, 99992|...].
  624
  625add_child(X, Child)	:-  pred_memo_update(add_new, X-Child).
  626%
  627add_child(X, Child, G):- pred_memo_update(add_new, X-Child, G).
 get_assoc(X, V, G) is det
Unify V with the value of key X only when X entry exists in S, otherwise, fails. ?- memo(apple-_), get_assoc(apple, _). % true ?- memo(orange). % false
  635get_assoc(X, V):- hash_get_assoc(X, V, zdd_hash).
  636
  637hash_get_assoc(X, V, G):- b_getval(G, H),
  638	term_bucket_index(X, H, B, _),
  639	memberchk(X-V, B).
  640%
  641get_assoc_stack(X):- b_getval(zdd_hash, H),
  642	b_getval(memo_stack, Hs),
  643	member(H0, [H|Hs]),
  644	term_bucket_index(X, H0, B, _),
  645	memberchk(X-_, B).
 memoq(U) is det
with U = X-V, Check V with the value of key X compared by == stored in the hash table of S. ?- push_memo, memo(a-b), memoq(a-Y). % fail. ?- push_memo, memo(a-b), memoq(a-b). % true
  651memoq(X-V):- get_assoc(X, U, zdd_hash), U == V.
  652%
  653memoq(X-V, G):- get_assoc(X, U, G),  U == V.
  654% ?- open_memo(g), key_assert(a, g), key_exists(a, g).
  655% ?- open_memo(g), key_assert(a, g), key_exists(b, g).  % false
  656key_assert(X, G):- b_getval(G, H),
  657	term_bucket_index(X, H, B, I),
  658	(	memberchk(X, B) -> true
  659	;	hash_vector(H, Vec),
  660		setarg(I, Vec, [X|B])
  661	).
  662%
  663key_exists(X, G):- b_getval(G, H),
  664	term_bucket_index(X, H, B, _),
  665	memberchk(X, B).
 index(?I, +Array, ?Elem) is det
Array = #(J, Vec). If I is bound, then I-th arg of Vec must be exists, and the I-th arg of Vec is unified with Elem. When I is unbound, Vec is extended by double if necessary, and I is unified with new position of arg of Vec for Elem such that arg(I, Vec, Elem) is true.
  674% ?- open_array(A), write(A).
  675% ?- open_array(A), index(I, A, a), index(J, A, a).
  676% ?- open_array(A), index(I, A, a), index(J, A, a), index(K, A, a).
  677
  678index(I, A, X):-nonvar(I), !,  % A must be an array #(Count, Vector)
  679	arg(2, A, V),
  680	arg(I, V, X).
  681index(I, A, X):-
  682	arg(1, A, K),
  683	I is K + 1,
  684	arg(2, A, Vec),  % Vec must be compound.
  685	functor(Vec, _, J),
  686	(	K < J -> arg(I, Vec, X)
  687	;	extend_array_double(A),
  688		arg(2, A, Vec0),		% Be careful for not Vec.
  689		arg(I, Vec0, X)			% Was setarg(I, V, X).
  690	),
  691	setarg(1, A, I).
  692
  693%  Simplified/special version of iterm, but almost equivalent.
  694%
  695% ?- open_array_hash(X), biject(X, a, I), biject(X, b, J), write(X).
  696% ?- open_array_hash(X), biject(X, a, I), biject(X, a, J).
  697% ?- open_array_hash(X), biject(X, a, I), biject(X, A, I).
  698
  699biject(Bijection, X, I):-nonvar(I), !,
  700	arg(1, Bijection, A),
  701	arg(2, A, V),
  702	arg(I, V, X).
  703biject(#(A, H), X, I):-
  704	hash(X, H, I),				% check X-I entry in H (hash)
  705	(	nonvar(I) -> true		% X already exists.
  706	;	index(I, A, X)			% X is new.
  707	).
  708
  709%	Similar to index_elem but for destructive and free vector
  710%	of the form #(vector).
  711%	Accessing free array (without current max index used).
  712%
  713% ?- xarg(1, a(b(1,2,3)), R).
  714% ?- I is 2^16, A = #(#(1,2,3)), xarg(I, A, hello), xarg(I, A, R).
  715% ?- I is 2^3, A = #(#(1,2,3)), xarg(I, A, hello), xarg(I, A, R), write(A).
  716
  717xarg(I, A, X):-		% I must be integer>0, and A is of the form a(b(....)).
  718	arg(1, A, Vec),
  719	(	arg(I, Vec, Y) -> X = Y   % within range
  720	;	extend_args_double(A),
  721		xarg(I, A, X)
  722	).
 xarg(I, A) is det
is equivalent to xarg(I, A, _).
  727% ?- xarg(1, a(b(1,2,3))).
  728% ?- I is 2^16, A = #(#(1,2,3)), xarg(I, A).
  729% ?- I is 2^3, A = #(#(1,2,3)), xarg(I, A), xarg(I, A, R), write(A).
  730xarg(I, A):- xarg(I, A, _).
 xsetarg(+I, +A, ?X) is det
A must be of thform f(Vec). % default f should #. Fails If I is greater than the size the Vec. othewise, setarg(I, Vec, X).
  737% ?- xsetarg(10, #(#(1,2,3)), 10).
  738% ?- A = a(b(1,2,3)), xsetarg(10, A, 10).
  739xsetarg(I, A, X):-		% I must be integer>0, and A is of the form a(b(....)).
  740	arg(1, A, Vec),
  741	(	arg(I, Vec, _) -> setarg(I, Vec, X)   % within range
  742	;	extend_args_double(A),
  743		xsetarg(I, A, X)
  744	).
 array_index(?I, +Array, ?X) is det
I: integer > 0, X : any term I-th element of Array is unifified with X. If I is unbund, I will unifiied with a new entry id of the Array, ` and when the Array is full, it is extended by double. Similar to xarg for vector, but for array instead. vector has not counter for max entry, but does array.
  754% ?- open_array(1, A), writeln(A),
  755%	array_index(I, A, a), writeln(A),
  756%	array_index(J, A, a), writeln(A).
  757% ?- open_array(1, A), writeln(A),
  758%	array_index(I, A, a), writeln(A),
  759%	array_index(I, A, a), writeln(A).
  760% ?- open_array(1, A), writeln(A),
  761%	array_index(I, A, a), writeln(A),
  762%	array_index(J, A, a), writeln(A).
  763
  764array_index(I, Array, X):- nonvar(I), !,
  765	arg(2, Array, Vec),
  766	arg(I, Vec, X).
  767array_index(I, Array, X):- Array = #(K, Vec),
  768	functor(Vec, _, N),
  769	(	K < N -> Vec0 = Vec
  770	; 	extend_array_double(Array),		% NOT confuse with extend_args_double !
  771		arg(2, Array, Vec0)
  772	),
  773	I is K + 1,
  774	setarg(1, Array, I),
  775	arg(I, Vec0, X).
  776
  777% ?- open_array(3, A),
  778%	array_index(_, A, a), array_index(_, A, b),
  779%	snap_array(A).
  780
  781snap_array(#(K,V)):- forall( between(1, K, I),
  782							 (	arg(I, V, E),
  783								writeln(#(I) = E)
  784							 )).
  785
  786% ?-  open_vector(0, A), extend_args_double(A), writeln(A),
  787%	extend_args_double(A), writeln(A),
  788%	extend_args_double(A), writeln(A),
  789%	extend_args_double(A), writeln(A),
  790%	close_vector(A), writeln(A).
  791
  792open_vector(0, #(#)):-!.
  793open_vector(N, #(V)):- functor(V, #, N).
  794%
  795close_vector(A):- setarg(1, A, #).
  796
  797% ?- open_array(1, A),
  798%	extend_array_double(A), writeln(A),
  799%	extend_array_double(A), writeln(A),
  800%	extend_array_double(A), writeln(A),
  801%	extend_array_double(A), writeln(A).
  802
  803extend_array_double(A):-
  804	arg(2, A, V),			% differ from extend_args_double/1
  805	functor(V, F, N),
  806	(	N = 0 -> N0 = 2
  807 	;	N0 is N + N
  808	),
  809	functor(U, F, N0),
  810	(	N = 0 -> true
  811	;	unify_args(1, V, U)
  812	),
  813	setarg(2, A, U).
  814
  815% ?- A= #(f(a)), extend_args_double(A), write(A).
  816% ?- A= #(f), extend_args_double(A), write(A).
  817% ?- A= #(f(a,b,c,d)), extend_args_double(A), write(A).
  818
  819extend_args_double(A):- % nonvar(A),
  820	arg(1, A, Vec),		% differ from extend_array_double/1
  821	functor(Vec, F, N),
  822	(	N = 0 -> N0 = 2
  823 	;	N0 is N + N
  824	),
  825	functor(VecDouble, F, N0),
  826	(	N = 0 -> true
  827	;	unify_args(1, Vec, VecDouble)
  828	),
  829	setarg(1, A, VecDouble).
  830
  831% ?- iterate_double_number(0, 1, X).
  832% ?- iterate_double_number(1, 2, X).
  833% ?- iterate_double_number(1, 100, X).
  834
  835iterate_double_number(N, I, N):- I =< N, !.
  836iterate_double_number(0, I, I):- !.
  837iterate_double_number(N, I, M):- N0 is 2*N,
  838	iterate_double_number(N0, I, M).
  839
  840% NEW style for processing arguments.
  841% ?- unify_args(1, f(A, B, C), f(U,V, W)).
  842unify_args(X, _):- atom(X), !.
  843unify_args(X, Y):- unify_args(1, X, Y).
  844%
  845unify_args(I, X, A):- arg(I, X, U), !,
  846	arg(I, A, U),
  847	J is I + 1,
  848	unify_args(J, X, A).
  849unify_args(_, _, _).
  850
  851% ?- initial_args(1, a(X, Y), 2).
  852%@ X = Y, Y = 2.
  853initial_args(I, V, C):- setarg(I, V, C), !,
  854	J is I+1,
  855	initial_args(J, V, C).
  856initial_args(_, _, _).
  857
  858		/***********************************************
  859		*         new_array_elem/get_elem/set_elem     *
  860		***********************************************/
  861
  862% ?- open_hash(2, H), write(H).
  863%!	open_hash(+N, -H) is det.
  864%   Create a new hash table with N entries for buckets, and unify with H.
  865% ?- open_hash(3, H), hash(a, H, X),  write(H).
  866open_hash(Hash):- open_hash(8, Hash).
  867%
  868open_hash(N, #(0,0,H)):- N>0,
  869	functor(H, #, N),
  870	initial_args(1, H, []).  % Buckets are empty at start.
  871
  872% ?- open_hash_gvar(g), b_getval(g, H), writeln(H).
  873open_hash_gvar(G):- open_hash(Hash), nb_linkval(G, Hash).
  874%
  875open_hash_gvar(G, N):- open_hash(N, Hash), nb_linkval(G, Hash).
 close_hash(+H) is det
close hash table H, to be reclaimed later.
  879close_hash(H):- hash_vector_set(H, []).  % not by nb_setarg, but by setarg.
 hash_memo(+X, +R, ?V) is det
Unify X-V with an element in the hash table R. Rehash may be applied to R by check_rehash/1.
  885% ?- open_hash(2, H),
  886%  time(repeat(1000, (hash(a, H, X), X=3, hash(a, H, Y)))).
 term_bucket_index(+X, +H, -B, -I) is det
I is unified with the value for X by term_hash/4, and B is unified with I-th bucket of H.
  892term_bucket_index(X, H, B, I):-
  893	hash_vector(H, Vec),
  894	functor(Vec, _, N),
  895	term_hash(X, 3, N, I0),
  896	I is I0 + 1,
  897	arg(I, Vec, B).
 hash(+X, +H, ?E) is det
Put a key-value term X-E on the hash table H. ! hash_scan(+X, +Y, ?Val)
  902hash_scan(X, H, Val):-
  903	term_bucket_index(X, H, U, _),
  904	memberchk(X-V, U),
  905	Val == V.
 hash_fresh_entry(+X, +H, -Var, -OldVal) is det
If X-OldVal exists in the hash table then the entry is removed, otherwise, OldVal is left uninstantiated. Then X-var is put as a fresh pair on the hash table. Rehash may be performed by check_rehash/1. This predicate is used to calculate value using old value after preparing the entry for the new value.
  914hash_fresh_entry(X, FreshVar, OldVal, H):-
  915	check_rehash(H),
  916	term_bucket_index(X, H, U, I),
  917	hash_vector(H, Vec),
  918	(	select(X-OldVal, U, U0) ->
  919		setarg(I, Vec, [X-FreshVar | U0])
  920	;	setarg(I, Vec, [X-FreshVar | U])
  921	).
  922
  923% ?- open_hash(H), check_rehash(H), writeln(H).
  924% ?- open_hash(H), check_rehash(H), check_rehash(H),
  925%  check_rehash(H), writeln(H).
 new_array_elem(+X, +Z, -I) is det
Unify I with an integer index for entry X
  930% ?- zdd.
  931% ?- numlist(1,3, Ns), X<<pow(Ns), psa(X).
  932% ?- numlist(1,3, Ns), zmod:zdd_eval(pow(Ns), X), card(X, C).
  933% ?- nb_setval(zdd_node, #(1, #(0))),
  934%	new_array_elem(a, A), new_array_elem(b,B), new_array_elem(c, C),
  935%	b_getval(zdd_node, V), write(V).
  936
  937
  938% ?- trace.
  939% ?- X<< pow(numlist(1,2)), new_array_elem(a, I),
  940%	new_array_elem(b, J),
  941%	new_array_elem(c, K),
  942%	show_array, b_getval(zdd_node, V), write(V).
  943
  944% ?-new_array_elem(a, I),
  945%	new_array_elem(b, J),
  946%	new_array_elem(c, K),
  947%	show_array, b_getval(zdd_node, V), write(V).
  948
  949
  950% ?-new_array_elem(a, I),
  951%	new_array_elem(b, J),
  952%	new_array_elem(c, K).
  953
  954% ?-new_array_elem(a, I),
  955%	new_array_elem(a, J),
  956%	new_array_elem(a, K).
  957
  958% The new elem may not be necessarily unique.
  959new_array_elem(X, I):- b_getval(zdd_node, Array),
  960	index(I, Array, X).
  961
  962% ?- open_hash(H), rehash(H), writeln(H),
  963%	rehash(H), rehash(H), rehash(H), writeln(H).
 rehash(H) is det
Extend the hash table H to double-sized with migration buckets. ( H is detructively rehashed. )
  968rehash(H):-
  969	hash_vector(H, Vec),
  970	functor(Vec, F, N),
  971	N0 is N + N,
  972	functor(Vec0, F, N0),
  973	initial_args(1, Vec0, []),
  974	(	functor(H, _, 2) ->
  975		migrate_hash(1, Vec, Vec0),			% Here was a bug
  976		hash_vector_set(H, Vec0)
  977	;	migrate_hash(1, Vec, Vec0, 0, C),	% Here was a bug
  978		hash_vector_set(H, Vec0),
  979		hash_bucket_count_set(H, C)
  980	).
 migrate_hash(I, V, V0) is det
Rehash all elements of I-th bucket of V into V0.
  984migrate_hash(I, V, V0):- arg(I, V, B), !,
  985	migrate_bucket(B, V0),
  986	I0 is I + 1,
  987	migrate_hash(I0, V, V0).
  988migrate_hash(_, _, _).
  989%
  990migrate_bucket([], _).
  991migrate_bucket([Q|U], H):-
  992	(	Q = (X-_) -> E = Q
  993	;   X = Q,
  994		E = Q
  995	),
  996	functor(H, _, S),
  997	term_hash(X, 3, S, K),
  998	K0 is K + 1,
  999	arg(K0, H, D),
 1000	setarg(K0, H, [E|D]),
 1001	migrate_bucket(U, H).
 1002%
 1003migrate_hash(I, V, V0, C, C0):-	arg(I, V, B), !,
 1004	migrate_bucket(B, V0, C, C1),
 1005	I0 is I + 1,
 1006	migrate_hash(I0, V, V0, C1, C0).
 1007migrate_hash(_, _, _, C, C).
 1008
 1009%
 1010migrate_bucket([], _, C, C).
 1011migrate_bucket([Q|U], H, C, C0):-
 1012	(	Q = (X-_) -> E = Q
 1013	;   X = Q,
 1014		E = Q
 1015	),
 1016	functor(H, _, S),
 1017	term_hash(X, 3, S, K),
 1018	K0 is K + 1,
 1019	arg(K0, H, D),
 1020	setarg(K0, H, [E|D]),
 1021	(	D = [] -> C1 is C + 1
 1022	;	C1 =  C
 1023	),
 1024	migrate_bucket(U, H, C1, C0).
 1025
 1026		/****************
 1027		*     cofact    *
 1028		****************/
 cofact(?X, ?T, +State) is det
T = t(A, L, R) Bidirectional. X is unified with the index of a triple C, or C is unified with the triple t/3 stored at index X of the array.

It is explained in terms of famiy of sets as follows. If X is given then Y is a triple t(A, L, R) such that A is the minimum atom in X w.r.t specified compare predicate, L = { U in X | not ( A in U ) }, R = { V \ {A} | V in X, A in V }. If Y is given then X = union of L and { unionf of U and {A} | U in R }.

Non standard use of cofact/3 is possible keeping the structure sharing, but withoug zero_suppress rule. IMO the rule is only meaningful under family of sets semantics for the empty family {} of sets.

?- X <<{[a,b,d]}, cofact(X, T). ?- X <<{[a]}, show_state, b_getval(zdd_node, Vec), write(Vec). ?- cofact(X, a), cofact(Y, b), cofact(Z, f(X, Y)), cofact(Z, C), cofact(X, A), cofact(Y, B).

 1054% ?- zdd_array:show_state.
 1055% ?- zdd.
 1056% ?- R << {[r]}, cofact(I, t(a, 0, R)), cofact(I, T).
 1057% ?- N = 10, numlist(1, N, Ns), X<<pow(Ns), card(X, C).
 1058
 1059% ?- cofact(I, c(a, 1)), cofact(J, c(b, I)),
 1060%	cofact(J, c(X, K)), cofact(K, c(Y, H)).
 1061
 1062cofact(I, X):- iterm(I,  X).
 1063
 1064cofact(I, X, AH):- iterm(I, X, AH).
 1065
 1066		/*********************
 1067		*     list in zdd    *
 1068		*********************/
 1069
 1070% ?- zdd.
 1071% ?- zcons(a, b, I).
 1072% ?- zcons(1, 1, X).
 1073% zcons(X, Y, I):- integer(I), I>1, !,
 1074% 	iterm_get_elem(I, c(X, Y)).
 1075% zcons(X, Y, I):- iterm_hash(c(X, Y), I).
 1076zcons(X, Y, I):- cofact(I, c(X, Y)).
 1077
 1078% ?- zcons(a, 1, I), zcons(b, 1, J), zconcat(I, J, K),
 1079%	zcons(A, X, K), zcons(B, Y, X).
 1080zconcat(1, X, X):-!.
 1081zconcat(X, Y, Z):- X>1,
 1082	zcons(A, R, X),
 1083	zconcat(R, Y, U),
 1084	zcons(A, U, Z).
 1085
 1086% ?- zdd.
 1087% ?- list_zlist([[a,b],[a,b]], U), list_zlist(L, U).
 1088% ?- list_zlist([a,b,c], R), list_zlist(A, R).
 1089% ?- list_zlist([[a,b],c], R), list_zlist(A, R).
 1090% ?- N=10000, findall(a(I), between(1, N, I),  As),
 1091%	time((list_zlist(As, U), list_zlist(Xs, U), list_zlist(Xs, V))),
 1092%	As == Xs.
 1093% ?- N=10000, findall(a(I), between(1, N, I),  As),
 1094%	time((list_zlist(As, U), list_zlist(Xs, U), list_zlist(Xs, V))),
 1095%	U==V, As == Xs.
 1096
 1097% ?- N=5, numlist(1, N, Ns), list_zlist(Ns, Z), list_zlist(H, Z).
 1098%@ N = 5,
 1099%@ Ns = H, H = [1, 2, 3, 4, 5],
 1100%@ Z = 6.
 1101
 1102list_zlist(X, Y):- nonvar(X), !, list_to_zlist(X, Y).
 1103list_zlist(X, Y):- zlist_to_list(Y, X).
 1104%
 1105list_to_zlist([], 1).
 1106list_to_zlist([I|Y], Z):-
 1107	(	is_list(I) -> list_to_zlist(I, H)
 1108	;	integer(I), I>=0 ->  H = @(I)
 1109	;	H = I
 1110	),
 1111	list_to_zlist(Y, U),
 1112	zcons(H, U, Z).
 1113
 1114% list_to_zlist([X|Y], Z):- list_to_zlist(X, U),
 1115% 	list_to_zlist(Y, V),
 1116% 	zcons(U, V, Z).
 1117% list_to_zlist(X, X).
 1118%
 1119zlist_to_list(1, []):-!.
 1120zlist_to_list(X, [U0|V0]):- integer(X), X > 1, !,
 1121	zcons(U, V, X),
 1122	zlist_to_list(U, U0),
 1123	zlist_to_list(V, V0).
 1124zlist_to_list(@(X), X):-!.
 1125zlist_to_list(X, X).
 1126
 1127
 1128% ?- zdd, show_state, iterm_get_elem(1, X).
 1129% ?- open_basic_state(g), b_getval(g, AH), iterm_get_elem(I, a, AH).
 1130% ?- open_basic_state(g), b_getval(g, AH), iterm_get_elem(I, a, AH), iterm_get_elem(J, a, AH).
 1131
 1132%	Helpers for cofact/iterm
 1133iterm_get_elem(I, X):- b_getval(zdd_node, #(_, Vec)),
 1134    arg(I, Vec, X).
 1135%
 1136iterm_get_elem(I, X, #(_,Vec)):- arg(I, Vec, X).
 1137%
 1138iterm_hash(X, I):- b_getval(zdd_hash, H),
 1139	hash(X, H, I),				% check X-I entry in H (hash)
 1140	(	nonvar(I) -> true		% X already exists.
 1141	;	b_getval(zdd_node, A),
 1142		index(I, A, X)			% X is new.
 1143	).
 1144%
 1145iterm_hash(X, I, #(A,H)):-
 1146	hash(X, H, I),				% check X-I entry in H (hash)
 1147	(	nonvar(I) -> true		% X already exists.
 1148	;	index(I, A, X)			% X is new.
 1149	).
 iterm(?I, ?X) is det
The default core state is assumed. If I is unbound then, X must be a ground term, and I is unified with a unique id number of X. If I is an integer >0, X is unified with a term whose id number is I. Note that each element of used args of array is always a unique ground term.
 1160% ?- zdd.
 1161% ?- iterm(I, a), iterm(J, a), iterm(J, A).
 1162% ?- iterm(X, @(a)), show_array.
 1163
 1164iterm(I, X):- nonvar(I), !,			% X>1 assumed.
 1165	b_getval(zdd_node, #(_, Vec)),
 1166	arg(I, Vec, X0),
 1167	(	X0 = t(A,R) -> X = t(A, 0, R)
 1168	;	X = X0
 1169	).
 1170iterm(I, t(_, I, 0)):-!.
 1171iterm(I, t(A, 0, R)):-!, iterm_hash(t(A, R), I).
 1172iterm(I, X):- iterm_hash(X, I).
 iterm(?I, ?X, +AH) is det
AH is a core state. Using the array and hash bound to AH, if I is unbound then X must be a ground term, and I is unified with a unique id number of X. If I is an integer >0, X is unified with a term whose id number is I. Note that each element of used args of array is always a unique ground term.
 1183% ?- open_array_hash(AH), iterm(I, a, AH),
 1184%	iterm(J, a, AH), iterm(J, A, AH).
 1185
 1186% ?- open_array_hash(AH), iterm(I, a, AH),
 1187%	iterm(J, a, AH), iterm(J, A, AH).
 1188
 1189% iterm(I, X, #(#(_,V),_)):- nonvar(I), !,		% X>1 assumed.
 1190% 	arg(I, V, X).
 1191% iterm(I, t(_, I, 0)):-!.			% Minato's rule. (t/3 is reserved.)
 1192% iterm(I, X, #(A, H)):-
 1193% 	hash(X, H, I),
 1194% 	index(I, A, X).
 1195
 1196% ?- open_array_hash(AH),
 1197%	iterm(I, t(a, 0, 1), AH),
 1198%	iterm(I, X, AH).
 1199
 1200iterm(I, X, AH):- nonvar(I),!, % I > 1 assumed.
 1201	AH = #(#(_,V),_),
 1202	arg(I, V, X0),
 1203	(	X0 = t(A, R) -> X = t(A, 0, R)
 1204	;	X = X0
 1205	).
 1206iterm(I, t(_, I, 0), _):-!.  % zero suppress rule.
 1207iterm(I, X, #(A, H)):-
 1208	(	X = t(B, 0, U) -> X0 = t(B, U)
 1209	;	X0 = X
 1210	),
 1211	hash(X0, H, I),
 1212	index(I, A, X0).
 1213
 1214
 1215%	Similar to xarg but for destructive free array
 1216%	of the form #(count, vector).
 1217
 1218% ?- open_array(2, A),
 1219%	index_elem(I, a, A),
 1220%	index_elem(J, b, A),
 1221%	index_elem(K, c, A),
 1222%	writeln(A).
 1223
 1224index_elem(I, X, #(_, V)):- nonvar(I), !,		% X>1 assumed.
 1225	arg(I, V, X).
 1226index_elem(I, X, A):-  % I is unbound
 1227	index(I, A, X).
 1228
 1229%   normal_zdd(J, Array, K) det.
 1230%
 1231%	Converter from what is built by index_elem
 1232%	to normal form zdd.
 1233
 1234% ?- open_array(10, A),
 1235%	index_elem(I, t(a, L, R), A),
 1236%	index_elem(L, 1, A),
 1237%	index_elem(R, 1, A),
 1238%	normal_zdd(I, A, J),
 1239%	card(J, C),
 1240%	writeln(A).
 1241
 1242normal_zdd(J, _, J):- J < 2, !.
 1243normal_zdd(J, S, K):- index_elem(J, A, S),
 1244	(	integer(A) -> normal_zdd(A, S, K)
 1245	;	A = t(U, L, R),
 1246		normal_zdd(L, S, L0),
 1247		normal_zdd(R, S, R0),
 1248		cofact(K, t(U, L0, R0))
 1249	).
 1250
 1251		/*****************************************************
 1252		*     bidirectional term to from index converter.    *
 1253		*****************************************************/
 1254
 1255% ?- zdd.
 1256% ?- term(I, a), term(J, @(a)), show_array.
 1257% ?- term(I, 0), term(J, 1), show_array.
 1258% ?- X=..[., a, b], term(I, X), iterm(I, U), write_canonical(U).
 1259% ?- X=..[., a, b], term(I, X), term(I, T), write_canonical(T), compound(T).
 1260% ?- N = 100, numlist(1, N, Ns), X=..[f|Ns],
 1261% term(I, X), term(I, Y), X = Y.
 1262
 1263term(I, X):- var(I), !, term_to_index(X, I).
 1264term(I, X):- iterm(I, Y), iterm_to_term(Y, X).
 1265%
 1266term_to_index(@(X), I):-!, iterm(I, @(X)).
 1267term_to_index(X, I):- atomic(X), !, iterm(I, X).
 1268term_to_index(t(A, L, R), I):-!,
 1269	term_to_index(L, J),
 1270	term_to_index(R, K),
 1271	iterm(I, t(A, J, K)).
 1272term_to_index(X, I):- functor(X, F, N),
 1273	functor(Y, F, N),
 1274	term_to_index(1, X, Y),
 1275	iterm(I, Y).
 1276%
 1277term_to_index(K, X, Y):- arg(K, X, A), !,
 1278	arg(K, Y, I),
 1279	term_to_index(A, I),
 1280	K0 is K + 1,
 1281	term_to_index(K0, X, Y).
 1282term_to_index(_, _, _).
 1283
 1284%
 1285iterm_to_term(@(X), @(X)):-!.
 1286iterm_to_term(X, X):- atomic(X), !.
 1287iterm_to_term(t(A, J, K), t(A, L, R)):-!,
 1288	iterm_to_term(J, L),
 1289	iterm_to_term(K, R).
 1290iterm_to_term(X, Y):- functor(X, F, N),
 1291	functor(Y, F, N),
 1292	iterm_to_term(1, X, Y).
 1293%
 1294iterm_to_term(K, X, Y):- arg(K, X, I), !,
 1295	arg(K, Y, T),
 1296	iterm(I, U),
 1297	iterm_to_term(U, T),
 1298	K0 is K + 1,
 1299	iterm_to_term(K0, X, Y).
 1300iterm_to_term(_, _, _).
 1301%
 1302print_root:- b_getval(root, X),
 1303			print_iterm(X).
 1304%
 1305print_iterm(X):-use_memo(print_array_elem(X)).
 1306%
 1307print_array_elem(X):- X < 2, !.
 1308print_array_elem(X):- memo(printed(X)-T),
 1309	cofact(X, t(A, L, R)),
 1310	(	nonvar(T)-> true
 1311	;	T = true,
 1312		writeln(X = t(A, L, R)),
 1313		print_array_elem(L),
 1314		print_array_elem(R)
 1315	).
 1316
 1317
 1318		/*****************************************
 1319		*     copy, slim, ord_copy, pred_copy    *
 1320		*****************************************/
 slim_gc(+X, -Y) is det
Do slim_iterms(X, Y), and call garbage_collect.
 1325% ?- zdd.
 1326% ?- X<<{[a,b]}, slim_gc(X, Y), psa(Y).
 1327% ?- X<<{[a,b]}, slim_gc(X, Y, q_atom_slim), psa(Y).
 1328
 1329slim_gc(X, Y):- slim_iterms(X, Y), !, garbage_collect.
 slim_iterms(+X, -Y) is det
Remove all redundant iterms (was zdds) that are irrelevant to those specified in X.
 1335% ?- _<<pow([a,b]), X<<pow([c,d,e]), psa(X), slim_gc(X, Y), psa(Y).
 1336
 1337slim_iterms(X, Y):-
 1338	b_getval(zdd_node, #(_,V)),
 1339	initial_basic_state([], #(A,H)),
 1340	b_setval(zdd_node, A),
 1341	b_setval(zdd_hash, H),
 1342	!,
 1343	reset_memo_call(slim_iterms(X, Y, V)).
 1344
 1345% ?- V = #(0, t(a, 0, 1)),   slim_iterms(2, Y, V), psa(Y).
 1346slim_iterms([], [], _):-!.
 1347slim_iterms([X|Xs], [Y|Ys], V):-!,
 1348	slim_iterms(X, Y, V),
 1349	slim_iterms(Xs, Ys, V).
 1350slim_iterms(X, Y, V):-
 1351	(	integer(X) -> slim_iterm(X, Y, V)
 1352	;   Y = X
 1353	).
 1354
 1355%
 1356slim_iterm(X, X, _):- X< 2,!.
 1357slim_iterm(X, Y, V):- memo(slim_iterm(X)-Y),
 1358	(	nonvar(Y) -> true
 1359	;	arg(X, V, T),
 1360		(	T = t(A, L, R) -> slim_iterm(L, L0, V)
 1361		;	T = t(A, R) -> L0 = 0
 1362		),
 1363		slim_iterm(R, R0, V),
 1364		cofact(Y, t(A, L0, R0))
 1365	).
 pred_slim_gc(+X, -Y, +F) is det
Do slim_iterms(X, Y, F), and call garbage_collect, where F is predicate such that call(F, A, B, V).
 1371% ?- spy(dummy).
 1372% ?- zdd.
 1373% ?- X<<{[q(2), q(3)]}, psa(2), psa(3).
 1374% ?- X<<{[q(2), q(3)]}, pred_slim_gc(X, Y, test_dummy), psa(Y).
 1375test_dummy(q(2), J, V):-!, arg(2, V, t(J, _,_)).
 1376test_dummy(I, I, _).
 1377
 1378:- meta_predicate pred_slim_gc(?, ?, 3). 1379pred_slim_gc(X, Y, F):- pred_slim_iterms(X, Y, F), !, garbage_collect.
 1380%
 1381:- meta_predicate pred_slim_iterms(?,?,3). 1382pred_slim_iterms(X, Y, F):-
 1383	b_getval(zdd_node, #(_,V)),
 1384	initial_basic_state([], #(A,H)),
 1385	b_setval(zdd_node, A),
 1386	b_setval(zdd_hash, H),
 1387	!,
 1388	reset_memo_call(pred_slim_iterms(X, Y, F, V)).
 1389
 1390% ?- V = f(0, t(a, 0, 1)),   slim_iterms(2, Y, V), psa(Y).
 1391pred_slim_iterms(X, Y, F, V):- integer(X), !,  pred_slim_iterm(X, Y, F, V).
 1392pred_slim_iterms([], [], _, _):-!.
 1393pred_slim_iterms([X|Xs], [Y|Ys], F, V):-
 1394	pred_slim_iterms(X, Y, F, V),
 1395	pred_slim_iterms(Xs, Ys, F, V).
 1396
 1397%
 1398:-meta_predicate pred_slim_iterm(?, ?, 2, ?). 1399pred_slim_iterm(X, X, _, _):- X< 2,!.
 1400pred_slim_iterm(X, Y, F, V):- memo(pred_slim_iterm(X)-Y),
 1401	(	nonvar(Y) -> true
 1402	;	arg(X, V, t(A, L, R)),
 1403		call(F, A, B, V),
 1404		pred_slim_iterm(L, L0, F, V),
 1405		pred_slim_iterm(R, R0, F, V),
 1406		cofact(Y, t(B, L0, R0))
 1407	).
 1408
 1409%-----
 1410% ?- ltr, N=3, K=100, open_hash(N, H), nb_setval(zdd_hash, H),
 1411%	numlist(1, K, Ks), X<< dnf(+Ks), dump_memo.
 1412%
 1413dump_memo:- dump_memo(zdd_hash).  % default main memo.
 1414%
 1415dump_memo(Name):- b_getval(Name, H),  dump_hash(H).
 1416%
 1417dump_hash(#(C,B,V)):-!, functor(V, _, S),
 1418	writeln((cont=C, bucket=B, hsize=S)),
 1419	forall(between(1, S, K), ( arg(K, V, D), writeln(D)))