From 30602c084923405ebe0ee18614cb63bfd8176f2b Mon Sep 17 00:00:00 2001 From: Mark Thom Date: Sun, 7 Feb 2021 21:13:27 -0700 Subject: [PATCH] clean up implementation of (->)/2, (;)/2, and (,)/2 --- src/lib/builtins.pl | 164 +++++++++++++++++++++----------------------- 1 file changed, 78 insertions(+), 86 deletions(-) diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index 4f2b1825..824c4dd2 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -234,6 +234,8 @@ G1 -> G2 :- ). +:-non_counted_backtracking call_or_cut/3. + call_or_cut(G, B, ErrorPI) :- ( '$call_with_default_policy'(var(G)) -> throw(error(instantiation_error, ErrorPI)) @@ -241,136 +243,126 @@ call_or_cut(G, B, ErrorPI) :- ). -call_or_cut(!, B) :- - '$set_cp_by_default'(B). -call_or_cut(_:!, B) :- - '$set_cp_by_default'(B). -call_or_cut((G1, G2), B) :- - !, - '$call_with_default_policy'(','(G1, G2, B)). -call_or_cut(_:(G1, G2), B) :- +:- non_counted_backtracking call_or_cut/2. + +call_or_cut(M:G, B) :- !, + ( nonvar(G), + '$call_with_default_policy'(call_or_cut_interp(G, B)) -> + true + ; call(M:G) + ). +call_or_cut(G, B) :- + ( '$call_with_default_policy'(call_or_cut_interp(G, B)) -> + true + ; call(G) + ). + + +:- non_counted_backtracking call_or_cut_interp/2. + +call_or_cut_interp(!, B) :- + '$set_cp_by_default'(B). +call_or_cut_interp((G1, G2), B) :- '$call_with_default_policy'(','(G1, G2, B)). -call_or_cut((G1 ; G2), B) :- - !, +call_or_cut_interp((G1 ; G2), B) :- '$call_with_default_policy'(';'(G1, G2, B)). -call_or_cut(_:(G1 ; G2), B) :- - !, - '$call_with_default_policy'(';'(G1, G2, B)). -call_or_cut((G1 -> G2), B) :- - !, +call_or_cut_interp((G1 -> G2), B) :- '$call_with_default_policy'(->(G1, G2, B)). -call_or_cut(_:(G1 -> G2), B) :- - !, - '$call_with_default_policy'(->(G1, G2, B)). -call_or_cut(G, _) :- - '$call_with_default_policy'(G). :- non_counted_backtracking (',')/3. -','((G1, G2), G3, B) :- - !, - '$call_with_default_policy'(','(G1, G2, B)), - '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)). -','(_:(G1, G2), G3, B) :- + +','(M:G1, G2, B) :- !, + ( nonvar(G1), + '$call_with_default_policy'(',-interp'(G1, G2, B)) -> + true + ; call(M:G1), + '$call_with_default_policy'(call_or_cut(G2, B, (',')/2)) + ). +','(G1, G2, B) :- + '$call_with_default_policy'(call_or_cut(G1, B, (',')/2)), + '$call_with_default_policy'(call_or_cut(G2, B, (',')/2)). + + +:- non_counted_backtracking (',-interp')/3. + +',-interp'((G1, G2), G3, B) :- '$call_with_default_policy'(','(G1, G2, B)), '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)). -','((G1; G2), G3, B) :- - !, - '$call_with_default_policy'(';'(G1, G2, B)), - '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)). -','(_:(G1; G2), G3, B) :- - !, +',-interp'((G1; G2), G3, B) :- '$call_with_default_policy'(';'(G1, G2, B)), '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)). -','((G1 -> G2), G3, B) :- - !, - '$call_with_default_policy'(->(G1, G2, B)), - '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)). -','(_:(G1 -> G2), G3, B) :- - !, +',-interp'((G1 -> G2), G3, B) :- '$call_with_default_policy'(->(G1, G2, B)), '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)). -','(G1, G2, B) :- - '$call_with_default_policy'(call_or_cut(G1, B, (',')/2)), - '$call_with_default_policy'(call_or_cut(G2, B, (',')/2)). :- non_counted_backtracking (;)/3. -';'((G1, G2), G3, B) :- + +';'(M:G1, G2, B) :- !, - ( '$call_with_default_policy'(','(G1, G2, B)) - ; '$call_with_default_policy'(call_or_cut(G3, B, (;)/2)) + ( nonvar(G1), + '$call_with_default_policy'(';-interp'(G1, G2, B)) -> + true + ; call(M:G1) + ; '$call_with_default_policy'(call_or_cut(G2, B, (;)/2)) ). -';'(_:(G1, G2), G3, B) :- - !, - ( '$call_with_default_policy'(','(G1, G2, B)) - ; '$call_with_default_policy'(call_or_cut(G3, B, (;)/2)) +';'(G1, G2, B) :- + ( '$call_with_default_policy'(call_or_cut(G1, B, (;)/2)) + ; '$call_with_default_policy'(call_or_cut(G2, B, (;)/2)) ). -';'((G1; G2), G3, B) :- - !, - ( '$call_with_default_policy'(';'(G1, G2, B)) + + +:- non_counted_backtracking ';-interp'/3. + +';-interp'((G1, G2), G3, B) :- + ( '$call_with_default_policy'(','(G1, G2, B)) ; '$call_with_default_policy'(call_or_cut(G3, B, (;)/2)) ). -';'(_:(G1; G2), G3, B) :- - !, +';-interp'((G1; G2), G3, B) :- ( '$call_with_default_policy'(';'(G1, G2, B)) ; '$call_with_default_policy'(call_or_cut(G3, B, (;)/2)) ). -';'((G1 -> G2), G3, B) :- - !, +';-interp'((G1 -> G2), G3, B) :- ( '$call_with_default_policy'(call_or_cut(G1, B, (->)/2)) -> '$call_with_default_policy'(call_or_cut(G2, B, (->)/2)) ; '$call_with_default_policy'(call_or_cut(G3, B, (;)/2)) ). -';'(_:(G1 -> G2), G3, B) :- + + +:- non_counted_backtracking (->)/3. + +->(M:G1, G2, B) :- !, - ( '$call_with_default_policy'(call_or_cut(G1, B, (->)/2)) -> + ( nonvar(G1), + '$call_with_default_policy'('->-interp'(G1, G2, B)) -> + true + ; call(M:G1) -> '$call_with_default_policy'(call_or_cut(G2, B, (->)/2)) - ; '$call_with_default_policy'(call_or_cut(G3, B, (;)/2)) ). -';'(G1, G2, B) :- - ( '$call_with_default_policy'(call_or_cut(G1, B, (;)/2)) - ; '$call_with_default_policy'(call_or_cut(G2, B, (;)/2)) +->(G1, G2, B) :- + ( '$call_with_default_policy'(call_or_cut(G1, B, (->)/2)) -> + '$call_with_default_policy'(call_or_cut(G2, B, (->)/2)) ). -:- non_counted_backtracking (->)/3. -->((G1, G2), G3, B) :- - !, - ( '$call_with_default_policy'(','(G1, G2, B)) -> - '$call_with_default_policy'(call_or_cut(G3, B, (->)/2)) - ). -->(_:(G1, G2), G3, B) :- - !, +:- non_counted_backtracking '->-interp'/3. + +'->-interp'((G1, G2), G3, B) :- ( '$call_with_default_policy'(','(G1, G2, B)) -> '$call_with_default_policy'(call_or_cut(G3, B, (->)/2)) ). -->((G1 ; G2), G3, B) :- - !, +'->-interp'((G1 ; G2), G3, B) :- ( '$call_with_default_policy'(';'(G1, G2, B)) -> '$call_with_default_policy'(call_or_cut(G3, B, (->)/2)) ). -->(_:(G1 ; G2), G3, B) :- - !, - ( '$call_with_default_policy'(';'(G1, G2, B)) -> - '$call_with_default_policy'(call_or_cut(G3, B, (->)/2)) - ). -->((G1 -> G2), G3, B) :- - !, +'->-interp'((G1 -> G2), G3, B) :- ( '$call_with_default_policy'(->(G1, G2, B)) -> '$call_with_default_policy'(call_or_cut(G3, B, (->)/2)) ). -->(_:(G1 -> G2), G3, B) :- - !, - ( '$call_with_default_policy'(->(G1, G2, B)) -> - '$call_with_default_policy'(call_or_cut(G3, B, (->)/2)) - ). -->(G1, G2, B) :- - ( '$call_with_default_policy'(call_or_cut(G1, B, (->)/2)) - -> '$call_with_default_policy'(call_or_cut(G2, B, (->)/2)) - ). + % univ. -- 2.54.0