From: Mark Thom <markjordanthom@gmail.com>
Date: Tue, 23 Mar 2021 04:05:03 +0000 (-0600)
Subject: use occurs check when enabled in UnifyValue (#885)
X-Git-Tag: v0.9.0~108
X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=7520fe70000e73f83a31b4804d2ca89e6d2cc051;p=scryer-prolog.git

use occurs check when enabled in UnifyValue (#885)
---

diff --git a/src/clause_types.rs b/src/clause_types.rs
index 51894bed..cf327707 100644
--- a/src/clause_types.rs
+++ b/src/clause_types.rs
@@ -306,6 +306,7 @@ pub(crate) enum SystemClauseType {
     SetNSTOAsUnify,
     SetSTOWithErrorAsUnify,
     HomeDirectory,
+    DebugHook,
 }
 
 impl SystemClauseType {
@@ -592,6 +593,7 @@ impl SystemClauseType {
             &SystemClauseType::SetNSTOAsUnify => clause_name!("$set_nsto_as_unify"),
             &SystemClauseType::HomeDirectory => clause_name!("$home_directory"),
             &SystemClauseType::SetSTOWithErrorAsUnify => clause_name!("$set_sto_with_error_as_unify"),
+            &SystemClauseType::DebugHook => clause_name!("$debug_hook"),
         }
     }
 
@@ -840,6 +842,7 @@ impl SystemClauseType {
             ("$set_nsto_as_unify", 0) => Some(SystemClauseType::SetNSTOAsUnify),
             ("$set_sto_with_error_as_unify", 0) => Some(SystemClauseType::SetSTOWithErrorAsUnify),
             ("$home_directory", 1) => Some(SystemClauseType::HomeDirectory),
+            ("$debug_hook", 0) => Some(SystemClauseType::DebugHook),
             _ => None,
         }
     }
diff --git a/src/machine/machine_state_impl.rs b/src/machine/machine_state_impl.rs
index 59352308..a6539ee2 100644
--- a/src/machine/machine_state_impl.rs
+++ b/src/machine/machine_state_impl.rs
@@ -1327,8 +1327,21 @@ impl MachineState {
                         self.increment_s_ptr(1);
                     }
                     MachineMode::Write => {
-                        let heap_val = self.store(self[reg]);
-                        self.heap.push(HeapCellValue::Addr(heap_val));
+                        let h = self.heap.h();
+                        self.heap.push(HeapCellValue::Addr(Addr::HeapCell(h)));
+
+                        let addr = self.store(self[reg]);
+                        (self.bind_fn)(self, Ref::HeapCell(h), addr);
+
+                        // the former code of this match arm was:
+
+                        // let addr = self.store(self[reg]);
+                        // self.heap.push(HeapCellValue::Addr(addr));
+
+                        // the old code didn't perform the occurs
+                        // check when enabled and so it was changed to
+                        // the above, which is only slightly less
+                        // efficient when the occurs_check is disabled.
                     }
                 };
             }
diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs
index 33cff953..082a3e16 100644
--- a/src/machine/system_calls.rs
+++ b/src/machine/system_calls.rs
@@ -3541,62 +3541,6 @@ impl MachineState {
                     }
                 }
             }
-            /*
-            &SystemClauseType::ResetGlobalVarAtKey => {
-                let key = self[temp_v!(1)];
-
-                match self.store(self.deref(key)) {
-                    Addr::Con(h) if self.heap.atom_at(h) => {
-                        if let HeapCellValue::Atom(ref key, _) = &self.heap[h] {
-                            indices.global_variables.swap_remove(key);
-                        } else {
-                            unreachable!()
-                        }
-                    }
-                    _ => {
-                        unreachable!()
-                    }
-                }
-            }
-            &SystemClauseType::ResetGlobalVarAtOffset => {
-                let key = self[temp_v!(1)];
-
-                let key = match self.store(self.deref(key)) {
-                    Addr::Con(h) if self.heap.atom_at(h) => {
-                        if let HeapCellValue::Atom(ref key, _) = &self.heap[h] {
-                            key.clone()
-                        } else {
-                            unreachable!()
-                        }
-                    }
-                    _ => {
-                        unreachable!()
-                    }
-                };
-
-                let value = self[temp_v!(2)];
-                let mut ball = Ball::new();
-
-                ball.boundary = self.heap.h();
-
-                copy_term(
-                    CopyBallTerm::new(&mut self.stack, &mut self.heap, &mut ball.stub),
-                    value,
-                    AttrVarPolicy::DeepCopy,
-                );
-
-                let offset = self[temp_v!(3)];
-
-                match self.store(self.deref(offset)) {
-                    Addr::Usize(offset) => {
-                        indices.global_variables.insert(key, (ball, Some(offset)));
-                    }
-                    _ => {
-                        indices.global_variables.insert(key, (ball, None));
-                    }
-                }
-            }
-            */
             &SystemClauseType::ResetAttrVarState => {
                 self.attr_var_init.reset();
             }
@@ -3658,22 +3602,6 @@ impl MachineState {
             &SystemClauseType::REPL(repl_code_ptr) => {
                 return self.repl_redirect(repl_code_ptr);
             }
-            /*
-            &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;
-
-                self.p = CodePtr::DynamicTransaction(trans_type, p);
-                return Ok(());
-            }
-            */
             &SystemClauseType::ReturnFromVerifyAttr => {
                 let e = self.e;
                 let frame_len = self.stack.index_and_frame(e).prelude.univ_prelude.num_cells;
@@ -5483,6 +5411,9 @@ impl MachineState {
 
                 self.fail = true;
             }
+            &SystemClauseType::DebugHook => {
+                self.fail = false;
+            }
         };
 
         return_from_clause!(self.last_call, self)
diff --git a/src/toplevel.pl b/src/toplevel.pl
index 27c76d20..a41af819 100644
--- a/src/toplevel.pl
+++ b/src/toplevel.pl
@@ -163,7 +163,7 @@ instruction_match(Term, VarList) :-
 
 submit_query_and_print_results_(Term, VarList) :-
     '$get_b_value'(B),
-    call(Term),
+    '$call'(Term),
     write_eqs_and_read_input(B, VarList),
     !.
 submit_query_and_print_results_(_, _) :-
@@ -174,7 +174,7 @@ submit_query_and_print_results_(_, _) :-
 
 
 submit_query_and_print_results(Term0, VarList) :-
-    expand_goal(call(Term0), user, Term),
+    expand_goal(call(Term0), user, call(Term)),
     !,
     setup_call_cleanup(bb_put('$first_answer', true),
                        submit_query_and_print_results_(Term, VarList),