add error value to occurs_check prolog flag (#783)

diff --git a/src/clause_types.rs b/src/clause_types.rs
index 67b3b101bda2cddd6de449a47efd382b021d559e..4d7e35d6aa098cc0772a202b229d0268a9d12d8b 100644 (file)
--- a/src/clause_types.rs
+++ b/src/clause_types.rs
@@ -307,6 +307,7 @@ pub(crate) enum SystemClauseType {
     IsSTOEnabled,
     SetSTOAsUnify,
     SetNSTOAsUnify,
+    SetSTOWithErrorAsUnify,
     HomeDirectory,
 }
 
@@ -593,6 +594,7 @@ impl SystemClauseType {
             &SystemClauseType::SetSTOAsUnify => clause_name!("$set_sto_as_unify"),
             &SystemClauseType::SetNSTOAsUnify => clause_name!("$set_nsto_as_unify"),
             &SystemClauseType::HomeDirectory => clause_name!("$home_directory"),
+            &SystemClauseType::SetSTOWithErrorAsUnify => clause_name!("$set_sto_with_error_as_unify"),
         }
     }
 
@@ -839,6 +841,7 @@ impl SystemClauseType {
             ("$is_sto_enabled", 1) => Some(SystemClauseType::IsSTOEnabled),
             ("$set_sto_as_unify", 0) => Some(SystemClauseType::SetSTOAsUnify),
             ("$set_nsto_as_unify", 0) => Some(SystemClauseType::SetNSTOAsUnify),
+            ("$set_sto_with_error_as_unify", 0) => Some(SystemClauseType::SetSTOWithErrorAsUnify),
             ("$home_directory", 1) => Some(SystemClauseType::HomeDirectory),
             _ => None,
         }

diff --git a/src/lib/builtins.pl b/src/lib/builtins.pl
index 3c9a380e8b10a6aa9e14a1468dbc4d9a8c07707c..ae727d4b427c954fb59cdefd44f3cfdc95b13d9c 100644 (file)
--- a/src/lib/builtins.pl
+++ b/src/lib/builtins.pl
@@ -171,6 +171,8 @@ set_prolog_flag(occurs_check, true) :-
     !, '$set_sto_as_unify'.
 set_prolog_flag(occurs_check, false) :-
     !, '$set_nsto_as_unify'.
+set_prolog_flag(occurs_check, error) :-
+    !, '$set_sto_with_error_as_unify'.
 set_prolog_flag(double_quotes, Value) :-
     throw(error(domain_error(flag_value, double_quotes + Value),
                        set_prolog_flag/2)). % 8.17.1.3 e

diff --git a/src/machine/machine_errors.rs b/src/machine/machine_errors.rs
index 8175d2613ff5c01afbe5dabf5c68ad9a48dc1c72..fbfb1bcf57eaa19406c93af748b402156cafe759 100644 (file)
--- a/src/machine/machine_errors.rs
+++ b/src/machine/machine_errors.rs
@@ -596,7 +596,8 @@ pub(crate) enum RepFlag {
     InCharacterCode,
     MaxArity,
     //    MaxInteger,
-    //    MinInteger
+    //    MinInteger,
+    Term,
 }
 
 impl RepFlag {
@@ -606,6 +607,7 @@ impl RepFlag {
             RepFlag::CharacterCode => "character_code",
             RepFlag::InCharacterCode => "in_character_code",
             RepFlag::MaxArity => "max_arity",
+            RepFlag::Term => "term",
             //            RepFlag::MaxInteger => "max_integer",
             //            RepFlag::MinInteger => "min_integer"
         }

diff --git a/src/machine/machine_state.rs b/src/machine/machine_state.rs
index b94de736220a74c3bb1db44a517751baa42dce5f..77a0d36844ecd316d91ec1cf8dd3cb513bbb0bd1 100644 (file)
--- a/src/machine/machine_state.rs
+++ b/src/machine/machine_state.rs
@@ -336,9 +336,13 @@ impl fmt::Debug for MachineState {
          .field("global_clock", &self.global_clock)
          .field("dynamic_mode", &self.dynamic_mode)
          .field("unify_fn",
-                if self.unify_fn as usize == MachineState::unify as usize
-                { &"MachineState::unify" }
-                else { &"MachineState::unify_with_occurs_check" })
+                if self.unify_fn as usize == MachineState::unify as usize {
+                    &"MachineState::unify"
+                } else if self.unify_fn as usize == MachineState::unify_with_occurs_check as usize {
+                    &"MachineState::unify_with_occurs_check"
+                } else {
+                    &"MachineState::unify_with_occurs_check_with_error"
+                })
          .finish()
     }
 }

