change the semantics of put_atts/2 to better reflect those of SICSTus

This commit is contained in:
Mark Thom
2019-03-12 18:45:42 -06:00
parent a6d3f39152
commit 2af08b31d2
4 changed files with 44 additions and 53 deletions

View File

@@ -2,35 +2,29 @@
:- use_module(library(atts)).
:- attribute dif/2.
:- attribute dif/1.
non_unif_member([X \== Y | Z], V, W) :-
( X == V, Y == W -> true
; non_unif_member(Z, V, W)
).
put_dif_att(Var, X, Y) :-
( get_atts(Var, +dif(Z)) ->
( non_unif_member(Z, X, Y) -> true
; put_atts(Var, +dif([X \== Y | Z]))
)
; put_atts(Var, +dif([X \== Y]))
).
dif_set_variables([], _, _).
dif_set_variables([Var|Vars], X, Y) :-
put_atts(Var, dif(X, Y)),
put_dif_att(Var, X, Y),
dif_set_variables(Vars, X, Y).
verify_dif_attrs([dif(X, Y) | Attrs], Value, [X \== Y | Goals]) :-
( get_atts(Value, +dif(X, Y)) -> true
; put_atts(Value, +dif(X, Y))
),
verify_dif_attrs(Attrs, Value, Goals).
verify_dif_attrs([_ | Attrs], Value, Goals) :-
verify_dif_attrs(Attrs, Value, Goals).
verify_dif_attrs([], _, []).
verify_dif_attrs_no_var([dif(X, Y) | Attrs], Value, [X \== Y | Goals]) :-
term_variables(Value, ValueVars),
dif_set_variables(ValueVars, X, Y),
verify_dif_attrs_no_var(Attrs, Value, Goals).
verify_dif_attrs_no_var([_ | Attrs], Value, Goals) :-
verify_dif_attrs_no_var(Attrs, Value, Goals).
verify_dif_attrs_no_var([], _, []).
verify_attributes(Var, Value, Goals) :-
( get_atts(Var, Attrs) ->
( var(Value) -> verify_dif_attrs(Attrs, Value, Goals)
; verify_dif_attrs_no_var(Attrs, Value, Goals)
)
( get_atts(Var, +dif(Goals)) -> true
; Goals = []
).
% Probably the world's worst dif/2 implementation. I'm open to
@@ -42,13 +36,10 @@ dif(X, Y) :- X \== Y,
dif_set_variables(YVars, X, Y)
).
gather_dif_goals(Attrs, _) :-
var(Attrs), !.
gather_dif_goals([dif(X, Y) | Attrs], [dif(X, Y) | Goals]) :-
gather_dif_goals(Attrs, Goals).
gather_dif_goals([_ | Attrs], Goals) :-
gather_dif_goals(Attrs, Goals).
gather_dif_goals([], _).
gather_dif_goals([(X \== Y) | Goals0], [dif(X, Y) | Goals]) :-
gather_dif_goals(Goals0, Goals).
attribute_goals(X, Goal) :-
'$get_attr_list'(X, Attrs),
gather_dif_goals(Attrs, Goal).
attribute_goals(X, Goals) :-
get_atts(X, +dif(Goals0)),
gather_dif_goals(Goals0, Goals).