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
14put_attr(V, A):- put_attr(V, cil, A).
15get_attr(V, A):- get_attr(V, cil, A).
16
20
39
46
47
48 51
52non_clause(:-(_)).
53non_clause(?-(_)).
54
56odict_expand(X, Y):- \+ non_clause(X),
57 odict_expand_clause(X, Y).
58
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
81period_term(X):- functor(X, (.), 2), !.
82period_term(role(_,_)).
83
85period_args(X, A, B):- X=..[(.), A, B].
86period_args(role(A, B), A, B).
87
96
98anti_subst(X, A, R):- anti_subst(X, A, R, []),
99 maplist(check_item, R).
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), !. 108anti_subst(X, A, R, R0):- X=..[F|Xs],
109 anti_subst_list(Xs, As, R, R0),
110 A=..[F|As].
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
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(_=_). 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).
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
136odict_to_balanced_btree(X, Y):- odict_to_list(X, X0, []),
137 list_to_btree(X0, Y).
138
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
148
149list_to_btree(X, Y):- sort(X, X0),
150 length(X0, N),
151 list_to_btree(X0, N, Y).
152
154list_to_btree([], _, _). 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).
164pair(A-B, A, B).
165pair(A=B, A, B).
166pair(A:B, A, B).
167
168 171
178
180is_btree(t(_,_,_,_)).
181is_btree({}).
182
184list_to_comma([], {}):-!.
185list_to_comma(X, {Y}):- list_to_comma_(X, Y).
187list_to_comma_([X], X):-!.
188list_to_comma_([X, Y|Z], (X, U)):- list_to_comma_([Y|Z], U).
189
192
193btree_to_odict(X, Y):- map_btree(X, Y0), list_to_comma(Y0, Y).
194
204
205skelton(X, Y):- map_btree_to_list(skelton_pair, X, Y, []).
206
209
210default_pair(terminal, K, V, K-leaf(V)).
211default_pair(nonterminal, K, V, K-V).
213ambiguous_pair(_, K, V, K-V).
215skelton_pair(terminal, K, _, K).
216skelton_pair(nonterminal, K, V, K-V).
217
219map_btree(X, Y):- map_btree_to_list(ambiguous_pair, X, Y, []).
220
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
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 ).
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 288
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).
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
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).
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
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).
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
344odict_expand_goal(X, Y):-
345 once(odict_expand_to_front(X, Y0)),
346 once(slim_goal(Y0, Y)).
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 373
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
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).
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 419
422
424slim_goal_and(true , B , B).
425slim_goal_and(A , true , A).
426slim_goal_and(A , B , (A, B)).
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)).
436slim_goal_cond(fail , _ , fail).
437slim_goal_cond(true , B , B).
438slim_goal_cond(A , B , A->B).
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
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)