From 4d29a3ae3cc7ae118d8ff3f10b762fd4b8c509bd Mon Sep 17 00:00:00 2001
From: Mark Thom <markjordanthom@gmail.com>
Date: Tue, 9 Feb 2021 16:40:25 -0700
Subject: [PATCH] check for control functors (,/;/->) before jumping to
 internal interpretation (#815)

---
 src/lib/builtins.pl | 28 ++++++++++++++++++----------
 src/loader.pl       |  4 ++--
 2 files changed, 20 insertions(+), 12 deletions(-)

diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl
index 824c4dd2..1396179b 100644
--- a/src/lib/builtins.pl
+++ b/src/lib/builtins.pl
@@ -243,18 +243,26 @@ call_or_cut(G, B, ErrorPI) :-
     ).
 
 
+:- non_counted_backtracking control_functor/1.
+
+control_functor(!).
+control_functor((_,_)).
+control_functor((_;_)).
+control_functor((_->_)).
+
+
 :- 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_with_default_policy'(control_functor(G)) ->
+       '$call_with_default_policy'(call_or_cut_interp(G, B))
     ;  call(M:G)
     ).
 call_or_cut(G, B) :-
-    (  '$call_with_default_policy'(call_or_cut_interp(G, B)) ->
-       true
+    (  '$call_with_default_policy'(control_functor(G)) ->
+       '$call_with_default_policy'(call_or_cut_interp(G, B))
     ;  call(G)
     ).
 
@@ -276,8 +284,8 @@ call_or_cut_interp((G1 -> G2), B) :-
 ','(M:G1, G2, B) :-
     !,
     (  nonvar(G1),
-       '$call_with_default_policy'(',-interp'(G1, G2, B)) ->
-       true
+       '$call_with_default_policy'(control_functor(G1)) ->
+       '$call_with_default_policy'(',-interp'(G1, G2, B))
     ;  call(M:G1),
        '$call_with_default_policy'(call_or_cut(G2, B, (',')/2))
     ).
@@ -304,8 +312,8 @@ call_or_cut_interp((G1 -> G2), B) :-
 ';'(M:G1, G2, B) :-
     !,
     (  nonvar(G1),
-       '$call_with_default_policy'(';-interp'(G1, G2, B)) ->
-       true
+       '$call_with_default_policy'(control_functor(G1)) ->
+       '$call_with_default_policy'(';-interp'(G1, G2, B))
     ;  call(M:G1)
     ;  '$call_with_default_policy'(call_or_cut(G2, B, (;)/2))
     ).
@@ -337,8 +345,8 @@ call_or_cut_interp((G1 -> G2), B) :-
 ->(M:G1, G2, B) :-
     !,
     (  nonvar(G1),
-       '$call_with_default_policy'('->-interp'(G1, G2, B)) ->
-       true
+       '$call_with_default_policy'(control_functor(G1)) ->
+       '$call_with_default_policy'('->-interp'(G1, G2, B))
     ;  call(M:G1) ->
        '$call_with_default_policy'(call_or_cut(G2, B, (->)/2))
     ).
diff --git a/src/loader.pl b/src/loader.pl
index c4235eaf..01fc23f4 100644
--- a/src/loader.pl
+++ b/src/loader.pl
@@ -92,7 +92,7 @@ file_load(Stream, Path, Evacuable) :-
     catch(loader:load_loop(Stream, Evacuable),
           E,
           builtins:(loader:unload_evacuable(Evacuable),
-		    builtins:throw(E))),
+		            builtins:throw(E))),
     run_initialization_goals,
     '$pop_load_context'.
 
@@ -102,7 +102,7 @@ load(Stream) :-
     catch(loader:load_loop(Stream, Evacuable),
           E,
           builtins:(loader:unload_evacuable(Evacuable),
-		    builtins:throw(E))),
+		            builtins:throw(E))),
     run_initialization_goals,
     '$pop_load_context'.
 
-- 
2.54.0