From: Mark Thom Date: Fri, 4 May 2018 02:15:45 +0000 (-0600) Subject: fix errors emitted by sort and keysort, add tests, add support for Max = -1 to '... X-Git-Tag: v0.8.110~475 X-Git-Url: https://git.sagredo.dev/?a=commitdiff_plain;h=11800532c9465de7063a12006a46bbeb5490fc31;p=scryer-prolog.git fix errors emitted by sort and keysort, add tests, add support for Max = -1 to '$skip_max_list' --- diff --git a/src/prolog/machine/machine_errors.rs b/src/prolog/machine/machine_errors.rs index 18d54079..bff1c9d5 100644 --- a/src/prolog/machine/machine_errors.rs +++ b/src/prolog/machine/machine_errors.rs @@ -6,6 +6,7 @@ use prolog::num::bigint::BigInt; use std::rc::Rc; pub(super) type MachineError = Vec; +pub(super) type MachineStub = Vec; // used by '$skip_max_list'. pub(super) enum CycleSearchResult { @@ -19,28 +20,31 @@ pub(super) enum CycleSearchResult { impl MachineState { // see 8.4.3 of Draft Technical Corrigendum 2. 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 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(..) => - Err(self.error_form(self.instantiation_error())), + Err(self.error_form(self.instantiation_error(), stub.clone())), 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(()) }?; - match self.detect_cycles(usize::max_value(), sorted.clone()) { + match self.detect_cycles(sorted.clone()) { 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(()) } } 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() => - 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; @@ -55,7 +59,8 @@ impl MachineState { HeapCellValue::Addr(Addr::HeapCell(_)) => break, HeapCellValue::Addr(Addr::StackCell(..)) => break, _ => 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. 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 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(..) => - Err(self.error_form(self.instantiation_error())), + Err(self.error_form(self.instantiation_error(), stub)), CycleSearchResult::NotList => - Err(self.error_form(self.type_error(ValidType::List, pairs))), + Err(self.error_form(self.type_error(ValidType::List, pairs), stub)), _ => Ok(()) }?; 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 { 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 { - let name = HeapCellValue::Addr(Addr::Con(Constant::Atom(name))); let h = self.heap.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 } @@ -109,13 +119,16 @@ impl MachineState { 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 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 } diff --git a/src/prolog/machine/machine_state.rs b/src/prolog/machine/machine_state.rs index 8d15a82d..84b54a9b 100644 --- a/src/prolog/machine/machine_state.rs +++ b/src/prolog/machine/machine_state.rs @@ -484,10 +484,11 @@ pub(crate) trait CallPolicy: Any { return_from_clause!(lco, machine_st) }, &ClauseType::Sort => { - let mut list = machine_st.try_from_list(temp_v!(1))?; - 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)); machine_st.term_dedup(&mut list); @@ -499,11 +500,12 @@ pub(crate) trait CallPolicy: Any { return_from_clause!(lco, machine_st) }, &ClauseType::KeySort => { - let mut list = machine_st.try_from_list(temp_v!(1))?; - let mut key_pairs = Vec::new(); - 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 { let key = machine_st.project_onto_key(val.clone())?; key_pairs.push((key, val.clone())); @@ -551,7 +553,7 @@ pub(crate) trait CallPolicy: Any { Ok(()) }, &ClauseType::SkipMaxList => { - machine_st.skip_max_list(); + machine_st.skip_max_list()?; machine_st.p += 1; Ok(()) diff --git a/src/prolog/machine/machine_state_impl.rs b/src/prolog/machine/machine_state_impl.rs index 6d08fe2a..7c631654 100644 --- a/src/prolog/machine/machine_state_impl.rs +++ b/src/prolog/machine/machine_state_impl.rs @@ -6,7 +6,7 @@ use prolog::heap_iter::*; use prolog::heap_print::*; use prolog::machine::machine_errors::*; 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::rational::Ratio; use prolog::or_stack::*; @@ -270,7 +270,9 @@ impl MachineState { } } - fn get_rational(&self, at: &ArithmeticTerm) -> Result>, MachineError> { + fn get_rational(&self, at: &ArithmeticTerm, caller: &MachineStub) + -> Result>, MachineError> + { let n = self.get_number(at)?; match n { @@ -279,7 +281,7 @@ impl MachineState { if let Some(r) = Ratio::from_float(fl.into_inner()) { Ok(Rc::new(r)) } else { - Err(self.error_form(self.instantiation_error())) + Err(self.error_form(self.instantiation_error(), caller.clone())) }, Number::Integer(bi) => Ok(Rc::new(Ratio::from_integer((*bi).clone()))) @@ -302,6 +304,7 @@ impl MachineState { { let a = self[r].clone(); + let caller = self.functor_stub(clause_name!("(is)"), 2); let mut interms: Vec = Vec::with_capacity(64); 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(self.div(a1, a2)?), "rdiv" => { - let r1 = self.get_rational(&ArithmeticTerm::Number(a1))?; - let r2 = self.get_rational(&ArithmeticTerm::Number(a2))?; + let r1 = self.get_rational(&ArithmeticTerm::Number(a1), &caller)?; + let r2 = self.get_rational(&ArithmeticTerm::Number(a2), &caller)?; let result = Number::Rational(self.rdiv(r1, r2)?); interms.push(result) @@ -330,7 +334,7 @@ impl MachineState { "xor" => interms.push(Number::Integer(self.xor(a1, a2)?)), "mod" => interms.push(Number::Integer(self.modulus(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)) => { @@ -338,13 +342,13 @@ impl MachineState { match name.as_str() { "-" => 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))) => 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>, r2: Rc>) -> Result>, MachineError> { + let stub = self.functor_stub(clause_name!("(rdiv)"), 2); + if *r2 == Ratio::zero() { - Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) + Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub)) } else { Ok(Rc::new(&*r1 / &*r2)) } @@ -363,44 +369,54 @@ impl MachineState { fn fidiv(&self, n1: Number, n2: Number) -> Result, MachineError> { + let stub = self.functor_stub(clause_name!("(div)"), 2); + match (n1, n2) { (Number::Integer(n1), Number::Integer(n2)) => if *n2 == BigInt::zero() { - Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) + Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub)) } else { Ok(Rc::new(n1.div_floor(&n2))) }, (Number::Integer(_), n2) => Err(self.error_form(self.type_error(ValidType::Integer, - Addr::Con(Constant::Number(n2))))), + Addr::Con(Constant::Number(n2))), + stub)), (n1, _) => 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, MachineError> { + let stub = self.functor_stub(clause_name!("(//)"), 2); + match (n1, n2) { (Number::Integer(n1), Number::Integer(n2)) => if *n2 == BigInt::zero() { - Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) + Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub)) } else { Ok(Rc::new(&*n1 / &*n2)) }, (Number::Integer(_), n2) => Err(self.error_form(self.type_error(ValidType::Integer, - Addr::Con(Constant::Number(n2))))), + Addr::Con(Constant::Number(n2))), + stub)), (n1, _) => 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 { + let stub = self.functor_stub(clause_name!("(/)"), 2); + if n2.is_zero() { - Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) + Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub)) } else { Ok(n1 / n2) } @@ -408,6 +424,8 @@ impl MachineState { fn shr(&self, n1: Number, n2: Number) -> Result, MachineError> { + let stub = self.functor_stub(clause_name!("(>>)"), 2); + match (n1, n2) { (Number::Integer(n1), Number::Integer(n2)) => match n2.to_usize() { @@ -416,15 +434,19 @@ impl MachineState { }, (Number::Integer(_), n2) => Err(self.error_form(self.type_error(ValidType::Integer, - Addr::Con(Constant::Number(n2))))), + Addr::Con(Constant::Number(n2))), + stub)), (n1, _) => 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, MachineError> { + let stub = self.functor_stub(clause_name!("(<<)"), 2); + match (n1, n2) { (Number::Integer(n1), Number::Integer(n2)) => match n2.to_usize() { @@ -433,88 +455,110 @@ impl MachineState { }, (Number::Integer(_), n2) => Err(self.error_form(self.type_error(ValidType::Integer, - Addr::Con(Constant::Number(n2))))), + Addr::Con(Constant::Number(n2))), + stub)), (n1, _) => 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, MachineError> { + let stub = self.functor_stub(clause_name!("(xor)"), 2); + match (n1, n2) { (Number::Integer(n1), Number::Integer(n2)) => Ok(self.signed_bitwise_op(&*n1, &*n2, |u_n1, u_n2| u_n1 ^ u_n2)), (Number::Integer(_), n2) => Err(self.error_form(self.type_error(ValidType::Integer, - Addr::Con(Constant::Number(n2))))), + Addr::Con(Constant::Number(n2))), + stub)), (n1, _) => 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, MachineError> { + let stub = self.functor_stub(clause_name!("(/\\)"), 2); + match (n1, n2) { (Number::Integer(n1), Number::Integer(n2)) => Ok(self.signed_bitwise_op(&*n1, &*n2, |u_n1, u_n2| u_n1 & u_n2)), (Number::Integer(_), n2) => Err(self.error_form(self.type_error(ValidType::Integer, - Addr::Con(Constant::Number(n2))))), + Addr::Con(Constant::Number(n2))), + stub)), (n1, _) => 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, MachineError> { + let stub = self.functor_stub(clause_name!("(mod)"), 2); + match (n1, n2) { (Number::Integer(n1), Number::Integer(n2)) => if *n2 == BigInt::zero() { - Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) + Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub)) } else { Ok(Rc::new(n1.mod_floor(&n2))) }, (Number::Integer(_), n2) => Err(self.error_form(self.type_error(ValidType::Integer, - Addr::Con(Constant::Number(n2))))), + Addr::Con(Constant::Number(n2))), + stub)), (n1, _) => 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, MachineError> { + let stub = self.functor_stub(clause_name!("(rem)"), 2); + match (n1, n2) { (Number::Integer(n1), Number::Integer(n2)) => if *n2 == BigInt::zero() { - Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor))) + Err(self.error_form(self.evaluation_error(EvalError::ZeroDivisor), stub)) } else { Ok(Rc::new(&*n1 % &*n2)) }, (Number::Integer(_), n2) => Err(self.error_form(self.type_error(ValidType::Integer, - Addr::Con(Constant::Number(n2))))), + Addr::Con(Constant::Number(n2))), + stub)), (n1, _) => 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, MachineError> { + let stub = self.functor_stub(clause_name!("(\\/)"), 2); + match (n1, n2) { (Number::Integer(n1), Number::Integer(n2)) => Ok(self.signed_bitwise_op(&*n1, &*n2, |u_n1, u_n2| u_n1 & u_n2)), (Number::Integer(_), n2) => Err(self.error_form(self.type_error(ValidType::Integer, - Addr::Con(Constant::Number(n2))))), + Addr::Con(Constant::Number(n2))), + stub)), (n1, _) => 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; }, &ArithmeticInstruction::RDiv(ref a1, ref a2, t) => { - let r1 = try_or_fail!(self, self.get_rational(a1)); - let r2 = try_or_fail!(self, self.get_rational(a2)); + let stub = self.functor_stub(clause_name!("(rdiv)"), 2); + + 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.p += 1; @@ -972,6 +1018,7 @@ impl MachineState { pub(super) fn setup_call_n(&mut self, arity: usize) -> Option { + let stub = self.functor_stub(clause_name!("call"), arity + 1); let addr = self.store(self.deref(self.registers[arity].clone())); let (name, narity) = match addr { @@ -981,7 +1028,7 @@ impl MachineState { if let HeapCellValue::NamedStr(narity, name, _) = result { if narity + arity > 63 { 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); @@ -1004,13 +1051,13 @@ impl MachineState { }, Addr::Con(Constant::Atom(name)) => (name, 0), 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); 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); return None; @@ -1088,7 +1135,8 @@ impl MachineState { _ => self.fail = true }; } 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.") }, _ => { - 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) } }; @@ -1598,6 +1648,7 @@ impl MachineState { } 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())); match a1.clone() { @@ -1646,10 +1697,10 @@ impl MachineState { self.unify(a1, f_a); } else { - return Err(self.error_form(self.instantiation_error())); + return Err(self.error_form(self.instantiation_error(), stub)); } } 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 } - pub(super) fn try_from_list(&self, r: RegType) -> Result, MachineError> + pub(super) fn try_from_list(&self, r: RegType, caller: MachineStub) + -> Result, MachineError> { let a1 = self.store(self.deref(self[r].clone())); @@ -1709,46 +1761,58 @@ impl MachineState { loop { match self.heap[l].clone() { - HeapCellValue::Addr(Addr::Lis(hcp)) => { - result.push(self.heap[hcp].as_addr(hcp)); - l = hcp + 1; - }, - HeapCellValue::Addr(Addr::Con(Constant::EmptyList)) => - break, - hcv => - return Err(self.type_error(ValidType::List, a1)) + HeapCellValue::Addr(addr) => + match self.store(self.deref(addr)) { + Addr::Lis(hcp) => { + result.push(self.heap[hcp].as_addr(hcp)); + l = hcp + 1; + }, + Addr::Con(Constant::EmptyList) => + 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) }, Addr::HeapCell(_) | Addr::StackCell(..) => - Err(self.error_form(self.instantiation_error())), + Err(self.error_form(self.instantiation_error(), caller)), Addr::Con(Constant::EmptyList) => 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. pub(super) fn project_onto_key(&self, a: Addr) -> Result { + let stub = self.functor_stub(clause_name!("keysort"), 2); + match self.store(self.deref(a)) { Addr::HeapCell(_) | Addr::StackCell(..) => - Err(self.error_form(self.instantiation_error())), + Err(self.error_form(self.instantiation_error(), stub)), Addr::Str(s) => match self.heap[s].clone() { HeapCellValue::NamedStr(2, ref name, Some(Fixity::In)) if *name == clause_name!("-") => Ok(Addr::HeapCell(s+1)), _ => 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)); @@ -1781,12 +1845,60 @@ impl MachineState { power <<= 1; } }, - HeapCellValue::Addr(Addr::Con(Constant::EmptyList)) => - return CycleSearchResult::ProperList(steps), - HeapCellValue::Addr(Addr::HeapCell(_)) | HeapCellValue::Addr(Addr::StackCell(..)) => - return CycleSearchResult::PartialList(steps, hare), - _ => - return CycleSearchResult::NotList + 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 + } + } + } + } + + 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,14 +1913,14 @@ impl MachineState { } } - pub(super) fn skip_max_list(&mut self) { - let max = self.store(self.deref(self[temp_v!(2)].clone())); + pub(super) fn skip_max_list(&mut self) -> Result<(), MachineError> { + let max_steps = self.arith_eval_by_metacall(temp_v!(2))?; - match max { - Addr::Con(Constant::Number(Number::Integer(ref max))) - if !max.is_negative() => { + match max_steps { + Number::Integer(ref max_steps) + if max_steps.to_isize().map(|i| i >= -1).unwrap_or(false) => { let n = self.store(self.deref(self[temp_v!(1)].clone())); - + match n { Addr::Con(Constant::Number(Number::Integer(ref n))) if n.is_zero() => { let xs0 = self[temp_v!(3)].clone(); @@ -1817,9 +1929,18 @@ impl MachineState { 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) => self.finalize_skip_max_list(0, Addr::Lis(l)), CycleSearchResult::EmptyList => @@ -1838,6 +1959,8 @@ impl MachineState { }, _ => self.fail = true }; + + Ok(()) } pub(super) fn duplicate_term(&mut self) { diff --git a/src/tests.rs b/src/tests.rs index ad0d5e74..1bb6e8f6 100644 --- a/src/tests.rs +++ b/src/tests.rs @@ -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, "?- 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, !)).", [["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).", [["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. assert_prolog_success!(&mut wam, "?- '$skip_max_list'(3, 4, [a,b,c|X], Xs0).", [["X = _1", "Xs0 = _1"]]);