1:- module(expand_dict, [
    2				expand_dict/3,
    3%				btree_build/2,
    4				btree_to_dict/2,
    5				expand_dict_head/3,
    6				expand_dict_basic/2,
    7				expand_dict_goal/2,
    8				expand_dict_clause/2,
    9				expand_dict_dcg_rule/2
   10			   ]).   11
   12:- use_module('odict-attr').   13:- use_module(reduce).   14:- use_module([
   15		library(lists),
   16		library(sort),
   17		library(ordsets)]).   18
   19% for short.
   20put_attr(V, A):- put_attr(V, cil, A).
   21get_attr(V, A):- get_attr(V, cil, A).
   22
   23% The term expansion is designed so that the expanded dict terms
   24% have  no calls of unify/2. It may have calls of role/3, though.
   25% btree unification is hooked in cil module.
   26
   27%	Syntax of iterm and dterm.
   28%
   29% term		:=	<prolog term>
   30% atom		:=  <prolog atom>
   31% variable  :=  <prolog variable>
   32% key		:=  <prolog ground term>
   33%
   34% iterm 	:=	{}		(void iterm)
   35%			|	{ key:dterm, key:dterm, ..., key:dterm }
   36%
   37% dterm		:=	term
   38%			|	atom(dterm, ..., dterm)
   39%			|	iterm
   40%			|	rterm
   41%
   42% rterm		:=  variable.kterm.kterm....kterm
   43%
   44% kterm		:=  term.
   45
   46% Examples of iterm
   47%   {a:1,  b:{c:2, d:3} }
   48%   {a:X,  b:f(X, X)}
   49%   {a:X,  b:X.c.d}
   50%   {a:f(X.a, Y.b)}
   51%   {a:f(X.A.B, Y.B)}
   52
   53	/**************************************
   54	*        term expansion for Dict      *
   55	**************************************/
   56
   57non_clause(:-(_)).
   58non_clause(?-(_)).
   59
   60is_clause(X):- \+ non_clause(X).
   61
   62%
   63expand_dict(X, Y):- is_clause(X),
   64					expand_dict_clause(X, Y).
   65
   66% ?- [misc('ptq-fragment')].
   67% ?- [pac('odict-expand')].
   68% ?- module(odict_expand).
   69% ?- btree_build({a:Y, Y}, Z).
   70% ?- btree_build({A:Y}, Z).
   71% ?- btree_build({a:Y, a:Y}, Z).
   72% ?- X = {a:1, B}.
   73% ?- X = {a:1, a:2}.
   74% ?- X={c:1, d: Y.d}, Y={c:X.c, d:2}, C= Y.c, D=X.d.
   75% ?- C= Y.c, D=X.d, X={c:1, d: Y.d}, Y={c:X.c, d:2}.
   76% ?- expand_dict_goal( (#=(role(X,a), 1), V = role(X,a)), R).
   77% ?- btree_build({k:1}, S0), btree_build({j:2}, R0), S=x(S0,_), R=x(R0,_),  unify(a(S,R), a(M, M)), role(k, M, V), role(j, M, U).
   78
   79btree_build(X, X):- (var(X); atomic(X)), !.
   80btree_build({X}, Y):- !,
   81	( var(X) -> throw(btree_build('variable dict found.'))
   82	;  	dict_to_balanced_btree(X, Y)
   83	).
   84btree_build(X, Y):- X=..[F|As],
   85		maplist(btree_build, As, Bs),
   86		Y=..[F|Bs].
   87
   88%  './2' and './3' are reserved for the dict in SWI-7.
   89%  './2' is untuchable for the user in a direct way.
   90period_term(X):- functor(X, (.), 2), !.
   91period_term(role(_,_)).
   92
   93%
   94period_args(X, A, B):- X=..[(.), A, B].
   95period_args(role(A, B), A, B).
   96
   97% :- expects_dialect(swi).
   98%@ true.
   99
  100% % anti_subst(+X, -A, -R) is det.
  101%  True if apply the assoc to A makes X.
  102%  Roughly it is an inverse operation of the substitution.
  103%
  104% ?- anti_subst(a({b:1}), B, R).
  105% ?- anti_subst(a({b:{c:1}}), B, R).
  106% ?- anti_subst(a({b:{C:1}}), B, R).
  107% ?- anti_subst(a({b:2, b:1}), B, R).
  108
  109%
  110anti_subst(X, A, R):- anti_subst(X, A, R, []),
  111 		  maplist(check_item, R).
  112%
  113anti_subst(X, A, R, R):- (var(X); atomic(X)), !, A=X.
  114anti_subst({X}, A, R, Q):- !,
  115		( var(X)	-> throw(btree_build('unexpected variable found'))
  116		;	anti_subst(X, X0, R, R0),
  117			R0= [A={X0}|Q]
  118		).
  119anti_subst(X, A, [A=X|R], R):- period_term(X), !. % X= .(_,_)
  120anti_subst(X, A, R, R0):- X=..[F|Xs],
  121			anti_subst_list(Xs, As, R, R0),
  122			A=..[F|As].
  123%
  124anti_subst_list([],[],R,R).
  125anti_subst_list([X|Xs],[Y|Ys],R, R0):-
  126			anti_subst(X, Y, R, R1),
  127			anti_subst_list(Xs, Ys, R1, R0).
  128
  129%
  130check_item(_={X}):- !,
  131	 ( once( (check_ground_key(X),
  132			  check_duplicate_key(X, [], _))) -> true
  133	 ; throw(btree_build(non_ground_or_duplicate_key({X})))
  134	 ).
  135check_item(_=_).   % X.a.b etc
  136%
  137check_ground_key(X):- var(X), !,
  138					  throw(btree_build('unexpected variable found')).
  139check_ground_key(X:_):- ground(X).
  140check_ground_key((X,Y)):- check_ground_key(X),
  141		check_ground_key(Y).
  142%
  143check_duplicate_key(X:_, Ks, [X|Ks]):- \+ memberchk(X, Ks).
  144check_duplicate_key((X,Y), L, M):-  check_duplicate_key(X, L, N),
  145		check_duplicate_key(Y, N, M).
  146
  147% ?- dict_to_balanced_btree((b:2, c:3, a:1), B).
  148dict_to_balanced_btree(X, Y):- dict_to_list(X, X0, []),
  149							   list_to_btree(X0, Y).
  150
  151%
  152dict_to_list(X, _, _):- var(X), !,
  153 		throw(btree_build('unexpected variable found')).
  154dict_to_list((X,Y), P, Q):- !, dict_to_list(X, P, P0),
  155							dict_to_list(Y, P0, Q).
  156dict_to_list(X, [X|P], P).
  157
  158% ?- module(expand_dict).
  159% ?- list_to_btree([a:1, b:2, c:3, d:4, e:5], T).
  160
  161list_to_btree(X, Y):- sort(X, X0),
  162	length(X0, N),
  163	list_to_btree(X0, N, Y).
  164
  165%
  166list_to_btree([], _, _).  % for open dict
  167list_to_btree(X, N, t(K, U, L0, R0)):-
  168		  J is N//2,
  169		  length(L, J),
  170		  append(L, [Pair|R], X),
  171		  pair(Pair, K, U),
  172		  list_to_btree(L, J, L0),
  173		  J0 is N - J - 1,
  174		  list_to_btree(R, J0, R0).
  175%
  176pair(A-B, A, B).
  177pair(A=B, A, B).
  178pair(A:B, A, B).
  179
  180	/*************************************
  181	*        convert btree to list/dict  *
  182	*************************************/
  183
  184% ?- module(expand_dict).
  185% ?- btree_to_dict({}, X).
  186% ?- btree_to_dict({a:1, b:2}, X).
  187% ?- btree_to_dict({a:f(1)}, X).
  188% ?- btree_to_dict({a:f({a:1})}, X).
  189% ?- btree_to_dict({a:f({a:A})}, X).
  190
  191%
  192is_btree(t(_,_,_,_)).
  193is_btree({}).
  194
  195%
  196list_to_comma([], {}):-!.
  197list_to_comma(X, {Y}):- list_to_comma_(X, Y).
  198%
  199list_to_comma_([X], X):-!.
  200list_to_comma_([X, Y|Z], (X, U)):- list_to_comma_([Y|Z], U).
 btree_to_dict(+X, -Y) is det
Y is a dict form of an internal binary tree X.
  205btree_to_dict(X, Y):- map_btree(X, Y0), list_to_comma(Y0, Y).
 skelton(+X, -Y) is det
True if a btree X becomes Y in form of the list with all leaves of X being removed.

?- skelton(t(a, b, t(c, t(d, E,_,_), _, t(f,g, _, _)), _), X). ?- skelton(t(a, t(c, t(d, E,_,_), _,_), _, _), X). ?- skelton(t(a, t(c, 1, _, _), _, _), X). ?- skelton(t(a, b, t(c, d, _,_), _), X).

  217skelton(X, Y):- map_btree_to_list(skelton_pair, X, Y, []).
  218
  219% Form options for pairing key-value, supposed to be
  220% passed to map_btree_to_list.
  221
  222default_pair(terminal, K, V, K-leaf(V)).
  223default_pair(nonterminal, K, V, K-V).
  224%
  225ambiguous_pair(_, K, V, K-V).
  226%
  227skelton_pair(terminal, K, _, K).
  228skelton_pair(nonterminal, K, V, K-V).
  229
  230% Amiguous mapping  a btree to its list form.
  231map_btree(X, Y):- map_btree_to_list(ambiguous_pair, X, Y, []).
 map_btree_to_list(+M, +X, -Y) is det
Y is a list form of an internal binary tree X, with a key-value formed by option M.
  237map_btree_to_list(M, X, Y, Z):- var(X), !,
  238				 ( get_attr(X, X0)
  239				 -> (X0 = btree(Btree)
  240					->	map_btree_to_list(M, Btree, Y, Z)
  241					;	Y = Z
  242						)
  243				 ;	Y = Z
  244				 ).
  245map_btree_to_list(_, {}, Y, Y):- !.
  246map_btree_to_list(M, t(K, V, L, R), P, Q):-
  247				map_btree_to_list(M, L, P, P0),
  248				map_btree_arg(M, K, V, Pair),
  249				P0=[Pair|P1],
  250				map_btree_to_list(M, R, P1, Q).
 map_btree_arg(+M, +K, +V, -Pair) is det
Pair is unified with a key-value formed by option M, where V is converted to be the value.
  256map_btree_arg(M, K, V, Pair):- attvar(V), !,
  257				get_attr(V, V0),
  258				(	is_btree(V0)
  259				->	map_btree_to_list(M, V0, P, []),
  260					call(M, nonterminal, K, P, Pair)
  261				;	call(M, terminal, K, V, Pair)
  262				).
  263map_btree_arg(M, K, V, Pair):- var(V), !,
  264			call(M, terminal, K, V, Pair).
  265map_btree_arg(M, K, V, Pair):- is_btree(V), !,
  266			map_btree_to_list(M, V, U, []),
  267			call(M, nonterminal, K, U, Pair).
  268map_btree_arg(M, K, V, Pair):-
  269			( atomic(V)
  270			->	call(M, terminal, K, V, Pair)
  271			;	V =..[F|Vs],
  272				maplist(map_btree_arg(M), Vs, Us),
  273				U =..[F|Us],
  274				call(M, terminal, K, U, Pair)
  275			).
  276% % map_btree_arg(+M,+V,+U) is det.
  277%  For a btree or non btree term V,  U is unified with
  278%  the converted form of V using option M.
  279
  280map_btree_arg(M, V, U):-
  281	(	var(V)
  282	->	(	get_attr(V, A)
  283		->	(	A = btree(T)
  284			->	map_btree_to_list(M, T, U, [])
  285			;	U = V
  286			)
  287		;	U = V
  288		)
  289	;	(	atomic(V)
  290		->	U = V
  291		;	V =..[F|Vs],
  292			map_btree_arg(M, Vs, Us),
  293			U =..[F|Us]
  294		)
  295	).
  296
  297
  298% ?- expand_dict:expand_dict({a:1}, Y, G).
  299
  300expand_dict(X, Y, G):-
  301		btree_build(X, X1),
  302		region_constr_of_leaves(X1, total, Put_attrs, []),
  303		G = (	put_attr(X0, cil, btree(X1)),
  304				maplist(call, Put_attrs),
  305				cil:(Y=X0)
  306			).
  307
  308
  309
  310	/*************************************************
  311	*      Expand Feature Structure Unification      *
  312	*************************************************/
  313
  314% ?- make_body_unify([a = A.b], X).
  315% ?- make_body_unify([a = A.b.c], X).
  316
  317% Note:   cil:(X=Y)  is for sending X=Y to attr_unify_hook/2
  318% defined in the cil module.
  319
  320make_head_unify([], true).
  321make_head_unify([E], X):- !,
  322		make_head_unify_one(E, X).
  323make_head_unify([E|R], (X, R0)):-
  324		make_head_unify_one(E, X),
  325		make_head_unify(R, R0).
  326%
  327make_head_unify_one(A = B, cil:(A=B)):- (var(B); atomic(B)), !.
  328make_head_unify_one(A = {B}, (put_attr(B0, cil, btree(B1)),
  329							  maplist(call, Put_attrs),
  330							  cil:(A=B0)) ):- !,
  331		btree_build({B}, B1),
  332		region_constr_of_leaves(B1, total, Put_attrs, []).
  333make_head_unify_one(A = P, G):- period_term(P), !,
  334		flatten_period(P, L, []),
  335		L=[X|L0],
  336		expand_dict_role(L0, X, A, G).
  337make_head_unify_one(A = P, cil:(A=P)).
  338
  339%
  340make_body_unify([], true).
  341make_body_unify([E], X):- !,
  342		make_body_unify_one(E, X).
  343make_body_unify([E|R], (X, R0)):-
  344		make_body_unify_one(E, X),
  345		make_body_unify(R, R0).
  346%
  347make_body_unify_one(A = B, true):- (var(B); atomic(B)), !, A = B.
  348make_body_unify_one(A = {B}, (	put_attr(B0, btree(B1)),
  349								maplist(call, Put_attrs),
  350								cil:(A=B0)
  351							 )):- !,
  352		btree_build({B}, B1),
  353		region_constr_of_leaves(B1, total, Put_attrs, []).
  354make_body_unify_one(A = P, G):- period_term(P), !,
  355		flatten_period(P, L, []),
  356		L = [X|L0],
  357		expand_dict_role(L0, X, A, G).
  358make_body_unify_one(A = P, true):- A = P.
  359
  360%
  361expand_dict_role([], X, A, cil:(A=X)):-!.
  362expand_dict_role([R|P], X, A, (role(R, X, Y), G) ):-
  363		expand_dict_role(P, Y, A, G).
  364%
  365flatten_period(P, [P|L], L):- var(P), !.
  366flatten_period(P, Q, R):- period_args(P, A, B), !,
  367		flatten_period(A, Q, Q0),
  368		flatten_period(B, Q0, R).
  369flatten_period(P, [P|Q], Q).
  370
  371% ?- expand_dict_goal((true, true), X).
  372expand_dict_goal(X, Y):-
  373		once(expand_dict_to_front(X, Y0)),
  374		once(slim_goal(Y0, Y)).
  375%
  376expand_dict_to_front((X,Y), (X0, Y0)):-
  377	expand_dict_to_front(X, X0),
  378	expand_dict_to_front(Y, Y0).
  379expand_dict_to_front(X;Y, X0; Y0):-
  380	expand_dict_to_front(X, X0),
  381	expand_dict_to_front(Y, Y0).
  382expand_dict_to_front(X->Y, X0->Y0):-
  383	expand_dict_to_front(X, X0),
  384	expand_dict_to_front(Y, Y0).
  385expand_dict_to_front(not(X), \+(X0)):-
  386	expand_dict_to_front(X, X0).
  387expand_dict_to_front(X, Y):- X=..[phrase, P|R], !,
  388	expand_dict_dcg_rule_body(P, Q),
  389	Y =..[phrase, Q|R].
  390expand_dict_to_front(L=R, G):-
  391	anti_subst(L=R, L0=R0, U0),
  392	make_body_unify(U0, U),
  393	( U==[]	->  G = (cil:(L0=R0))
  394	;  G = (U, cil:(L0=R0))
  395    ).
  396expand_dict_to_front(X, Y):- expand_dict_basic(X, Y).
  397
  398
  399 	/****************************************
  400	*   Expand CIL clauses, DCG rules,		*
  401	*	and queries.						*
  402	****************************************/
  403
  404% ?- expand_dict_clause(m: ((a:-b), c:-d), R).
  405%@ R = m:((a:-b), c:-d).
  406
  407expand_dict_clause(:-(H, B), :-(NewH, NewB)):-!,
  408		expand_dict_head(H, NewH, U),
  409	    expand_dict_goal(B, NewB0),
  410		slim_goal((U, NewB0), NewB).
  411expand_dict_clause(M:A, M:B):-!,
  412		expand_dict_clause(A, B).
  413expand_dict_clause(X-->X0, Y):-
  414		expand_dict_dcg_rule(X-->X0, Y),
  415		!.
  416expand_dict_clause(X, H:-Eqs):-
  417         expand_dict_head(X, H, Eqs).
  418
  419
  420% ?- expand_dict_head(a:-b, R).
  421expand_dict_head(H, NewH, Eqs):-
  422        anti_subst(H, NewH, U),
  423		make_head_unify(U, Eqs).
  424
  425% ?- expand_dict:expand_dict_basic(p({a:1}), R).
  426expand_dict_basic(X, (U, X0)):-
  427	anti_subst(X, X0, U0),
  428	make_body_unify(U0, U).
  429
  430% ?- module(expand_dict).
  431% ?- expand_dict_dcg_rule(a({j:1})-->b, R).
  432% ?- expand_dict_dcg_rule(a({j:1})-->b({k:2}), R).
  433% ?- expand_dict_dcg_rule(a({j:{i:1}})-->b({k:{l:2}}), R).
  434% ?- expand_dict_dcg_rule(a-->b({k:{l:2}}), R).
  435
  436expand_dict_dcg_rule(H --> B, (NewH--> {SlimU}, NewB)):-
  437        anti_subst(H, NewH, Eqs),
  438		make_head_unify(Eqs, U),
  439		slim_goal(U, SlimU),
  440	    expand_dict_dcg_rule_body(B, B0),
  441		slim_goal(B0, NewB).
  442%
  443expand_dict_dcg_rule_body(A, A):-
  444		(var(A); atomic(A); is_list(A); string(A)), !.
  445expand_dict_dcg_rule_body((A, B), (A0, B0)):- !,
  446		expand_dict_dcg_rule_body(A, A0),
  447		expand_dict_dcg_rule_body(B, B0).
  448expand_dict_dcg_rule_body(X;Y, X0; Y0):-
  449		expand_dict_dcg_rule_body(X, X0),
  450		expand_dict_dcg_rule_body(Y, Y0).
  451expand_dict_dcg_rule_body(X|Y, X0|Y0):-
  452		expand_dict_dcg_rule_body(X, X0),
  453		expand_dict_dcg_rule_body(Y, Y0).
  454expand_dict_dcg_rule_body({A}, {B}):- !,
  455		expand_dict_goal(A, B).
  456expand_dict_dcg_rule_body(A, ({U}, A0)):-
  457		anti_subst(A, A0, U0),
  458		make_body_unify(U0, U)