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"),
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"),
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
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) =>
; 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))
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
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) :-
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))
; 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))
).
( 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) :-
; 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))
)
}
}
+ 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 =
DiscontiguousProperty,
DynamicProperty,
CompilePendingPredicates,
+ AbolishClause,
Asserta,
Assertz,
Retract,
REPLCodePtr::Retract => {
self.retract_clause();
}
+ REPLCodePtr::AbolishClause => {
+ self.abolish_clause();
+ }
}
self.machine_st.p = CodePtr::Local(p);
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 =
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) => {
} 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 => {
}
}
}
- /*
- &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());
} 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);
- }*/
+ }
}
}
}
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,
write!(f, "REPLCodePtr::AddGoalExpansionClause"),
REPLCodePtr::AddTermExpansionClause =>
write!(f, "REPLCodePtr::AddTermExpansionClause"),
+ REPLCodePtr::AbolishClause =>
+ write!(f, "REPLCodePtr::AbolishClause"),
REPLCodePtr::Assertz =>
write!(f, "REPLCodePtr::Assertz"),
REPLCodePtr::Asserta =>
projects / scryer-prolog.git / commitdiff