]> Repositorios git - scryer-prolog.git/commitdiff
bb_put/2 and bb_get/2
authorMark Thom <[email protected]>
Wed, 13 Mar 2019 04:38:47 +0000 (22:38 -0600)
committerMark Thom <[email protected]>
Wed, 13 Mar 2019 04:38:47 +0000 (22:38 -0600)
src/prolog/clause_types.rs
src/prolog/lib/builtins.pl
src/prolog/machine/machine_indices.rs
src/prolog/machine/system_calls.rs
src/prolog/macros.rs

index 022ced677e9477d006eebd615ff72251441a522a..8e4ee2a6450bedf49e89aca56ff69ffed3b07655 100644 (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),
index d5d61c1a7ecb0a21be121f46894430ef61f07b50..848787b2d0259bfd5096f2dfe791e723c87900ea 100644 (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)).
index 9be8619b9c44f2007cc37c1fddc0e54ed4a64765..a540dde9a4e9aa1ac193a623f5af890b61f40f1b 100644 (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(),
index 9d4d9737eef82223eb46df521142b3c68f4d27b4..ebce8f23f1a08aedf530774507b4665d3de13349 100644 (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();
index c8f5ddf3ccbca9c0ea3ef5aef4820d257cdf71b3..e4fea309176c98b95dfd7fa0550eed9f8b18e6bf 100644 (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 }