From: Mark Thom Date: Sun, 28 Feb 2021 18:44:07 +0000 (-0700) Subject: add error value to occurs_check prolog flag (#783) X-Git-Tag: v0.9.0~150^2~6 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=101ed9a633e51356ff808a50a9f1497be1af3d2b;p=scryer-prolog.git add error value to occurs_check prolog flag (#783) --- diff --git a/src/clause_types.rs b/src/clause_types.rs index 67b3b101..4d7e35d6 100644 --- 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 3c9a380e..ae727d4b 100644 --- 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 8175d261..fbfb1bcf 100644 --- 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 b94de736..77a0d368 100644 --- 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 efb0e6a9..b4486366 100644 --- 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 a37e4efe..6793c085 100644 --- 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,