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% ?- [util('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).
209btree_to_dict(X, Y):- map_btree(X, Y0), list_to_comma(Y0, Y).
?- 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, []).
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).
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)