]> Repositorios git - scryer-prolog.git/commitdiff
defer installation of inference counter for call_with_inference_limit til after goals...
authorMark Thom <[email protected]>
Tue, 7 Dec 2021 01:08:38 +0000 (18:08 -0700)
committerMark Thom <[email protected]>
Fri, 7 Jan 2022 04:44:41 +0000 (21:44 -0700)
src/clause_types.rs
src/lib/builtins.pl
src/lib/iso_ext.pl
src/loader.pl
src/machine/system_calls.rs
src/tests/call_with_inference_limit.pl

index 2e298dff050cdaf52cb0797d7b8480c78709f3a9..e11e84b16aeac74f5b5c175bf9f01f5702faf8f3 100644 (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"),
index 86d5841f5185821ed88aff17ad214808e9dfe54e..e27a1f43e3bf9710f2392dfbac1afbb4a4df2663 100644 (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)
     ).
 
 
index f48af1d29f53a3f8145a746e584b4bc4ffe83d65..2127ca8ac51978c585586fd02498c47b6564e41b 100644 (file)
 
 :- 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))),
index 720e534af1c837daf14339ee4ba07c532c746e37..d1e86b1a677e9a32c5d77b0261f8b33027105422 100644 (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)
        )
index dd1f7eab90a7b73dea731b9398c9422828d136ba..81bdccfed1cb3e0236fc19740e90ba8c3df40d23 100644 (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]));
index a1cf2a4ef19efb468fbbd966a099ba3421225a69..18fda2ddc58ba6b6fe868b65aa95b0923789d571 100644 (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).