flatten passage of cut point B in (,)/2, (->)/2 and (;)/2 (#685, #683)

diff --git a/Cargo.lock b/Cargo.lock
index 4faec27cd81e2e43c3ae2f72cd249eb79371c0c4..3b662efaa0e4e4e7ac5b750c499b8f8e906763cf 100644 (file)
--- a/Cargo.lock
+++ b/Cargo.lock
@@ -906,6 +906,8 @@ dependencies = [
 [[package]]
 name = "prolog_parser"
 version = "0.8.68"
+source = "registry+https://github.com/rust-lang/crates.io-index"
+checksum = "520bf98dcd386ef320ef11239415c9a11856d3b28fab0d8dc0b61b0d7e65ffe5"
 dependencies = [
  "lexical",
  "num-rug-adapter",

diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl
index df31270841e5549d832b9f5bac17fe10e4ae35dc..3d7aa79f867037734f6a03cf1eeddade42b9d18b 100644 (file)
--- a/src/lib/builtins.pl
+++ b/src/lib/builtins.pl
@@ -191,81 +191,129 @@ set_prolog_flag(Flag, _) :-
 
 fail :- '$fail'.
 
+
 \+ G :- call(G), !, false.
 \+ _.
 
+
 X \= X :- !, false.
 _ \= _.
 
+
 once(G) :- call(G), !.
 
+
 repeat.
 repeat :- repeat.
 
-','(G1, G2) :- '$get_b_value'(B), '$call_with_default_policy'(comma_errors(G1, G2, B)).
 
-:- non_counted_backtracking comma_errors/3.
-comma_errors(G1, G2, B) :- var(G1), throw(error(instantiation_error, (',')/2)).
-comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, B)).
+','(G1, G2) :-
+    '$get_b_value'(B),
+    (  '$call_with_default_policy'(var(G1)) ->
+       throw(error(instantiation_error, (',')/2))
+    ;  '$call_with_default_policy'(','(G1, G2, B))
+    ).
+
 
-:- non_counted_backtracking (',')/3.
-','(!, CF, B) :- compound(CF),
-                '$call_with_default_policy'(CF = ','(G1, G2)),
-                '$set_cp'(B),
-                '$call_with_default_policy'(comma_errors(G1, G2, B)).
-','(!, Atom, B) :- Atom == !, '$set_cp'(B).
-','(!, G, B)  :- '$set_cp'(B), call(G).
-','(G, CF, B) :- compound(CF),
-                '$call_with_default_policy'(CF = ','(G1, G2)),
-                !,
-                call(G),
-                '$call_with_default_policy'(comma_errors(G1, G2, B)).
-','(G, Atom, B) :- Atom == !, !, call(G), '$set_cp'(B).
-','(G1, G2, _)  :- call(G1), call(G2).
-
-;(G1, G2) :- '$get_b_value'(B), ;(G1, G2, B).
-
-:- non_counted_backtracking semicolon_compound_selector/3.
-semicolon_compound_selector(->(G2, G3), G4, B) :-
-    (  call(G2) ->
-       call(G3)
-    ;  '$set_cp'(B),
-       call(G4)
-    ).
-semicolon_compound_selector(','(G2, G3), G4, B) :-
-    (  ','(G2, G3, B)
-    ;  '$set_cp'(B),
-       call(G4)
-    ).
-semicolon_compound_selector(';'(G2, G3), G4, B) :-
-    (  ';'(G2, G3, B)
-    ;  '$set_cp'(B),
-       call(G4)
+';'(G1, G2) :-
+    '$get_b_value'(B),
+    (  '$call_with_default_policy'(var(G1)) ->
+       throw(error(instantiation_error, (';')/2))
+    ;  '$call_with_default_policy'(';'(G1, G2, B))
+    ).
+
+
+G1 -> G2 :-
+    '$get_b_value'(B),
+    (  '$call_with_default_policy'(var(G1)) ->
+       throw(error(instantiation_error, (->)/2))
+    ;  '$call_with_default_policy'(->(G1, G2, B))
     ).
 
+
+call_or_cut(G, B, ErrorPI) :-
+    (  '$call_with_default_policy'(var(G)) ->
+       throw(error(instantiation_error, ErrorPI))
+    ;  '$call_with_default_policy'(call_or_cut(G, 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) :-
+    !,
+    '$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) :-
+    !,
+    '$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)).
+
+
 :- non_counted_backtracking (;)/3.
-;(G1, G4, B) :-
-    ( (  G1 = (_ -> _)
-      ;  G1 = (_ , _)
-      ;  G1 = (_ ; _)
-      ) ->
-      !,
-      semicolon_compound_selector(G1, G4, B)
-    ).
-;(G1, G2, B) :-
-    G1 == !, !, '$set_cp'(B), call(G2).
-;(G1, G2, B) :-
-    G2 == !, !, call(G1), '$set_cp'(B).
-;(G, _, _) :-
-    call(G).
-;(_, G, _) :-
-    call(G).
-
-G1 -> G2 :- '$get_b_value'(B), '$call_with_default_policy'(->(G1, G2, B)).
+';'((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) :-
+    !,
+    (  '$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, 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, B) :- G2 == !, call(G1), '$set_cp'(B).
-->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2).
+->((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) :-
+    !,
+    (  '$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.