From b593fffc7d05f0c7ca2e150a7a750eb9719bf3b3 Mon Sep 17 00:00:00 2001 From: Mark Date: Tue, 27 Jun 2023 11:08:29 -0600 Subject: [PATCH] support module resolution in current_predicate/1 (#1817) --- build/instructions_template.rs | 4 +-- src/lib/builtins.pl | 14 ++++++--- src/machine/machine_indices.rs | 1 - src/machine/system_calls.rs | 53 +++++++++++++++++++++++++++++----- 4 files changed, 57 insertions(+), 15 deletions(-) diff --git a/build/instructions_template.rs b/build/instructions_template.rs index 8e61ad23..7f559b8e 100644 --- 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 1c183a0c..ab821f4b 100644 --- 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 ca31e4bd..df880447 100644 --- a/src/machine/machine_indices.rs +++ b/src/machine/machine_indices.rs @@ -227,7 +227,6 @@ impl CodeIndex { } pub(crate) type HeapVarDict = IndexMap; -// pub(crate) type AllocVarDict = IndexMap; pub(crate) type GlobalVarDir = IndexMap), FxBuildHasher>; diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index df89c520..48741974 100644 --- 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)]), -- 2.54.0