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

fix errors emitted by sort and keysort, add tests, add support for Max = -1 to '$skip_max_list'

Browse Source
This commit is contained in:
Mark Thom
2018-05-03 20:15:45 -06:00
parent 29356fbc3b
commit 11800532c9
4 changed files with 285 additions and 94 deletions
Download Patch File Download Diff File Expand all files Collapse all files

49
src/prolog/machine/machine_errors.rs
View File

@@ -6,6 +6,7 @@ use prolog::num::bigint::BigInt;
use std::rc::Rc; use std::rc::Rc;
pub(super) type MachineError = Vec<HeapCellValue>; pub(super) type MachineError = Vec<HeapCellValue>;
pub(super) type MachineStub = Vec<HeapCellValue>;
// used by '$skip_max_list'. // used by '$skip_max_list'.
pub(super) enum CycleSearchResult { pub(super) enum CycleSearchResult {
@@ -19,28 +20,31 @@ pub(super) enum CycleSearchResult {
impl MachineState { impl MachineState {
// see 8.4.3 of Draft Technical Corrigendum 2. // see 8.4.3 of Draft Technical Corrigendum 2.
pub(super) fn check_sort_errors(&self) -> Result<(), MachineError> { pub(super) fn check_sort_errors(&self) -> Result<(), MachineError> {
let stub = self.functor_stub(clause_name!("sort"), 2);
let list = self.store(self.deref(self[temp_v!(1)].clone())); let list = self.store(self.deref(self[temp_v!(1)].clone()));
let sorted = self.store(self.deref(self[temp_v!(2)].clone())); let sorted = self.store(self.deref(self[temp_v!(2)].clone()));
match self.detect_cycles(usize::max_value(), list.clone()) { match self.detect_cycles(list.clone()) {
CycleSearchResult::PartialList(..) => CycleSearchResult::PartialList(..) =>
Err(self.error_form(self.instantiation_error())), Err(self.error_form(self.instantiation_error(), stub.clone())),
CycleSearchResult::NotList => CycleSearchResult::NotList =>
Err(self.error_form(self.type_error(ValidType::List, list))), Err(self.error_form(self.type_error(ValidType::List, list), stub.clone())),
_ => Ok(()) _ => Ok(())
}?; }?;
match self.detect_cycles(usize::max_value(), sorted.clone()) { match self.detect_cycles(sorted.clone()) {
CycleSearchResult::NotList if !sorted.is_ref() => CycleSearchResult::NotList if !sorted.is_ref() =>
Err(self.error_form(self.type_error(ValidType::List, sorted))), Err(self.error_form(self.type_error(ValidType::List, sorted), stub)),
_ => Ok(()) _ => Ok(())
} }
} }
fn check_for_list_pairs(&self, list: Addr) -> Result<(), MachineError> { fn check_for_list_pairs(&self, list: Addr) -> Result<(), MachineError> {
match self.detect_cycles(usize::max_value(), list.clone()) { let stub = self.functor_stub(clause_name!("keysort"), 2);
match self.detect_cycles(list.clone()) {
CycleSearchResult::NotList if !list.is_ref() => CycleSearchResult::NotList if !list.is_ref() =>
Err(self.error_form(self.type_error(ValidType::List, list))), Err(self.error_form(self.type_error(ValidType::List, list), stub)),
_ => { _ => {
let mut addr = list; let mut addr = list;
@@ -55,7 +59,8 @@ impl MachineState {
HeapCellValue::Addr(Addr::HeapCell(_)) => break, HeapCellValue::Addr(Addr::HeapCell(_)) => break,
HeapCellValue::Addr(Addr::StackCell(..)) => break, HeapCellValue::Addr(Addr::StackCell(..)) => break,
_ => return Err(self.error_form(self.type_error(ValidType::Pair, _ => return Err(self.error_form(self.type_error(ValidType::Pair,
Addr::HeapCell(l)))) Addr::HeapCell(l)),
stub))
}; };
} }
@@ -69,20 +74,26 @@ impl MachineState {
// see 8.4.4 of Draft Technical Corrigendum 2. // see 8.4.4 of Draft Technical Corrigendum 2.
pub(super) fn check_keysort_errors(&self) -> Result<(), MachineError> { pub(super) fn check_keysort_errors(&self) -> Result<(), MachineError> {
let stub = self.functor_stub(clause_name!("keysort"), 2);
let pairs = self.store(self.deref(self[temp_v!(1)].clone())); let pairs = self.store(self.deref(self[temp_v!(1)].clone()));
let sorted = self.store(self.deref(self[temp_v!(2)].clone())); let sorted = self.store(self.deref(self[temp_v!(2)].clone()));
match self.detect_cycles(usize::max_value(), pairs.clone()) { match self.detect_cycles(pairs.clone()) {
CycleSearchResult::PartialList(..) => CycleSearchResult::PartialList(..) =>
Err(self.error_form(self.instantiation_error())), Err(self.error_form(self.instantiation_error(), stub)),
CycleSearchResult::NotList => CycleSearchResult::NotList =>
Err(self.error_form(self.type_error(ValidType::List, pairs))), Err(self.error_form(self.type_error(ValidType::List, pairs), stub)),
_ => Ok(()) _ => Ok(())
}?; }?;
self.check_for_list_pairs(sorted) self.check_for_list_pairs(sorted)
} }
pub(super) fn functor_stub(&self, name: ClauseName, arity: usize) -> MachineStub {
let name = HeapCellValue::Addr(Addr::Con(Constant::Atom(name)));
functor!("/", 2, [name, heap_integer!(arity)], Fixity::In)
}
pub(super) fn evaluation_error(&self, eval_error: EvalError) -> MachineError { pub(super) fn evaluation_error(&self, eval_error: EvalError) -> MachineError {
functor!("evaluation_error", 1, [heap_atom!(eval_error.as_str())]) functor!("evaluation_error", 1, [heap_atom!(eval_error.as_str())])
} }
@@ -92,11 +103,10 @@ impl MachineState {
} }
pub(super) fn existence_error(&self, name: ClauseName, arity: usize) -> MachineError { pub(super) fn existence_error(&self, name: ClauseName, arity: usize) -> MachineError {
let name = HeapCellValue::Addr(Addr::Con(Constant::Atom(name)));
let h = self.heap.h; let h = self.heap.h;
let mut error = functor!("existence_error", 2, [heap_atom!("procedure"), heap_str!(3 + h)]); let mut error = functor!("existence_error", 2, [heap_atom!("procedure"), heap_str!(3 + h)]);
error.append(&mut functor!("/", 2, [name, heap_integer!(arity)], Fixity::In)); error.append(&mut self.functor_stub(name, arity));
error error
} }
@@ -109,13 +119,16 @@ impl MachineState {
functor!("representation_error", 1, [heap_atom!(flag.as_str())]) functor!("representation_error", 1, [heap_atom!(flag.as_str())])
} }
pub(super) fn error_form(&self, mut err: MachineError) -> MachineError { pub(super) fn error_form(&self, err: MachineError, src: MachineStub) -> MachineError {
let h = self.heap.h; let h = self.heap.h;
let mut error_form = functor!("error", 2,
[HeapCellValue::Addr(Addr::HeapCell(h + 3)),
HeapCellValue::Addr(Addr::HeapCell(h + 2))]);
error_form.append(&mut err); let mut error_form = vec![HeapCellValue::NamedStr(2, clause_name!("error"), None),
HeapCellValue::Addr(Addr::HeapCell(h + 3)),
HeapCellValue::Addr(Addr::HeapCell(h + 3 + err.len()))];
error_form.extend(err.into_iter());
error_form.extend(src.into_iter());
error_form error_form
} }

14
src/prolog/machine/machine_state.rs
View File

@@ -484,10 +484,11 @@ pub(crate) trait CallPolicy: Any {
return_from_clause!(lco, machine_st) return_from_clause!(lco, machine_st)
}, },
&ClauseType::Sort => { &ClauseType::Sort => {
let mut list = machine_st.try_from_list(temp_v!(1))?;
machine_st.check_sort_errors()?; machine_st.check_sort_errors()?;
let stub = machine_st.functor_stub(clause_name!("sort"), 2);
let mut list = machine_st.try_from_list(temp_v!(1), stub)?;
list.sort_unstable_by(|a1, a2| machine_st.compare_term_test(a1, a2)); list.sort_unstable_by(|a1, a2| machine_st.compare_term_test(a1, a2));
machine_st.term_dedup(&mut list); machine_st.term_dedup(&mut list);
@@ -499,11 +500,12 @@ pub(crate) trait CallPolicy: Any {
return_from_clause!(lco, machine_st) return_from_clause!(lco, machine_st)
}, },
&ClauseType::KeySort => { &ClauseType::KeySort => {
let mut list = machine_st.try_from_list(temp_v!(1))?;
let mut key_pairs = Vec::new();
machine_st.check_keysort_errors()?; machine_st.check_keysort_errors()?;
let stub = machine_st.functor_stub(clause_name!("keysort"), 2);
let mut list = machine_st.try_from_list(temp_v!(1), stub)?;
let mut key_pairs = Vec::new();
for val in list { for val in list {
let key = machine_st.project_onto_key(val.clone())?; let key = machine_st.project_onto_key(val.clone())?;
key_pairs.push((key, val.clone())); key_pairs.push((key, val.clone()));
@@ -551,7 +553,7 @@ pub(crate) trait CallPolicy: Any {
Ok(()) Ok(())
}, },
&ClauseType::SkipMaxList => { &ClauseType::SkipMaxList => {
machine_st.skip_max_list(); machine_st.skip_max_list()?;
machine_st.p += 1; machine_st.p += 1;
Ok(()) Ok(())

261
src/prolog/machine/machine_state_impl.rs
View File

@@ -6,7 +6,7 @@ use prolog::heap_iter::*;
use prolog::heap_print::*; use prolog::heap_print::*;
use prolog::machine::machine_errors::*; use prolog::machine::machine_errors::*;
use prolog::machine::machine_state::*; use prolog::machine::machine_state::*;
use prolog::num::{Integer, Signed, ToPrimitive, Zero}; use prolog::num::{Integer, ToPrimitive, Zero};
use prolog::num::bigint::{BigInt, BigUint}; use prolog::num::bigint::{BigInt, BigUint};
use prolog::num::rational::Ratio; use prolog::num::rational::Ratio;
use prolog::or_stack::*; use prolog::or_stack::*;
@@ -270,7 +270,9 @@ impl MachineState {
} }
} }
fn get_rational(&self, at: &ArithmeticTerm) -> Result<Rc<Ratio<BigInt>>, MachineError> { fn get_rational(&self, at: &ArithmeticTerm, caller: &MachineStub)
-> Result<Rc<Ratio<BigInt>>, MachineError>
{
let n = self.get_number(at)?; let n = self.get_number(at)?;
match n { match n {
@@ -279,7 +281,7 @@ impl MachineState {
if let Some(r) = Ratio::from_float(fl.into_inner()) { if let Some(r) = Ratio::from_float(fl.into_inner()) {
Ok(Rc::new(r)) Ok(Rc::new(r))
} else { } else {
Err(self.error_form(self.instantiation_error())) Err(self.error_form(self.instantiation_error(), caller.clone()))
}, },
Number::Integer(bi) => Number::Integer(bi) =>
Ok(Rc::new(Ratio::from_integer((*bi).clone()))) Ok(Rc::new(Ratio::from_integer((*bi).clone())))
@@ -302,6 +304,7 @@ impl MachineState {
{ {
let a = self[r].clone(); let a = self[r].clone();
let caller = self.functor_stub(clause_name!("(is)"), 2);
let mut interms: Vec<Number> = Vec::with_capacity(64); let mut interms: Vec<Number> = Vec::with_capacity(64);
for heap_val in self.post_order_iter(a) { for heap_val in self.post_order_iter(a) {
@@ -314,9 +317,10 @@ impl MachineState {
"+" => interms.push(a1 + a2), "+" => interms.push(a1 + a2),
"-" => interms.push(a1 - a2), "-" => interms.push(a1 - a2),
"*" => interms.push(a1 * a2), "*" => interms.push(a1 * a2),
"/" => interms.push(self.div(a1, a2)?),
"rdiv" => { "rdiv" => {
let r1 = self.get_rational(&ArithmeticTerm::Number(a1))?; let r1 = self.get_rational(&ArithmeticTerm::Number(a1), &caller)?;
let r2 = self.get_rational(&ArithmeticTerm::Number(a2))?; let r2 = self.get_rational(&ArithmeticTerm::Number(a2), &caller)?;
let result = Number::Rational(self.rdiv(r1, r2)?); let result = Number::Rational(self.rdiv(r1, r2)?);
interms.push(result) interms.push(result)
@@ -330,7 +334,7 @@ impl MachineState {
"xor" => interms.push(Number::Integer(self.xor(a1, a2)?)), "xor" => interms.push(Number::Integer(self.xor(a1, a2)?)),
"mod" => interms.push(Number::Integer(self.modulus(a1, a2)?)), "mod" => interms.push(Number::Integer(self.modulus(a1, a2)?)),
"rem" => interms.push(Number::Integer(self.remainder(a1, a2)?)), "rem" => interms.push(Number::Integer(self.remainder(a1, a2)?)),
_ => return Err(self.error_form(self.instantiation_error())) _ => return Err(self.error_form(self.instantiation_error(), caller))
} }
}, },
HeapCellValue::NamedStr(1, name, Some(Fixity::Pre)) => { HeapCellValue::NamedStr(1, name, Some(Fixity::Pre)) => {
@@ -338,13 +342,13 @@ impl MachineState {
match name.as_str() { match name.as_str() {
"-" => interms.push(- a1), "-" => interms.push(- a1),
_ => return Err(self.error_form(self.instantiation_error())) _ => return Err(self.error_form(self.instantiation_error(), caller))
} }
}, },
HeapCellValue::Addr(Addr::Con(Constant::Number(n))) => HeapCellValue::Addr(Addr::Con(Constant::Number(n))) =>
interms.push(n), interms.push(n),
_ => _ =>
return Err(self.error_form(self.instantiation_error())) return Err(self.error_form(self.instantiation_error(), caller))
} }
}; };
@@ -354,8 +358,10 @@ impl MachineState {
fn rdiv(&self, r1: Rc<Ratio<BigInt>>, r2: Rc<Ratio<BigInt>>) fn rdiv(&self, r1: Rc<Ratio<BigInt>>, r2: Rc<Ratio<BigInt>>)
-> Result<Rc<Ratio<BigInt>>, MachineError> -> Result<Rc<Ratio<BigInt>>, MachineError>
{ {
let stub = self.functor_stub(clause_name!("(rdiv)"), 2);
if *r2 == Ratio::zero() { if *r2 == Ratio::zero() {
Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub))
} else { } else {
Ok(Rc::new(&*r1 / &*r2)) Ok(Rc::new(&*r1 / &*r2))
} }
@@ -363,44 +369,54 @@ impl MachineState {
fn fidiv(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError> fn fidiv(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError>
{ {
let stub = self.functor_stub(clause_name!("(div)"), 2);
match (n1, n2) { match (n1, n2) {
(Number::Integer(n1), Number::Integer(n2)) => (Number::Integer(n1), Number::Integer(n2)) =>
if *n2 == BigInt::zero() { if *n2 == BigInt::zero() {
Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub))
} else { } else {
Ok(Rc::new(n1.div_floor(&n2))) Ok(Rc::new(n1.div_floor(&n2)))
}, },
(Number::Integer(_), n2) => (Number::Integer(_), n2) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n2))))), Addr::Con(Constant::Number(n2))),
stub)),
(n1, _) => (n1, _) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n1))))) Addr::Con(Constant::Number(n1))),
stub))
} }
} }
fn idiv(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError> fn idiv(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError>
{ {
let stub = self.functor_stub(clause_name!("(//)"), 2);
match (n1, n2) { match (n1, n2) {
(Number::Integer(n1), Number::Integer(n2)) => (Number::Integer(n1), Number::Integer(n2)) =>
if *n2 == BigInt::zero() { if *n2 == BigInt::zero() {
Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub))
} else { } else {
Ok(Rc::new(&*n1 / &*n2)) Ok(Rc::new(&*n1 / &*n2))
}, },
(Number::Integer(_), n2) => (Number::Integer(_), n2) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n2))))), Addr::Con(Constant::Number(n2))),
stub)),
(n1, _) => (n1, _) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n1))))) Addr::Con(Constant::Number(n1))),
stub))
} }
} }
fn div(&self, n1: Number, n2: Number) -> Result<Number, MachineError> fn div(&self, n1: Number, n2: Number) -> Result<Number, MachineError>
{ {
let stub = self.functor_stub(clause_name!("(/)"), 2);
if n2.is_zero() { if n2.is_zero() {
Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub))
} else { } else {
Ok(n1 / n2) Ok(n1 / n2)
} }
@@ -408,6 +424,8 @@ impl MachineState {
fn shr(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError> fn shr(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError>
{ {
let stub = self.functor_stub(clause_name!("(>>)"), 2);
match (n1, n2) { match (n1, n2) {
(Number::Integer(n1), Number::Integer(n2)) => (Number::Integer(n1), Number::Integer(n2)) =>
match n2.to_usize() { match n2.to_usize() {
@@ -416,15 +434,19 @@ impl MachineState {
}, },
(Number::Integer(_), n2) => (Number::Integer(_), n2) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n2))))), Addr::Con(Constant::Number(n2))),
stub)),
(n1, _) => (n1, _) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n1))))) Addr::Con(Constant::Number(n1))),
stub))
} }
} }
fn shl(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError> fn shl(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError>
{ {
let stub = self.functor_stub(clause_name!("(<<)"), 2);
match (n1, n2) { match (n1, n2) {
(Number::Integer(n1), Number::Integer(n2)) => (Number::Integer(n1), Number::Integer(n2)) =>
match n2.to_usize() { match n2.to_usize() {
@@ -433,88 +455,110 @@ impl MachineState {
}, },
(Number::Integer(_), n2) => (Number::Integer(_), n2) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n2))))), Addr::Con(Constant::Number(n2))),
stub)),
(n1, _) => (n1, _) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n1))))) Addr::Con(Constant::Number(n1))),
stub))
} }
} }
fn xor(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError> fn xor(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError>
{ {
let stub = self.functor_stub(clause_name!("(xor)"), 2);
match (n1, n2) { match (n1, n2) {
(Number::Integer(n1), Number::Integer(n2)) => (Number::Integer(n1), Number::Integer(n2)) =>
Ok(self.signed_bitwise_op(&*n1, &*n2, |u_n1, u_n2| u_n1 ^ u_n2)), Ok(self.signed_bitwise_op(&*n1, &*n2, |u_n1, u_n2| u_n1 ^ u_n2)),
(Number::Integer(_), n2) => (Number::Integer(_), n2) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n2))))), Addr::Con(Constant::Number(n2))),
stub)),
(n1, _) => (n1, _) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n1))))) Addr::Con(Constant::Number(n1))),
stub))
} }
} }
fn and(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError> fn and(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError>
{ {
let stub = self.functor_stub(clause_name!("(/\\)"), 2);
match (n1, n2) { match (n1, n2) {
(Number::Integer(n1), Number::Integer(n2)) => (Number::Integer(n1), Number::Integer(n2)) =>
Ok(self.signed_bitwise_op(&*n1, &*n2, |u_n1, u_n2| u_n1 & u_n2)), Ok(self.signed_bitwise_op(&*n1, &*n2, |u_n1, u_n2| u_n1 & u_n2)),
(Number::Integer(_), n2) => (Number::Integer(_), n2) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n2))))), Addr::Con(Constant::Number(n2))),
stub)),
(n1, _) => (n1, _) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n1))))) Addr::Con(Constant::Number(n1))),
stub))
} }
} }
fn modulus(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError> fn modulus(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError>
{ {
let stub = self.functor_stub(clause_name!("(mod)"), 2);
match (n1, n2) { match (n1, n2) {
(Number::Integer(n1), Number::Integer(n2)) => (Number::Integer(n1), Number::Integer(n2)) =>
if *n2 == BigInt::zero() { if *n2 == BigInt::zero() {
Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub))
} else { } else {
Ok(Rc::new(n1.mod_floor(&n2))) Ok(Rc::new(n1.mod_floor(&n2)))
}, },
(Number::Integer(_), n2) => (Number::Integer(_), n2) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n2))))), Addr::Con(Constant::Number(n2))),
stub)),
(n1, _) => (n1, _) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n1))))) Addr::Con(Constant::Number(n1))),
stub))
} }
} }
fn remainder(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError> fn remainder(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError>
{ {
let stub = self.functor_stub(clause_name!("(rem)"), 2);
match (n1, n2) { match (n1, n2) {
(Number::Integer(n1), Number::Integer(n2)) => (Number::Integer(n1), Number::Integer(n2)) =>
if *n2 == BigInt::zero() { if *n2 == BigInt::zero() {
Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub))
} else { } else {
Ok(Rc::new(&*n1 % &*n2)) Ok(Rc::new(&*n1 % &*n2))
}, },
(Number::Integer(_), n2) => (Number::Integer(_), n2) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n2))))), Addr::Con(Constant::Number(n2))),
stub)),
(n1, _) => (n1, _) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n1))))) Addr::Con(Constant::Number(n1))),
stub))
} }
} }
fn or(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError> fn or(&self, n1: Number, n2: Number) -> Result<Rc<BigInt>, MachineError>
{ {
let stub = self.functor_stub(clause_name!("(\\/)"), 2);
match (n1, n2) { match (n1, n2) {
(Number::Integer(n1), Number::Integer(n2)) => (Number::Integer(n1), Number::Integer(n2)) =>
Ok(self.signed_bitwise_op(&*n1, &*n2, |u_n1, u_n2| u_n1 & u_n2)), Ok(self.signed_bitwise_op(&*n1, &*n2, |u_n1, u_n2| u_n1 & u_n2)),
(Number::Integer(_), n2) => (Number::Integer(_), n2) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n2))))), Addr::Con(Constant::Number(n2))),
stub)),
(n1, _) => (n1, _) =>
Err(self.error_form(self.type_error(ValidType::Integer, Err(self.error_form(self.type_error(ValidType::Integer,
Addr::Con(Constant::Number(n1))))) Addr::Con(Constant::Number(n1))),
stub))
} }
} }
@@ -542,8 +586,10 @@ impl MachineState {
self.p += 1; self.p += 1;
}, },
&ArithmeticInstruction::RDiv(ref a1, ref a2, t) => { &ArithmeticInstruction::RDiv(ref a1, ref a2, t) => {
let r1 = try_or_fail!(self, self.get_rational(a1)); let stub = self.functor_stub(clause_name!("(rdiv)"), 2);
let r2 = try_or_fail!(self, self.get_rational(a2));
let r1 = try_or_fail!(self, self.get_rational(a1, &stub));
let r2 = try_or_fail!(self, self.get_rational(a2, &stub));
self.interms[t - 1] = Number::Rational(try_or_fail!(self, self.rdiv(r1, r2))); self.interms[t - 1] = Number::Rational(try_or_fail!(self, self.rdiv(r1, r2)));
self.p += 1; self.p += 1;
@@ -972,6 +1018,7 @@ impl MachineState {
pub(super) fn setup_call_n(&mut self, arity: usize) -> Option<PredicateKey> pub(super) fn setup_call_n(&mut self, arity: usize) -> Option<PredicateKey>
{ {
let stub = self.functor_stub(clause_name!("call"), arity + 1);
let addr = self.store(self.deref(self.registers[arity].clone())); let addr = self.store(self.deref(self.registers[arity].clone()));
let (name, narity) = match addr { let (name, narity) = match addr {
@@ -981,7 +1028,7 @@ impl MachineState {
if let HeapCellValue::NamedStr(narity, name, _) = result { if let HeapCellValue::NamedStr(narity, name, _) = result {
if narity + arity > 63 { if narity + arity > 63 {
let representation_error = let representation_error =
self.error_form(self.representation_error(RepFlag::MaxArity)); self.error_form(self.representation_error(RepFlag::MaxArity), stub);
self.throw_exception(representation_error); self.throw_exception(representation_error);
@@ -1004,13 +1051,13 @@ impl MachineState {
}, },
Addr::Con(Constant::Atom(name)) => (name, 0), Addr::Con(Constant::Atom(name)) => (name, 0),
Addr::HeapCell(_) | Addr::StackCell(_, _) => { Addr::HeapCell(_) | Addr::StackCell(_, _) => {
let instantiation_error = self.error_form(self.instantiation_error()); let instantiation_error = self.error_form(self.instantiation_error(), stub);
self.throw_exception(instantiation_error); self.throw_exception(instantiation_error);
return None; return None;
}, },
_ => { _ => {
let type_error = self.error_form(self.type_error(ValidType::Callable, addr)); let type_error = self.error_form(self.type_error(ValidType::Callable, addr), stub);
self.throw_exception(type_error); self.throw_exception(type_error);
return None; return None;
@@ -1088,7 +1135,8 @@ impl MachineState {
_ => self.fail = true _ => self.fail = true
}; };
} else { } else {
return Err(self.error_form(self.type_error(ValidType::Compound, a2))); let stub = self.functor_stub(clause_name!("arg"), 3);
return Err(self.error_form(self.type_error(ValidType::Compound, a2), stub));
} }
} }
@@ -1471,7 +1519,9 @@ impl MachineState {
CallWithInferenceLimitCallPolicy.") CallWithInferenceLimitCallPolicy.")
}, },
_ => { _ => {
let type_error = self.error_form(self.type_error(ValidType::Integer, a2)); let stub = self.functor_stub(clause_name!("call_with_inference_limit"), 3);
let type_error = self.error_form(self.type_error(ValidType::Integer, a2),
stub);
self.throw_exception(type_error) self.throw_exception(type_error)
} }
}; };
@@ -1598,6 +1648,7 @@ impl MachineState {
} }
pub(super) fn try_functor(&mut self) -> Result<(), MachineError> { pub(super) fn try_functor(&mut self) -> Result<(), MachineError> {
let stub = self.functor_stub(clause_name!("functor"), 3);
let a1 = self.store(self.deref(self[temp_v!(1)].clone())); let a1 = self.store(self.deref(self[temp_v!(1)].clone()));
match a1.clone() { match a1.clone() {
@@ -1646,10 +1697,10 @@ impl MachineState {
self.unify(a1, f_a); self.unify(a1, f_a);
} else { } else {
return Err(self.error_form(self.instantiation_error())); return Err(self.error_form(self.instantiation_error(), stub));
} }
} else { } else {
return Err(self.error_form(self.instantiation_error())); return Err(self.error_form(self.instantiation_error(), stub));
} }
}, },
_ => { _ => {
@@ -1696,7 +1747,8 @@ impl MachineState {
head_addr head_addr
} }
pub(super) fn try_from_list(&self, r: RegType) -> Result<Vec<Addr>, MachineError> pub(super) fn try_from_list(&self, r: RegType, caller: MachineStub)
-> Result<Vec<Addr>, MachineError>
{ {
let a1 = self.store(self.deref(self[r].clone())); let a1 = self.store(self.deref(self[r].clone()));
@@ -1709,46 +1761,58 @@ impl MachineState {
loop { loop {
match self.heap[l].clone() { match self.heap[l].clone() {
HeapCellValue::Addr(Addr::Lis(hcp)) => { HeapCellValue::Addr(addr) =>
result.push(self.heap[hcp].as_addr(hcp)); match self.store(self.deref(addr)) {
l = hcp + 1; Addr::Lis(hcp) => {
}, result.push(self.heap[hcp].as_addr(hcp));
HeapCellValue::Addr(Addr::Con(Constant::EmptyList)) => l = hcp + 1;
break, },
hcv => Addr::Con(Constant::EmptyList) =>
return Err(self.type_error(ValidType::List, a1)) break,
Addr::HeapCell(_) | Addr::StackCell(..) =>
return Err(self.error_form(self.instantiation_error(), caller)),
_ =>
return Err(self.error_form(self.type_error(ValidType::List, a1),
caller))
},
_ =>
return Err(self.error_form(self.type_error(ValidType::List, a1),
caller))
}; };
} }
Ok(result) Ok(result)
}, },
Addr::HeapCell(_) | Addr::StackCell(..) => Addr::HeapCell(_) | Addr::StackCell(..) =>
Err(self.error_form(self.instantiation_error())), Err(self.error_form(self.instantiation_error(), caller)),
Addr::Con(Constant::EmptyList) => Addr::Con(Constant::EmptyList) =>
Ok(vec![]), Ok(vec![]),
_ => _ =>
Err(self.error_form(self.type_error(ValidType::List, a1))) Err(self.error_form(self.type_error(ValidType::List, a1), caller))
} }
} }
// see 8.4.4.3 of Draft Technical Corrigendum 2 for an error guide. // see 8.4.4.3 of Draft Technical Corrigendum 2 for an error guide.
pub(super) fn project_onto_key(&self, a: Addr) -> Result<Addr, MachineError> { pub(super) fn project_onto_key(&self, a: Addr) -> Result<Addr, MachineError> {
let stub = self.functor_stub(clause_name!("keysort"), 2);
match self.store(self.deref(a)) { match self.store(self.deref(a)) {
Addr::HeapCell(_) | Addr::StackCell(..) => Addr::HeapCell(_) | Addr::StackCell(..) =>
Err(self.error_form(self.instantiation_error())), Err(self.error_form(self.instantiation_error(), stub)),
Addr::Str(s) => Addr::Str(s) =>
match self.heap[s].clone() { match self.heap[s].clone() {
HeapCellValue::NamedStr(2, ref name, Some(Fixity::In)) HeapCellValue::NamedStr(2, ref name, Some(Fixity::In))
if *name == clause_name!("-") => if *name == clause_name!("-") =>
Ok(Addr::HeapCell(s+1)), Ok(Addr::HeapCell(s+1)),
_ => Err(self.error_form(self.type_error(ValidType::Pair, _ => Err(self.error_form(self.type_error(ValidType::Pair,
self.heap[s].as_addr(s)))) self.heap[s].as_addr(s)),
stub))
}, },
a => Err(self.error_form(self.type_error(ValidType::Pair, a))) a => Err(self.error_form(self.type_error(ValidType::Pair, a), stub))
} }
} }
pub(super) fn detect_cycles(&self, max_steps: usize, addr: Addr) -> CycleSearchResult pub(super) fn detect_cycles_with_max(&self, max_steps: usize, addr: Addr) -> CycleSearchResult
{ {
let addr = self.store(self.deref(addr)); let addr = self.store(self.deref(addr));
@@ -1781,12 +1845,60 @@ impl MachineState {
power <<= 1; power <<= 1;
} }
}, },
HeapCellValue::Addr(Addr::Con(Constant::EmptyList)) => HeapCellValue::NamedStr(..) =>
return CycleSearchResult::ProperList(steps), return CycleSearchResult::NotList,
HeapCellValue::Addr(Addr::HeapCell(_)) | HeapCellValue::Addr(Addr::StackCell(..)) => HeapCellValue::Addr(addr) =>
return CycleSearchResult::PartialList(steps, hare), match self.store(self.deref(addr)) {
_ => Addr::Con(Constant::EmptyList) =>
return CycleSearchResult::NotList return CycleSearchResult::ProperList(steps),
Addr::HeapCell(_) | Addr::StackCell(..) =>
return CycleSearchResult::PartialList(steps, hare),
_ =>
return CycleSearchResult::NotList
}
}
}
}
pub(super) fn detect_cycles(&self, addr: Addr) -> CycleSearchResult
{
let addr = self.store(self.deref(addr));
let mut hare = match addr {
Addr::Lis(offset) => offset + 1,
Addr::Con(Constant::EmptyList) => return CycleSearchResult::EmptyList,
_ => return CycleSearchResult::NotList
};
// use Brent's algorithm to detect cycles.
let mut tortoise = hare;
let mut power = 2;
let mut steps = 1;
loop {
match self.heap[hare].clone() {
HeapCellValue::Addr(Addr::Lis(l)) => {
hare = l + 1;
steps += 1;
if tortoise == hare {
return CycleSearchResult::NotList;
} else if steps == power {
tortoise = hare;
power <<= 1;
}
},
HeapCellValue::NamedStr(..) =>
return CycleSearchResult::NotList,
HeapCellValue::Addr(addr) =>
match self.store(self.deref(addr)) {
Addr::Con(Constant::EmptyList) =>
return CycleSearchResult::ProperList(steps),
Addr::HeapCell(_) | Addr::StackCell(..) =>
return CycleSearchResult::PartialList(steps, hare),
_ =>
return CycleSearchResult::NotList
}
} }
} }
} }
@@ -1801,12 +1913,12 @@ impl MachineState {
} }
} }
pub(super) fn skip_max_list(&mut self) { pub(super) fn skip_max_list(&mut self) -> Result<(), MachineError> {
let max = self.store(self.deref(self[temp_v!(2)].clone())); let max_steps = self.arith_eval_by_metacall(temp_v!(2))?;
match max { match max_steps {
Addr::Con(Constant::Number(Number::Integer(ref max))) Number::Integer(ref max_steps)
if !max.is_negative() => { if max_steps.to_isize().map(|i| i >= -1).unwrap_or(false) => {
let n = self.store(self.deref(self[temp_v!(1)].clone())); let n = self.store(self.deref(self[temp_v!(1)].clone()));
match n { match n {
@@ -1817,9 +1929,18 @@ impl MachineState {
self.unify(xs0, xs); self.unify(xs0, xs);
}, },
_ => { _ => {
let max = max.to_usize().unwrap_or(usize::max_value()); let search_result = if let Some(max_steps) = max_steps.to_isize() {
if max_steps == -1 {
self.detect_cycles(self[temp_v!(3)].clone())
} else {
self.detect_cycles_with_max(max_steps as usize,
self[temp_v!(3)].clone())
}
} else {
self.detect_cycles(self[temp_v!(3)].clone())
};
match self.detect_cycles(max, self[temp_v!(3)].clone()) { match search_result {
CycleSearchResult::UntouchedList(l) => CycleSearchResult::UntouchedList(l) =>
self.finalize_skip_max_list(0, Addr::Lis(l)), self.finalize_skip_max_list(0, Addr::Lis(l)),
CycleSearchResult::EmptyList => CycleSearchResult::EmptyList =>
@@ -1838,6 +1959,8 @@ impl MachineState {
}, },
_ => self.fail = true _ => self.fail = true
}; };
Ok(())
} }
pub(super) fn duplicate_term(&mut self) { pub(super) fn duplicate_term(&mut self) {

53
src/tests.rs
View File

@@ -1410,6 +1410,39 @@ fn test_queries_on_builtins()
assert_prolog_success!(&mut wam, "?- [X,Y,X] =@= [V,W,V]."); assert_prolog_success!(&mut wam, "?- [X,Y,X] =@= [V,W,V].");
assert_prolog_success!(&mut wam, "?- g(B) = B, g(A) = A, A =@= B."); assert_prolog_success!(&mut wam, "?- g(B) = B, g(A) = A, A =@= B.");
assert_prolog_success!(&mut wam, "?- keysort([1-1, 1-1], Sorted).",
[["Sorted = [1 - 1, 1 - 1]"]]);
assert_prolog_success!(&mut wam, "?- keysort([2-99, 1-a, 3-f(_), 1-z, 1-a, 2-44], Sorted).",
[["Sorted = [1 - a, 1 - z, 1 - a, 2 - 99, 2 - 44, 3 - f(_7)]"]]);
assert_prolog_success!(&mut wam, "?- keysort([X-1,1-1],[2-1,1-1]).",
[["X = 2"]]);
assert_prolog_success!(&mut wam, "?- keysort([], L).",
[["L = []"]]);
assert_prolog_success!(&mut wam, "?- catch(keysort([a|_], _), error(E, _), true).",
[["E = instantiation_error"]]);
assert_prolog_success!(&mut wam, "?- catch(keysort([],[a|a]),error(Pat, _),true).",
[["Pat = type_error(list, [a | a])"]]);
assert_prolog_success!(&mut wam, "?- catch(keysort(_, _), error(E, _), true).",
[["E = type_error(list, _12)"]]);
assert_prolog_success!(&mut wam, "?- catch(keysort([a-1], [_|b]), error(E, _), true).",
[["E = type_error(list, [_23 | b])"]]);
assert_prolog_success!(&mut wam, "?- catch(keysort([a-1], [a-b,c-d,a]), error(E, _), true).",
[["E = type_error(pair, a)"]]);
assert_prolog_success!(&mut wam, "?- catch(keysort([a], [a-b]), error(E, _), true).",
[["E = type_error(pair, a)"]]);
assert_prolog_success!(&mut wam, "?- catch(sort([a|_], _), error(E, _), true).",
[["E = instantiation_error"]]);
assert_prolog_success!(&mut wam, "?- catch(sort([],[a|a]),error(Pat, _),true).",
[["Pat = type_error(list, [a | a])"]]);
assert_prolog_success!(&mut wam, "?- sort([], L).",
[["L = []"]]);
assert_prolog_success!(&mut wam, "?- catch(sort(_, []), error(E, _), true).",
[["E = type_error(list, _12)"]]);
assert_prolog_success!(&mut wam, "?- catch(sort([a,b,c], not_a_list), error(E, _), true).",
[["E = type_error(list, not_a_list)"]]);
assert_prolog_success!(&mut wam, "?- call(((G = 2 ; fail), B=3, !)).", assert_prolog_success!(&mut wam, "?- call(((G = 2 ; fail), B=3, !)).",
[["G = 2", "B = 3"]]); [["G = 2", "B = 3"]]);
@@ -1632,6 +1665,26 @@ fn test_queries_on_skip_max_list() {
assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 3, [a,b,c], Xs).", assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 3, [a,b,c], Xs).",
[["Xs = []"]]); [["Xs = []"]]);
// tests on proper and empty lists with no max.
// test on proper and empty lists.
assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, -1, [], Xs).",
[["Xs = []", "N = 0"]]);
assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, -1, [a,b,c], Xs).",
[["Xs = []", "N = 3"]]);
assert_prolog_success!(&mut wam, "?- '$skip_max_list'(N, -1, [], Xs).",
[["Xs = []", "N = 0"]]);
assert_prolog_failure!(&mut wam, "?- '$skip_max_list'(4, -1, [], Xs).");
assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, -1, [a,b,c], Xs).",
[["Xs = []"]]);
assert_prolog_success!(&mut wam, "?- '$skip_max_list'(0, -1, [], Xs).",
[["Xs = []"]]);
assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, -1, [a,b,c], Xs).",
[["Xs = []"]]);
// tests on partial lists. // tests on partial lists.
assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 4, [a,b,c|X], Xs0).", assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 4, [a,b,c|X], Xs0).",
[["X = _1", "Xs0 = _1"]]); [["X = _1", "Xs0 = _1"]]);