implement abolish/1

This commit is contained in:
Mark Thom
2021-02-05 18:06:27 -07:00
parent 927871d73d
commit bbbf95705b
7 changed files with 125 additions and 201 deletions

View File

@@ -310,11 +310,6 @@ pub enum SystemClauseType {
impl SystemClauseType { impl SystemClauseType {
pub fn name(&self) -> ClauseName { pub fn name(&self) -> ClauseName {
match self { match self {
// &SystemClauseType::AbolishClause => clause_name!("$abolish_clause"),
// &SystemClauseType::AbolishModuleClause => clause_name!("$abolish_module_clause"),
// &SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$assertz"),
// &SystemClauseType::AssertDynamicPredicateToFront => clause_name!("$asserta"),
// &SystemClauseType::AtEndOfExpansion => clause_name!("$at_end_of_expansion"),
&SystemClauseType::AtomChars => clause_name!("$atom_chars"), &SystemClauseType::AtomChars => clause_name!("$atom_chars"),
&SystemClauseType::AtomCodes => clause_name!("$atom_codes"), &SystemClauseType::AtomCodes => clause_name!("$atom_codes"),
&SystemClauseType::AtomLength => clause_name!("$atom_length"), &SystemClauseType::AtomLength => clause_name!("$atom_length"),
@@ -394,6 +389,8 @@ impl SystemClauseType {
clause_name!("$cpp_discontiguous_property"), clause_name!("$cpp_discontiguous_property"),
&SystemClauseType::REPL(REPLCodePtr::CompilePendingPredicates) => &SystemClauseType::REPL(REPLCodePtr::CompilePendingPredicates) =>
clause_name!("$compile_pending_predicates"), clause_name!("$compile_pending_predicates"),
&SystemClauseType::REPL(REPLCodePtr::AbolishClause) =>
clause_name!("$abolish_clause"),
&SystemClauseType::Close => clause_name!("$close"), &SystemClauseType::Close => clause_name!("$close"),
&SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"), &SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"),
&SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"), &SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"),
@@ -561,7 +558,8 @@ impl SystemClauseType {
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> { pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
match (name, arity) { match (name, arity) {
// ("$abolish_clause", 2) => Some(SystemClauseType::AbolishClause), ("$abolish_clause", 3) =>
Some(SystemClauseType::REPL(REPLCodePtr::AbolishClause)),
("$add_dynamic_predicate", 3) => ("$add_dynamic_predicate", 3) =>
Some(SystemClauseType::REPL(REPLCodePtr::AddDynamicPredicate)), Some(SystemClauseType::REPL(REPLCodePtr::AddDynamicPredicate)),
("$add_goal_expansion_clause", 4) => ("$add_goal_expansion_clause", 4) =>

View File

@@ -836,7 +836,9 @@ module_assertz_clause(Head, Body, Module) :-
; functor(Head, Name, Arity), ; functor(Head, Name, Arity),
atom(Name), atom(Name),
Name \== '.' -> Name \== '.' ->
( '$head_is_dynamic'(Module, Head) -> ( '$no_such_predicate'(Module, Head) ->
call_assertz(Head, Body, Name, Arity, Module)
; '$head_is_dynamic'(Module, Head) ->
call_assertz(Head, Body, Name, Arity, Module) call_assertz(Head, Body, Name, Arity, Module)
; throw(error(permission_error(modify, static_procedure, Name/Arity), ; throw(error(permission_error(modify, static_procedure, Name/Arity),
assertz/1)) assertz/1))
@@ -883,7 +885,7 @@ assertz(Clause) :-
module_retract_clauses([Clause|Clauses0], Head, Body, Name, Arity, Module) :- module_retract_clauses([Clause|Clauses0], Head, Body, Name, Arity, Module) :-
functor(VarHead, Name, Arity), functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), Module:clause(Module:VarHead, VarBody), Clauses1), findall((VarHead :- VarBody), Module:'$clause'(VarHead, VarBody), Clauses1),
first_match_index(Clauses1, (Head :- Body), 0, N), first_match_index(Clauses1, (Head :- Body), 0, N),
( Clauses0 == [] -> ! ( Clauses0 == [] -> !
; true ; true
@@ -894,7 +896,7 @@ module_retract_clauses([_|Clauses0], 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) :- call_module_retract(Head, Body, Name, Arity, Module) :-
findall((Head :- Body), Module:clause(Module:Head, Body), Clauses), findall((Head :- Body), Module:'$clause'(Head, Body), Clauses),
module_retract_clauses(Clauses, Head, Body, Name, Arity, Module). module_retract_clauses(Clauses, Head, Body, Name, Arity, Module).
retract_module_clause(Head, Body, Module) :- retract_module_clause(Head, Body, Module) :-
@@ -904,7 +906,10 @@ retract_module_clause(Head, Body, Module) :-
atom(Name), atom(Name),
Name \== '.' -> Name \== '.' ->
( '$head_is_dynamic'(Module, Head) -> ( '$head_is_dynamic'(Module, Head) ->
call_module_retract(Head, Body, Name, Arity, Module) ( 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(permission_error(modify, static_procedure, Name/Arity), retract/1))
) )
; throw(error(type_error(callable, Head), retract/1)) ; throw(error(type_error(callable, Head), retract/1))
@@ -941,16 +946,16 @@ retract_clause(Head, Body) :-
; functor(Head, Name, Arity), ; functor(Head, Name, Arity),
atom(Name), atom(Name),
Name \== '.' -> Name \== '.' ->
( Name == (:), ( Name == (:),
Arity =:= 2 -> Arity =:= 2 ->
arg(1, Head, Module), arg(1, Head, Module),
arg(2, Head, F), arg(2, Head, F),
retract_module_clause(F, Body, Module) retract_module_clause(F, Body, Module)
; '$head_is_dynamic'(user, Head) -> ; '$head_is_dynamic'(user, Head) ->
call_retract(Head, Body, Name, Arity) call_retract(Head, Body, Name, Arity)
; '$no_such_predicate'(user, Head) -> ; '$no_such_predicate'(user, Head) ->
'$fail' '$fail'
; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1)) ; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1))
) )
; throw(error(type_error(callable, Head), retract/1)) ; throw(error(type_error(callable, Head), retract/1))
). ).
@@ -972,21 +977,21 @@ module_abolish(Pred, Module) :-
( var(Name) -> ( var(Name) ->
throw(error(instantiation_error, abolish/1)) throw(error(instantiation_error, abolish/1))
; integer(Arity) -> ; integer(Arity) ->
( \+ atom(Name) -> ( \+ atom(Name) ->
throw(error(type_error(atom, Name), abolish/1)) throw(error(type_error(atom, Name), abolish/1))
; Arity < 0 -> ; Arity < 0 ->
throw(error(domain_error(not_less_than_zero, Arity), abolish/1)) throw(error(domain_error(not_less_than_zero, Arity), abolish/1))
; max_arity(N), Arity > N -> ; max_arity(N), Arity > N ->
throw(error(representation_error(max_arity), abolish/1)) throw(error(representation_error(max_arity), abolish/1))
; functor(Head, Name, Arity) -> ; functor(Head, Name, Arity) ->
( '$module_head_is_dynamic'(Head, Module) -> ( '$head_is_dynamic'(Module, Head) ->
'$abolish_module_clause'(Name, Arity, Module) '$abolish_clause'(Module, Name, Arity)
; throw(error(permission_error(modify, static_procedure, Pred), abolish/1)) ; throw(error(permission_error(modify, static_procedure, Pred), abolish/1))
) )
) )
; throw(error(type_error(integer, Arity), abolish/1)) ; throw(error(type_error(integer, Arity), abolish/1))
) )
; throw(error(type_error(predicate_indicator, Module:Pred), abolish/1)) ; throw(error(type_error(predicate_indicator, Module:Pred), abolish/1))
). ).
abolish(Pred) :- abolish(Pred) :-
@@ -1000,17 +1005,19 @@ abolish(Pred) :-
; var(Arity) -> ; var(Arity) ->
throw(error(instantiation_error, abolish/1)) throw(error(instantiation_error, abolish/1))
; integer(Arity) -> ; integer(Arity) ->
( \+ atom(Name) -> ( \+ atom(Name) ->
throw(error(type_error(atom, Name), abolish/1)) throw(error(type_error(atom, Name), abolish/1))
; Arity < 0 -> ; Arity < 0 ->
throw(error(domain_error(not_less_than_zero, Arity), abolish/1)) throw(error(domain_error(not_less_than_zero, Arity), abolish/1))
; max_arity(N), Arity > N -> ; max_arity(N), Arity > N ->
throw(error(representation_error(max_arity), abolish/1)) throw(error(representation_error(max_arity), abolish/1))
; functor(Head, Name, Arity) -> ; functor(Head, Name, Arity) ->
( '$no_such_predicate'(Head) -> true ( '$no_such_predicate'(user, Head) ->
; '$head_is_dynamic'(Head) -> '$abolish_clause'(Name, Arity) true
; throw(error(permission_error(modify, static_procedure, Pred), abolish/1)) ; '$head_is_dynamic'(user, Head) ->
) '$abolish_clause'(user, Name, Arity)
; throw(error(permission_error(modify, static_procedure, Pred), abolish/1))
)
) )
; throw(error(type_error(integer, Arity), abolish/1)) ; throw(error(type_error(integer, Arity), abolish/1))
) )

View File

@@ -1432,6 +1432,75 @@ impl Machine {
} }
} }
pub(crate)
fn abolish_clause(&mut self) {
let module_name = atom_from!(
self.machine_st,
self.machine_st.store(self.machine_st.deref(
self.machine_st[temp_v!(1)]
))
);
let key =
self.machine_st.read_predicate_key(
self.machine_st[temp_v!(2)],
self.machine_st[temp_v!(3)],
);
let compilation_target =
match module_name.as_str() {
"user" => CompilationTarget::User,
_ => CompilationTarget::Module(module_name),
};
let mut loader = Loader::new(LiveTermStream::new(ListingSource::User), self);
loader.load_state.compilation_target = compilation_target;
match loader.load_state.wam.indices.get_predicate_skeleton(
&loader.load_state.compilation_target,
&key
) {
Some(skeleton) => {
skeleton.clauses.clear();
skeleton.clause_clause_locs.clear();
}
_ => {
unreachable!();
}
}
let code_index = loader.load_state.get_or_insert_code_index(key);
code_index.set(IndexPtr::DynamicUndefined);
match loader.load_state.compilation_target {
CompilationTarget::User => {
loader.load_state.compilation_target =
CompilationTarget::Module(clause_name!("builtins"));
}
_ => {
}
};
match loader.load_state.wam.indices.get_predicate_skeleton(
&loader.load_state.compilation_target,
&(clause_name!("$clause"), 2),
) {
Some(skeleton) => {
skeleton.clauses.clear();
skeleton.clause_clause_locs.clear();
}
_ => {
unreachable!();
}
}
let clause_clause_code_index = loader.load_state.get_or_insert_code_index(
(clause_name!("$clause"), 2),
);
clause_clause_code_index.set(IndexPtr::DynamicUndefined);
}
pub(crate) pub(crate)
fn retract_clause(&mut self) { fn retract_clause(&mut self) {
let key = let key =

View File

@@ -525,6 +525,7 @@ pub enum REPLCodePtr {
DiscontiguousProperty, DiscontiguousProperty,
DynamicProperty, DynamicProperty,
CompilePendingPredicates, CompilePendingPredicates,
AbolishClause,
Asserta, Asserta,
Assertz, Assertz,
Retract, Retract,

View File

@@ -503,6 +503,9 @@ impl Machine {
REPLCodePtr::Retract => { REPLCodePtr::Retract => {
self.retract_clause(); self.retract_clause();
} }
REPLCodePtr::AbolishClause => {
self.abolish_clause();
}
} }
self.machine_st.p = CodePtr::Local(p); self.machine_st.p = CodePtr::Local(p);

View File

@@ -792,22 +792,6 @@ impl MachineState {
current_output_stream: &mut Stream, current_output_stream: &mut Stream,
) -> CallResult { ) -> CallResult {
match ct { match ct {
/*
&SystemClauseType::AbolishClause => {
let p = self.cp;
let trans_type = DynamicTransactionType::Abolish;
self.p = CodePtr::DynamicTransaction(trans_type, p);
return Ok(());
}
&SystemClauseType::AbolishModuleClause => {
let p = self.cp;
let trans_type = DynamicTransactionType::ModuleAbolish;
self.p = CodePtr::DynamicTransaction(trans_type, p);
return Ok(());
}
*/
&SystemClauseType::BindFromRegister => { &SystemClauseType::BindFromRegister => {
let reg = self.store(self.deref(self[temp_v!(2)])); let reg = self.store(self.deref(self[temp_v!(2)]));
let n = let n =
@@ -835,23 +819,6 @@ impl MachineState {
self.fail = true; self.fail = true;
} }
/*
&SystemClauseType::AssertDynamicPredicateToFront => {
let p = self.cp;
let trans_type = DynamicTransactionType::Assert(DynamicAssertPlace::Front);
self.p = CodePtr::DynamicTransaction(trans_type, p);
return Ok(());
}
&SystemClauseType::AssertDynamicPredicateToBack => {
// let p = self.cp;
// let trans_type = DynamicTransactionType::Assert(DynamicAssertPlace::Back);
// self.p = CodePtr::DynamicTransaction(trans_type, p);
self.p = CodePtr::REPL(REPLCodePtr::UserAssertz, self.cp);
return Ok(());
}
*/
&SystemClauseType::CurrentHostname => { &SystemClauseType::CurrentHostname => {
match hostname::get().ok() { match hostname::get().ok() {
Some(host) => { Some(host) => {
@@ -1755,15 +1722,7 @@ impl MachineState {
} else if self.fail { } else if self.fail {
return Ok(()); return Ok(());
} }
}/* } }
_ => {
let stub = MachineError::functor_stub(clause_name!("get_char"), 2);
let err = MachineError::representation_error(RepFlag::Character);
let err = self.error_form(err, stub);
return Err(err);
}*/
}
} }
} }
&SystemClauseType::NumberToChars => { &SystemClauseType::NumberToChars => {
@@ -1859,22 +1818,6 @@ impl MachineState {
} }
} }
} }
/*
&SystemClauseType::ModuleAssertDynamicPredicateToFront => {
let p = self.cp;
let trans_type = DynamicTransactionType::ModuleAssert(DynamicAssertPlace::Front);
self.p = CodePtr::DynamicTransaction(trans_type, p);
return Ok(());
}
&SystemClauseType::ModuleAssertDynamicPredicateToBack => {
let p = self.cp;
let trans_type = DynamicTransactionType::ModuleAssert(DynamicAssertPlace::Back);
self.p = CodePtr::DynamicTransaction(trans_type, p);
return Ok(());
}
*/
&SystemClauseType::LiftedHeapLength => { &SystemClauseType::LiftedHeapLength => {
let a1 = self[temp_v!(1)]; let a1 = self[temp_v!(1)];
let lh_len = Addr::Usize(self.lifted_heap.h()); let lh_len = Addr::Usize(self.lifted_heap.h());
@@ -2732,14 +2675,7 @@ impl MachineState {
} else if self.fail { } else if self.fail {
return Ok(()); return Ok(());
} }
}/* }
_ => {
let stub = MachineError::functor_stub(clause_name!("get_char"), 2);
let err = MachineError::representation_error(RepFlag::Character);
let err = self.error_form(err, stub);
return Err(err);
}*/
} }
} }
} }
@@ -2857,98 +2793,6 @@ impl MachineState {
self.unify(Addr::Char(c), a1); self.unify(Addr::Char(c), a1);
} }
/*
&SystemClauseType::GetModuleClause => {
let module = self[temp_v!(3)];
let head = self[temp_v!(1)];
let module = match self.store(self.deref(module)) {
Addr::Con(h) if self.heap.atom_at(h) => {
if let HeapCellValue::Atom(module, _) = &self.heap[h] {
module.clone()
} else {
unreachable!()
}
}
_ => {
self.fail = true;
return Ok(());
}
};
let subsection = match self.store(self.deref(head)) {
Addr::Str(s) => match &self.heap[s] {
&HeapCellValue::NamedStr(arity, ref name, ..) => {
indices.get_clause_subsection(module, name.clone(), arity)
}
_ => {
unreachable!()
}
},
Addr::Con(h) => {
if let HeapCellValue::Atom(name, _) = &self.heap[h] {
indices.get_clause_subsection(module, name.clone(), 0)
} else {
unreachable!()
}
}
_ => {
unreachable!()
}
};
match subsection {
Some(dynamic_predicate_info) => {
self.execute_at_index(
2,
dir_entry!(dynamic_predicate_info.clauses_subsection_p),
);
return Ok(());
}
None => {
self.fail = true;
}
}
}
&SystemClauseType::ModuleHeadIsDynamic => {
let module = self[temp_v!(2)];
let head = self[temp_v!(1)];
let module = match self.store(self.deref(module)) {
Addr::Con(h) if self.heap.atom_at(h) =>
if let HeapCellValue::Atom(module, _) = &self.heap[h] {
module.clone()
} else {
unreachable!()
}
_ => {
self.fail = true;
return Ok(());
}
};
self.fail = !match self.store(self.deref(head)) {
Addr::Str(s) => match &self.heap[s] {
&HeapCellValue::NamedStr(arity, ref name, ..) => {
indices.get_clause_subsection(module, name.clone(), arity)
.is_some()
}
_ => unreachable!(),
},
Addr::Con(h) => {
if let HeapCellValue::Atom(name, _) = &self.heap[h] {
indices.get_clause_subsection(module, name.clone(), 0)
.is_some()
} else {
unreachable!()
}
}
_ => unreachable!(),
};
}
*/
&SystemClauseType::HeadIsDynamic => { &SystemClauseType::HeadIsDynamic => {
let module_name = atom_from!( let module_name = atom_from!(
self, self,

View File

@@ -26,6 +26,8 @@ impl fmt::Display for REPLCodePtr {
write!(f, "REPLCodePtr::AddGoalExpansionClause"), write!(f, "REPLCodePtr::AddGoalExpansionClause"),
REPLCodePtr::AddTermExpansionClause => REPLCodePtr::AddTermExpansionClause =>
write!(f, "REPLCodePtr::AddTermExpansionClause"), write!(f, "REPLCodePtr::AddTermExpansionClause"),
REPLCodePtr::AbolishClause =>
write!(f, "REPLCodePtr::AbolishClause"),
REPLCodePtr::Assertz => REPLCodePtr::Assertz =>
write!(f, "REPLCodePtr::Assertz"), write!(f, "REPLCodePtr::Assertz"),
REPLCodePtr::Asserta => REPLCodePtr::Asserta =>