&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"),
% 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))
).
'$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),
),
'$unwind_stack'.
+
:- non_counted_backtracking '$iterate_find_all'/4.
+
'$iterate_find_all'(Template, Goal, _, LhOffset) :-
call(Goal),
'$copy_to_lh'(LhOffset, Template),
:- 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),
( builtins:truncate_lh_to(LhLength), builtins:throw(Error) ))
).
-
:- non_counted_backtracking '$iterate_find_all_diff'/5.
'$iterate_find_all_diff'(Template, Goal, _, _, LhOffset) :-
:- 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,
:- 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) :-
:- 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)
).
:- 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) :-
).
-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,
; '$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),
'$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))),
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)
)
}
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(
&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));
}
&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]));
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]));
\+ 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).