Skip to content

Commit

Permalink
fix current_predicate/1 (#1761)
Browse files Browse the repository at this point in the history
  • Loading branch information
@mthom
mthom committed Apr 25, 2023
1 parent f12a903 commit c5a3ec3
Show file tree
Hide file tree
Showing 4 changed files with 92 additions and 57 deletions.
12 changes: 8 additions & 4 deletions build/instructions_template.rs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -306,10 +306,10 @@ enum SystemClauseType {
GetBValue,
#[strum_discriminants(strum(props(Arity = "3", Name = "$get_cont_chunk")))]
GetContinuationChunk,
#[strum_discriminants(strum(props(Arity = "4", Name = "$get_next_db_ref")))]
GetNextDBRef,
#[strum_discriminants(strum(props(Arity = "7", Name = "$get_next_op_db_ref")))]
GetNextOpDBRef,
#[strum_discriminants(strum(props(Arity = "2", Name = "$lookup_db_ref")))]
LookupDBRef,
#[strum_discriminants(strum(props(Arity = "1", Name = "$is_partial_string")))]
IsPartialString,
#[strum_discriminants(strum(props(Arity = "1", Name = "$halt")))]
Expand Down Expand Up @@ -578,6 +578,8 @@ enum SystemClauseType {
DeleteAllAttributesFromVar,
#[strum_discriminants(strum(props(Arity = "1", Name = "$unattributed_var")))]
UnattributedVar,
#[strum_discriminants(strum(props(Arity = "3", Name = "$get_db_refs")))]
GetDBRefs,
REPL(REPLCodePtr),
}

Expand Down Expand Up @@ -1641,6 +1643,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallDeleteFromAttributedVarList(_) |
&Instruction::CallDeleteAllAttributesFromVar(_) |
&Instruction::CallUnattributedVar(_) |
&Instruction::CallGetDBRefs(_) |
&Instruction::CallFetchGlobalVar(_) |
&Instruction::CallFirstStream(_) |
&Instruction::CallFlushOutput(_) |
Expand All @@ -1656,8 +1659,8 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallGetAttrVarQueueBeyond(_) |
&Instruction::CallGetBValue(_) |
&Instruction::CallGetContinuationChunk(_) |
&Instruction::CallGetNextDBRef(_) |
&Instruction::CallGetNextOpDBRef(_) |
&Instruction::CallLookupDBRef(_) |
&Instruction::CallIsPartialString(_) |
&Instruction::CallHalt(_) |
&Instruction::CallGetLiftedHeapFromOffset(_) |
Expand Down Expand Up @@ -1862,6 +1865,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteDeleteFromAttributedVarList(_) |
&Instruction::ExecuteDeleteAllAttributesFromVar(_) |
&Instruction::ExecuteUnattributedVar(_) |
&Instruction::ExecuteGetDBRefs(_) |
&Instruction::ExecuteFetchGlobalVar(_) |
&Instruction::ExecuteFirstStream(_) |
&Instruction::ExecuteFlushOutput(_) |
Expand All @@ -1877,8 +1881,8 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteGetAttrVarQueueBeyond(_) |
&Instruction::ExecuteGetBValue(_) |
&Instruction::ExecuteGetContinuationChunk(_) |
&Instruction::ExecuteGetNextDBRef(_) |
&Instruction::ExecuteGetNextOpDBRef(_) |
&Instruction::ExecuteLookupDBRef(_) |
&Instruction::ExecuteIsPartialString(_) |
&Instruction::ExecuteHalt(_) |
&Instruction::ExecuteGetLiftedHeapFromOffset(_) |
Expand Down
37 changes: 15 additions & 22 deletions src/lib/builtins.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1205,7 +1205,6 @@
; throw(error(type_error(predicate_indicator, Module:Pred), abolish/1))
).


:- meta_predicate abolish(:).

%% abolish(Pred).
Expand Down Expand Up @@ -1246,41 +1245,35 @@
; throw(error(type_error(predicate_indicator, Pred), abolish/1))
).


'$iterate_db_refs'(Name, Arity, Name/Arity). % :-
% '$lookup_db_ref'(Ref, Name, Arity).
'$iterate_db_refs'(RName, RArity, Name/Arity) :-
'$get_next_db_ref'(RName, RArity, RRName, RRArity),
'$iterate_db_refs'(RRName, RRArity, Name/Arity).

%% current_predicate(Pred).
%
% Pred must satisfy: `Pred = Name/Arity`.
% True iff there's a predicate Pred that is currently loaded at the moment.
% It can be used to check for existence of a predicate or to enumerate all loaded predicates
current_predicate(Pred) :-
( var(Pred) ->
'$get_next_db_ref'(RN, RA, _, _),
'$iterate_db_refs'(RN, RA, Pred)
; Pred \= _/_ ->
throw(error(type_error(predicate_indicator, Pred), current_predicate/1))
; Pred = Name/Arity,
( nonvar(Name), \+ atom(Name)
; nonvar(Arity), \+ integer(Arity)
; integer(Arity), Arity < 0
) ->
throw(error(type_error(predicate_indicator, Pred), current_predicate/1))
; '$get_next_db_ref'(RN, RA, _, _),
'$iterate_db_refs'(RN, RA, Pred)
'$get_db_refs'(_, _, PIs),
lists:member(Pred, PIs)
; Pred = Name/Arity ->
( ( nonvar(Name), \+ atom(Name)
; nonvar(Arity), \+ integer(Arity)
; integer(Arity), Arity < 0
) ->
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)
)
; throw(error(type_error(predicate_indicator, Pred), current_predicate/1))
).


