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

improve retract/1 and related predicates (#1598)

Browse Source
This commit is contained in:
Mark Thom
2023-01-22 20:14:36 -07:00
parent 5e0e3e2754
commit a7e93db363
11 changed files with 315 additions and 107 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
build/instructions_template.rs
View File

@@ -562,6 +562,10 @@ enum SystemClauseType {
InlineCallN(usize),
#[strum_discriminants(strum(props(Arity = "1", Name = "$is_expanded_or_inlined")))]
IsExpandedOrInlined,
#[strum_discriminants(strum(props(Arity = "3", Name = "$get_clause_p")))]
GetClauseP,
#[strum_discriminants(strum(props(Arity = "6", Name = "$invoke_clause_at_p")))]
InvokeClauseAtP,
REPL(REPLCodePtr),
}
@@ -1620,6 +1624,8 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::CallPrepareCallClause(..) |
&Instruction::CallCompileInlineOrExpandedGoal(..) |
&Instruction::CallIsExpandedOrInlined(_) |
&Instruction::CallGetClauseP(_) |
&Instruction::CallInvokeClauseAtP(_) |
&Instruction::CallEnqueueAttributedVar(_) |
&Instruction::CallFetchGlobalVar(_) |
&Instruction::CallFirstStream(_) |
@@ -1822,7 +1828,7 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecuteMakeDirectoryPath(_) |
&Instruction::ExecuteDeleteFile(_) |
&Instruction::ExecuteRenameFile(_) |
&Instruction::ExecuteFileCopy(_) |
&Instruction::ExecuteFileCopy(_) |
&Instruction::ExecuteWorkingDirectory(_) |
&Instruction::ExecuteDeleteDirectory(_) |
&Instruction::ExecutePathCanonical(_) |
@@ -1833,6 +1839,8 @@ fn generate_instruction_preface() -> TokenStream {
&Instruction::ExecutePrepareCallClause(..) |
&Instruction::ExecuteCompileInlineOrExpandedGoal(..) |
&Instruction::ExecuteIsExpandedOrInlined(_) |
&Instruction::ExecuteGetClauseP(_) |
&Instruction::ExecuteInvokeClauseAtP(_) |
&Instruction::ExecuteEnqueueAttributedVar(_) |
&Instruction::ExecuteFetchGlobalVar(_) |
&Instruction::ExecuteFirstStream(_) |

4
src/codegen.rs
View File

@@ -1189,7 +1189,7 @@ impl<'b> CodeGenerator<'b> {
if let Some(arg) = arg {
let index = code.len();
if clauses.len() > 1 || self.settings.is_dynamic() {
if clauses.len() > 1 || self.settings.is_extensible {
code_offsets.index_term(arg, index, &mut clause_index_info, self.atom_tbl);
}
}
@@ -1211,7 +1211,7 @@ impl<'b> CodeGenerator<'b> {
code.extend(clause_code.into_iter());
}
let index_code = if clauses.len() > 1 || self.settings.is_dynamic() {
let index_code = if clauses.len() > 1 || self.settings.is_extensible {
code_offsets.compute_indices(skip_stub_try_me_else)
} else {
vec![]

89
src/lib/builtins.pl
View File

@@ -854,70 +854,30 @@ retract(Clause0) :-
retract_module_clause(Head, Body, Module)
).
module_retract_clauses([Clause|Clauses0], Head, Body, Name, Arity, Module) :-
functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), Module:'$clause'(VarHead, VarBody), Clauses1),
( first_match_index(Clauses1, (Head :- Body), 0, N) ->
retract_clauses([L-P | Ps], Head, Body, Name, Arity, Module) :-
'$invoke_clause_at_p'(Head, Body, L, P, N, Module),
( integer(N) ->
'$retract_clause'(Name, Arity, N, Module)
; Clause = (Head :- Body)
; true % the clause at index N has already been retracted in this
% case but unify (Head :- Body) anyway.
),
( Clauses0 == [] -> !
( Ps == [] -> !
; true
).
retract_clauses([_ | Ps], Head, Body, Name, Arity, Module) :-
retract_clauses(Ps, Head, Body, Name, Arity, Module).
module_retract_clauses([_|Clauses0], Head, Body, Name, Arity, Module) :-
module_retract_clauses(Clauses0, Head, Body, Name, Arity, Module).
call_module_retract(Head, Body, Name, Arity, Module) :-
findall((Head :- Body), Module:'$clause'(Head, Body), Clauses),
module_retract_clauses(Clauses, Head, Body, Name, Arity, Module).
retract_module_clause(Head, Body, Module) :-
( var(Head) ->
throw(error(instantiation_error, retract/1))
; callable(Head),
functor(Head, Name, Arity) ->
( '$no_such_predicate'(Module, Head) ->
'$fail'
; '$head_is_dynamic'(Module, Head) ->
( Module == user ->
call_retract(Head, Body, Name, Arity)
; call_module_retract(Head, Body, Name, Arity, Module)
)
; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1))
)
; throw(error(type_error(callable, Head), retract/1))
).
first_match_index([Clause | _], Clause, N, N) :-
!.
first_match_index([_ | Clauses], Clause, N0, N) :-
N1 is N0 + 1,
first_match_index(Clauses, Clause, N1, N).
retract_clauses([Clause | Clauses0], Head, Body, Name, Arity) :-
functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), builtins:'$clause'(VarHead, VarBody), Clauses1),
( first_match_index(Clauses1, (Head :- Body), 0, N) ->
'$retract_clause'(Name, Arity, N, user)
; Clause = (Head :- Body)
call_retract_helper(Head, Body, P, Module) :-
( Module == user ->
ClauseQualifier = builtins
; ClauseQualifier = Module
),
( Clauses0 == [] -> !
; true
).
retract_clauses([_ | Clauses0], Head, Body, Name, Arity) :-
retract_clauses(Clauses0, Head, Body, Name, Arity).
call_retract(Head, Body, Name, Arity) :-
findall((Head :- Body), builtins:'$clause'(Head, Body), Clauses),
retract_clauses(Clauses, Head, Body, Name, Arity).
ClauseQualifier:'$clause'(Head, Body),
'$get_clause_p'(Head, P, Module).
call_retract(Head, Body, Name, Arity, Module) :-
findall(P, builtins:call_retract_helper(Head, Body, P, Module), Ps),
retract_clauses(Ps, Head, Body, Name, Arity, Module).
retract_clause(Head, Body) :-
( var(Head) ->
@@ -932,12 +892,25 @@ retract_clause(Head, Body) :-
; '$no_such_predicate'(user, Head) ->
'$fail'
; '$head_is_dynamic'(user, Head) ->
call_retract(Head, Body, Name, Arity)
call_retract(Head, Body, Name, Arity, user)
; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1))
)
; throw(error(type_error(callable, Head), retract/1))
).
retract_module_clause(Head, Body, Module) :-
( var(Head) ->
throw(error(instantiation_error, retract/1))
; callable(Head),
functor(Head, Name, Arity) ->
( '$no_such_predicate'(Module, Head) ->
'$fail'
; '$head_is_dynamic'(Module, Head) ->
call_retract(Head, Body, Name, Arity, Module)
; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1))
)
; throw(error(type_error(callable, Head), retract/1))
).
:- meta_predicate retractall(:).

