bb_put/2 and bb_get/2

This commit is contained in:
Mark Thom
2019-03-12 22:38:47 -06:00
parent b5ad8051d8
commit 527ac606e9
5 changed files with 79 additions and 10 deletions

View File

@@ -150,6 +150,7 @@ pub enum SystemClauseType {
EnqueueAttributedVar, EnqueueAttributedVar,
ExpandGoal, ExpandGoal,
ExpandTerm, ExpandTerm,
FetchGlobalVar,
TruncateIfNoLiftedHeapGrowthDiff, TruncateIfNoLiftedHeapGrowthDiff,
TruncateIfNoLiftedHeapGrowth, TruncateIfNoLiftedHeapGrowth,
GetAttributedVariableList, GetAttributedVariableList,
@@ -173,9 +174,11 @@ pub enum SystemClauseType {
RedoAttrVarBindings, RedoAttrVarBindings,
RemoveCallPolicyCheck, RemoveCallPolicyCheck,
RemoveInferenceCounter, RemoveInferenceCounter,
ResetGlobalVarAtKey,
RetractClause, RetractClause,
RestoreCutPolicy, RestoreCutPolicy,
SetCutPoint(RegType), SetCutPoint(RegType),
StoreGlobalVar,
InferenceLevel, InferenceLevel,
CleanUpBlock, CleanUpBlock,
EraseBall, EraseBall,
@@ -217,6 +220,7 @@ impl SystemClauseType {
&SystemClauseType::EnqueueAttributedVar => clause_name!("$enqueue_attr_var"), &SystemClauseType::EnqueueAttributedVar => clause_name!("$enqueue_attr_var"),
&SystemClauseType::ExpandTerm => clause_name!("$expand_term"), &SystemClauseType::ExpandTerm => clause_name!("$expand_term"),
&SystemClauseType::ExpandGoal => clause_name!("$expand_goal"), &SystemClauseType::ExpandGoal => clause_name!("$expand_goal"),
&SystemClauseType::FetchGlobalVar => clause_name!("$fetch_global_var"),
&SystemClauseType::TruncateIfNoLiftedHeapGrowth => clause_name!("$truncate_if_no_lh_growth"), &SystemClauseType::TruncateIfNoLiftedHeapGrowth => clause_name!("$truncate_if_no_lh_growth"),
&SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff => clause_name!("$truncate_if_no_lh_growth_diff"), &SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff => clause_name!("$truncate_if_no_lh_growth_diff"),
&SystemClauseType::GetAttributedVariableList => clause_name!("$get_attr_list"), &SystemClauseType::GetAttributedVariableList => clause_name!("$get_attr_list"),
@@ -242,6 +246,7 @@ impl SystemClauseType {
&SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"), &SystemClauseType::RemoveInferenceCounter => clause_name!("$remove_inference_counter"),
&SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"), &SystemClauseType::RestoreCutPolicy => clause_name!("$restore_cut_policy"),
&SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"), &SystemClauseType::SetCutPoint(_) => clause_name!("$set_cp"),
&SystemClauseType::StoreGlobalVar => clause_name!("$store_global_var"),
&SystemClauseType::InferenceLevel => clause_name!("$inference_level"), &SystemClauseType::InferenceLevel => clause_name!("$inference_level"),
&SystemClauseType::CleanUpBlock => clause_name!("$clean_up_block"), &SystemClauseType::CleanUpBlock => clause_name!("$clean_up_block"),
&SystemClauseType::EraseBall => clause_name!("$erase_ball"), &SystemClauseType::EraseBall => clause_name!("$erase_ball"),
@@ -251,6 +256,7 @@ impl SystemClauseType {
&SystemClauseType::GetCurrentBlock => clause_name!("$get_current_block"), &SystemClauseType::GetCurrentBlock => clause_name!("$get_current_block"),
&SystemClauseType::InstallNewBlock => clause_name!("$install_new_block"), &SystemClauseType::InstallNewBlock => clause_name!("$install_new_block"),
&SystemClauseType::ModuleRetractClause => clause_name!("$module_retract_clause"), &SystemClauseType::ModuleRetractClause => clause_name!("$module_retract_clause"),
&SystemClauseType::ResetGlobalVarAtKey => clause_name!("$reset_global_var_at_key"),
&SystemClauseType::RetractClause => clause_name!("$retract_clause"), &SystemClauseType::RetractClause => clause_name!("$retract_clause"),
&SystemClauseType::ResetBlock => clause_name!("$reset_block"), &SystemClauseType::ResetBlock => clause_name!("$reset_block"),
&SystemClauseType::ReturnFromAttributeGoals => clause_name!("$return_from_attribute_goals"), &SystemClauseType::ReturnFromAttributeGoals => clause_name!("$return_from_attribute_goals"),
@@ -284,6 +290,7 @@ impl SystemClauseType {
("$enqueue_attr_var", 1) => Some(SystemClauseType::EnqueueAttributedVar), ("$enqueue_attr_var", 1) => Some(SystemClauseType::EnqueueAttributedVar),
("$expand_term", 2) => Some(SystemClauseType::ExpandTerm), ("$expand_term", 2) => Some(SystemClauseType::ExpandTerm),
("$expand_goal", 2) => Some(SystemClauseType::ExpandGoal), ("$expand_goal", 2) => Some(SystemClauseType::ExpandGoal),
("$fetch_global_var", 2) => Some(SystemClauseType::FetchGlobalVar),
("$truncate_if_no_lh_growth", 1) => Some(SystemClauseType::TruncateIfNoLiftedHeapGrowth), ("$truncate_if_no_lh_growth", 1) => Some(SystemClauseType::TruncateIfNoLiftedHeapGrowth),
("$truncate_if_no_lh_growth_diff", 2) => Some(SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff), ("$truncate_if_no_lh_growth_diff", 2) => Some(SystemClauseType::TruncateIfNoLiftedHeapGrowthDiff),
("$get_attr_list", 2) => Some(SystemClauseType::GetAttributedVariableList), ("$get_attr_list", 2) => Some(SystemClauseType::GetAttributedVariableList),
@@ -319,6 +326,7 @@ impl SystemClauseType {
("$get_cp", 1) => Some(SystemClauseType::GetCutPoint), ("$get_cp", 1) => Some(SystemClauseType::GetCutPoint),
("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock), ("$install_new_block", 1) => Some(SystemClauseType::InstallNewBlock),
("$reset_block", 1) => Some(SystemClauseType::ResetBlock), ("$reset_block", 1) => Some(SystemClauseType::ResetBlock),
("$reset_global_var_at_key", 1) => Some(SystemClauseType::ResetGlobalVarAtKey),
("$retract_clause", 4) => Some(SystemClauseType::RetractClause), ("$retract_clause", 4) => Some(SystemClauseType::RetractClause),
("$return_from_attribute_goals", 0) => Some(SystemClauseType::ReturnFromAttributeGoals), ("$return_from_attribute_goals", 0) => Some(SystemClauseType::ReturnFromAttributeGoals),
("$return_from_verify_attr", 0) => Some(SystemClauseType::ReturnFromVerifyAttr), ("$return_from_verify_attr", 0) => Some(SystemClauseType::ReturnFromVerifyAttr),
@@ -326,6 +334,7 @@ impl SystemClauseType {
("$set_cp_by_default", 1) => Some(SystemClauseType::SetCutPointByDefault(temp_v!(1))), ("$set_cp_by_default", 1) => Some(SystemClauseType::SetCutPointByDefault(temp_v!(1))),
("$set_double_quotes", 1) => Some(SystemClauseType::SetDoubleQuotes), ("$set_double_quotes", 1) => Some(SystemClauseType::SetDoubleQuotes),
("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList), ("$skip_max_list", 4) => Some(SystemClauseType::SkipMaxList),
("$store_global_var", 2) => Some(SystemClauseType::StoreGlobalVar),
("$term_variables", 2) => Some(SystemClauseType::TermVariables), ("$term_variables", 2) => Some(SystemClauseType::TermVariables),
("$truncate_lh_to", 1) => Some(SystemClauseType::TruncateLiftedHeapTo), ("$truncate_lh_to", 1) => Some(SystemClauseType::TruncateLiftedHeapTo),
("$unwind_stack", 0) => Some(SystemClauseType::UnwindStack), ("$unwind_stack", 0) => Some(SystemClauseType::UnwindStack),

View File

@@ -6,12 +6,13 @@
(>)/2, (<)/2, (=\=)/2, (=:=)/2, (>=)/2, (=<)/2, (,)/2, (->)/2, (>)/2, (<)/2, (=\=)/2, (=:=)/2, (>=)/2, (=<)/2, (,)/2, (->)/2,
(;)/2, (=..)/2, (==)/2, (\==)/2, (@=<)/2, (@>=)/2, (@<)/2, (;)/2, (=..)/2, (==)/2, (\==)/2, (@=<)/2, (@>=)/2, (@<)/2,
(@>)/2, (=@=)/2, (\=@=)/2, (:)/2, abolish/1, asserta/1, (@>)/2, (=@=)/2, (\=@=)/2, (:)/2, abolish/1, asserta/1,
assertz/1, bagof/3, call_with_inference_limit/3, catch/3, assertz/1, bagof/3, bb_get/2, bb_put/2, call_cleanup/2,
clause/2, current_predicate/1, current_prolog_flag/2, call_with_inference_limit/3, catch/3, clause/2,
expand_goal/2, expand_term/2, findall/3, findall/4, once/1, current_predicate/1, current_prolog_flag/2, expand_goal/2,
repeat/0, retract/1, set_prolog_flag/2, setof/3, expand_term/2, findall/3, findall/4, once/1, repeat/0,
setup_call_cleanup/3, term_variables/2, throw/1, true/0, retract/1, set_prolog_flag/2, setof/3, setup_call_cleanup/3,
false/0, write/1, write_canonical/1, writeq/1, write_term/2]). term_variables/2, throw/1, true/0, false/0, write/1,
write_canonical/1, writeq/1, write_term/2]).
/* this is an implementation specific declarative operator used to implement call_with_inference_limit/3 /* this is an implementation specific declarative operator used to implement call_with_inference_limit/3
and setup_call_cleanup/3. switches to the default trust_me and retry_me_else. Indexing choice and setup_call_cleanup/3. switches to the default trust_me and retry_me_else. Indexing choice
@@ -299,6 +300,8 @@ run_cleaners_without_handling(Cp) :-
run_cleaners_without_handling(Cp) :- run_cleaners_without_handling(Cp) :-
'$set_cp_by_default'(Cp), '$restore_cut_policy'. '$set_cp_by_default'(Cp), '$restore_cut_policy'.
call_cleanup(G, C) :- setup_call_cleanup(true, G, C).
% call_with_inference_limit % call_with_inference_limit
call_with_inference_limit(G, L, R) :- call_with_inference_limit(G, L, R) :-
@@ -734,3 +737,18 @@ current_predicate(Pred) :-
) )
; throw(error(type_error(predicate_indicator, Pred), current_predicate/1)) ; throw(error(type_error(predicate_indicator, Pred), current_predicate/1))
). ).
bb_put(Key, Value) :- bb_put(Key, _, Value).
store_global_var(Key, Value) :- '$store_global_var'(Key, Value).
reset_global_var_at_key(Key) :- '$reset_global_var_at_key'(Key).
bb_put(Key, OldValue, NewValue) :-
( bb_get(Key, OldValue) ->
call_cleanup((store_global_var(Key, NewValue) ; false), store_global_var(Key, OldValue))
; call_cleanup((store_global_var(Key, NewValue) ; false), reset_global_var_at_key(Key))
).
bb_get(Key, Value) :- atom(Key), !, '$fetch_global_var'(Key, Value).
bb_get(Key, _) :- throw(error(type_error(atom, Key), bb_get/2)).

View File

@@ -390,13 +390,16 @@ pub type InSituCodeDir = HashMap<PredicateKey, usize>;
// key type: module name, predicate indicator. // key type: module name, predicate indicator.
pub type DynamicCodeDir = HashMap<(ClauseName, ClauseName, usize), DynamicPredicateInfo>; pub type DynamicCodeDir = HashMap<(ClauseName, ClauseName, usize), DynamicPredicateInfo>;
pub type GlobalVarDir = HashMap<ClauseName, Addr>;
pub struct IndexStore { pub struct IndexStore {
pub(super) atom_tbl: TabledData<Atom>, pub(super) atom_tbl: TabledData<Atom>,
pub(super) code_dir: CodeDir, pub(super) code_dir: CodeDir,
pub(super) dynamic_code_dir: DynamicCodeDir, pub(super) dynamic_code_dir: DynamicCodeDir,
pub(super) global_variables: GlobalVarDir,
pub(super) in_situ_code_dir: InSituCodeDir, pub(super) in_situ_code_dir: InSituCodeDir,
pub(super) op_dir: OpDir,
pub(super) modules: ModuleDir, pub(super) modules: ModuleDir,
pub(super) op_dir: OpDir,
} }
impl IndexStore { impl IndexStore {
@@ -455,6 +458,7 @@ impl IndexStore {
atom_tbl: TabledData::new(Rc::new("user".to_string())), atom_tbl: TabledData::new(Rc::new("user".to_string())),
code_dir: CodeDir::new(), code_dir: CodeDir::new(),
dynamic_code_dir: DynamicCodeDir::new(), dynamic_code_dir: DynamicCodeDir::new(),
global_variables: GlobalVarDir::new(),
in_situ_code_dir: InSituCodeDir::new(), in_situ_code_dir: InSituCodeDir::new(),
op_dir: default_op_dir(), op_dir: default_op_dir(),
modules: ModuleDir::new(), modules: ModuleDir::new(),

View File

@@ -215,7 +215,7 @@ impl MachineState {
pub(super) fn system_call(&mut self, pub(super) fn system_call(&mut self,
ct: &SystemClauseType, ct: &SystemClauseType,
indices: &IndexStore, indices: &mut IndexStore,
call_policy: &mut Box<CallPolicy>, call_policy: &mut Box<CallPolicy>,
cut_policy: &mut Box<CutPolicy>) cut_policy: &mut Box<CutPolicy>)
-> CallResult -> CallResult
@@ -277,6 +277,21 @@ impl MachineState {
_ => self.fail = true _ => self.fail = true
}; };
}, },
&SystemClauseType::FetchGlobalVar => {
let key = self[temp_v!(1)].clone();
let key = match self.store(self.deref(key)) {
Addr::Con(Constant::Atom(atom, _)) => atom,
_ => unreachable!()
};
let addr = self[temp_v!(2)].clone();
match indices.global_variables.get(&key).cloned() {
Some(sought_addr) => self.unify(addr, sought_addr),
None => self.fail = true
};
},
&SystemClauseType::GetModuleClause => { &SystemClauseType::GetModuleClause => {
let module = self[temp_v!(3)].clone(); let module = self[temp_v!(3)].clone();
let head = self[temp_v!(1)].clone(); let head = self[temp_v!(1)].clone();
@@ -322,7 +337,7 @@ impl MachineState {
return Ok(()); return Ok(());
} }
}; };
self.fail = !match self.store(self.deref(head)) { self.fail = !match self.store(self.deref(head)) {
Addr::Str(s) => Addr::Str(s) =>
match self.heap[s].clone() { match self.heap[s].clone() {
@@ -333,7 +348,7 @@ impl MachineState {
Addr::Con(Constant::Atom(name, _)) => Addr::Con(Constant::Atom(name, _)) =>
indices.get_clause_subsection(module, name, 0).is_some(), indices.get_clause_subsection(module, name, 0).is_some(),
_ => unreachable!() _ => unreachable!()
}; };
}, },
&SystemClauseType::HeadIsDynamic => { &SystemClauseType::HeadIsDynamic => {
let head = self[temp_v!(1)].clone(); let head = self[temp_v!(1)].clone();
@@ -718,6 +733,16 @@ impl MachineState {
self.heap[h] = HeapCellValue::Addr(addr); self.heap[h] = HeapCellValue::Addr(addr);
} }
}, },
&SystemClauseType::ResetGlobalVarAtKey => {
let key = self[temp_v!(1)].clone();
let key = match self.store(self.deref(key)) {
Addr::Con(Constant::Atom(atom, _)) => atom,
_ => unreachable!()
};
indices.global_variables.remove(&key);
},
&SystemClauseType::RemoveCallPolicyCheck => { &SystemClauseType::RemoveCallPolicyCheck => {
let restore_default = let restore_default =
match call_policy.downcast_mut::<CWILCallPolicy>().ok() { match call_policy.downcast_mut::<CWILCallPolicy>().ok() {
@@ -930,6 +955,18 @@ impl MachineState {
&SystemClauseType::SkipMaxList => if let Err(err) = self.skip_max_list() { &SystemClauseType::SkipMaxList => if let Err(err) = self.skip_max_list() {
return Err(err); return Err(err);
}, },
&SystemClauseType::StoreGlobalVar => {
let key = self[temp_v!(1)].clone();
let key = match self.store(self.deref(key)) {
Addr::Con(Constant::Atom(atom, _)) => atom,
_ => unreachable!()
};
let value = self[temp_v!(2)].clone();
indices.global_variables.insert(key, value);
}
&SystemClauseType::Succeed => {}, &SystemClauseType::Succeed => {},
&SystemClauseType::TermVariables => { &SystemClauseType::TermVariables => {
let a1 = self[temp_v!(1)].clone(); let a1 = self[temp_v!(1)].clone();

View File

@@ -214,6 +214,7 @@ macro_rules! index_store {
IndexStore { atom_tbl: $atom_tbl, IndexStore { atom_tbl: $atom_tbl,
code_dir: $code_dir, code_dir: $code_dir,
dynamic_code_dir: DynamicCodeDir::new(), dynamic_code_dir: DynamicCodeDir::new(),
global_variables: GlobalVarDir::new(),
in_situ_code_dir: InSituCodeDir::new(), in_situ_code_dir: InSituCodeDir::new(),
op_dir: $op_dir, op_dir: $op_dir,
modules: $modules } modules: $modules }