'$iterate_op_db_refs'(RPriority, RSpec, ROp, _, RPriority, RSpec, ROp).
'$iterate_op_db_refs'(RPriority, RSpec, ROp, OssifiedOpDir, Priority, Spec, Op) :-
'$get_next_op_db_ref'(RPriority, RSpec, ROp, OssifiedOpDir, RRPriority, RRSpec, RROp),
'$iterate_op_db_refs'(RRPriority, RRSpec, RROp, OssifiedOpDir, Priority, Spec, Op).


can_be_op_priority(Priority) :- var(Priority).
can_be_op_priority(Priority) :- op_priority(Priority).

Expand Down
16 changes: 12 additions & 4 deletions src/machine/dispatch.rs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3720,12 +3720,12 @@ impl Machine {
self.get_continuation_chunk();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallGetNextDBRef(_) => {
self.get_next_db_ref();
&Instruction::CallLookupDBRef(_) => {
self.lookup_db_ref();
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteGetNextDBRef(_) => {
self.get_next_db_ref();
&Instruction::ExecuteLookupDBRef(_) => {
self.lookup_db_ref();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallGetNextOpDBRef(_) => {
Expand Down Expand Up @@ -5255,6 +5255,14 @@ impl Machine {
self.machine_st.unattributed_var();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallGetDBRefs(_) => {
self.get_db_refs();
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteGetDBRefs(_) => {
self.get_db_refs();
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
}
}

Expand Down
84 changes: 57 additions & 27 deletions src/machine/system_calls.rs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3660,44 +3660,74 @@ impl Machine {
}

#[inline(always)]
pub(crate) fn get_next_db_ref(&mut self) {
let a1 = self.deref_register(1);
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;

if self.indices.code_dir.get(&(name, arity)).is_none() {
self.machine_st.fail = true;
}
}

#[inline(always)]
pub(crate) fn get_db_refs(&mut self) {
let name_match: fn(Atom, Atom) -> bool;
let arity_match: fn(usize, usize) -> bool;

let atom = self.deref_register(1);

if let Some(name_var) = a1.as_var() {
let mut iter = self.indices.code_dir.iter();
let pred_atom = if atom.is_var() {
name_match = |_, _| true;
atom!("")
} else {
name_match = |atom_1, atom_2| atom_1 == atom_2;
cell_as_atom!(atom)
};

while let Some(((name, arity), _)) = iter.next() {
let arity_var = self.machine_st.deref(self.machine_st.registers[2])
.as_var().unwrap();
let arity = self.deref_register(2);

let pred_arity = if arity.is_var() {
arity_match = |_, _| true;
0
} else {
arity_match = |arity_1, arity_2| arity_1 == arity_2;

self.machine_st.bind(name_var, atom_as_cell!(name));
self.machine_st.bind(arity_var, fixnum_as_cell!(Fixnum::build_with(*arity as i64)));
let arity = match Number::try_from(arity) {
Ok(Number::Fixnum(n)) => Some(n.get_num() as usize),
Ok(Number::Integer(n)) => n.to_usize(),
_ => None,
};

if let Some(arity) = arity {
arity
} else {
self.machine_st.fail = true;
return;
}
};

self.machine_st.fail = true;
} else if a1.get_tag() == HeapCellValueTag::Atom {
let name = cell_as_atom!(a1);
let arity = cell_as_fixnum!(self.deref_register(2)).get_num() as usize;

match self.machine_st.get_next_db_ref(&self.indices, &DBRef::NamedPred(name, arity)) {
Some(DBRef::NamedPred(name, arity)) => {
let atom_var = self.machine_st.deref(self.machine_st.registers[3])
.as_var().unwrap();
let h = self.machine_st.heap.len();
let mut num_functors = 0;

let arity_var = self.machine_st.deref(self.machine_st.registers[4])
.as_var().unwrap();
for (name, arity) in self.indices.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)]),
);

self.machine_st.bind(atom_var, atom_as_cell!(name));
self.machine_st.bind(arity_var, fixnum_as_cell!(Fixnum::build_with(arity as i64)));
}
Some(DBRef::Op(..)) | None => {
self.machine_st.fail = true;
}
num_functors += 1;
}
}

if num_functors > 0 {
let h = iter_to_heap_list(
&mut self.machine_st.heap,
(0 .. num_functors).map(|i| str_loc_as_cell!(h + 3 * i)),
);

unify!(self.machine_st, heap_loc_as_cell!(h), self.machine_st.registers[3]);
} else {
self.machine_st.fail = true;
unify!(self.machine_st, empty_list_as_cell!(), self.machine_st.registers[3]);
}
}

Expand Down

0 comments on commit c5a3ec3

Please sign in to comment.