move setup_call_cleanup/3 and call_with_inference_limit/3 to non_iso

src/prolog/lib/builtins.pl

@@ -12,13 +12,13 @@
 	(=<)/2, (',')/2, (->)/2, (;)/2, (=..)/2, (==)/2, (\==)/2,
 	(@=<)/2, (@>=)/2, (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2,
 	abolish/1, asserta/1, assertz/1, atom_chars/2, atom_codes/2,
-	atom_length/2, bagof/3, call_with_inference_limit/3, catch/3,
+	atom_length/2, bagof/3, catch/3, char_code/2, clause/2,
-	char_code/2, clause/2, current_op/3, current_predicate/1,
+	current_op/3, current_predicate/1, current_prolog_flag/2,
-	current_prolog_flag/2, expand_goal/2, expand_term/2, false/0,
+	expand_goal/2, expand_term/2, false/0, findall/3, findall/4,
-	findall/3, findall/4, get_char/1, halt/0, once/1, op/3,
+	get_char/1, halt/0, once/1, op/3, read_term/2, repeat/0,
-	read_term/2, repeat/0, retract/1, set_prolog_flag/2, setof/3,
+	retract/1, set_prolog_flag/2, setof/3, term_variables/2,
-	setup_call_cleanup/3, term_variables/2, throw/1, true/0,
+	throw/1, true/0, write/1, write_canonical/1, write_term/2,
-	write/1, write_canonical/1, write_term/2, writeq/1]).
+	writeq/1]).
 
 % module resolution operator.
 :- op(600, xfy, :).
@@ -772,83 +772,3 @@ get_char(C) :-
     ;  atom_length(C, 1) -> '$get_char'(C)
     ;  throw(error(type_error(in_character, C), get_char/1))
     ).
-
-% setup_call_cleanup.
-
-setup_call_cleanup(S, G, C) :- '$get_b_value'(B),
-    S, '$set_cp_by_default'(B), '$get_current_block'(Bb),
-    ( '$call_with_default_policy'(var(C)) -> throw(error(instantiation_error, setup_call_cleanup/3))
-    ; '$call_with_default_policy'(scc_helper(C, G, Bb)) ).
-
-:- non_counted_backtracking run_cleaners_with_handling/0.
-run_cleaners_with_handling :-
-    '$get_scc_cleaner'(C), '$get_level'(B),
-    '$call_with_default_policy'(catch(C, _, true)),
-    '$set_cp_by_default'(B),
-    '$call_with_default_policy'(run_cleaners_with_handling).
-run_cleaners_with_handling :-
-    '$restore_cut_policy'.
-
-:- non_counted_backtracking run_cleaners_without_handling/1.
-run_cleaners_without_handling(Cp) :-
-    '$get_scc_cleaner'(C), '$get_level'(B), C, '$set_cp_by_default'(B),
-    '$call_with_default_policy'(run_cleaners_without_handling(Cp)).
-run_cleaners_without_handling(Cp) :-
-    '$set_cp_by_default'(Cp), '$restore_cut_policy'.
-
-:- non_counted_backtracking scc_helper/3.
-scc_helper(C, G, Bb) :-
-    '$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').
-scc_helper(_, _, Bb) :-
-    '$reset_block'(Bb), '$get_ball'(Ball),
-    '$call_with_default_policy'(run_cleaners_with_handling),
-    '$erase_ball',
-    '$call_with_default_policy'(throw(Ball)).
-scc_helper(_, _, _) :-
-    '$get_cp'(Cp),
-    '$call_with_default_policy'(run_cleaners_without_handling(Cp)),
-    '$fail'.
-
-% call_with_inference_limit
-
-:- non_counted_backtracking end_block/4.
-end_block(_, Bb, NBb, L) :-
-    '$clean_up_block'(NBb),
-    '$reset_block'(Bb).
-end_block(B, Bb, NBb, L) :-
-    '$install_inference_counter'(B, L, _),
-    '$reset_block'(NBb),
-    '$fail'.
-
-:- non_counted_backtracking handle_ile/3.
-handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :- !.
-handle_ile(B, E, _) :-
-    '$remove_call_policy_check'(B),
-    '$call_with_default_policy'(throw(E)).
-
-call_with_inference_limit(G, L, R) :-
-    '$get_current_block'(Bb),
-    '$get_b_value'(B),
-    '$call_with_default_policy'(call_with_inference_limit(G, L, R, Bb, B)),
-    '$remove_call_policy_check'(B).
-
-:- non_counted_backtracking call_with_inference_limit/5.
-call_with_inference_limit(G, L, R, Bb, B) :-
-    '$install_new_block'(NBb),
-    '$install_inference_counter'(B, L, Count0),
-    call(G),
-    '$inference_level'(R, B),
-    '$remove_inference_counter'(B, Count1),
-    '$call_with_default_policy'(is(Diff, L - (Count1 - Count0))),
-    '$call_with_default_policy'(end_block(B, Bb, NBb, Diff)).
-call_with_inference_limit(_, _, R, Bb, B) :-
-    '$reset_block'(Bb),
-    '$remove_inference_counter'(B, _),
-    ( '$get_ball'(Ball), '$get_level'(Cp), '$set_cp_by_default'(Cp)
-    ; '$remove_call_policy_check'(B), '$fail' ),
-    '$erase_ball',
-    '$call_with_default_policy'(handle_ile(B, Ball, R)).

