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

@@ -106,8 +106,10 @@ put_attr(Name, Arity) -->
{ functor(Attr, Name, Arity),
numbervars(Attr, 0, Arity),
V = '$VAR'(Arity) },
[(put_atts(V, +Attr) :- !, functor(Attr, _, _), '$put_attr'(V, Attr)),
(put_atts(V, Attr) :- !, functor(Attr, _, _), '$put_attr'(V, Attr)),
[(put_atts(V, +Attr) :- !, functor(Attr, Head, Arity), functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls), '$del_attr'(Ls, V, AttrForm), '$put_attr'(V, Attr)),
(put_atts(V, Attr) :- !, functor(Attr, Head, Arity), functor(AttrForm, Head, Arity),
'$get_attr_list'(V, Ls), '$del_attr'(Ls, V, AttrForm), '$put_attr'(V, Attr)),
(put_atts(V, -Attr) :- !, functor(Attr, _, _), '$get_attr_list'(V, Ls), '$del_attr'(Ls, V, Attr))].
get_attr(Name, Arity) -->

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).

View File

@@ -8,8 +8,7 @@ verify_attributes(Var, Other, Goals) :-
get_atts(Var, frozen(Fa)), !, % are we involved?
( var(Other) -> % must be attributed then
( get_atts(Other, frozen(Fb)) % has a pending goal?
-> put_atts(Other, -frozen(Fb)),
put_atts(Other, frozen((Fb,Fa))) % rescue conjunction
-> put_atts(Other, frozen((Fb,Fa))) % rescue conjunction
; put_atts(Other, frozen(Fa)) % rescue the pending goal
),
Goals = []
@@ -23,8 +22,8 @@ freeze(X, Goal) :-
gather_freeze_goals(Attrs, _, _) :-
var(Attrs), !.
gather_freeze_goals([frozen(X) | Attrs], Var, [frozen(Var, X) | Goals]) :-
gather_freeze_goals(Attrs, Var, Goals).
gather_freeze_goals([frozen(X) | _], Var, [frozen(Var, X) | _]) :-
!.
gather_freeze_goals([_ | Attrs], Var, Goals) :-
gather_freeze_goals(Attrs, Var, Goals).