From: Mark Thom Date: Tue, 7 Dec 2021 01:08:38 +0000 (-0700) Subject: defer installation of inference counter for call_with_inference_limit til after goals... X-Git-Tag: v0.9.0^2~106 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=8ba61a1da14540f07c125d4155bf8fbd7cbd761c;p=scryer-prolog.git defer installation of inference counter for call_with_inference_limit til after goals expanded --- diff --git a/src/clause_types.rs b/src/clause_types.rs index 2e298dff..e11e84b1 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -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"), diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index 86d5841f..e27a1f43 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -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) ). diff --git a/src/lib/iso_ext.pl b/src/lib/iso_ext.pl index f48af1d2..2127ca8a 100644 --- a/src/lib/iso_ext.pl +++ b/src/lib/iso_ext.pl @@ -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) :- ). -call_cleanup(G, C) :- setup_call_cleanup(true, G, C). +% setup_call_cleanup. +:- meta_predicate(call_cleanup(0, 0)). -% setup_call_cleanup. +call_cleanup(G, C) :- setup_call_cleanup(true, G, C). + +:- 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))), diff --git a/src/loader.pl b/src/loader.pl index 720e534a..d1e86b1a 100644 --- a/src/loader.pl +++ b/src/loader.pl @@ -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) ) diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index dd1f7eab..81bdccfe 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -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])); diff --git a/src/tests/call_with_inference_limit.pl b/src/tests/call_with_inference_limit.pl index a1cf2a4e..18fda2dd 100644 --- a/src/tests/call_with_inference_limit.pl +++ b/src/tests/call_with_inference_limit.pl @@ -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).