diff --git a/src/machine/machine_state_impl.rs b/src/machine/machine_state_impl.rs
index efb0e6a92c1e907be81ec198dd39d0be84a4e2ce..b44863663e94b260e71347ab00085f049103c0c6 100644 (file)
--- a/src/machine/machine_state_impl.rs
+++ b/src/machine/machine_state_impl.rs
@@ -153,31 +153,58 @@ impl MachineState {
         }
     }
 
-    fn bind_with_occurs_check(&mut self, r: Ref, addr: Addr) {
+    #[inline]
+    fn bind_with_occurs_check(&mut self, r: Ref, addr: Addr) -> bool {
         if let Ref::StackCell(..) = r {
             // local variable optimization -- r cannot occur in the
             // data structure bound to addr, so don't bother
             // traversing it.
             self.bind(r, addr);
-            return;
+            return false;
         }
 
-        let mut fail = false;
+        let mut occurs_triggered = false;
 
         for addr in self.acyclic_pre_order_iter(addr) {
             if let Some(inner_r) = addr.as_var() {
                 if r == inner_r {
-                    fail = true;
+                    occurs_triggered = true;
                     break;
                 }
             }
         }
 
-        self.fail = fail;
+        self.fail = occurs_triggered;
         self.bind(r, addr);
+
+        return occurs_triggered;
+    }
+
+    pub(super) fn unify_with_occurs_check_with_error(&mut self, a1: Addr, a2: Addr) {
+        let mut throw_error = false;
+        self.unify_with_occurs_check_loop(a1, a2, || throw_error = true);
+
+        if throw_error {
+            let err = self.representation_error(
+                RepFlag::Term,
+                clause_name!("unify_with_occurs_check"),
+                2,
+            );
+
+            self.throw_exception(err);
+        }
     }
 
     pub(super) fn unify_with_occurs_check(&mut self, a1: Addr, a2: Addr) {
+        self.unify_with_occurs_check_loop(a1, a2, || {})
+    }
+
+    pub(super) fn unify_with_occurs_check_loop(
+        &mut self,
+        a1: Addr,
+        a2: Addr,
+        mut occurs_trigger: impl FnMut()
+    ) {
         let mut pdl = vec![a1, a2];
         let mut tabu_list: IndexSet<(Addr, Addr)> = IndexSet::new();
 
@@ -199,13 +226,19 @@ impl MachineState {
 
                 match (d1, d2) {
                     (Addr::AttrVar(h), addr) | (addr, Addr::AttrVar(h)) => {
-                        self.bind_with_occurs_check(Ref::AttrVar(h), addr)
+                        if self.bind_with_occurs_check(Ref::AttrVar(h), addr) {
+                            occurs_trigger();
+                        }
                     }
                     (Addr::HeapCell(h), addr) | (addr, Addr::HeapCell(h)) => {
-                        self.bind_with_occurs_check(Ref::HeapCell(h), addr)
+                        if self.bind_with_occurs_check(Ref::HeapCell(h), addr) {
+                            occurs_trigger();
+                        }
                     }
                     (Addr::StackCell(fr, sc), addr) | (addr, Addr::StackCell(fr, sc)) => {
-                        self.bind_with_occurs_check(Ref::StackCell(fr, sc), addr)
+                        if self.bind_with_occurs_check(Ref::StackCell(fr, sc), addr) {
+                            occurs_trigger();
+                        }
                     }
                     (Addr::Lis(a1), Addr::Str(a2)) | (Addr::Str(a2), Addr::Lis(a1)) => {
                         if let &HeapCellValue::NamedStr(n2, ref f2, _) = &self.heap[a2] {

diff --git a/src/machine/system_calls.rs b/src/machine/system_calls.rs
index a37e4efee0cf8c06633e3e1680b8272f17d903eb..6793c0859085e061e06056e69bb6d6de00d557f8 100644 (file)
--- a/src/machine/system_calls.rs
+++ b/src/machine/system_calls.rs
@@ -5439,6 +5439,12 @@ impl MachineState {
                         HeapCellValue::Atom(clause_name!("true"), None),
                     );
 
+                    (self.unify_fn)(self, self[temp_v!(1)], value);
+                } else if self.unify_fn as usize == MachineState::unify_with_occurs_check_with_error as usize {
+                    let value = self.heap.to_unifiable(
+                        HeapCellValue::Atom(clause_name!("error"), None),
+                    );
+
                     (self.unify_fn)(self, self[temp_v!(1)], value);
                 } else {
                     let value = self.heap.to_unifiable(
@@ -5454,6 +5460,9 @@ impl MachineState {
             &SystemClauseType::SetNSTOAsUnify => {
                 self.unify_fn = MachineState::unify;
             }
+            &SystemClauseType::SetSTOWithErrorAsUnify => {
+                self.unify_fn = MachineState::unify_with_occurs_check_with_error;
+            }
             &SystemClauseType::HomeDirectory => {
                 let path = match dirs_next::home_dir() {
                     Some(path) => path,