I'm working on my own implementation of when/2.
Internally, when/2 needs to be able to—for a lack of a better word—"reify" ground/1. Doing this using attributed variables (in the style of
SICStus-Prolog) is what this question is all about.
My implementation should work like the following "reference" implementation:
ground_t(Term,T) :- when(ground(Term), T=true).
In a fit of curiosity, I wrote the following little solver:
:- module(ground_t,[ground_t/2]).
:- use_module(library(atts)).
:- attribute ground_t/1.
ground_t(Term,T) :-
( ground(Term)
-> T = true
; term_variables(Term,Vs),
create_mutable(Vs,MVs),
attach_to_new_vars(Vs,MVs,T)
).
attach_to_new_vars([],_,_).
attach_to_new_vars([V|Vs],MVs,T) :-
( get_atts(V,+ground_t(Cs0))
-> Cs = Cs0
; Cs = []
),
put_atts(V,+ground_t([MVs-T|Cs])),
attach_to_new_vars(Vs,MVs,T).
% simple case: unify w/ground term
cliques_var_goals__ground([],_,[]).
cliques_var_goals__ground([MVs-T|Cs],Var,Goals) :-
get_mutable(Vs0,MVs),
list_eq_removed_atmost_once(Vs0,Var,Vs1),
update_mutable(Vs1,MVs),
( Vs1 = []
-> Goals = [T=true|Goals0]
; Goals = Goals0
),
cliques_var_goals__ground(Cs,Var,Goals0).
list_eq_removed_atmost_once([],_,[]).
list_eq_removed_atmost_once([X|Xs],E,Ys) :-
( X == E
-> Ys = Xs % remove item. do it at most once and stop
; Ys = [X|Ys0],
list_eq_removed_atmost_once(Xs,E,Ys0)
).
% general case: unify w/non-ground term
cliques_var_other__nonvar([],_,_).
cliques_var_other__nonvar([MVs-T|Cs],Var,Other) :-
get_mutable(Vs0,MVs),
term_variables(Vs0+Other,Vs1),
term_variables(Other,New0),
list_eq_removed_atmost_once(New0,Var,New),
list_eq_removed_atmost_once(Vs1,Var,Vs2),
attach_to_new_vars(New,MVs,T),
update_mutable(Vs2,MVs),
cliques_var_other__nonvar(Cs,Var,Other).
sort_all([]).
sort_all([MVs-_T|Xs]) :-
get_mutable(Vs0,MVs),
term_variables(Vs0,Vs),
update_mutable(Vs,MVs),
sort_all(Xs).
merge_cliques_post_unify(Cs0,Cs1,Other) :-
append(Cs0,Cs1,Cs01),
sort_all(Cs01),
put_atts(Other,+ground_t(Cs01)).
verify_attributes(Var,Other,Goals) :-
( get_atts(Var,+ground_t(Cs0))
-> ( ground(Other)
-> cliques_var_goals__ground(Cs0,Var,Goals)
; nonvar(Other)
-> cliques_var_other__nonvar(Cs0,Var,Other),
Goals = []
; get_atts(Other,+ground_t(Cs1))
-> Goals = [merge_cliques_post_unify(Cs0,Cs1,Other)]
; put_atts(Other,+ground_t(Cs0)),
Goals = []
)
; Goals = []
).
cliques_to_goal([]) --> [].
cliques_to_goal([MVs-T|Cs]) -->
{ get_mutable(Vs,MVs) },
( { Vs = [] } -> []
; { Vs = [V] } -> [ground_t(V ,T)]
; [ground_t(Vs,T)]
),
cliques_to_goal(Cs).
list_to_commalist([],true).
list_to_commalist([X],Y) :-
!,
X = Y.
list_to_commalist([X|Xs],(X,Y)) :-
list_to_commalist(Xs,Y).
attribute_goals(Var) -->
{ get_atts(Var,+ground_t(Cs)) },
cliques_to_goal(Cs).
attribute_goal(Var,Goal) :-
phrase(attribute_goals(Var),Goals),
list_to_commalist(Goals,Goal).
That was the easy part; now comes the hard part...
How do I go about testing if the behavior of the two solvers are equivalent—when performing multiple steps of variable aliasing and instantiation in a forest of shared terms?
Here are some simple manual tests that I did:
| ?- ground_t(X+Y,T1). | ?- ground_t(X+Y,T1),X=f(U). | ?- ground_t(X+Y,T1),X=f(U),U=Y. | ?- ground_t(X+Y,T1),X=f(U),U=Y,Y=y.
| ?- ground_t(X+Y,T1),ground_t(X+Z,T2). | ?- ground_t(X+Y,T1),ground_t(X+Z,T2),X = -U,Z = +V. | ?- ground_t(X+Y,T1),ground_t(X+Z,T2),X = -U,Z = +U. | ?- ground_t(X+Y,T1),ground_t(X+Z,T2),X = -U,Z = +U,U=u. | ?- ground_t(X+Y,T1),ground_t(X+Z,T2),X = -U,Z = +U,U=u,Y=U.
Maybe you have a good idea for some nice corner cases... please share!
