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

implement abolish/1

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

10
src/clause_types.rs
View File

@@ -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<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) =>

81
src/lib/builtins.pl
View File

@@ -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))
)

69
src/machine/loader.rs
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)
fn retract_clause(&mut self) {
let key =

1
src/machine/machine_indices.rs
View File

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

3
src/machine/mod.rs
View File

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

160
src/machine/system_calls.rs
View File

@@ -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,

2
src/write.rs
View File

@@ -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 =>