8
src/machine/compile.rs
View File

@@ -1869,7 +1869,13 @@ impl<'a, LS: LoadState<'a>> Loader<'a, LS> {
skeleton.clauses[target_pos + 1].clause_start =
skeleton.clauses[target_pos].clause_start;
let index_ptr_opt = if target_pos == 0 {
let update_code_index = target_pos == 0 &&
skeleton.clauses[target_pos + 1]
.opt_arg_index_key
.switch_on_term_loc()
.is_none();
let index_ptr_opt = if update_code_index {
Some(IndexPtr::index(clause_loc))
} else {
None

125
src/machine/dispatch.rs
View File

@@ -1010,7 +1010,6 @@ impl Machine {
.stack
.index_or_frame(self.machine_st.b)
.prelude
.univ_prelude
.num_cells;
self.machine_st.cc = cell_as_fixnum!(
@@ -1081,7 +1080,6 @@ impl Machine {
.stack
.index_or_frame(self.machine_st.b)
.prelude
.univ_prelude
.num_cells;
self.machine_st.cc = cell_as_fixnum!(
@@ -3143,7 +3141,6 @@ impl Machine {
.stack
.index_or_frame(b)
.prelude
.univ_prelude
.num_cells;
self.machine_st.cc = cell_as_fixnum!(
@@ -5088,6 +5085,128 @@ impl Machine {
);
}
}
&Instruction::CallGetClauseP(_) => {
let module_name = cell_as_atom!(self.deref_register(3));
let (n, p) = self.get_clause_p(module_name);
let r = self.machine_st.registers[2];
let r = self.machine_st.store(self.machine_st.deref(r));
let h = self.machine_st.heap.len();
self.machine_st.heap.extend(functor!(atom!("-"), [fixnum(n), fixnum(p)]));
let r = r.as_var().unwrap();
self.machine_st.bind(r, str_loc_as_cell!(h));
step_or_fail!(self, self.machine_st.p += 1);
}
&Instruction::ExecuteGetClauseP(_) => {
let module_name = cell_as_atom!(self.deref_register(3));
let (n, p) = self.get_clause_p(module_name);
let r = self.machine_st.registers[2];
let r = self.machine_st.store(self.machine_st.deref(r));
let h = self.machine_st.heap.len();
self.machine_st.heap.extend(functor!(atom!("-"), [fixnum(n), fixnum(p)]));
let r = r.as_var().unwrap();
self.machine_st.bind(r, str_loc_as_cell!(h));
step_or_fail!(self, self.machine_st.p = self.machine_st.cp);
}
&Instruction::CallInvokeClauseAtP(_) => {
let key_cell = self.machine_st.registers[1];
let key = self.machine_st.name_and_arity_from_heap(key_cell).unwrap();
let l = self.machine_st.registers[3];
let l = self.machine_st.store(self.machine_st.deref(l));
let l = match Number::try_from(l) {
Ok(Number::Fixnum(l)) => l.get_num() as usize,
_ => unreachable!(),
};
let p = self.machine_st.registers[4];
let p = self.machine_st.store(self.machine_st.deref(p));
let p = match Number::try_from(p) {
Ok(Number::Fixnum(p)) => p.get_num() as usize,
_ => unreachable!(),
};
let module_name = cell_as_atom!(self.deref_register(6));
let compilation_target = match module_name {
atom!("user") => CompilationTarget::User,
_ => CompilationTarget::Module(module_name),
};
let skeleton = self.indices.get_predicate_skeleton_mut(
&compilation_target,
&key,
).unwrap();
match skeleton.target_pos_of_clause_clause_loc(l) {
Some(n) => {
let r = self.machine_st.store(self.machine_st.deref(
self.machine_st.registers[5],
));
self.machine_st.unify_fixnum(Fixnum::build_with(n as i64), r);
}
None => {}
}
self.machine_st.call_at_index(2, p);
}
&Instruction::ExecuteInvokeClauseAtP(_) => {
let key_cell = self.machine_st.registers[1];
let key = self.machine_st.name_and_arity_from_heap(key_cell).unwrap();
let l = self.machine_st.registers[3];
let l = self.machine_st.store(self.machine_st.deref(l));
let l = match Number::try_from(l) {
Ok(Number::Fixnum(l)) => l.get_num() as usize,
_ => unreachable!(),
};
let p = self.machine_st.registers[4];
let p = self.machine_st.store(self.machine_st.deref(p));
let p = match Number::try_from(p) {
Ok(Number::Fixnum(p)) => p.get_num() as usize,
_ => unreachable!(),
};
let module_name = cell_as_atom!(self.deref_register(6));
let compilation_target = match module_name {
atom!("user") => CompilationTarget::User,
_ => CompilationTarget::Module(module_name),
};
let skeleton = self.indices.get_predicate_skeleton_mut(
&compilation_target,
&key,
).unwrap();
match skeleton.target_pos_of_clause_clause_loc(l) {
Some(n) => {
let r = self.machine_st.store(self.machine_st.deref(
self.machine_st.registers[5],
));
self.machine_st.unify_fixnum(Fixnum::build_with(n as i64), r);
}
None => {}
}
self.machine_st.execute_at_index(2, p);
}
}
}

13
src/machine/machine_indices.rs
View File

@@ -371,22 +371,11 @@ impl IndexStore {
module: Atom,
) -> Option<CodeIndex> {
if module == atom!("user") {
/*match ClauseType::from(name, arity) {
ClauseType::Named(arity, name, _) => */
self.code_dir.get(&(name, arity)).cloned()
/* _ => None,
}*/
} else {
self.modules
.get(&module)
.and_then(|module|/* |module| match ClauseType::from(name, arity) {
ClauseType::Named(arity, name, _) => { */
module.code_dir.get(&(name, arity)).cloned()
/*
}
_ => None,
} */
)
.and_then(|module| module.code_dir.get(&(name, arity)).cloned())
}
}

4
src/machine/machine_state.rs
View File

@@ -839,7 +839,7 @@ impl MachineState {
let b = self.stack.allocate_or_frame(n);
let or_frame = self.stack.index_or_frame_mut(b);
or_frame.prelude.univ_prelude.num_cells = n;
or_frame.prelude.num_cells = n;
or_frame.prelude.e = self.e;
or_frame.prelude.cp = self.cp;
or_frame.prelude.b = self.b;
@@ -867,7 +867,7 @@ impl MachineState {
let b = self.stack.allocate_or_frame(n);
let or_frame = self.stack.index_or_frame_mut(b);
or_frame.prelude.univ_prelude.num_cells = n;
or_frame.prelude.num_cells = n;
or_frame.prelude.e = self.e;
or_frame.prelude.cp = self.cp;
or_frame.prelude.b = self.b;

2
src/machine/machine_state_impl.rs
View File

@@ -2786,7 +2786,7 @@ impl MachineState {
if self.e > self.b {
let frame = self.stack.index_and_frame(self.e);
let size = AndFrame::size_of(frame.prelude.univ_prelude.num_cells);
let size = AndFrame::size_of(frame.prelude.num_cells);
self.stack.truncate(self.e + size);
}

8
src/machine/mod.rs
View File

@@ -555,7 +555,7 @@ impl Machine {
fn retry_me_else(&mut self, offset: usize) {
let b = self.machine_st.b;
let or_frame = self.machine_st.stack.index_or_frame_mut(b);
let n = or_frame.prelude.univ_prelude.num_cells;
let n = or_frame.prelude.num_cells;
for i in 0..n {
self.machine_st.registers[i + 1] = or_frame[i];
@@ -589,7 +589,7 @@ impl Machine {
fn retry(&mut self, offset: usize) {
let b = self.machine_st.b;
let or_frame = self.machine_st.stack.index_or_frame_mut(b);
let n = or_frame.prelude.univ_prelude.num_cells;
let n = or_frame.prelude.num_cells;
for i in 0..n {
self.machine_st.registers[i+1] = or_frame[i];
@@ -625,7 +625,7 @@ impl Machine {
fn trust(&mut self, offset: usize) {
let b = self.machine_st.b;
let or_frame = self.machine_st.stack.index_or_frame(b);
let n = or_frame.prelude.univ_prelude.num_cells;
let n = or_frame.prelude.num_cells;
for i in 0..n {
self.machine_st.registers[i+1] = or_frame[i];
@@ -661,7 +661,7 @@ impl Machine {
fn trust_me(&mut self) {
let b = self.machine_st.b;
let or_frame = self.machine_st.stack.index_or_frame(b);
let n = or_frame.prelude.univ_prelude.num_cells;
let n = or_frame.prelude.num_cells;
for i in 0..n {
self.machine_st.registers[i+1] = or_frame[i];

15
src/machine/stack.rs
View File

@@ -36,14 +36,9 @@ impl Drop for Stack {
}
}
#[derive(Debug, Clone, Copy)]
pub(crate) struct FramePrelude {
pub(crate) num_cells: usize,
}
#[derive(Debug)]
pub(crate) struct AndFramePrelude {
pub(crate) univ_prelude: FramePrelude,
pub(crate) num_cells: usize,
pub(crate) e: usize,
pub(crate) cp: usize,
}
@@ -113,7 +108,7 @@ impl IndexMut<usize> for Stack {
#[derive(Debug)]
pub(crate) struct OrFramePrelude {
pub(crate) univ_prelude: FramePrelude,
pub(crate) num_cells: usize,
pub(crate) e: usize,
pub(crate) cp: usize,
pub(crate) b: usize,
@@ -208,7 +203,7 @@ impl Stack {
}
let and_frame = &mut *(new_ptr as *mut AndFrame);
and_frame.prelude.univ_prelude.num_cells = num_cells;
and_frame.prelude.num_cells = num_cells;
e
}
@@ -232,7 +227,7 @@ impl Stack {
}
let or_frame = &mut *(new_ptr as *mut OrFrame);
or_frame.prelude.univ_prelude.num_cells = num_cells;
or_frame.prelude.num_cells = num_cells;
b
}
@@ -298,7 +293,7 @@ mod tests {
0// 10 * mem::size_of::<HeapCellValue>() + prelude_size::<AndFrame>()
);
assert_eq!(and_frame.prelude.univ_prelude.num_cells, 10);
assert_eq!(and_frame.prelude.num_cells, 10);
for idx in 0..10 {
assert_eq!(and_frame[idx + 1], stack_loc_as_cell!(AndFrame, e, idx + 1));

144
src/machine/system_calls.rs
View File

@@ -457,6 +457,20 @@ impl BrentAlgState {
}
impl MachineState {
pub(crate) fn name_and_arity_from_heap(&self, cell: HeapCellValue) -> Option<PredicateKey> {
read_heap_cell!(self.store(self.deref(cell)),
(HeapCellValueTag::Str, s) => {
Some(cell_as_atom_cell!(self.heap[s]).get_name_and_arity())
}
(HeapCellValueTag::Atom, (name, _arity)) => {
Some((name, 0))
}
_ => {
None
}
)
}
#[inline]
pub(crate) fn variable_set<S: BuildHasher>(
&mut self,
@@ -988,6 +1002,116 @@ impl MachineState {
}
impl Machine {
#[inline(always)]
pub(crate) fn get_clause_p(&self, module_name: Atom) -> (usize, usize) {
use crate::machine::loader::CompilationTarget;
let key_cell = self.machine_st.registers[1];
let key = self.machine_st.name_and_arity_from_heap(key_cell).unwrap();
let compilation_target = if module_name == atom!("user") {
CompilationTarget::User
} else {
CompilationTarget::Module(module_name)
};
let skeleton = self.indices.get_predicate_skeleton(
&compilation_target,
&key,
).unwrap();
if self.machine_st.b > self.machine_st.e {
let or_frame = self.machine_st.stack.index_or_frame(self.machine_st.b);
let bp = or_frame.prelude.bp;
match &self.code[bp] {
&Instruction::IndexingCode(ref indexing_code) => {
match &indexing_code[or_frame.prelude.boip as usize] {
&IndexingLine::IndexedChoice(ref indexed_choice) => {
let p = or_frame.prelude.biip as usize - 1;
match &indexed_choice[p] {
&IndexedChoiceInstruction::Try(offset) |
&IndexedChoiceInstruction::Retry(offset) => {
let clause_clause_loc = skeleton.core.clause_clause_locs[p];
(clause_clause_loc, bp + offset)
}
&IndexedChoiceInstruction::Trust(_) => {
unreachable!()
}
}
}
_ => {
unreachable!()
}
}
}
_ => unreachable!()
}
} else {
let module_name = match compilation_target {
CompilationTarget::User => atom!("builtins"),
CompilationTarget::Module(target) => target,
};
let bp = self.indices
.get_predicate_code_index(atom!("$clause"), 2, module_name)
.and_then(|idx| idx.local())
.unwrap();
macro_rules! extract_ptr {
($ptr: expr) => {
match $ptr {
IndexingCodePtr::External(p) => return (
skeleton.core.clause_clause_locs.back().cloned().unwrap(),
bp + p,
),
IndexingCodePtr::Internal(boip) => boip,
_ => unreachable!(),
}
};
}
match &self.code[bp] {
&Instruction::IndexingCode(ref indexing_code) => {
let indexing_code_ptr = match &indexing_code[0] {
&IndexingLine::Indexing(IndexingInstruction::SwitchOnTerm(_, _, c, _, s)) => {
if key.1 > 0 { s } else { c }
}
_ => {
unreachable!()
}
};
let boip = extract_ptr!(indexing_code_ptr);
let boip = match &indexing_code[boip] {
&IndexingLine::Indexing(IndexingInstruction::SwitchOnStructure(ref hm)) => {
boip + extract_ptr!(hm.get(&key).cloned().unwrap())
}
&IndexingLine::Indexing(IndexingInstruction::SwitchOnConstant(ref hm)) => {
boip + extract_ptr!(hm.get(&Literal::Atom(key.0)).cloned().unwrap())
}
_ => boip,
};
match &indexing_code[boip] {
&IndexingLine::IndexedChoice(ref indexed_choice) => {
return (
skeleton.core.clause_clause_locs.back().cloned().unwrap(),
bp + indexed_choice.back().unwrap().offset(),
);
}
_ => unreachable!(),
}
}
_ => {
return (skeleton.core.clause_clause_locs.back().cloned().unwrap(), bp);
}
}
}
}
#[inline(always)]
pub(crate) fn deref_register(&mut self, i: usize) -> HeapCellValue {
self.machine_st.store(self.machine_st.deref(self.machine_st.registers[i]))
@@ -3281,20 +3405,14 @@ impl Machine {
pub(crate) fn head_is_dynamic(&mut self) {
let module_name = cell_as_atom!(self.deref_register(1));
let (name, arity) = read_heap_cell!(
self.deref_register(2),
(HeapCellValueTag::Str, s) => {
cell_as_atom_cell!(self.machine_st.heap[s]).get_name_and_arity()
match self.machine_st.name_and_arity_from_heap(self.machine_st.registers[2]) {
Some((name, arity)) => {
self.machine_st.fail = !self.indices.is_dynamic_predicate(module_name, (name, arity));
}
(HeapCellValueTag::Atom, (name, _arity)) => {
(name, 0)
None => {
self.machine_st.fail = true;
}
_ => {
unreachable!()
}
);
self.machine_st.fail = !self.indices.is_dynamic_predicate(module_name, (name, arity));
}
}
#[inline(always)]
@@ -4669,7 +4787,7 @@ impl Machine {
self.restore_instr_at_verify_attr_interrupt();
let e = self.machine_st.e;
let frame_len = self.machine_st.stack.index_and_frame(e).prelude.univ_prelude.num_cells;
let frame_len = self.machine_st.stack.index_and_frame(e).prelude.num_cells;
for i in 1..frame_len - 2 {
self.machine_st.registers[i] = self.machine_st.stack[stack_loc!(AndFrame, e, i)];