rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add call_with_inference_limit/3

Browse Source
This commit is contained in:
Mark Thom
2018-08-08 00:42:57 -06:00
parent 707e5fcf8b
commit 7016d378d6
9 changed files with 201 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
src/prolog/lib/builtins.pl
View File

@@ -5,7 +5,8 @@
(>>)/2, (mod)/2, (rem)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2,
(-)/1, (>=)/2, (=<)/2, (,)/2, (->)/2, (;)/2, (=..)/2, (==)/2,
(\==)/2, (@=<)/2, (@>=)/2, (@<)/2, (@>)/2, (=@=)/2, (\=@=)/2,
(:)/2, catch/3, setup_call_cleanup/3, throw/1, true/0, false/0]).
(:)/2, call_with_inference_limit/3, catch/3,
setup_call_cleanup/3, throw/1, true/0, false/0]).
% arithmetic operators.
:- op(700, xfx, is).
@@ -149,13 +150,13 @@ univ_worker(Term, List, _) :-
% setup_call_cleanup.
setup_call_cleanup(S, G, C) :- '$get_cp'(B),
setup_call_cleanup(S, G, C) :- '$get_b_value'(B),
S, '$set_cp_by_default'(B), '$get_current_block'(Bb),
( var(C) -> throw(error(instantiation_error, setup_call_cleanup/3))
; scc_helper(C, G, Bb) ).
scc_helper(C, G, Bb) :-
'$get_level'(Cp), '$install_scc_cleaner'(C, NBb), call(G),
'$get_cp'(Cp), '$install_scc_cleaner'(C, NBb), call(G),
( '$check_cp'(Cp) -> '$reset_block'(Bb), run_cleaners_without_handling(Cp)
; true
; '$reset_block'(NBb), '$fail').
@@ -163,7 +164,7 @@ scc_helper(_, _, Bb) :-
'$reset_block'(Bb), '$get_ball'(Ball),
run_cleaners_with_handling, throw(Ball).
scc_helper(_, _, _) :-
run_cleaners_without_handling(Cp), false.
'$get_cp'(Cp), run_cleaners_without_handling(Cp), '$fail'.
run_cleaners_with_handling :-
'$get_scc_cleaner'(C), '$get_level'(B), catch(C, _, true), '$set_cp_by_default'(B),
@@ -177,6 +178,40 @@ run_cleaners_without_handling(Cp) :-
run_cleaners_without_handling(Cp) :-
'$set_cp_by_default'(Cp), '$restore_cut_policy'.
% call_with_inference_limit
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).
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' ),
'$call_with_default_policy'(handle_ile(B, Ball, R)).
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'.
handle_ile(B, inference_limit_exceeded(B), inference_limit_exceeded) :- !.
handle_ile(B, _, _) :- '$remove_call_policy_check'(B), '$unwind_stack'. % throw(E).
% exceptions.
catch(G,C,R) :- '$get_current_block'(Bb), catch(G,C,R,Bb).
@@ -187,7 +222,7 @@ catch(G,C,R,Bb) :- '$reset_block'(Bb), '$get_ball'(Ball), handle_ball(Ball, C, R
end_block(Bb, NBb) :- '$clean_up_block'(NBb), '$reset_block'(Bb).
end_block(Bb, NBb) :- '$reset_block'(NBb), '$fail'.
handle_ball(Ball, C, R) :- Ball = C, '$get_level'(B), '$set_cp_by_default'(B), '$erase_ball', call(R).
handle_ball(C, C, R) :- !, '$erase_ball', call(R).
handle_ball(_, _, _) :- '$unwind_stack'.
throw(Ball) :- '$set_ball'(Ball), '$unwind_stack'.