src/prolog/lib/non_iso.pl

@@ -4,7 +4,8 @@
 %% ?- use_module(library(non_iso)).
 
 :- module(non_iso, [bb_b_put/2, bb_get/2, bb_put/2, call_cleanup/2,
-		    forall/2]).
+		    call_with_inference_limit/3, forall/2,
+		    setup_call_cleanup/3]).
 
 forall(Generate, Test) :-
     \+ (Generate, \+ Test).
@@ -28,3 +29,84 @@ bb_get(Key, Value) :- atom(Key), !, '$fetch_global_var'(Key, Value).
 bb_get(Key, _) :- throw(error(type_error(atom, Key), bb_get/2)).
 
 call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
+
+
+% setup_call_cleanup.
+
+setup_call_cleanup(S, G, C) :- '$get_b_value'(B),
+    S, '$set_cp_by_default'(B), '$get_current_block'(Bb),
+    ( '$call_with_default_policy'(var(C)) -> throw(error(instantiation_error, setup_call_cleanup/3))
+    ; '$call_with_default_policy'(scc_helper(C, G, Bb)) ).
+
+:- non_counted_backtracking run_cleaners_with_handling/0.
+run_cleaners_with_handling :-
+    '$get_scc_cleaner'(C), '$get_level'(B),
+    '$call_with_default_policy'(catch(C, _, true)),
+    '$set_cp_by_default'(B),
+    '$call_with_default_policy'(run_cleaners_with_handling).
+run_cleaners_with_handling :-
+    '$restore_cut_policy'.
+
+:- non_counted_backtracking run_cleaners_without_handling/1.
+run_cleaners_without_handling(Cp) :-
+    '$get_scc_cleaner'(C), '$get_level'(B), C, '$set_cp_by_default'(B),
+    '$call_with_default_policy'(run_cleaners_without_handling(Cp)).
+run_cleaners_without_handling(Cp) :-
+    '$set_cp_by_default'(Cp), '$restore_cut_policy'.
+
+:- non_counted_backtracking scc_helper/3.
+scc_helper(C, G, Bb) :-
+    '$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').
+scc_helper(_, _, Bb) :-
+    '$reset_block'(Bb), '$get_ball'(Ball),
+    '$call_with_default_policy'(run_cleaners_with_handling),
+    '$erase_ball',
+    '$call_with_default_policy'(throw(Ball)).
+scc_helper(_, _, _) :-
+    '$get_cp'(Cp),
+    '$call_with_default_policy'(run_cleaners_without_handling(Cp)),
+    '$fail'.
+
+% call_with_inference_limit
+
+:- non_counted_backtracking end_block/4.
+end_block(_, Bb, NBb, L) :-
+    '$clean_up_block'(NBb),
+    '$reset_block'(Bb).
+end_block(B, Bb, NBb, L) :-
+    '$install_inference_counter'(B, L, _),
+    '$reset_block'(NBb),
+    '$fail'.
+
+:- non_counted_backtracking handle_ile/3.
+handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :- !.
+handle_ile(B, E, _) :-
+    '$remove_call_policy_check'(B),
+    '$call_with_default_policy'(throw(E)).
+
+call_with_inference_limit(G, L, R) :-
+    '$get_current_block'(Bb),
+    '$get_b_value'(B),
+    '$call_with_default_policy'(call_with_inference_limit(G, L, R, Bb, B)),
+    '$remove_call_policy_check'(B).
+
+:- non_counted_backtracking call_with_inference_limit/5.
+call_with_inference_limit(G, L, R, Bb, B) :-
+    '$install_new_block'(NBb),
+    '$install_inference_counter'(B, L, Count0),
+    call(G),
+    '$inference_level'(R, B),
+    '$remove_inference_counter'(B, Count1),
+    '$call_with_default_policy'(is(Diff, L - (Count1 - Count0))),
+    '$call_with_default_policy'(end_block(B, Bb, NBb, Diff)).
+call_with_inference_limit(_, _, R, Bb, B) :-
+    '$reset_block'(Bb),
+    '$remove_inference_counter'(B, _),
+    ( '$get_ball'(Ball), '$get_level'(Cp), '$set_cp_by_default'(Cp)
+    ; '$remove_call_policy_check'(B), '$fail' ),
+    '$erase_ball',
+    '$call_with_default_policy'(handle_ile(B, Ball, R)).

