add error value to occurs_check prolog flag (#783)

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,
         }

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

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"
         }

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
+                if self.unify_fn as usize == MachineState::unify as usize {
-                { &"MachineState::unify" }
+                    &"MachineState::unify"
-                else { &"MachineState::unify_with_occurs_check" })
+                } 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()
     }
 }

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] {

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,