rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix current_predicate/1 (#1761)

Browse Source
This commit is contained in:
Mark
2023-04-24 23:23:19 -06:00
parent f12a90351a
commit c5a3ec3ba8
4 changed files with 92 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
build/instructions_template.rs
View File

@@ -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")))]
@@ -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),
}
@@ -1641,6 +1643,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallDeleteFromAttributedVarList(_) |
&Instruction::CallDeleteAllAttributesFromVar(_) |
&Instruction::CallUnattributedVar(_) |
&Instruction::CallGetDBRefs(_) |
&Instruction::CallFetchGlobalVar(_) |
&Instruction::CallFirstStream(_) |
&Instruction::CallFlushOutput(_) |
@@ -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(_) |
@@ -1862,6 +1865,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteDeleteFromAttributedVarList(_) |
&Instruction::ExecuteDeleteAllAttributesFromVar(_) |
&Instruction::ExecuteUnattributedVar(_) |
&Instruction::ExecuteGetDBRefs(_) |
&Instruction::ExecuteFetchGlobalVar(_) |
&Instruction::ExecuteFirstStream(_) |
&Instruction::ExecuteFlushOutput(_) |
@@ -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(_) |

37
src/lib/builtins.pl
View File

@@ -1205,7 +1205,6 @@ module_abolish(Pred, Module) :-
; throw(error(type_error(predicate_indicator, Module:Pred), abolish/1))
).
:- meta_predicate abolish(:).
%% abolish(Pred).
@@ -1246,13 +1245,6 @@ abolish(Pred) :-
; 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`.
@@ -1260,27 +1252,28 @@ abolish(Pred) :-
% 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).

16
src/machine/dispatch.rs
View File

@@ -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(_) => {
@@ -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);
}
}
}

84
src/machine/system_calls.rs
View File

@@ -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 let Some(name_var) = a1.as_var() {
let mut iter = self.indices.code_dir.iter();
if self.indices.code_dir.get(&(name, arity)).is_none() {
self.machine_st.fail = true;
}
}
while let Some(((name, arity), _)) = iter.next() {
let arity_var = self.machine_st.deref(self.machine_st.registers[2])
.as_var().unwrap();
#[inline(always)]
pub(crate) fn get_db_refs(&mut self) {
let name_match: fn(Atom, Atom) -> bool;
let arity_match: fn(usize, usize) -> bool;
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 atom = self.deref_register(1);
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)
};
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;
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;
let h = self.machine_st.heap.len();
let mut num_functors = 0;
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();
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)]),
);
let arity_var = self.machine_st.deref(self.machine_st.registers[4])
.as_var().unwrap();
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]);
}
}