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::CpuNow => atom!("$cpu_now"),
&SystemClauseType::CurrentTime => atom!("$current_time"),
// &SystemClauseType::ModuleHeadIsDynamic => atom!("$module_head_is_dynamic"),
&SystemClauseType::ModuleExists => atom!("$module_exists"),
&SystemClauseType::NextStream => atom!("$next_stream"),
&SystemClauseType::NoSuchPredicate => atom!("$no_such_predicate"),

28
src/lib/builtins.pl
View File

@@ -69,7 +69,8 @@ Module : Predicate :-
% dynamic module resolution.
:(Module, Predicate, A1) :-
( atom(Module) -> '$module_call'(A1, Module, Predicate)
( atom(Module) ->
'$module_call'(A1, Module, Predicate)
; 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'(G7),
'$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]) :-
!,
'$call'(G1),
@@ -585,7 +586,9 @@ throw(Ball) :-
),
'$unwind_stack'.
:- non_counted_backtracking '$iterate_find_all'/4.
'$iterate_find_all'(Template, Goal, _, LhOffset) :-
call(Goal),
'$copy_to_lh'(LhOffset, Template),
@@ -601,7 +604,7 @@ truncate_lh_to(LhLength) :- '$truncate_lh_to'(LhLength).
:- meta_predicate findall(?, 0, ?).
findall(Template, Goal, Solutions) :-
error:can_be(list, Solutions),
'$call_with_default_policy'(error:can_be(list, Solutions)),
'$lh_length'(LhLength),
'$call_with_default_policy'(
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) ))
).
:- non_counted_backtracking '$iterate_find_all_diff'/5.
'$iterate_find_all_diff'(Template, Goal, _, _, LhOffset) :-
@@ -624,8 +626,8 @@ findall(Template, Goal, Solutions) :-
:- meta_predicate findall(?, 0, ?, ?).
findall(Template, Goal, Solutions0, Solutions1) :-
error:can_be(list, Solutions0),
error:can_be(list, Solutions1),
'$call_with_default_policy'(error:can_be(list, Solutions0)),
'$call_with_default_policy'(error:can_be(list, Solutions1)),
'$lh_length'(LhLength),
'$call_with_default_policy'(
catch(builtins:'$iterate_find_all_diff'(Template, Goal, Solutions0,
@@ -819,13 +821,14 @@ asserta_clause(Head, Body) :-
:- meta_predicate asserta(0).
asserta(Clause) :-
asserta(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
( Clause \= (_ :- _) ->
Head = Clause,
Body = true,
asserta_clause(Head, Body)
module_asserta_clause(Head, Body, Module)
; Clause = (Head :- Body) ->
asserta_clause(Head, Body)
module_asserta_clause(Head, Body, Module)
).
module_assertz_clause(Head, Body, Module) :-
@@ -874,13 +877,14 @@ assertz_clause(Head, Body) :-
:- meta_predicate assertz(0).
assertz(Clause) :-
assertz(Clause0) :-
loader:strip_module(Clause0, Module, Clause),
( Clause \= (_ :- _) ->
Head = Clause,
Body = true,
assertz_clause(Head, Body)
module_assertz_clause(Head, Body, Module)
; 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]).
:- meta_predicate(call_cleanup(0, 0)).
:- meta_predicate(setup_call_cleanup(0, 0, 0)).
:- meta_predicate(forall(0, 0)).
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).
% setup_call_cleanup.
:- meta_predicate(setup_call_cleanup(0, 0, 0)).
setup_call_cleanup(S, G, C) :-
'$get_b_value'(B),
call(S),
'$call'(S),
'$set_cp_by_default'(B),
'$get_current_block'(Bb),
( C = _:CC,
@@ -72,6 +71,8 @@ setup_call_cleanup(S, G, C) :-
; '$call_with_default_policy'(scc_helper(C, G, Bb))
).
:- meta_predicate(scc_helper(?,0,?)).
:- non_counted_backtracking scc_helper/3.
scc_helper(C, G, Bb) :-
'$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)),
'$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.
call_with_inference_limit(G, L, R, Bb, B) :-
'$install_new_block'(NBb),
'$install_inference_counter'(B, L, Count0),
call(G),
'$call'(G),
'$inference_level'(R, B),
'$remove_inference_counter'(B, Count1),
'$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)
; 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),
Terms = (Head1 :- Body1)
)

