From: Mark Thom <markjordanthom@gmail.com>
Date: Wed, 24 Mar 2021 21:05:59 +0000 (-0600)
Subject: stop unifying ! to free variables in control_functor/1 (#887)
X-Git-Tag: v0.9.0~106
X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=37f2336eeebf1d8ab94a65c5345016c153ccf28e;p=scryer-prolog.git

stop unifying ! to free variables in control_functor/1 (#887)
---

diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl
index 16d842bb..ad86d219 100644
--- a/src/lib/builtins.pl
+++ b/src/lib/builtins.pl
@@ -255,8 +255,8 @@ call_or_cut(G, B, ErrorPI) :-
 
 :- non_counted_backtracking control_functor/1.
 
-control_functor(_:G) :- control_functor(G).
-control_functor(call(_:!)).
+control_functor(_:G) :- nonvar(G), control_functor(G).
+control_functor(call(_:C)) :- C == !.
 control_functor(!).
 control_functor((_,_)).
 control_functor((_;_)).
@@ -577,9 +577,6 @@ catch(G,C,R) :-
     '$get_current_block'(Bb),
     '$call_with_default_policy'(catch(G,C,R,Bb)).
 
-
-:- meta_predicate catch(0, ?, 0, +).
-
 :- non_counted_backtracking catch/4.
 catch(G,C,R,Bb) :-
     '$install_new_block'(NBb),
@@ -599,8 +596,6 @@ end_block(Bb, NBb) :-
     '$reset_block'(NBb),
     '$fail'.
 
-:- meta_predicate handle_ball(?, ?, 0).
-
 :- non_counted_backtracking handle_ball/3.
 handle_ball(C, C, R) :-
     !,
@@ -612,8 +607,6 @@ handle_ball(_, _, _) :-
 throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'.
 
 
-% :- meta_predicate '$iterate_find_all'(?, 0, ?, ?).
-
 :- non_counted_backtracking '$iterate_find_all'/4.
 '$iterate_find_all'(Template, Goal, _, LhOffset) :-
     call(Goal),
diff --git a/src/lib/iso_ext.pl b/src/lib/iso_ext.pl
index 7d580497..4d064193 100644
--- a/src/lib/iso_ext.pl
+++ b/src/lib/iso_ext.pl
@@ -17,13 +17,17 @@
                     variant/2,
                     copy_term_nat/2]).
 
-:- use_module(library(error), [can_be/2, domain_error/3, type_error/3]).
+:- use_module(library(error), [can_be/2,
+                               domain_error/3,
+                               instantiation_error/1,
+                               type_error/3]).
 
 
 :- meta_predicate call_cleanup(0, 0).
 
 :- meta_predicate setup_call_cleanup(0, 0, 0).
 
+:- meta_predicate forall(0, 0).
 
 forall(Generate, Test) :-
     \+ (Generate, \+ Test).
@@ -61,20 +65,24 @@ setup_call_cleanup(S, G, C) :-
     call(S),
     '$set_cp_by_default'(B),
     '$get_current_block'(Bb),
-    (  '$call_with_default_policy'(var(C)) ->
-       throw(error(instantiation_error, setup_call_cleanup/3))
+    (  C = _:CC,
+       '$call_with_default_policy'(var(CC)) ->
+       instantiation_error(setup_call_cleanup/3)
     ;  '$call_with_default_policy'(scc_helper(C, G, Bb))
     ).
 
 :- non_counted_backtracking scc_helper/3.
 scc_helper(C, G, Bb) :-
-    '$get_cp'(Cp), '$install_scc_cleaner'(C, NBb), call(G),
+    '$get_cp'(Cp),
+    '$install_scc_cleaner'(C, NBb),
+    call(G),
     ( '$check_cp'(Cp) ->
       '$reset_block'(Bb),
       '$call_with_default_policy'(run_cleaners_without_handling(Cp))
     ; '$call_with_default_policy'(true)
     ; '$reset_block'(NBb),
-      '$fail').
+      '$fail'
+    ).
 scc_helper(_, _, Bb) :-
     '$reset_block'(Bb),
     '$get_ball'(Ball),
diff --git a/src/toplevel.pl b/src/toplevel.pl
index a41af819..0ddec431 100644
--- a/src/toplevel.pl
+++ b/src/toplevel.pl
@@ -149,10 +149,9 @@ instruction_match(Term, VarList) :-
 	      ;
              submit_query_and_print_results(consult(Item), [])
 	      )
-       ;
-	   catch(type_error(atom, Item, repl/0),
-		     E,
-		     print_exception_with_check(E))
+       ;  catch(type_error(atom, Item, repl/0),
+		        E,
+		        print_exception_with_check(E))
        )
     ;  Term = end_of_file ->
        halt
@@ -167,15 +166,12 @@ submit_query_and_print_results_(Term, VarList) :-
     write_eqs_and_read_input(B, VarList),
     !.
 submit_query_and_print_results_(_, _) :-
-    %  clear attribute goal lists, which may be populated by
-    %  copy_term/3 prior to failure.
     write('false.'),
     nl.
 
 
 submit_query_and_print_results(Term0, VarList) :-
     expand_goal(call(Term0), user, call(Term)),
-    !,
     setup_call_cleanup(bb_put('$first_answer', true),
                        submit_query_and_print_results_(Term, VarList),
                        bb_put('$first_answer', false)).