rishi/scryer-prolog
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add error value to occurs_check prolog flag (#783)

Browse Source
This commit is contained in:
Mark Thom
2021-02-28 11:44:07 -07:00
parent 81ecd17b93
commit 101ed9a633
6 changed files with 65 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
src/clause_types.rs
View File

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

2
src/lib/builtins.pl
View File

@@ -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

4
src/machine/machine_errors.rs
View File

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

10
src/machine/machine_state.rs
View File

@@ -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()
}
}

49
src/machine/machine_state_impl.rs
View File

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

9
src/machine/system_calls.rs
View File

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