72
src/machine/system_calls.rs
View File

@@ -407,29 +407,29 @@ impl MachineState {
}
fn term_variables_under_max_depth(
&mut self,
term: HeapCellValue,
max_depth: usize,
list_of_vars: HeapCellValue,
&mut self,
term: HeapCellValue,
max_depth: usize,
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() {
if iter.parent_stack_len() >= max_depth {
iter.pop_stack();
continue;
}
if iter.parent_stack_len() >= max_depth {
iter.pop_stack();
continue;
}
let value = unmark_cell_bits!(value);
let value = unmark_cell_bits!(value);
if value.is_var() && !seen_set.contains(&value) {
seen_set.insert(value);
}
if value.is_var() && !seen_set.contains(&value) {
seen_set.insert(value);
}
}
}
}
let outcome = heap_loc_as_cell!(
iter_to_heap_list(
@@ -2499,17 +2499,17 @@ impl MachineState {
&SystemClauseType::HeadIsDynamic => {
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) => {
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)) => {
(name, 0)
}
(name, 0)
}
_ => {
unreachable!()
}
);
unreachable!()
}
);
self.fail = !indices.is_dynamic_predicate(module_name, (name, arity));
}
@@ -2698,13 +2698,13 @@ impl MachineState {
&SystemClauseType::EnqueueAttributedVar => {
let addr = self.store(self.deref(self.registers[1]));
read_heap_cell!(addr,
(HeapCellValueTag::AttrVar, h) => {
self.attr_var_init.attr_var_queue.push(h);
}
_ => {
}
);
read_heap_cell!(addr,
(HeapCellValueTag::AttrVar, h) => {
self.attr_var_init.attr_var_queue.push(h);
}
_ => {
}
);
}
&SystemClauseType::GetNextDBRef => {
let a1 = self.store(self.deref(self.registers[1]));
@@ -4384,12 +4384,12 @@ impl MachineState {
unify_fn!(self, a2, outcome);
}
&SystemClauseType::TermVariablesUnderMaxDepth => {
// Term, MaxDepth, VarList
let max_depth = cell_as_fixnum!(
self.store(self.deref(self.registers[2]))
).get_num() as usize;
// Term, MaxDepth, VarList
let max_depth = cell_as_fixnum!(
self.store(self.deref(self.registers[2]))
).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 => {
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),
maplist(assertz, [g(1), g(2), g(3), g(4), g(5)]),
findall([R,X],
call_with_inference_limit(g(X), 10, R),
call_with_inference_limit(g(X), 11, R),
[[true, 1],
[true, 2],
[true, 3],
[true, 4],
[!, 5]]),
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, 2],
[true, 3],
[true, 4],
[!, 5]]),
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, 2],
[inference_limit_exceeded, _]]),
findall([X,R1,R2],
(call_with_inference_limit(g(X), 4, R1),
call_with_inference_limit(g(X), 5, R2)),
(call_with_inference_limit(g(X), 5, R1),
call_with_inference_limit(g(X), 6, R2)),
[[1,true,!],
[2,true,!],
[3,true,!],
[4,true,!],
[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],
call_with_inference_limit(f(X), 12, R),
[[true,1],
[true,2],
[true,3],
[true,4],
[!,5]]).
call_with_inference_limit(f(X), 14, R),
Solutions),
Solutions == [[true,1],
[true,2],
[true,3],
[true,4],
[!,5]].
:- initialization(test_queries_on_call_with_inference_limit).