support module resolution in current_predicate/1 (#1817)

diff --git a/build/instructions_template.rs b/build/instructions_template.rs
index 8e61ad239a54b32eb51f95b2a5a64b001c38c1b6..7f559b8e287043d140aa3ad279d8e7a8acda7236 100644 (file)
--- a/build/instructions_template.rs
+++ b/build/instructions_template.rs
@@ -308,7 +308,7 @@ enum SystemClauseType {
     GetContinuationChunk,
     #[strum_discriminants(strum(props(Arity = "7", Name = "$get_next_op_db_ref")))]
     GetNextOpDBRef,
-    #[strum_discriminants(strum(props(Arity = "2", Name = "$lookup_db_ref")))]
+    #[strum_discriminants(strum(props(Arity = "3", Name = "$lookup_db_ref")))]
     LookupDBRef,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$is_partial_string")))]
     IsPartialString,
@@ -578,7 +578,7 @@ enum SystemClauseType {
     DeleteAllAttributesFromVar,
     #[strum_discriminants(strum(props(Arity = "1", Name = "$unattributed_var")))]
     UnattributedVar,
-    #[strum_discriminants(strum(props(Arity = "3", Name = "$get_db_refs")))]
+    #[strum_discriminants(strum(props(Arity = "4", Name = "$get_db_refs")))]
     GetDBRefs,
     REPL(REPLCodePtr),
 }

diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl
index 1c183a0c88aa88bdf43223bb2b927d24e56250ee..ab821f4ba7cc7736f52f3ba600c439fe3b8bc32e 100644 (file)
--- a/src/lib/builtins.pl
+++ b/src/lib/builtins.pl
@@ -1254,7 +1254,13 @@ current_predicate(Pred) :-
     (  var(Pred) ->
        '$get_db_refs'(_, _, PIs),
        lists:member(Pred, PIs)
-    ;  Pred = Name/Arity ->
+    ;  '$strip_module'(Pred, Module, UnqualifiedPred),
+       (  var(Module),
+          \+ functor(Pred, (:), 2)
+       ;  atom(Module)
+       ),
+       nonvar(UnqualifiedPred),
+       UnqualifiedPred = Name/Arity ->
        (  (  nonvar(Name), \+ atom(Name)
           ;  nonvar(Arity), \+ integer(Arity)
           ;  integer(Arity), Arity < 0
@@ -1262,9 +1268,9 @@ current_predicate(Pred) :-
           throw(error(type_error(predicate_indicator, Pred), current_predicate/1))
        ;  nonvar(Name),
           nonvar(Arity) ->
-          '$lookup_db_ref'(Name, Arity)
-       ;  '$get_db_refs'(Name, Arity, PIs),
-          lists:member(Pred, PIs)
+          '$lookup_db_ref'(Module, Name, Arity)
+       ;  '$get_db_refs'(Module, Name, Arity, PIs),
+          lists:member(UnqualifiedPred, PIs)
        )
     ;  throw(error(type_error(predicate_indicator, Pred), current_predicate/1))
     ).

diff --git a/src/machine/machine_indices.rs b/src/machine/machine_indices.rs
index ca31e4bd0ef89c4061ba43bd0fce57077338d570..df880447f5d438ea08a7c241f6c7e6b098a07857 100644 (file)
--- a/src/machine/machine_indices.rs
+++ b/src/machine/machine_indices.rs
@@ -227,7 +227,6 @@ impl CodeIndex {
 }
 
 pub(crate) type HeapVarDict = IndexMap<VarPtr, HeapCellValue, FxBuildHasher>;
-// pub(crate) type AllocVarDict = IndexMap<Var, VarAlloc, FxBuildHasher>;
 
 pub(crate) type GlobalVarDir = IndexMap<Atom, (Ball, Option<HeapCellValue>), FxBuildHasher>;
 

diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs
index df89c520605c9c35a07fb6fd74afa6fe4c1a4ee1..48741974ce43ad3587590854ae463f41861465ec 100644 (file)
--- a/src/machine/system_calls.rs
+++ b/src/machine/system_calls.rs
@@ -3744,12 +3744,25 @@ impl Machine {
 
     #[inline(always)]
     pub(crate) fn lookup_db_ref(&mut self) {
-        let name = cell_as_atom!(self.deref_register(1));
-        let arity = cell_as_fixnum!(self.deref_register(2)).get_num() as usize;
+        let module_name = self.deref_register(1);
+        let name = cell_as_atom!(self.deref_register(2));
+        let arity = cell_as_fixnum!(self.deref_register(3)).get_num() as usize;
 
-        if self.indices.code_dir.get(&(name, arity)).is_none() {
-            self.machine_st.fail = true;
-        }
+        let module_name = read_heap_cell!(module_name,
+            (HeapCellValueTag::Atom, (module_name, _arity)) => {
+                module_name
+            }
+            (HeapCellValueTag::AttrVar | HeapCellValueTag::Var) => {
+                atom!("user")
+            }
+            _ => {
+                unreachable!()
+            }
+        );
+
+        self.machine_st.fail = self.indices
+            .get_predicate_code_index(name, arity, module_name)
+            .is_none();
     }
 
     #[inline(always)]
@@ -3757,7 +3770,19 @@ impl Machine {
         let name_match: fn(Atom, Atom) -> bool;
         let arity_match: fn(usize, usize) -> bool;
 
-        let atom = self.deref_register(1);
+        let module_name = read_heap_cell!(self.deref_register(1),
+            (HeapCellValueTag::Atom, (module_name, _arity)) => {
+                module_name
+            }
+            (HeapCellValueTag::AttrVar | HeapCellValueTag::Var) => {
+                atom!("user")
+            }
+            _ => {
+                unreachable!()
+            }
+        );
+
+        let atom = self.deref_register(2);
 
         let pred_atom = if atom.is_var() {
             name_match = |_, _| true;
@@ -3767,7 +3792,7 @@ impl Machine {
             cell_as_atom!(atom)
         };
 
-        let arity = self.deref_register(2);
+        let arity = self.deref_register(3);
 
         let pred_arity = if arity.is_var() {
             arity_match = |_, _| true;
@@ -3792,7 +3817,19 @@ impl Machine {
         let h = self.machine_st.heap.len();
         let mut num_functors = 0;
 
-        for (name, arity) in self.indices.code_dir.keys() {
+        let code_dir = if module_name == atom!("user") {
+            &self.indices.code_dir
+        } else {
+            match self.indices.modules.get(&module_name).map(|module| &module.code_dir) {
+                Some(code_dir) => code_dir,
+                None => {
+                    self.machine_st.fail = true;
+                    return;
+                }
+            }
+        };
+
+        for (name, arity) in code_dir.keys() {
             if name_match(pred_atom, *name) && arity_match(pred_arity, *arity) {
                 self.machine_st.heap.extend(
                     functor!(atom!("/"), [cell(atom_as_cell!(name)), fixnum(*arity)]),