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

support module modification using dynamic database predicates

Browse Source
This commit is contained in:
Mark Thom
2019-03-06 21:53:08 -07:00
parent 07fe30c970
commit b69bf71ff4
5 changed files with 291 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
src/prolog/clause_types.rs
View File

@@ -136,8 +136,11 @@ impl InlinedClauseType {
#[derive(Copy, Clone, PartialEq)]
pub enum SystemClauseType {
AbolishClause,
AbolishModuleClause,
AssertDynamicPredicateToBack,
AssertDynamicPredicateToFront,
ModuleAssertDynamicPredicateToFront,
ModuleAssertDynamicPredicateToBack,
CheckCutPoint,
CopyToLiftedHeap,
DeleteAttribute,
@@ -155,6 +158,7 @@ pub enum SystemClauseType {
GetBValue,
GetClause,
GetCurrentPredicateList,
GetModuleClause,
GetLiftedHeapFromOffset,
GetLiftedHeapFromOffsetDiff,
GetSCCCleaner,
@@ -163,6 +167,7 @@ pub enum SystemClauseType {
InstallInferenceCounter,
LiftedHeapLength,
ModuleOf,
ModuleRetractClause,
NoSuchPredicate,
RedoAttrVarBindings,
RemoveCallPolicyCheck,
@@ -197,8 +202,11 @@ impl SystemClauseType {
pub fn name(&self) -> ClauseName {
match self {
&SystemClauseType::AbolishClause => clause_name!("$abolish_clause"),
&SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$asserta"),
&SystemClauseType::AssertDynamicPredicateToFront => clause_name!("$assertz"),
&SystemClauseType::AbolishModuleClause => clause_name!("$abolish_module_clause"),
&SystemClauseType::AssertDynamicPredicateToBack => clause_name!("$assertz"),
&SystemClauseType::AssertDynamicPredicateToFront => clause_name!("$asserta"),
&SystemClauseType::ModuleAssertDynamicPredicateToFront => clause_name!("$module_asserta"),
&SystemClauseType::ModuleAssertDynamicPredicateToBack => clause_name!("$module_assertz"),
&SystemClauseType::CheckCutPoint => clause_name!("$check_cp"),
&SystemClauseType::CopyToLiftedHeap => clause_name!("$copy_to_lh"),
&SystemClauseType::DeleteAttribute => clause_name!("$del_attr_non_head"),
@@ -219,6 +227,7 @@ impl SystemClauseType {
&SystemClauseType::GetBValue => clause_name!("$get_b_value"),
&SystemClauseType::GetClause => clause_name!("$get_clause"),
&SystemClauseType::GetDoubleQuotes => clause_name!("$get_double_quotes"),
&SystemClauseType::GetModuleClause => clause_name!("$get_module_clause"),
&SystemClauseType::GetSCCCleaner => clause_name!("$get_scc_cleaner"),
&SystemClauseType::HeadIsDynamic => clause_name!("$head_is_dynamic"),
&SystemClauseType::InstallSCCCleaner => clause_name!("$install_scc_cleaner"),
@@ -239,6 +248,7 @@ impl SystemClauseType {
&SystemClauseType::GetCutPoint => clause_name!("$get_cp"),
&SystemClauseType::GetCurrentBlock => clause_name!("$get_current_block"),
&SystemClauseType::InstallNewBlock => clause_name!("$install_new_block"),
&SystemClauseType::ModuleRetractClause => clause_name!("$module_retract_clause"),
&SystemClauseType::RetractClause => clause_name!("$retract_clause"),
&SystemClauseType::ResetBlock => clause_name!("$reset_block"),
&SystemClauseType::ReturnFromAttributeGoals => clause_name!("$return_from_attribute_goals"),
@@ -254,10 +264,13 @@ impl SystemClauseType {
&SystemClauseType::WriteTerm => clause_name!("$write_term"),
}
}
pub fn from(name: &str, arity: usize) -> Option<SystemClauseType> {
match (name, arity) {
("$abolish_clause", 2) => Some(SystemClauseType::AbolishClause),
("$abolish_module_clause", 3) => Some(SystemClauseType::AbolishModuleClause),
("$module_asserta", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToFront),
("$module_assertz", 5) => Some(SystemClauseType::ModuleAssertDynamicPredicateToBack),
("$asserta", 4) => Some(SystemClauseType::AssertDynamicPredicateToFront),
("$assertz", 4) => Some(SystemClauseType::AssertDynamicPredicateToBack),
("$check_cp", 1) => Some(SystemClauseType::CheckCutPoint),
@@ -274,6 +287,7 @@ impl SystemClauseType {
("$get_attr_list", 2) => Some(SystemClauseType::GetAttributedVariableList),
("$get_b_value", 1) => Some(SystemClauseType::GetBValue),
("$get_clause", 2) => Some(SystemClauseType::GetClause),
("$get_module_clause", 3) => Some(SystemClauseType::GetModuleClause),
("$get_current_predicate_list", 1) => Some(SystemClauseType::GetCurrentPredicateList),
("$get_lh_from_offset", 2) => Some(SystemClauseType::GetLiftedHeapFromOffset),
("$get_lh_from_offset_diff", 3) => Some(SystemClauseType::GetLiftedHeapFromOffsetDiff),
@@ -284,6 +298,7 @@ impl SystemClauseType {
("$install_inference_counter", 3) => Some(SystemClauseType::InstallInferenceCounter),
("$lh_length", 1) => Some(SystemClauseType::LiftedHeapLength),
("$module_of", 2) => Some(SystemClauseType::ModuleOf),
("$module_retract_clause", 5) => Some(SystemClauseType::ModuleRetractClause),
("$no_such_predicate", 1) => Some(SystemClauseType::NoSuchPredicate),
("$redo_attr_var_bindings", 0) => Some(SystemClauseType::RedoAttrVarBindings),
("$remove_call_policy_check", 1) => Some(SystemClauseType::RemoveCallPolicyCheck),

110
src/prolog/lib/builtins.pl
View File

@@ -459,15 +459,30 @@ setof(Template, Goal, Solution) :-
'$clause_body_is_valid'(B) :-
( var(B) -> true
; functor(B, Name, _) -> ( atom(Name), Name \= '.' -> true
; functor(B, Name, _) -> ( atom(Name), Name \== '.' -> true
; throw(error(type_error(callable, B), clause/2))
)
; throw(error(type_error(callable, B), clause/2))
).
'$module_clause'(H, B, Module) :-
( var(H) -> throw(error(instantiation_error, clause/2))
; functor(H, Name, Arity) -> ( Name == '.' -> throw(error(type_error(callable, H), clause/2))
; '$head_is_dynamic'(H) -> '$clause_body_is_valid'(B),
'$get_module_clause'(H, B, Module)
; throw(error(permission_error(access, private_procedure, Name/Arity),
clause/2))
)
; throw(error(type_error(callable, H), clause/2))
).
clause(H, B) :-
( var(H) -> throw(error(instantiation_error, clause/2))
; functor(H, Name, Arity) -> ( Name == '.' -> throw(error(type_error(callable, H), clause/2))
; Name == (:), Arity =:= 2 ->
arg(1, H, Module),
arg(2, H, F),
'$module_clause'(F, B, Module)
%% '$no_such_predicate' fails if H is not callable.
; '$no_such_predicate'(H) -> '$fail'
; '$head_is_dynamic'(H) -> '$clause_body_is_valid'(B),
@@ -478,16 +493,35 @@ clause(H, B) :-
; throw(error(type_error(callable, H), clause/2))
).
call_module_asserta(Head, Body, Name, Arity, Module) :-
'$clause_body_is_valid'(Body),
functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), clause(Module:VarHead, VarBody), Clauses),
'$module_asserta'((Head :- Body), Clauses, Name, Arity, Module).
call_asserta(Head, Body, Name, Arity) :-
'$clause_body_is_valid'(Body),
functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses),
'$asserta'((Head :- Body), Clauses, Name, Arity).
module_asserta_clause(Head, Body, Module) :-
( var(Head) -> throw(error(instantiation_error, asserta/1))
; functor(Head, Name, Arity), atom(Name), Name \== '.' ->
( '$head_is_dynamic'(Head) -> call_module_asserta(Head, Body, Name, Arity, Module)
; throw(error(permission_error(modify, static_procedure, Name/Arity), asserta/1))
)
; throw(error(type_error(callable, Head), asserta/1))
).
asserta_clause(Head, Body) :-
( var(Head) -> throw(error(instantiation_error, asserta/1))
; functor(Head, Name, Arity), atom(Name), Name \== '.' ->
( '$no_such_predicate'(Head) -> call_asserta(Head, Body, Name, Arity)
( Name == (:), Arity =:= 2 ->
arg(1, Head, Module),
arg(2, Head, F),
module_asserta_clause(F, Body, Module)
; '$no_such_predicate'(Head) -> call_asserta(Head, Body, Name, Arity)
; '$head_is_dynamic'(Head) -> call_asserta(Head, Body, Name, Arity)
; throw(error(permission_error(modify, static_procedure, Name/Arity), asserta/1))
)
@@ -499,16 +533,35 @@ asserta(Clause) :-
; Clause = (Head :- Body) -> asserta_clause(Head, Body)
).
call_module_assertz(Head, Body, Name, Arity, Module) :-
'$clause_body_is_valid'(Body),
functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), clause(Module:VarHead, VarBody), Clauses),
'$module_assertz'((Head :- Body), Clauses, Name, Arity, Module).
call_assertz(Head, Body, Name, Arity) :-
'$clause_body_is_valid'(Body),
functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), clause(VarHead, VarBody), Clauses),
'$assertz'((Head :- Body), Clauses, Name, Arity).
module_assertz_clause(Head, Body, Module) :-
( var(Head) -> throw(error(instantiation_error, assertz/1))
; functor(Head, Name, Arity), atom(Name), Name \== '.' ->
( '$head_is_dynamic'(Head) -> call_module_assertz(Head, Body, Name, Arity, Module)
; throw(error(permission_error(modify, static_procedure, Name/Arity), assertz/1))
)
; throw(error(type_error(callable, Head), assertz/1))
).
assertz_clause(Head, Body) :-
( var(Head) -> throw(error(instantiation_error, assertz/1))
; functor(Head, Name, Arity), atom(Name), Name \== '.' ->
( '$no_such_predicate'(Head) -> call_assertz(Head, Body, Name, Arity)
( Name == (:), Arity =:= 2 ->
arg(1, Head, Module),
arg(2, Head, F),
module_assertz_clause(F, Body, Module)
; '$no_such_predicate'(Head) -> call_assertz(Head, Body, Name, Arity)
; '$head_is_dynamic'(Head) -> call_assertz(Head, Body, Name, Arity)
; throw(error(permission_error(modify, static_procedure, Name/Arity), assertz/1))
)
@@ -541,10 +594,38 @@ call_retract(Head, Body, Name, Arity) :-
findall((Head :- Body), clause(Head, Body), Clauses),
retract_clauses(Clauses, Head, Body, Name, Arity).
module_retract_clauses([Clause|Clauses0], Head, Body, Name, Arity, Module) :-
functor(VarHead, Name, Arity),
findall((VarHead :- VarBody), clause(Module:VarHead, VarBody), Clauses1),
first_match_index(Clauses1, (Head :- Body), 0, N),
( Clauses0 == [] -> !
; true
),
'$module_retract_clause'(Name, Arity, N, Clauses1, 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), clause(Module: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))
; functor(Head, Name, Arity), atom(Name), Name \== '.' ->
( '$head_is_dynamic'(Head) -> 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))
).
retract_clause(Head, Body) :-
( var(Head) -> throw(error(instantiation_error, retract/1))
; functor(Head, Name, Arity), atom(Name), Name \== '.' ->
( '$head_is_dynamic'(Head) -> call_retract(Head, Body, Name, Arity)
( Name == (:), Arity =:= 2 ->
arg(1, Head, Module),
arg(2, Head, F),
retract_module_clause(F, Body, Module)
; '$head_is_dynamic'(Head) -> call_retract(Head, Body, Name, Arity)
; '$no_such_predicate'(Head) -> '$fail'
; throw(error(permission_error(modify, static_procedure, Name/Arity), retract/1))
)
@@ -556,8 +637,27 @@ retract(Clause) :-
; Clause = (Head :- Body) -> retract_clause(Head, Body)
).
module_abolish(Pred, Module) :-
( var(Pred) -> throw(error(instantiation_error), abolish/1)
; Pred = Name/Arity ->
( var(Name) -> throw(error(instantiation_error, abolish/1))
; integer(Arity) ->
( \+ atom(Name) -> throw(error(type_error(atom, Name), abolish/1))
; Arity < 0 -> throw(domain_error(not_less_than_zero, Arity), abolish/1)
; max_arity(N), Arity > N -> throw(representation_error(max_arity), abolish/1)
; functor(Head, Name, Arity) ->
( '$head_is_dynamic'(Head) -> '$abolish_module_clause'(Name, Arity, Module)
; 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))
).
abolish(Pred) :-
( var(Pred) -> throw(error(instantiation_error), abolish/1)
; Pred = Module:InnerPred -> module_abolish(InnerPred, Module)
; Pred = Name/Arity ->
( var(Name) -> throw(error(instantiation_error, abolish/1))
; var(Arity) -> throw(error(instantiation_error, abolish/1))
@@ -566,7 +666,7 @@ abolish(Pred) :-
; Arity < 0 -> throw(domain_error(not_less_than_zero, Arity), abolish/1)
; max_arity(N), Arity > N -> throw(representation_error(max_arity), abolish/1)
; functor(Head, Name, Arity) ->
( '$no_such_predicate'(Head) -> '$abolish_clause'(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))
)

104
src/prolog/machine/dynamic_database.rs
View File

@@ -16,7 +16,7 @@ impl Machine {
_ => self.indices.atom_tbl()
}
}
fn compile_into_machine<R: Read>(&mut self, src: R, name: ClauseName) -> EvalSession
{
match name.owning_module().as_str() {
@@ -72,6 +72,35 @@ impl Machine {
self.indices.remove_code_index((name, arity));
}
fn abolish_dynamic_clause_in_module(&mut self, name: RegType, arity: RegType, module: RegType)
{
let (name, arity) = self.get_predicate_key(name, arity);
let module_addr = self.machine_st[module].clone();
let module_name = match self.machine_st.store(self.machine_st.deref(module_addr)) {
Addr::Con(Constant::Atom(module, _)) =>
match self.indices.modules.get_mut(&module) {
Some(ref mut module) => {
module.code_dir.remove(&(name.clone(), arity));
module.module_decl.name.clone()
},
_ => {
self.machine_st.fail = true;
return;
}
},
_ => unreachable!()
};
if let Some(idx) = self.indices.code_dir.get(&(name.clone(), arity)) {
if idx.module_name() == module_name {
set_code_index!(idx, IndexPtr::Undefined, clause_name!("user"));
}
}
self.indices.remove_code_index((name, arity));
}
fn handle_eval_result_from_dynamic_compile(&mut self, pred_str: String, name: ClauseName,
src: ClauseName)
{
@@ -90,10 +119,9 @@ impl Machine {
}
}
fn recompile_dynamic_predicate(&mut self, place: DynamicAssertPlace)
fn recompile_dynamic_predicate_impl(&mut self, place: DynamicAssertPlace, name: ClauseName,
arity: usize)
{
let (name, arity) = self.get_predicate_key(temp_v!(3), temp_v!(4));
let stub = MachineError::functor_stub(place.predicate_name(), 1);
let pred_str = match self.machine_st.try_from_list(temp_v!(2), stub) {
Ok(addrs) => {
@@ -110,7 +138,44 @@ impl Machine {
self.handle_eval_result_from_dynamic_compile(pred_str, name, place.predicate_name());
}
fn retract_from_dynamic_predicate(&mut self)
fn set_module_atom_tbl(&mut self, module_addr: Addr, name: &mut ClauseName) -> bool
{
let atom_tbl = match self.machine_st.store(self.machine_st.deref(module_addr)) {
Addr::Con(Constant::Atom(module, _)) =>
match self.indices.modules.get(&module) {
Some(ref module) => module.atom_tbl.clone(),
None => {
self.machine_st.fail = true;
return false;
}
},
_ => unreachable!()
};
if let &mut ClauseName::User(ref mut rc) = name {
rc.table = atom_tbl;
}
true
}
fn recompile_dynamic_predicate_in_module(&mut self, place: DynamicAssertPlace)
{
let (mut name, arity) = self.get_predicate_key(temp_v!(3), temp_v!(4));
let module_addr = self.machine_st[temp_v!(5)].clone();
if self.set_module_atom_tbl(module_addr, &mut name) {
self.recompile_dynamic_predicate_impl(place, name, arity);
}
}
fn recompile_dynamic_predicate(&mut self, place: DynamicAssertPlace)
{
let (name, arity) = self.get_predicate_key(temp_v!(3), temp_v!(4));
self.recompile_dynamic_predicate_impl(place, name, arity);
}
fn retract_from_dynamic_predicate_in_module(&mut self)
{
let index = self.machine_st[temp_v!(3)].clone();
let index = match self.machine_st.store(self.machine_st.deref(index)) {
@@ -118,9 +183,30 @@ impl Machine {
_ => unreachable!()
};
let stub = MachineError::functor_stub(clause_name!("retract"), 1);
let (mut name, arity) = self.get_predicate_key(temp_v!(1), temp_v!(2));
let module_addr = self.machine_st[temp_v!(5)].clone();
if self.set_module_atom_tbl(module_addr, &mut name) {
self.retract_from_dynamic_predicate_impl(name, arity, index);
}
}
fn retract_from_dynamic_predicate(&mut self)
{
let index = self.machine_st[temp_v!(3)].clone();
let index = match self.machine_st.store(self.machine_st.deref(index)) {
Addr::Con(Constant::Number(Number::Integer(n))) => n.to_usize().unwrap(),
_ => unreachable!()
};
let (name, arity) = self.get_predicate_key(temp_v!(1), temp_v!(2));
self.retract_from_dynamic_predicate_impl(name, arity, index);
}
fn retract_from_dynamic_predicate_impl(&mut self, name: ClauseName, arity: usize, index: usize)
{
let stub = MachineError::functor_stub(clause_name!("retract"), 1);
let pred_str = match self.machine_st.try_from_list(temp_v!(4), stub) {
Ok(addrs) => {
let mut addrs = VecDeque::from(addrs);
@@ -148,6 +234,12 @@ impl Machine {
self.abolish_dynamic_clause(temp_v!(1), temp_v!(2)),
DynamicTransactionType::Assert(place) =>
self.recompile_dynamic_predicate(place),
DynamicTransactionType::ModuleAbolish =>
self.abolish_dynamic_clause_in_module(temp_v!(1), temp_v!(2), temp_v!(3)),
DynamicTransactionType::ModuleAssert(place) =>
self.recompile_dynamic_predicate_in_module(place),
DynamicTransactionType::ModuleRetract =>
self.retract_from_dynamic_predicate_in_module(),
DynamicTransactionType::Retract =>
self.retract_from_dynamic_predicate()
}

5
src/prolog/machine/machine_indices.rs
View File

@@ -234,6 +234,9 @@ impl DynamicAssertPlace {
pub enum DynamicTransactionType {
Abolish,
Assert(DynamicAssertPlace),
ModuleAbolish,
ModuleAssert(DynamicAssertPlace),
ModuleRetract,
Retract // dynamic index of the clause to remove.
}
@@ -421,7 +424,7 @@ impl IndexStore {
pub fn get_clause_subsection(&self, name: ClauseName, arity: usize) -> Option<DynamicPredicateInfo> {
self.dynamic_code_dir.get(&(name, arity)).cloned()
}
#[inline]
pub fn take_module(&mut self, name: ClauseName) -> Option<Module> {
self.modules.remove(&name)

66
src/prolog/machine/system_calls.rs
View File

@@ -228,6 +228,13 @@ impl MachineState {
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::AssertDynamicPredicateToFront => {
let p = self.cp;
let trans_type = DynamicTransactionType::Assert(DynamicAssertPlace::Front);
@@ -242,6 +249,20 @@ impl MachineState {
self.p = CodePtr::DynamicTransaction(trans_type, p);
return Ok(());
},
&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)].clone();
let lh_len = Addr::Con(Constant::Usize(self.lifted_heap.len()));
@@ -256,6 +277,44 @@ impl MachineState {
_ => self.fail = true
};
},
&SystemClauseType::GetModuleClause => {
let module = self[temp_v!(3)].clone();
let head = self[temp_v!(1)].clone();
let module = match self.store(self.deref(module)) {
Addr::Con(Constant::Atom(module, _)) =>
module,
_ => {
self.fail = true;
return Ok(());
}
};
let subsection = match self.store(self.deref(head)) {
Addr::Str(s) =>
match self.heap[s].clone() {
HeapCellValue::NamedStr(arity, name, ..) =>
indices.get_clause_subsection(name, arity),
_ => unreachable!()
},
Addr::Con(Constant::Atom(name, _)) =>
indices.get_clause_subsection(name, 0),
_ => unreachable!()
};
match subsection {
Some(dynamic_predicate_info) => {
if dynamic_predicate_info.module_src != module {
self.fail = true;
} else {
self.execute_at_index(2, dynamic_predicate_info.clauses_subsection_p);
}
return Ok(());
},
None => self.fail = true
}
},
&SystemClauseType::HeadIsDynamic => {
let head = self[temp_v!(1)].clone();
@@ -682,6 +741,13 @@ impl MachineState {
None => panic!("remove_inference_counter: requires \\
CWILCallPolicy.")
},
&SystemClauseType::ModuleRetractClause => {
let p = self.cp;
let trans_type = DynamicTransactionType::ModuleRetract;
self.p = CodePtr::DynamicTransaction(trans_type, p);
return Ok(());
},
&SystemClauseType::RetractClause => {
let p = self.cp;
let trans_type = DynamicTransactionType::Retract;