(=<)/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,
- char_code/2, clause/2, current_op/3, current_predicate/1,
- current_prolog_flag/2, expand_goal/2, expand_term/2, false/0,
- findall/3, findall/4, get_char/1, halt/0, once/1, op/3,
- read_term/2, repeat/0, retract/1, set_prolog_flag/2, setof/3,
- setup_call_cleanup/3, term_variables/2, throw/1, true/0,
- write/1, write_canonical/1, write_term/2, writeq/1]).
+ atom_length/2, bagof/3, catch/3, char_code/2, clause/2,
+ current_op/3, current_predicate/1, current_prolog_flag/2,
+ expand_goal/2, expand_term/2, false/0, findall/3, findall/4,
+ get_char/1, halt/0, once/1, op/3, read_term/2, repeat/0,
+ retract/1, set_prolog_flag/2, setof/3, term_variables/2,
+ throw/1, true/0, write/1, write_canonical/1, write_term/2,
+ writeq/1]).
% module resolution operator.
:- op(600, xfy, :).
; 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)).
%% ?- 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).
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)).
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_wo_h = self.get_internal(r_wo_h, 1, builtins).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, 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 {
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).",
{
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).");
{
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).");