1:- module(odict_expand, [
    2				odict_expand_goal/2,
    3				odict_expand/2,
    4				btree_to_odict/2
    5			   ]).    6
    7:- use_module(['odict-attr']).    8:- use_module([
    9		library(lists),
   10		library(sort),
   11		library(ordsets)]).   12
   13% for short.
   14put_attr(V, A):- put_attr(V, cil, A).
   15get_attr(V, A):- get_attr(V, cil, A).
   16
   17% The term expansion is designed so that the expanded odict terms
   18% have  no calls of unify/2. It may have calls of role/3, though.
   19% btree unification is hooked in cil module.
   20
   21%	Syntax of iterm and dterm.
   22%
   23% term		:=	<prolog term>
   24% atom		:=  <prolog atom>
   25% variable  :=  <prolog variable>
   26% key		:=  <prolog ground term>
   27%
   28% iterm 	:=	{}		(void iterm)
   29%			|	{ key:dterm, key:dterm, ..., key:dterm }
   30%
   31% dterm		:=	term
   32%			|	atom(dterm, ..., dterm)
   33%			|	iterm
   34%			|	rterm
   35%
   36% rterm		:=  variable.kterm.kterm....kterm
   37%
   38% kterm		:=  term.
   39
   40% Examples of iterm
   41%   {a:1,  b:{c:2, d:3} }
   42%   {a:X,  b:f(X, X)}
   43%   {a:X,  b:X.c.d}
   44%   {a:f(X.a, Y.b)}
   45%   {a:f(X.A.B, Y.B)}
   46
   47
   48	/**************************************
   49	*        term expansion for Odict      *
   50	**************************************/
   51
   52non_clause(:-(_)).
   53non_clause(?-(_)).
   54
   55%
   56odict_expand(X, Y):- \+ non_clause(X),
   57			   odict_expand_clause(X, Y).
   58
   59% ?- ['ptq-fragment'].
   60% ?- btree_build({a:Y, Y}, Z).
   61% ?- btree_build({A:Y}, Z).
   62% ?- btree_build({a:Y, a:Y}, Z).
   63% ?- X = {a:1, B}.
   64% ?- X = {a:1, a:2}.
   65% ?- X={c:1, d: Y.d}, Y={c:X.c, d:2}, C= Y.c, D=X.d.
   66% ?- C= Y.c, D=X.d, X={c:1, d: Y.d}, Y={c:X.c, d:2}.
   67% ?- odict_expand_goal( (#=(role(X,a), 1), V = role(X,a)), R).
   68% ?- 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).
   69
   70btree_build(X, X):- (var(X); atomic(X)), !.
   71btree_build({X}, Y):- !,
   72	( var(X) -> throw(btree_build('variable odict found.'))
   73	;  	odict_to_balanced_btree(X, Y)
   74	).
   75btree_build(X, Y):- X=..[F|As],
   76		maplist(btree_build, As, Bs),
   77		Y=..[F|Bs].
   78
   79%  './2' and './3' are reserved for the odict in SWI-7.
   80%  './2' is untuchable for the user in a direct way.
   81period_term(X):- functor(X, (.), 2), !.
   82period_term(role(_,_)).
   83
   84%
   85period_args(X, A, B):- X=..[(.), A, B].
   86period_args(role(A, B), A, B).
   87
   88% % anti_subst(+X, -A, -R) is det.
   89%  True if apply the assoc to A makes X.
   90%  Roughly it is an inverse operation of the substitution.
   91%
   92% ?- anti_subst(a({b:1}), B, R).
   93% ?- anti_subst(a({b:{c:1}}), B, R).
   94% ?- anti_subst(a({b:{C:1}}), B, R).
   95% ?- anti_subst(a({b:2, b:1}), B, R).
   96
   97%
   98anti_subst(X, A, R):- anti_subst(X, A, R, []),
   99 		  maplist(check_item, R).
  100%
  101anti_subst(X, A, R, R):- (var(X); atomic(X)), !, A=X.
  102anti_subst({X}, A, R, Q):- !,
  103		( var(X)	-> throw(btree_build('unexpected variable found'))
  104		;	anti_subst(X, X0, R, R0),
  105			R0= [A={X0}|Q]
  106		).
  107anti_subst(X, A, [A=X|R], R):- period_term(X), !. % X= .(_,_)
  108anti_subst(X, A, R, R0):- X=..[F|Xs],
  109			anti_subst_list(Xs, As, R, R0),
  110			A=..[F|As].
  111%
  112anti_subst_list([],[],R,R).
  113anti_subst_list([X|Xs],[Y|Ys],R, R0):-
  114			anti_subst(X, Y, R, R1),
  115			anti_subst_list(Xs, Ys, R1, R0).
  116
  117%
  118check_item(_={X}):- !,
  119	 ( once( (check_ground_key(X),
  120			  check_duplicate_key(X, [], _))) -> true
  121	 ; throw(btree_build(non_ground_or_duplicate_key({X})))
  122	 ).
  123check_item(_=_).   % X.a.b etc
  124%
  125check_ground_key(X):- var(X), !,
  126					  throw(btree_build('unexpected variable found')).
  127check_ground_key(X:_):- ground(X).
  128check_ground_key((X,Y)):- check_ground_key(X),
  129		check_ground_key(Y).
  130%
  131check_duplicate_key(X:_, Ks, [X|Ks]):- \+ memberchk(X, Ks).
  132check_duplicate_key((X,Y), L, M):-  check_duplicate_key(X, L, N),
  133		check_duplicate_key(Y, N, M).
  134
  135% ?- odict_to_balanced_btree((b:2, c:3, a:1), B).
  136odict_to_balanced_btree(X, Y):- odict_to_list(X, X0, []),
  137							   list_to_btree(X0, Y).
  138
  139%
  140odict_to_list(X, _, _):- var(X), !,
  141 		throw(btree_build('unexpected variable found')).
  142odict_to_list((X,Y), P, Q):- !, odict_to_list(X, P, P0),
  143							odict_to_list(Y, P0, Q).
  144odict_to_list(X, [X|P], P).
  145
  146% ?- module(odict_expand).
  147% ?- list_to_btree([a:1, b:2, c:3, d:4, e:5], T).
  148
  149list_to_btree(X, Y):- sort(X, X0),
  150	length(X0, N),
  151	list_to_btree(X0, N, Y).
  152
  153%
  154list_to_btree([], _, _).  % for open odict
  155list_to_btree(X, N, t(K, U, L0, R0)):-
  156		  J is N//2,
  157		  length(L, J),
  158		  append(L, [Pair|R], X),
  159		  pair(Pair, K, U),
  160		  list_to_btree(L, J, L0),
  161		  J0 is N - J - 1,
  162		  list_to_btree(R, J0, R0).
  163%
  164pair(A-B, A, B).
  165pair(A=B, A, B).
  166pair(A:B, A, B).
  167
  168	/*************************************
  169	*        convert btree to list/odict  *
  170	*************************************/
  171
  172% ?- module(odict_expand).
  173% ?- btree_to_odict({}, X).
  174% ?- btree_to_odict({a:1, b:2}, X).
  175% ?- btree_to_odict({a:f(1)}, X).
  176% ?- btree_to_odict({a:f({a:1})}, X).
  177% ?- btree_to_odict({a:f({a:A})}, X).
  178
  179%
  180is_btree(t(_,_,_,_)).
  181is_btree({}).
  182
  183%
  184list_to_comma([], {}):-!.
  185list_to_comma(X, {Y}):- list_to_comma_(X, Y).
  186%
  187list_to_comma_([X], X):-!.
  188list_to_comma_([X, Y|Z], (X, U)):- list_to_comma_([Y|Z], U).
  189
  190% % btree_to_odict(+X, -Y) is det.
  191%  Y is a odict form of an internal binary tree X.
  192
  193btree_to_odict(X, Y):- map_btree(X, Y0), list_to_comma(Y0, Y).
  194
  195% % skelton(+X, -Y) is det.
  196%
  197%   True if a btree X becomes Y in form of the list with
  198%	all leaves of X being removed.
  199%
  200%  ?- skelton(t(a, b, t(c, t(d, E,_,_), _, t(f,g, _, _)), _), X).
  201%  ?- skelton(t(a, t(c, t(d, E,_,_), _,_), _, _), X).
  202%  ?- skelton(t(a, t(c, 1, _, _), _, _), X).
  203%  ?- skelton(t(a, b, t(c, d, _,_), _), X).
  204
  205skelton(X, Y):- map_btree_to_list(skelton_pair, X, Y, []).
  206
  207% Form options for pairing key-value, supposed to be
  208% passed to map_btree_to_list.
  209
  210default_pair(terminal, K, V, K-leaf(V)).
  211default_pair(nonterminal, K, V, K-V).
  212%
  213ambiguous_pair(_, K, V, K-V).
  214%
  215skelton_pair(terminal, K, _, K).
  216skelton_pair(nonterminal, K, V, K-V).
  217
  218% Amiguous mapping  a btree to its list form.
  219map_btree(X, Y):- map_btree_to_list(ambiguous_pair, X, Y, []).
  220
  221% % map_btree_to_list(+M, +X, -Y) is det.
  222%  Y is a list form of an internal binary tree X,
  223%  with a key-value formed by option M.
  224
  225map_btree_to_list(M, X, Y, Z):- var(X), !,
  226				 ( get_attr(X, X0)
  227				 -> (X0 = btree(Btree)
  228					->	map_btree_to_list(M, Btree, Y, Z)
  229					;	Y = Z
  230						)
  231				 ;	Y = Z
  232				 ).
  233map_btree_to_list(_, {}, Y, Y):- !.
  234map_btree_to_list(M, t(K, V, L, R), P, Q):-
  235				map_btree_to_list(M, L, P, P0),
  236				map_btree_arg(M, K, V, Pair),
  237				P0=[Pair|P1],
  238				map_btree_to_list(M, R, P1, Q).
  239
  240% % map_btree_arg(+M, +K, +V, -Pair) is det.
  241%  Pair is unified with a key-value formed by option M,
  242%	where V is converted to be the value.
  243
  244map_btree_arg(M, K, V, Pair):- attvar(V), !,
  245				get_attr(V, V0),
  246				(	is_btree(V0)
  247				->	map_btree_to_list(M, V0, P, []),
  248					call(M, nonterminal, K, P, Pair)
  249				;	call(M, terminal, K, V, Pair)
  250				).
  251map_btree_arg(M, K, V, Pair):- var(V), !,
  252			call(M, terminal, K, V, Pair).
  253map_btree_arg(M, K, V, Pair):- is_btree(V), !,
  254			map_btree_to_list(M, V, U, []),
  255			call(M, nonterminal, K, U, Pair).
  256map_btree_arg(M, K, V, Pair):-
  257			( atomic(V)
  258			->	call(M, terminal, K, V, Pair)
  259			;	V =..[F|Vs],
  260				maplist(map_btree_arg(M), Vs, Us),
  261				U =..[F|Us],
  262				call(M, terminal, K, U, Pair)
  263			).
  264% % map_btree_arg(+M,+V,+U) is det.
  265%  For a btree or non btree term V,  U is unified with
  266%  the converted form of V using option M.
  267
  268map_btree_arg(M, V, U):-
  269	(	var(V)
  270	->	(	get_attr(V, A)
  271		->	(	A = btree(T)
  272			->	map_btree_to_list(M, T, U, [])
  273			;	U = V
  274			)
  275		;	U = V
  276		)
  277	;	(	atomic(V)
  278		->	U = V
  279		;	V =..[F|Vs],
  280			map_btree_arg(M, Vs, Us),
  281			U =..[F|Us]
  282		)
  283	).
  284
  285	/*************************************************
  286	*      Expand Feature Structure Unification      *
  287	*************************************************/
  288
  289% ?- make_body_unify([a = A.b], X).
  290% ?- make_body_unify([a = A.b.c], X).
  291
  292make_head_unify([], true).
  293make_head_unify([E], X):- !,
  294		make_head_unify_one(E, X).
  295make_head_unify([E|R], (X, R0)):-
  296		make_head_unify_one(E, X),
  297		make_head_unify(R, R0).
  298%
  299make_head_unify_one(A = B, cil:(A=B)):- (var(B); atomic(B)), !.
  300make_head_unify_one(A = {B}, (put_attr(B0, btree(B1)),
  301							  maplist(call, Put_attrs),
  302							  cil:(A=B0)) ):- !,
  303		btree_build({B}, B1),
  304		region_constr_of_leaves(B1, total, Put_attrs, []).
  305make_head_unify_one(A = P, G):- period_term(P), !,
  306		flatten_period(P, L, []),
  307		L=[X|L0],
  308		odict_expand_role(L0, X, A, G).
  309make_head_unify_one(A = P, cil:(A=P)).
  310
  311%
  312make_body_unify([], true).
  313make_body_unify([E], X):- !,
  314		make_body_unify_one(E, X).
  315make_body_unify([E|R], (X, R0)):-
  316		make_body_unify_one(E, X),
  317		make_body_unify(R, R0).
  318%
  319make_body_unify_one(A = B, true):- (var(B); atomic(B)), !, A = B.
  320make_body_unify_one(A = {B}, (	put_attr(B0, btree(B1)),
  321								maplist(call, Put_attrs),
  322								cil:(A=B0)
  323							 )):- !,
  324		btree_build({B}, B1),
  325		region_constr_of_leaves(B1, total, Put_attrs, []).
  326make_body_unify_one(A = P, G):- period_term(P), !,
  327		flatten_period(P, L, []),
  328		L = [X|L0],
  329		odict_expand_role(L0, X, A, G).
  330make_body_unify_one(A = P, true):- A = P.
  331
  332%
  333odict_expand_role([], X, A, cil:(A=X)):-!.
  334odict_expand_role([R|P], X, A, (role(R, X, Y), G) ):-
  335		odict_expand_role(P, Y, A, G).
  336%
  337flatten_period(P, [P|L], L):- var(P), !.
  338flatten_period(P, Q, R):- period_args(P, A, B), !,
  339		flatten_period(A, Q, Q0),
  340		flatten_period(B, Q0, R).
  341flatten_period(P, [P|Q], Q).
  342
  343% ?- odict_expand_goal((true, true), X).
  344odict_expand_goal(X, Y):-
  345		once(odict_expand_to_front(X, Y0)),
  346		once(slim_goal(Y0, Y)).
  347%
  348odict_expand_to_front((X,Y), (X0, Y0)):-
  349	odict_expand_to_front(X, X0),
  350	odict_expand_to_front(Y, Y0).
  351odict_expand_to_front(X;Y, X0; Y0):-
  352	odict_expand_to_front(X, X0),
  353	odict_expand_to_front(Y, Y0).
  354odict_expand_to_front(X->Y, X0->Y0):-
  355	odict_expand_to_front(X, X0),
  356	odict_expand_to_front(Y, Y0).
  357odict_expand_to_front(not(X), \+(X0)):-
  358	odict_expand_to_front(X, X0).
  359odict_expand_to_front(L=R, G):-
  360	anti_subst(L=R, L0=R0, U0),
  361	make_body_unify(U0, U),
  362	( U==[]	->  G = (cil:(L0=R0))
  363	;  G = (U, cil:(L0=R0))
  364    ).
  365odict_expand_to_front(X, (U, X0)):-
  366	anti_subst(X, X0, U0),
  367	make_body_unify(U0, U).
  368
  369 	/****************************************
  370	*   Expand CIL clauses, DCG rules,		*
  371	*	and queries.						*
  372	****************************************/
  373
  374% ?- odict_expand_clause(a:-b, R).
  375odict_expand_clause(:-(H, B), :-(NewH, NewB)):-!,
  376        anti_subst(H, NewH, Eqs),
  377		make_head_unify(Eqs, U),
  378	    odict_expand_goal(B, NewB0),
  379		slim_goal((U, NewB0), NewB).
  380odict_expand_clause(X, Y):-
  381		odict_expand_dcg_rule(X, Y).
  382odict_expand_clause(X, Y):-
  383        odict_expand_clause(X:-true, Y).
  384
  385% ?- module(odict_expand).
  386% ?- odict_expand_dcg_rule(a({j:1})-->b, R).
  387% ?- odict_expand_dcg_rule(a({j:1})-->b({k:2}), R).
  388% ?- odict_expand_dcg_rule(a({j:{i:1}})-->b({k:{l:2}}), R).
  389% ?- odict_expand_dcg_rule(a-->b({k:{l:2}}), R).
  390
  391odict_expand_dcg_rule(H --> B, (NewH--> {SlimU}, NewB)):-
  392        anti_subst(H, NewH, Eqs),
  393		make_head_unify(Eqs, U),
  394		slim_goal(U, SlimU),
  395	    odict_expand_dcg_rule_body(B, B0),
  396		slim_goal(B0, NewB).
  397%
  398odict_expand_dcg_rule_body(A, A):-
  399		(var(A); atomic(A); is_list(A); string(A)), !.
  400odict_expand_dcg_rule_body((A, B), (A0, B0)):- !,
  401		odict_expand_dcg_rule_body(A, A0),
  402		odict_expand_dcg_rule_body(B, B0).
  403odict_expand_dcg_rule_body(X;Y, X0; Y0):-
  404		odict_expand_dcg_rule_body(X, X0),
  405		odict_expand_dcg_rule_body(Y, Y0).
  406odict_expand_dcg_rule_body(X|Y, X0|Y0):-
  407		odict_expand_dcg_rule_body(X, X0),
  408		odict_expand_dcg_rule_body(Y, Y0).
  409odict_expand_dcg_rule_body({A}, {B}):- !,
  410		odict_expand_goal(A, B).
  411odict_expand_dcg_rule_body(A, ({U}, A0)):-
  412		anti_subst(A, A0, U0),
  413		make_body_unify(U0, U).
  414
  415	/****************************************************
  416	*     Simplifier of goals.                          *
  417	*     This codes is the same as in reduce.pl.       *
  418	****************************************************/
  419
  420% ?- slim_goal((true, true, true), R).
  421% ?- slim_goal((true, a=b, true, true), R).
  422
  423% Pseudo truth tables for goal simplification.
  424slim_goal_and(true	, B		, B).
  425slim_goal_and(A		, true	, A).
  426slim_goal_and(A		, B		, (A,  B)).
  427%
  428slim_goal_or(fail	, B		, B	).
  429slim_goal_or(false	, B		, B	).
  430slim_goal_or(true	, _		, true).
  431slim_goal_or(A		, fail	, A	).
  432slim_goal_or(A		, false	, A	).
  433slim_goal_or(_		, true	, true).
  434slim_goal_or(A		, B		, (A; B)).
  435%
  436slim_goal_cond(fail	,  _	, fail).
  437slim_goal_cond(true	, B	, B).
  438slim_goal_cond(A	, B	, A->B).
  439%
  440slim_goal_neg(fail	, true).
  441slim_goal_neg(false	, true).
  442slim_goal_neg(true	, fail).
  443slim_goal_neg(\+B	, B).
  444slim_goal_neg(A		, \+A).
  445
  446%
  447slim_goal(G, X) :- var(G), !, X = G.
  448slim_goal({G}, {X}) :- !, slim_goal(G, X).
  449slim_goal((A0, B0), X) :- !,
  450	    slim_goal(A0, A),
  451	    slim_goal(B0, B),
  452	    once(slim_goal_and(A, B, X)).
  453slim_goal((A0 ; B0), X) :- !,
  454	    slim_goal(A0, A),
  455	    slim_goal(B0, B),
  456	    once(slim_goal_or(A, B, X)).
  457slim_goal((A0 -> B0), X) :- !,
  458	    slim_goal(A0, A),
  459	    slim_goal(B0, B),
  460	    once(slim_goal_cond(A, B, X)).
  461slim_goal(\+(A0), X) :- !,
  462	    slim_goal(A0, A),
  463	    once(slim_goal_neg(A, X)).
  464slim_goal(X, X)