From 6c4f2ce30f529ff97b5744b04e7ae399b10384d8 Mon Sep 17 00:00:00 2001 From: jeshan Date: Mon, 5 Feb 2024 17:59:51 +0400 Subject: [PATCH 1/2] Copy PR #420 from Scryer. Fixes #27 https://github.com/mthom/scryer-prolog/pull/420 --- clpz.pl | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/clpz.pl b/clpz.pl index 8d7d3da..e89da9e 100644 --- a/clpz.pl +++ b/clpz.pl @@ -7375,7 +7375,8 @@ verify_attributes(Var, Other, Gs) :- % portray_clause(Var = Other), - ( get_attr(Var, clpz, clpz_attr(_,_,_,Dom,Ps,Q)) -> + ( get_atts(Var, clpz(CLPZ)) -> + CLPZ = clpz_attr(_,_,_,Dom,Ps,Q), ( nonvar(Other) -> ( integer(Other) -> true ; type_error(integer, Other) @@ -7383,14 +7384,17 @@ domain_contains(Dom, Other), phrase(trigger_props(Ps), [Q], [_]), Gs = [phrase(do_queue, [Q], _)] - ; fd_get(Other, OD, OPs), - domains_intersection(OD, Dom, Dom1), - append_propagators(Ps, OPs, Ps1), - new_queue(Q0), - variables_same_queue([Var,Other]), - phrase((fd_put(Other,Dom1,Ps1), - trigger_props(Ps1)), [Q0], _), + ; ( get_atts(Other, clpz(clpz_attr(_,_,_,OD,OPs,_))) -> + domains_intersection(OD, Dom, Dom1), + append_propagators(Ps, OPs, Ps1), + new_queue(Q0), + variables_same_queue([Var,Other]), + phrase((fd_put(Other,Dom1,Ps1), + trigger_props(Ps1)), [Q0], _), Gs = [phrase(do_queue, [Q0], _)] + ; put_atts(Other, clpz(CLPZ)), + Gs = [] + ) ) ; Gs = [] ). From 777f3466ce12f18f96c2c19656d82ca992bfdaef Mon Sep 17 00:00:00 2001 From: jeshan Date: Mon, 5 Feb 2024 18:14:06 +0400 Subject: [PATCH 2/2] scryer Aug 2020 mod enhancements --- clpz.pl | 286 +++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 209 insertions(+), 77 deletions(-) diff --git a/clpz.pl b/clpz.pl index e89da9e..a86d365 100644 --- a/clpz.pl +++ b/clpz.pl @@ -4913,97 +4913,229 @@ %% % Z = X mod Y run_propagator(pmod(X,Y,Z), MState) --> - ( nonvar(X) -> - ( nonvar(Y) -> kill(MState), Y =\= 0, Z is X mod Y + ( Y == 0 -> { false } + ; Y == Z -> { false } + % ; nonvar(Y), Z == X -> true + ; X == Y -> kill(MState), queue_goal(Z = 0) + ; true + ), + ( nonvar(X), nonvar(Y) -> + kill(MState), + Z is X mod Y + ; nonvar(Y), nonvar(Z) -> + ( Y > 0 -> Z >= 0, Z < Y + ; Y < 0 -> Z =< 0, Z > Y + ), + ( { fd_get(X, _, n(XL), _, _) } -> + ( (XL - Z) mod Y =\= 0 -> + XMin is Z + Y * ((XL - Z) div Y + 1) + ; XMin is XL + ), + { fd_get(X, XD0, XPs), + domain_remove_smaller_than(XD0, XMin, XD2) }, + fd_put(X, XD2, XPs) + % queue_goal(X #>= XMin) + ; true + ), + ( { fd_get(X, _, _, n(XU), _) } -> + XMax is Z + Y * ((XU - Z) div Y), + { fd_get(X, XD1, XPs), + domain_remove_greater_than(XD1, XMax, XD3) }, + fd_put(X, XD3, XPs) + % queue_goal(X #=< XMax) ; true ) - ; nonvar(Y) -> - Y =\= 0, - ( abs(Y) =:= 1 -> kill(MState), Z = 0 - ; var(Z) -> - YP is abs(Y) - 1, - ( Y > 0, { fd_get(X, _, n(XL), n(XU), _) } -> - ( XL >= 0, XU < Y -> - kill(MState), Z = X, ZL = XL, ZU = XU - ; ZL = 0, ZU = YP + % kill(MState), + % queue_goal(X #= Z + Y * _) % Add a variable to be efficient. + ; nonvar(Z), nonvar(X) -> + ( Z > 0 -> + ( X < 0 -> true + ; X >= Z + ) + ; Z < 0 -> + ( X > 0 -> true + ; X =< Z + ) + ; Z =:= 0 % Multiple solutions so do nothing special. + ), + ( Z > 0 -> + { fd_get(Y, YD, YPs), + YMin is Z + 1, + domain_remove_smaller_than(YD, YMin, YD1) }, + fd_put(Y, YD1, YPs) + % queue_goal(Y #> Z) + ; Z < 0 -> + { fd_get(Y, YD, YPs), + YMax is Z - 1, + domain_remove_greater_than(YD, YMax, YD1) }, + fd_put(Y, YD1, YPs) + % queue_goal(Y #< Z) + ; true + ) + ; run_propagator(pmodz(X,Y,Z), MState), + run_propagator(pmody(X,Y,Z), MState), + true + ). + +run_propagator(pmodz(X,Y,Z), MState) --> + ( nonvar(Z) -> true % Nothing to do. + ; nonvar(X) -> + ( X =:= 0 -> kill(MState), queue_goal(Z = X) + ; ( X > 0 -> + ( { fd_get(Y, _, n(YL), _, _), YL > X } -> + kill(MState), + queue_goal(Z = X) + ; { fd_get(Z, ZD0, ZPs), + domain_remove_greater_than(ZD0, X, ZD2) }, + fd_put(Z, ZD2, ZPs) + % queue_goal(Z #=< X) ) - ; Y > 0 -> ZL = 0, ZU = YP - ; YN is -YP, ZL = YN, ZU = 0 - ), - ( { fd_get(Z, ZD, ZPs) } -> - { domains_intersection(ZD, from_to(n(ZL), n(ZU)), ZD1), - domain_infimum(ZD1, n(ZMin)), - domain_supremum(ZD1, n(ZMax)) }, - fd_put(Z, ZD1, ZPs) - ; ZMin = Z, ZMax = Z - ), - ( { fd_get(X, XD, XPs), domain_infimum(XD, n(XMin)) } -> - Z1 is XMin mod Y, - ( { between(ZMin, ZMax, Z1) } -> true - ; Y > 0 -> - Next is ((XMin - ZMin + Y - 1) div Y)*Y + ZMin, - { domain_remove_smaller_than(XD, Next, XD1) }, - fd_put(X, XD1, XPs) - ; neq_num(X, XMin) + ; X < 0 -> + ( { fd_get(Y, _, _, n(YU), _), YU < X } -> + kill(MState), + queue_goal(Z = X) + ; { fd_get(Z, ZD0, ZPs), + domain_remove_smaller_than(ZD0, X, ZD2) }, + fd_put(Z, ZD2, ZPs) + % queue_goal(Z #>= X) ) - ; true ), - ( { fd_get(X, XD2, XPs2), domain_supremum(XD2, n(XMax)) } -> - Z2 is XMax mod Y, - ( { between(ZMin, ZMax, Z2) } -> true - ; Y > 0 -> - Prev is ((XMax - ZMin) div Y)*Y + ZMax, - { domain_remove_greater_than(XD2, Prev, XD3) }, - fd_put(X, XD3, XPs2) - ; neq_num(X, XMax) - ) + ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> + ZMax is YU - 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in 0..ZMax) + ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> + ZMin is YL + 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in ZMin..0) ; true ) - ; { fd_get(X, XD, XPs) }, - % if possible, propagate at the boundaries - ( { domain_infimum(XD, n(Min)) } -> - ( Min mod Y =:= Z -> true - ; Y > 0 -> - Next is ((Min - Z + Y - 1) div Y)*Y + Z, - { domain_remove_smaller_than(XD, Next, XD1) }, - fd_put(X, XD1, XPs) - ; neq_num(X, Min) - ) + ) + ; nonvar(Y) -> + ( abs(Y) =:= 1 -> kill(MState), queue_goal(Z = 0) + ; Y < 0 -> + ( { fd_get(X, _, n(XL), n(XU), _), XU =< 0, Y < XL } -> + kill(MState), + queue_goal(Z = X) + ; ZMin is Y + 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in ZMin..0) + ) + ; Y > 0 -> + ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0, Y > XU } -> + kill(MState), + queue_goal(Z = X) + ; ZMax is Y - 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in 0..ZMax) + ) + ) + ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0, + fd_get(Y, _, n(YL), _, _), XU < YL } -> + kill(MState), + queue_goal(Z = X) + ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0, + fd_get(Y, _, _, n(YU), _), XL > YU } -> + kill(MState), + queue_goal(Z = X) + ; ( { fd_get(X, _, n(XL), n(XU), _), XL >= 0 } -> + { fd_get(Z, ZD0, ZPs), + domain_remove_greater_than(ZD0, XU, ZD2) }, + fd_put(Z, ZD2, ZPs) + % queue_goal(Z #=< XU) + ; { fd_get(X, _, n(XL), n(XU), _), XU =< 0 } -> + { fd_get(Z, ZD0, ZPs), + domain_remove_smaller_than(ZD0, XL, ZD2) }, + fd_put(Z, ZD2, ZPs) + % queue_goal(Z #>= XL) ; true ), - ( { fd_get(X, XD2, XPs2) } -> - ( { domain_supremum(XD2, n(Max)) } -> - ( Max mod Y =:= Z -> true - ; Y > 0 -> - Prev is ((Max - Z) div Y)*Y + Z, - { domain_remove_greater_than(XD2, Prev, XD3) }, - fd_put(X, XD3, XPs2) - ; neq_num(X, Max) - ) - ; true - ) + ( { fd_get(Y, _, n(YL), n(YU), _), YL > 0 } -> + ZMax is YU - 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_smaller_than(ZD1, 0, ZD3), + domain_remove_greater_than(ZD3, ZMax, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in 0..ZMax) + ; { fd_get(Y, _, n(YL), n(YU), _), YU < 0 } -> + ZMin is YL + 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, 0, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in ZMin..0) + ; { fd_get(Y, _, n(YL), n(YU), _) } -> + ZMin is YL + 1, + ZMax is YU - 1, + { fd_get(Z, ZD1, ZPs), + domain_remove_greater_than(ZD1, ZMax, ZD3), + domain_remove_smaller_than(ZD3, ZMin, ZD5) }, + fd_put(Z, ZD5, ZPs) + % queue_goal(Z in ZMin..ZMax) + %/* This doesn't work very well. + ; { fd_get(Y, _, _, n(YU), _), YU > 0 } -> + { fd_get(Z, ZD1, ZPs), + ZMax is YU - 1, + domain_remove_greater_than(ZD1, ZMax, ZD3) }, + fd_put(Z, ZD3, ZPs) + % queue_goal(Z #< YU) + ; { fd_get(Y, _, n(YL), _, _), YL < 0 } -> + { fd_get(Z, ZD1, ZPs), + ZMin is YL + 1, + domain_remove_smaller_than(ZD1, ZMin, ZD3) }, + fd_put(Z, ZD3, ZPs) + % queue_goal(Z #> YL) + % * / ; true ) ) - ; X == Y -> kill(MState), Z = 0 - ; { fd_get(X, XD, XPs), - fd_get(Y, YD, _), - fd_get(Z, ZD, ZPs) }, - ( { domain_infimum(XD, n(XMin)), XMin >= 0, - domain_infimum(YD, n(YMin)), YMin > 0 } -> - { domain_remove_smaller_than(ZD, 0, ZD1) } - ; ZD1 = ZD - ), - ( { domain_supremum(YD, n(YMax)), YMax > 0 } -> - { Max is YMax - 1, Min is -Max, - domain_remove_smaller_than(ZD1, Min, ZD2), - domain_remove_greater_than(ZD2, Max, ZD3) } - ; ZD3 = ZD1 - ), - fd_put(Z, ZD3, ZPs) - % TODO: propagate more ). +run_propagator(pmody(X,Y,Z), MState) --> + ( nonvar(Y) -> true % Nothing to do. + % ; nonvar(X) -> true + ; nonvar(Z) -> + ( Z > 0 -> % queue_goal(Y #> Z) + { fd_get(Y, YD, YPs), + YMin is Z + 1, + domain_remove_smaller_than(YD, YMin, YD1) }, + fd_put(Y, YD1, YPs) + ; Z < 0 -> % queue_goal(Y #< Z) + { fd_get(Y, YD, YPs), + YMax is Z - 1, + domain_remove_greater_than(YD, YMax, YD1) }, + fd_put(Y, YD1, YPs) + ; Z =:= 0 -> kill(MState), queue_goal(X / Y #= _) + ) + ; ( { fd_get(Z, _, n(ZL), _, _), ZL > 0 } -> + { fd_get(Y, YD, YPs), + YMin is ZL + 1, + domain_remove_smaller_than(YD, YMin, YD1) }, + fd_put(Y, YD1, YPs) + % queue_goal(Y #> ZL) + ; { fd_get(Z, _, _, n(ZU), _), ZU < 0 } -> + { fd_get(Y, YD, YPs), + YMax is ZU - 1, + domain_remove_greater_than(YD, YMax, YD1) }, + fd_put(Y, YD1, YPs) + % queue_goal(Y #< ZU) + ; true + ) + ). + + %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% % Z = X rem Y