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

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",

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.
+','(G1, G2) :-
-comma_errors(G1, G2, B) :- var(G1), throw(error(instantiation_error, (',')/2)).
+    '$get_b_value'(B),
-comma_errors(G1, G2, B) :- '$call_with_default_policy'(','(G1, G2, 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))
+    ).
+
+
+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.
-','(!, CF, B) :- compound(CF),
+','((G1, G2), G3, B) :-
-		 '$call_with_default_policy'(CF = ','(G1, G2)),
+    !,
-		 '$set_cp'(B),
+    '$call_with_default_policy'(','(G1, G2, B)),
-		 '$call_with_default_policy'(comma_errors(G1, G2, B)).
+    '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)).
-','(!, Atom, B) :- Atom == !, '$set_cp'(B).
+','((G1; G2), G3, B) :-
-','(!, G, B)  :- '$set_cp'(B), call(G).
+    !,
-','(G, CF, B) :- compound(CF),
+    '$call_with_default_policy'(';'(G1, G2, B)),
-		 '$call_with_default_policy'(CF = ','(G1, G2)),
+    '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)).
-		 !,
+','((G1 -> G2), G3, B) :-
-		 call(G),
+    !,
-		 '$call_with_default_policy'(comma_errors(G1, G2, B)).
+    '$call_with_default_policy'(->(G1, G2, B)),
-','(G, Atom, B) :- Atom == !, !, call(G), '$set_cp'(B).
+    '$call_with_default_policy'(call_or_cut(G3, B, (',')/2)).
-','(G1, G2, _)  :- call(G1), call(G2).
+','(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) :- '$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)
-    ).
 
 :- non_counted_backtracking (;)/3.
-;(G1, G4, B) :-
+';'((G1, G2), G3, B) :-
-    ( (  G1 = (_ -> _)
+    !,
-      ;  G1 = (_ , _)
+    (  '$call_with_default_policy'(','(G1, G2, B))
-      ;  G1 = (_ ; _)
+    ;  '$call_with_default_policy'(call_or_cut(G3, B, (;)/2))
-      ) ->
+    ).
-      !,
+';'((G1; G2), G3, B) :-
-      semicolon_compound_selector(G1, G4, 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))
     ).
-;(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)).
 
 :- non_counted_backtracking (->)/3.
-->(G1, G2, B) :- G2 == !, call(G1), '$set_cp'(B).
+->((G1, G2), G3, B) :-
-->(G1, G2, B) :- call(G1), '$set_cp'(B), call(G2).
+    !,
+    (  '$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.