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% ?- module(ptqfrag).
   68% ?- run_samples.
   69
   70% ?- module('expand_dict').
   71% ?- btree_build({A:Y}, Z).
   72% ?- btree_build({a:Y, a:Y}, Z).
   73% ?- enable_odict.
   74% ?- enable_pac_query.
   75% ?- X = {a:1, B}.		% not dict.
   76% ?- X = {a:1, a:2}.	% dict.
   77% ?- X={c:1, d: Y.d}, Y={c:X.c, d:2}, C= Y.c, D=X.d.
   78% ?- C= Y.c, D=X.d, X={c:1, d: Y.d}, Y={c:X.c, d:2}.
   79% ?- expand_dict_goal( (#=(role(X,a), 1), V = role(X,a)), R).
   80
   81% ?- disable_odict.
   82% ?- disable_pac_query.
   83% ?- trace, 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).
   84
   85btree_build(X, X):- (var(X); atomic(X)), !.
   86btree_build({X}, Y):- !,
   87	( var(X) -> throw(btree_build('variable dict found.'))
   88	;  	dict_to_balanced_btree(X, Y)
   89	).
   90btree_build(X, Y):- X=..[F|As],
   91		maplist(btree_build, As, Bs),
   92		Y=..[F|Bs].
   93
   94%  './2' and './3' are reserved for the dict in SWI-7.
   95%  './2' is untuchable for the user in a direct way.
   96period_term(X):- functor(X, (.), 2), !.
   97period_term(role(_,_)).
   98
   99%
  100period_args(X, A, B):- X=..[(.), A, B].
  101period_args(role(A, B), A, B).
  102
  103% % anti_subst(+X, -A, -R) is det.
  104%  True if apply the assoc to A makes X.
  105%  Roughly it is an inverse operation of the substitution.
  106%
  107% ?- anti_subst(a({b:1}), B, R).
  108% ?- anti_subst(a({b:{c:1}}), B, R).
  109% ?- anti_subst(a({b:{C:1}}), B, R).
  110% ?- anti_subst(a({b:2, b:1}), B, R).
  111
  112%
  113anti_subst(X, A, R):- anti_subst(X, A, R, []),
  114 		  maplist(check_item, R).
  115%
  116anti_subst(X, A, R, R):- (var(X); atomic(X)), !, A=X.
  117anti_subst({X}, A, R, Q):- !,
  118		( var(X)	-> throw(btree_build('unexpected variable found'))
  119		;	anti_subst(X, X0, R, R0),
  120			R0= [A={X0}|Q]
  121		).
  122anti_subst(X, A, [A=X|R], R):- period_term(X), !. % X= .(_,_)
  123anti_subst(X, A, R, R0):- X=..[F|Xs],
  124			anti_subst_list(Xs, As, R, R0),
  125			A=..[F|As].
  126%
  127anti_subst_list([],[],R,R).
  128anti_subst_list([X|Xs],[Y|Ys],R, R0):-
  129			anti_subst(X, Y, R, R1),
  130			anti_subst_list(Xs, Ys, R1, R0).
  131
  132%
  133check_item(_={X}):- !,
  134	 ( once( (check_ground_key(X),
  135			  check_duplicate_key(X, [], _))) -> true
  136	 ; throw(btree_build(non_ground_or_duplicate_key({X})))
  137	 ).
  138check_item(_=_).   % X.a.b etc
  139%
  140check_ground_key(X):- var(X), !,
  141					  throw(btree_build('unexpected variable found')).
  142check_ground_key(X:_):- ground(X).
  143check_ground_key((X,Y)):- check_ground_key(X),
  144		check_ground_key(Y).
  145%
  146check_duplicate_key(X:_, Ks, [X|Ks]):- \+ memberchk(X, Ks).
  147check_duplicate_key((X,Y), L, M):-  check_duplicate_key(X, L, N),
  148		check_duplicate_key(Y, N, M).
  149
  150% ?- dict_to_balanced_btree((b:2, c:3, a:1), B).
  151dict_to_balanced_btree(X, Y):- dict_to_list(X, X0, []),
  152							   list_to_btree(X0, Y).
  153
  154%
  155dict_to_list(X, _, _):- var(X), !,
  156 		throw(btree_build('unexpected variable found')).
  157dict_to_list((X,Y), P, Q):- !, dict_to_list(X, P, P0),
  158							dict_to_list(Y, P0, Q).
  159dict_to_list(X, [X|P], P).
  160
  161% ?- module(expand_dict).
  162% ?- list_to_btree([a:1, b:2, c:3, d:4, e:5], T).
  163
  164list_to_btree(X, Y):- sort(X, X0),
  165	length(X0, N),
  166	list_to_btree(X0, N, Y).
  167
  168%
  169list_to_btree([], _, _).  % for open dict
  170list_to_btree(X, N, t(K, U, L0, R0)):-
  171		  J is N//2,
  172		  length(L, J),
  173		  append(L, [Pair|R], X),
  174		  pair(Pair, K, U),
  175		  list_to_btree(L, J, L0),
  176		  J0 is N - J - 1,
  177		  list_to_btree(R, J0, R0).
  178%
  179pair(A-B, A, B).
  180pair(A=B, A, B).
  181pair(A:B, A, B).
  182
  183	/*************************************
  184	*        convert btree to list/dict  *
  185	*************************************/
  186
  187% ?- module(expand_dict).
  188% ?- btree_to_dict({}, X).
  189% ?- btree_to_dict({a:1, b:2}, X).
  190% ?- trace, btree_to_dict({a:f(1)}, X).
  191% ?- btree_to_dict({a:f({a:1})}, X).
  192% ?- btree_to_dict({a:f({a:A})}, X).
  193%
  194is_btree(t(_,_,_,_)).
  195is_btree({}).
  196
  197%
  198list_to_comma([], {}):-!.
  199list_to_comma(X, {Y}):- list_to_comma_(X, Y).
  200%
  201list_to_comma_([X], X):-!.
  202list_to_comma_([X, Y|Z], (X, U)):- list_to_comma_([Y|Z], U).
  203
  204% ?- module(expand_dict).
 btree_to_dict(+X, -Y) is det
Y is a dict form of an internal binary tree X.
  209btree_to_dict(X, Y):- map_btree(X, Y0), list_to_comma(Y0, Y).
 skelton(+X, -Y) is det
True if Y is a btree X in the 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).

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