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

bb_put/2 and bb_get/2

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

9
src/prolog/clause_types.rs
View File

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

30
src/prolog/lib/builtins.pl
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, abolish/1, asserta/1,
assertz/1, bagof/3, call_with_inference_limit/3, catch/3,
clause/2, current_predicate/1, current_prolog_flag/2,
expand_goal/2, expand_term/2, findall/3, findall/4, once/1,
repeat/0, retract/1, set_prolog_flag/2, setof/3,
setup_call_cleanup/3, term_variables/2, throw/1, true/0,
false/0, write/1, write_canonical/1, writeq/1, write_term/2]).
assertz/1, bagof/3, bb_get/2, bb_put/2, call_cleanup/2,
call_with_inference_limit/3, catch/3, clause/2,
current_predicate/1, current_prolog_flag/2, expand_goal/2,
expand_term/2, findall/3, findall/4, once/1, repeat/0,
retract/1, set_prolog_flag/2, setof/3, setup_call_cleanup/3,
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
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) :-
'$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(G, L, R) :-
@@ -734,3 +737,18 @@ current_predicate(Pred) :-
)
; 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)).

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

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

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

@@ -215,7 +215,7 @@ impl MachineState {
pub(super) fn system_call(&mut self,
ct: &SystemClauseType,
indices: &IndexStore,
indices: &mut IndexStore,
call_policy: &mut Box<CallPolicy>,
cut_policy: &mut Box<CutPolicy>)
-> CallResult
@@ -277,6 +277,21 @@ impl MachineState {
_ => 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 => {
let module = self[temp_v!(3)].clone();
let head = self[temp_v!(1)].clone();
@@ -322,7 +337,7 @@ impl MachineState {
return Ok(());
}
};
self.fail = !match self.store(self.deref(head)) {
Addr::Str(s) =>
match self.heap[s].clone() {
@@ -333,7 +348,7 @@ impl MachineState {
Addr::Con(Constant::Atom(name, _)) =>
indices.get_clause_subsection(module, name, 0).is_some(),
_ => unreachable!()
};
};
},
&SystemClauseType::HeadIsDynamic => {
let head = self[temp_v!(1)].clone();
@@ -718,6 +733,16 @@ impl MachineState {
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 => {
let restore_default =
match call_policy.downcast_mut::<CWILCallPolicy>().ok() {
@@ -930,6 +955,18 @@ impl MachineState {
&SystemClauseType::SkipMaxList => if let Err(err) = self.skip_max_list() {
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::TermVariables => {
let a1 = self[temp_v!(1)].clone();

1
src/prolog/macros.rs
View File

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