src/prolog/machine/machine_indices.rs

@@ -528,10 +528,10 @@ impl IndexStore {
         let r_w_h  = clause_name!("run_cleaners_with_handling");
         let r_wo_h = clause_name!("run_cleaners_without_handling");
 
-        let builtins = clause_name!("builtins");
+        let non_iso = clause_name!("non_iso");
 
-        let r_w_h  = self.get_internal(r_w_h, 0, builtins.clone()).and_then(|item| item.local());
+        let r_w_h  = self.get_internal(r_w_h, 0, non_iso.clone()).and_then(|item| item.local());
-        let r_wo_h = self.get_internal(r_wo_h, 1, builtins).and_then(|item| item.local());
+        let r_wo_h = self.get_internal(r_wo_h, 1, non_iso).and_then(|item| item.local());
 
         if let Some(r_w_h) = r_w_h {
             if let Some(r_wo_h) = r_wo_h {

src/tests.rs

@@ -1669,6 +1669,8 @@ fn test_queries_on_builtins()
     assert_prolog_success!(&mut wam, "call(((G = 2 ; fail), B=3, !)).",
                            [["G = 2", "B = 3"]]);
 
+    submit(&mut wam, ":- use_module(library(non_iso)).");
+
     assert_prolog_success!(&mut wam, "call_with_inference_limit((setup_call_cleanup(S=1,(G=2;fail),writeq(S+G>B)), B=3, !), 100, R).",
                            [["G = 2", "B = 3", "R = !", "S = 1"]]);
     assert_prolog_success!(&mut wam, "call_with_inference_limit((setup_call_cleanup(S=1,(G=2;fail),writeq(S+G>B)), B=3, !), 10, R).",
@@ -1977,6 +1979,8 @@ fn test_queries_on_setup_call_cleanup()
 {
     let mut wam = Machine::new(readline::input_stream());
 
+    submit(&mut wam, ":- use_module(library(non_iso)).");
+    
     // Test examples from the ISO Prolog page for setup_call_catch.
     assert_prolog_failure!(&mut wam, "setup_call_cleanup(false, _, _).");
     assert_prolog_success!(&mut wam, "catch(setup_call_cleanup(true, throw(unthrown), _), error(instantiation_error, _), true).");
@@ -2037,6 +2041,8 @@ fn test_queries_on_call_with_inference_limit()
 {
     let mut wam = Machine::new(readline::input_stream());
 
+    submit(&mut wam, ":- use_module(library(non_iso)).");
+    
     assert_prolog_success!(&mut wam, "call_with_inference_limit(throw(error), 0, R).",
                            [["R = inference_limit_exceeded"]]);
     assert_prolog_success!(&mut wam, "catch(call_with_inference_limit(throw(error), 1, R), error, true).");