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

defer installation of inference counter for call_with_inference_limit til after goals expanded

Browse Source
This commit is contained in:
Mark Thom
2021-12-06 18:08:38 -07:00
parent cd129e32a7
commit 8ba61a1da1
6 changed files with 82 additions and 71 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
src/clause_types.rs
View File

@@ -481,7 +481,6 @@ impl SystemClauseType {
&SystemClauseType::Maybe => atom!("maybe"), &SystemClauseType::Maybe => atom!("maybe"),
&SystemClauseType::CpuNow => atom!("$cpu_now"), &SystemClauseType::CpuNow => atom!("$cpu_now"),
&SystemClauseType::CurrentTime => atom!("$current_time"), &SystemClauseType::CurrentTime => atom!("$current_time"),
// &SystemClauseType::ModuleHeadIsDynamic => atom!("$module_head_is_dynamic"),
&SystemClauseType::ModuleExists => atom!("$module_exists"), &SystemClauseType::ModuleExists => atom!("$module_exists"),
&SystemClauseType::NextStream => atom!("$next_stream"), &SystemClauseType::NextStream => atom!("$next_stream"),
&SystemClauseType::NoSuchPredicate => atom!("$no_such_predicate"), &SystemClauseType::NoSuchPredicate => atom!("$no_such_predicate"),

28
src/lib/builtins.pl
View File

@@ -69,7 +69,8 @@ Module : Predicate :-
% dynamic module resolution. % dynamic module resolution.
:(Module, Predicate, A1) :- :(Module, Predicate, A1) :-
( atom(Module) -> '$module_call'(A1, Module, Predicate) ( atom(Module) ->
'$module_call'(A1, Module, Predicate)
; throw(error(type_error(atom, Module), (:)/2)) ; throw(error(type_error(atom, Module), (:)/2))
). ).
@@ -262,7 +263,7 @@ comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7,G8|Gs]) :-
'$call'(G6), '$call'(G6),
'$call'(G7), '$call'(G7),
'$call'(G8), '$call'(G8),
comma_dispatch_call_list(Gs). '$call_with_default_policy'(comma_dispatch_call_list(Gs)).
comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :- comma_dispatch_call_list([G1,G2,G3,G4,G5,G6,G7]) :-
!, !,
'$call'(G1), '$call'(G1),
@@ -585,7 +586,9 @@ throw(Ball) :-
), ),
'$unwind_stack'. '$unwind_stack'.
:- non_counted_backtracking '$iterate_find_all'/4. :- non_counted_backtracking '$iterate_find_all'/4.
'$iterate_find_all'(Template, Goal, _, LhOffset) :- '$iterate_find_all'(Template, Goal, _, LhOffset) :-
call(Goal), call(Goal),
'$copy_to_lh'(LhOffset, Template), '$copy_to_lh'(LhOffset, Template),
@@ -601,7 +604,7 @@ truncate_lh_to(LhLength) :- '$truncate_lh_to'(LhLength).
:- meta_predicate findall(?, 0, ?). :- meta_predicate findall(?, 0, ?).
findall(Template, Goal, Solutions) :- findall(Template, Goal, Solutions) :-
error:can_be(list, Solutions), '$call_with_default_policy'(error:can_be(list, Solutions)),
'$lh_length'(LhLength), '$lh_length'(LhLength),
'$call_with_default_policy'( '$call_with_default_policy'(
catch(builtins:'$iterate_find_all'(Template, Goal, Solutions, LhLength), catch(builtins:'$iterate_find_all'(Template, Goal, Solutions, LhLength),
@@ -609,7 +612,6 @@ findall(Template, Goal, Solutions) :-
( builtins:truncate_lh_to(LhLength), builtins:throw(Error) )) ( builtins:truncate_lh_to(LhLength), builtins:throw(Error) ))
). ).
:- non_counted_backtracking '$iterate_find_all_diff'/5. :- non_counted_backtracking '$iterate_find_all_diff'/5.
'$iterate_find_all_diff'(Template, Goal, _, _, LhOffset) :- '$iterate_find_all_diff'(Template, Goal, _, _, LhOffset) :-
@@ -624,8 +626,8 @@ findall(Template, Goal, Solutions) :-
:- meta_predicate findall(?, 0, ?, ?). :- meta_predicate findall(?, 0, ?, ?).
findall(Template, Goal, Solutions0, Solutions1) :- findall(Template, Goal, Solutions0, Solutions1) :-
error:can_be(list, Solutions0), '$call_with_default_policy'(error:can_be(list, Solutions0)),
error:can_be(list, Solutions1), '$call_with_default_policy'(error:can_be(list, Solutions1)),
'$lh_length'(LhLength), '$lh_length'(LhLength),
'$call_with_default_policy'( '$call_with_default_policy'(
catch(builtins:'$iterate_find_all_diff'(Template, Goal, Solutions0, catch(builtins:'$iterate_find_all_diff'(Template, Goal, Solutions0,
@@ -819,13 +821,14 @@ asserta_clause(Head, Body) :-
:- meta_predicate asserta(0). :- meta_predicate asserta(0).
asserta(Clause) :- asserta(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
( Clause \= (_ :- _) -> ( Clause \= (_ :- _) ->
Head = Clause, Head = Clause,
Body = true, Body = true,
asserta_clause(Head, Body) module_asserta_clause(Head, Body, Module)
; Clause = (Head :- Body) -> ; Clause = (Head :- Body) ->
asserta_clause(Head, Body) module_asserta_clause(Head, Body, Module)
). ).
module_assertz_clause(Head, Body, Module) :- module_assertz_clause(Head, Body, Module) :-
@@ -874,13 +877,14 @@ assertz_clause(Head, Body) :-
:- meta_predicate assertz(0). :- meta_predicate assertz(0).
assertz(Clause) :- assertz(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
( Clause \= (_ :- _) -> ( Clause \= (_ :- _) ->
Head = Clause, Head = Clause,
Body = true, Body = true,
assertz_clause(Head, Body) module_assertz_clause(Head, Body, Module)
; Clause = (Head :- Body) -> ; Clause = (Head :- Body) ->
assertz_clause(Head, Body) module_assertz_clause(Head, Body, Module)
). ).

23
src/lib/iso_ext.pl
View File

@@ -24,10 +24,6 @@
:- use_module(library(lists), [maplist/3]). :- use_module(library(lists), [maplist/3]).
:- meta_predicate(call_cleanup(0, 0)).
:- meta_predicate(setup_call_cleanup(0, 0, 0)).
:- meta_predicate(forall(0, 0)). :- meta_predicate(forall(0, 0)).
forall(Generate, Test) :- forall(Generate, Test) :-
@@ -56,14 +52,17 @@ bb_get(Key, Value) :-
). ).
% setup_call_cleanup.
:- meta_predicate(call_cleanup(0, 0)).
call_cleanup(G, C) :- setup_call_cleanup(true, G, C). call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
:- meta_predicate(setup_call_cleanup(0, 0, 0)).
% setup_call_cleanup.
setup_call_cleanup(S, G, C) :- setup_call_cleanup(S, G, C) :-
'$get_b_value'(B), '$get_b_value'(B),
call(S), '$call'(S),
'$set_cp_by_default'(B), '$set_cp_by_default'(B),
'$get_current_block'(Bb), '$get_current_block'(Bb),
( C = _:CC, ( C = _:CC,
@@ -72,6 +71,8 @@ setup_call_cleanup(S, G, C) :-
; '$call_with_default_policy'(scc_helper(C, G, Bb)) ; '$call_with_default_policy'(scc_helper(C, G, Bb))
). ).
:- meta_predicate(scc_helper(?,0,?)).
:- non_counted_backtracking scc_helper/3. :- non_counted_backtracking scc_helper/3.
scc_helper(C, G, Bb) :- scc_helper(C, G, Bb) :-
'$get_cp'(Cp), '$get_cp'(Cp),
@@ -140,11 +141,17 @@ call_with_inference_limit(G, L, R) :-
'$call_with_default_policy'(call_with_inference_limit(G, L, R, Bb, B)), '$call_with_default_policy'(call_with_inference_limit(G, L, R, Bb, B)),
'$remove_call_policy_check'(B). '$remove_call_policy_check'(B).
install_inference_counter(B, L, Count0) :-
'$install_inference_counter'(B, L, Count0).
:- meta_predicate(call_with_inference_limit(0,?,?,?,?)).
:- non_counted_backtracking call_with_inference_limit/5. :- non_counted_backtracking call_with_inference_limit/5.
call_with_inference_limit(G, L, R, Bb, B) :- call_with_inference_limit(G, L, R, Bb, B) :-
'$install_new_block'(NBb), '$install_new_block'(NBb),
'$install_inference_counter'(B, L, Count0), '$install_inference_counter'(B, L, Count0),
call(G), '$call'(G),
'$inference_level'(R, B), '$inference_level'(R, B),
'$remove_inference_counter'(B, Count1), '$remove_inference_counter'(B, Count1),
'$call_with_default_policy'(is(Diff, L - (Count1 - Count0))), '$call_with_default_policy'(is(Diff, L - (Count1 - Count0))),

4
src/loader.pl
View File

@@ -257,8 +257,8 @@ expand_term_goals(Terms0, Terms) :-
Terms = (Module:Head2 :- Body1) Terms = (Module:Head2 :- Body1)
; type_error(atom, Module, load/1) ; type_error(atom, Module, load/1)
) )
; prolog_load_context(module, Target), ; module_expanded_head_variables(Head1, HeadVars),
module_expanded_head_variables(Head1, HeadVars), prolog_load_context(module, Target),
expand_goal(Body0, Target, Body1, HeadVars), expand_goal(Body0, Target, Body1, HeadVars),
Terms = (Head1 :- Body1) Terms = (Head1 :- Body1)
) )

72
src/machine/system_calls.rs
View File

@@ -407,29 +407,29 @@ impl MachineState {
} }
fn term_variables_under_max_depth( fn term_variables_under_max_depth(
&mut self, &mut self,
term: HeapCellValue, term: HeapCellValue,
max_depth: usize, max_depth: usize,
list_of_vars: HeapCellValue, list_of_vars: HeapCellValue,
) { ) {
let mut seen_set = IndexSet::new(); let mut seen_set = IndexSet::new();
{ {
let mut iter = stackful_post_order_iter(&mut self.heap, term); let mut iter = stackful_post_order_iter(&mut self.heap, term);
while let Some(value) = iter.next() { while let Some(value) = iter.next() {
if iter.parent_stack_len() >= max_depth { if iter.parent_stack_len() >= max_depth {
iter.pop_stack(); iter.pop_stack();
continue; continue;
} }
let value = unmark_cell_bits!(value); let value = unmark_cell_bits!(value);
if value.is_var() && !seen_set.contains(&value) { if value.is_var() && !seen_set.contains(&value) {
seen_set.insert(value); seen_set.insert(value);
} }
} }
} }
let outcome = heap_loc_as_cell!( let outcome = heap_loc_as_cell!(
iter_to_heap_list( iter_to_heap_list(
@@ -2499,17 +2499,17 @@ impl MachineState {
&SystemClauseType::HeadIsDynamic => { &SystemClauseType::HeadIsDynamic => {
let module_name = cell_as_atom!(self.store(self.deref(self.registers[1]))); let module_name = cell_as_atom!(self.store(self.deref(self.registers[1])));
let (name, arity) = read_heap_cell!(self.store(self.deref(self.registers[2])), let (name, arity) = read_heap_cell!(self.store(self.deref(self.registers[2])),
(HeapCellValueTag::Str, s) => { (HeapCellValueTag::Str, s) => {
cell_as_atom_cell!(self.heap[s]).get_name_and_arity() cell_as_atom_cell!(self.heap[s]).get_name_and_arity()
} }
(HeapCellValueTag::Atom, (name, _arity)) => { (HeapCellValueTag::Atom, (name, _arity)) => {
(name, 0) (name, 0)
} }
_ => { _ => {
unreachable!() unreachable!()
} }
); );
self.fail = !indices.is_dynamic_predicate(module_name, (name, arity)); self.fail = !indices.is_dynamic_predicate(module_name, (name, arity));
} }
@@ -2698,13 +2698,13 @@ impl MachineState {
&SystemClauseType::EnqueueAttributedVar => { &SystemClauseType::EnqueueAttributedVar => {
let addr = self.store(self.deref(self.registers[1])); let addr = self.store(self.deref(self.registers[1]));
read_heap_cell!(addr, read_heap_cell!(addr,
(HeapCellValueTag::AttrVar, h) => { (HeapCellValueTag::AttrVar, h) => {
self.attr_var_init.attr_var_queue.push(h); self.attr_var_init.attr_var_queue.push(h);
} }
_ => { _ => {
} }
); );
} }
&SystemClauseType::GetNextDBRef => { &SystemClauseType::GetNextDBRef => {
let a1 = self.store(self.deref(self.registers[1])); let a1 = self.store(self.deref(self.registers[1]));
@@ -4384,12 +4384,12 @@ impl MachineState {
unify_fn!(self, a2, outcome); unify_fn!(self, a2, outcome);
} }
&SystemClauseType::TermVariablesUnderMaxDepth => { &SystemClauseType::TermVariablesUnderMaxDepth => {
// Term, MaxDepth, VarList // Term, MaxDepth, VarList
let max_depth = cell_as_fixnum!( let max_depth = cell_as_fixnum!(
self.store(self.deref(self.registers[2])) self.store(self.deref(self.registers[2]))
).get_num() as usize; ).get_num() as usize;
self.term_variables_under_max_depth(self.registers[1], max_depth, self.registers[3]); self.term_variables_under_max_depth(self.registers[1], max_depth, self.registers[3]);
} }
&SystemClauseType::TruncateLiftedHeapTo => { &SystemClauseType::TruncateLiftedHeapTo => {
let a1 = self.store(self.deref(self.registers[1])); let a1 = self.store(self.deref(self.registers[1]));

25
src/tests/call_with_inference_limit.pl
View File

@@ -16,39 +16,40 @@ test_queries_on_call_with_inference_limit :-
\+ call_with_inference_limit(g(X), 5, R), \+ call_with_inference_limit(g(X), 5, R),
maplist(assertz, [g(1), g(2), g(3), g(4), g(5)]), maplist(assertz, [g(1), g(2), g(3), g(4), g(5)]),
findall([R,X], findall([R,X],
call_with_inference_limit(g(X), 10, R), call_with_inference_limit(g(X), 11, R),
[[true, 1], [[true, 1],
[true, 2], [true, 2],
[true, 3], [true, 3],
[true, 4], [true, 4],
[!, 5]]), [!, 5]]),
findall([R,X], findall([R,X],
(call_with_inference_limit(g(X), 10, R), call(true)), (call_with_inference_limit(g(X), 11, R), call(true)),
[[true, 1], [[true, 1],
[true, 2], [true, 2],
[true, 3], [true, 3],
[true, 4], [true, 4],
[!, 5]]), [!, 5]]),
findall([R,X], findall([R,X],
(call_with_inference_limit(g(X), 4, R), call(true)), (call_with_inference_limit(g(X), 5, R), call(true)),
[[true, 1], [[true, 1],
[true, 2], [true, 2],
[inference_limit_exceeded, _]]), [inference_limit_exceeded, _]]),
findall([X,R1,R2], findall([X,R1,R2],
(call_with_inference_limit(g(X), 4, R1), (call_with_inference_limit(g(X), 5, R1),
call_with_inference_limit(g(X), 5, R2)), call_with_inference_limit(g(X), 6, R2)),
[[1,true,!], [[1,true,!],
[2,true,!], [2,true,!],
[3,true,!], [3,true,!],
[4,true,!], [4,true,!],
[5,!,!]]), [5,!,!]]),
\+ \+ assertz((f(X) :- call_with_inference_limit(g(X), 8, _))), \+ \+ assertz((f(X) :- call_with_inference_limit(tests_on_call_with_inference_limit:g(X), 11, _))),
findall([R,X], findall([R,X],
call_with_inference_limit(f(X), 12, R), call_with_inference_limit(f(X), 14, R),
[[true,1], Solutions),
[true,2], Solutions == [[true,1],
[true,3], [true,2],
[true,4], [true,3],
[!,5]]). [true,4],
[!,5]].
:- initialization(test_queries_on_call_with_inference_limit). :- initialization(test_queries_on_call_with_inference_limit).