From: Mark Thom Date: Sat, 6 Feb 2021 01:06:27 +0000 (-0700) Subject: implement abolish/1 X-Git-Tag: v0.9.0~150^2~65^2~12 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=bbbf95705b6d0e8063a152bb4be15ff1f70134f9;p=scryer-prolog.git implement abolish/1 --- diff --git a/src/clause_types.rs b/src/clause_types.rs index ab83a3e9..76c70e74 100644 --- a/src/clause_types.rs +++ b/src/clause_types.rs @@ -310,11 +310,6 @@ pub enum SystemClauseType { impl SystemClauseType { pub fn name(&self) -> ClauseName { 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::AtomCodes => clause_name!("$atom_codes"), &SystemClauseType::AtomLength => clause_name!("$atom_length"), @@ -394,6 +389,8 @@ impl SystemClauseType { clause_name!("$cpp_discontiguous_property"), &SystemClauseType::REPL(REPLCodePtr::CompilePendingPredicates) => clause_name!("$compile_pending_predicates"), + &SystemClauseType::REPL(REPLCodePtr::AbolishClause) => + clause_name!("$abolish_clause"), &SystemClauseType::Close => clause_name!("$close"), &SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"), &SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"), @@ -561,7 +558,8 @@ impl SystemClauseType { pub fn from(name: &str, arity: usize) -> Option { match (name, arity) { - // ("$abolish_clause", 2) => Some(SystemClauseType::AbolishClause), + ("$abolish_clause", 3) => + Some(SystemClauseType::REPL(REPLCodePtr::AbolishClause)), ("$add_dynamic_predicate", 3) => Some(SystemClauseType::REPL(REPLCodePtr::AddDynamicPredicate)), ("$add_goal_expansion_clause", 4) => diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl index 6cd87ad9..2be9c783 100644 --- a/src/lib/builtins.pl +++ b/src/lib/builtins.pl @@ -836,7 +836,9 @@ module_assertz_clause(Head, Body, Module) :- ; functor(Head, Name, Arity), atom(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) ; throw(error(permission_error(modify, static_procedure, Name/Arity), assertz/1)) @@ -883,7 +885,7 @@ assertz(Clause) :- module_retract_clauses([Clause|Clauses0], Head, Body, Name, Arity, Module) :- 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), ( Clauses0 == [] -> ! ; true @@ -894,7 +896,7 @@ 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(Module:Head, Body), Clauses), + findall((Head :- Body), Module:'$clause'(Head, Body), Clauses), module_retract_clauses(Clauses, Head, Body, Name, Arity, Module). retract_module_clause(Head, Body, Module) :- @@ -904,7 +906,10 @@ retract_module_clause(Head, Body, Module) :- atom(Name), Name \== '.' -> ( '$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(type_error(callable, Head), retract/1)) @@ -941,16 +946,16 @@ retract_clause(Head, Body) :- ; functor(Head, Name, Arity), atom(Name), Name \== '.' -> - ( Name == (:), - Arity =:= 2 -> - arg(1, Head, Module), - arg(2, Head, F), - retract_module_clause(F, Body, Module) - ; '$head_is_dynamic'(user, Head) -> - call_retract(Head, Body, Name, Arity) - ; '$no_such_predicate'(user, Head) -> - '$fail' - ; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1)) + ( Name == (:), + Arity =:= 2 -> + arg(1, Head, Module), + arg(2, Head, F), + retract_module_clause(F, Body, Module) + ; '$head_is_dynamic'(user, Head) -> + call_retract(Head, Body, Name, Arity) + ; '$no_such_predicate'(user, Head) -> + '$fail' + ; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1)) ) ; throw(error(type_error(callable, Head), retract/1)) ). @@ -972,21 +977,21 @@ module_abolish(Pred, Module) :- ( var(Name) -> throw(error(instantiation_error, abolish/1)) ; integer(Arity) -> - ( \+ atom(Name) -> - throw(error(type_error(atom, Name), abolish/1)) - ; Arity < 0 -> - throw(error(domain_error(not_less_than_zero, Arity), abolish/1)) - ; max_arity(N), Arity > N -> - throw(error(representation_error(max_arity), abolish/1)) - ; functor(Head, Name, Arity) -> - ( '$module_head_is_dynamic'(Head, Module) -> - '$abolish_module_clause'(Name, Arity, Module) - ; throw(error(permission_error(modify, static_procedure, Pred), abolish/1)) - ) + ( \+ atom(Name) -> + throw(error(type_error(atom, Name), abolish/1)) + ; Arity < 0 -> + throw(error(domain_error(not_less_than_zero, Arity), abolish/1)) + ; max_arity(N), Arity > N -> + throw(error(representation_error(max_arity), abolish/1)) + ; functor(Head, Name, Arity) -> + ( '$head_is_dynamic'(Module, Head) -> + '$abolish_clause'(Module, Name, Arity) + ; throw(error(permission_error(modify, static_procedure, Pred), 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) :- @@ -1000,17 +1005,19 @@ abolish(Pred) :- ; var(Arity) -> throw(error(instantiation_error, abolish/1)) ; integer(Arity) -> - ( \+ atom(Name) -> - throw(error(type_error(atom, Name), abolish/1)) - ; Arity < 0 -> - throw(error(domain_error(not_less_than_zero, Arity), abolish/1)) - ; max_arity(N), Arity > N -> - throw(error(representation_error(max_arity), abolish/1)) - ; functor(Head, Name, Arity) -> - ( '$no_such_predicate'(Head) -> true - ; '$head_is_dynamic'(Head) -> '$abolish_clause'(Name, Arity) - ; throw(error(permission_error(modify, static_procedure, Pred), abolish/1)) - ) + ( \+ atom(Name) -> + throw(error(type_error(atom, Name), abolish/1)) + ; Arity < 0 -> + throw(error(domain_error(not_less_than_zero, Arity), abolish/1)) + ; max_arity(N), Arity > N -> + throw(error(representation_error(max_arity), abolish/1)) + ; functor(Head, Name, Arity) -> + ( '$no_such_predicate'(user, Head) -> + true + ; '$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)) ) diff --git a/src/machine/loader.rs b/src/machine/loader.rs index 5dbb5ba3..eae4ab57 100644 --- a/src/machine/loader.rs +++ b/src/machine/loader.rs @@ -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) fn retract_clause(&mut self) { let key = diff --git a/src/machine/machine_indices.rs b/src/machine/machine_indices.rs index 0812c67e..7a183ecd 100644 --- a/src/machine/machine_indices.rs +++ b/src/machine/machine_indices.rs @@ -525,6 +525,7 @@ pub enum REPLCodePtr { DiscontiguousProperty, DynamicProperty, CompilePendingPredicates, + AbolishClause, Asserta, Assertz, Retract, diff --git a/src/machine/mod.rs b/src/machine/mod.rs index d3dc04d7..0b0439cd 100644 --- a/src/machine/mod.rs +++ b/src/machine/mod.rs @@ -503,6 +503,9 @@ impl Machine { REPLCodePtr::Retract => { self.retract_clause(); } + REPLCodePtr::AbolishClause => { + self.abolish_clause(); + } } self.machine_st.p = CodePtr::Local(p); diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs index 8762c764..6990ed40 100644 --- a/src/machine/system_calls.rs +++ b/src/machine/system_calls.rs @@ -792,22 +792,6 @@ impl MachineState { current_output_stream: &mut Stream, ) -> CallResult { 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 => { let reg = self.store(self.deref(self[temp_v!(2)])); let n = @@ -835,23 +819,6 @@ impl MachineState { 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 => { match hostname::get().ok() { Some(host) => { @@ -1755,15 +1722,7 @@ impl MachineState { } else if self.fail { 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 => { @@ -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 => { let a1 = self[temp_v!(1)]; let lh_len = Addr::Usize(self.lifted_heap.h()); @@ -2732,14 +2675,7 @@ impl MachineState { } else if self.fail { 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); } -/* - &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 => { let module_name = atom_from!( self, diff --git a/src/write.rs b/src/write.rs index 963e2599..17944e9d 100644 --- a/src/write.rs +++ b/src/write.rs @@ -26,6 +26,8 @@ impl fmt::Display for REPLCodePtr { write!(f, "REPLCodePtr::AddGoalExpansionClause"), REPLCodePtr::AddTermExpansionClause => write!(f, "REPLCodePtr::AddTermExpansionClause"), + REPLCodePtr::AbolishClause => + write!(f, "REPLCodePtr::AbolishClause"), REPLCodePtr::Assertz => write!(f, "REPLCodePtr::Assertz"), REPLCodePtr::Asserta =>