diff --git a/src/arithmetic.rs b/src/arithmetic.rs index 59a4f4cdc..e5d6b1145 100644 --- a/src/arithmetic.rs +++ b/src/arithmetic.rs @@ -354,17 +354,17 @@ impl<'a> ArithmeticEvaluator<'a> { } // integer division rounding function -- 9.1.3.1. -pub(crate) fn rnd_i(n: &'_ Number, arena: &mut Arena) -> Number { +pub(crate) fn rnd_i(n: &'_ Number, arena: &mut Arena) -> Result { match n { &Number::Integer(i) => { let result = (&*i).try_into(); if let Ok(value) = result { - fixnum!(Number, value, arena) + Ok(fixnum!(Number, value, arena)) } else { - *n + Ok(*n) } } - Number::Fixnum(_) => *n, + Number::Fixnum(_) => Ok(*n), &Number::Float(f) => { let f = f.floor(); @@ -372,18 +372,23 @@ pub(crate) fn rnd_i(n: &'_ Number, arena: &mut Arena) -> Number { const I64_MAX_TO_F: OrderedFloat = OrderedFloat(i64::MAX as f64); if I64_MIN_TO_F <= f && f <= I64_MAX_TO_F { - fixnum!(Number, f.into_inner() as i64, arena) + Ok(fixnum!(Number, f.into_inner() as i64, arena)) } else { - Number::Integer(arena_alloc!(Integer::from(f.0 as i64), arena)) + Ok(Number::Integer(arena_alloc!( + Integer::try_from(classify_float(f.0)?).unwrap_or_else(|_| { + unreachable!(); + }), + arena + ))) } } Number::Rational(ref r) => { - let (_, floor) = (r.fract(), r.floor()); + let floor = r.floor(); if let Ok(value) = (&floor).try_into() { - fixnum!(Number, value, arena) + Ok(fixnum!(Number, value, arena)) } else { - Number::Integer(arena_alloc!(floor, arena)) + Ok(Number::Integer(arena_alloc!(floor, arena))) } } } diff --git a/src/machine/arithmetic_ops.rs b/src/machine/arithmetic_ops.rs index 64e66f4de..eab7e7080 100644 --- a/src/machine/arithmetic_ops.rs +++ b/src/machine/arithmetic_ops.rs @@ -455,13 +455,8 @@ pub(crate) fn max(n1: Number, n2: Number) -> Result { Ok(Number::Fixnum(n2)) } } - (Number::Integer(n1), Number::Integer(n2)) => { - if n1 > n2 { - Ok(Number::Integer(n1)) - } else { - Ok(Number::Integer(n2)) - } - } + (Number::Integer(n1), Number::Integer(n2)) => Ok(Number::Integer(cmp::max(n1, n2))), + (Number::Rational(r1), Number::Rational(r2)) => Ok(Number::Rational(cmp::max(r1, r2))), (n1, n2) => { let stub_gen = || { let max_atom = atom!("max"); @@ -471,7 +466,15 @@ pub(crate) fn max(n1: Number, n2: Number) -> Result { let f1 = try_numeric_result!(result_f(&n1), stub_gen)?; let f2 = try_numeric_result!(result_f(&n2), stub_gen)?; - Ok(Number::Float(cmp::max(OrderedFloat(f1), OrderedFloat(f2)))) + match OrderedFloat(f1).cmp(&OrderedFloat(f2)) { + cmp::Ordering::Less => Ok(n2), + cmp::Ordering::Equal => { + // Note: n1 and n2 were compared as floats, + // so we return the second argument as a floating point value. + Ok(Number::Float(OrderedFloat(f2))) + } + cmp::Ordering::Greater => Ok(n1), + } } } } @@ -499,13 +502,8 @@ pub(crate) fn min(n1: Number, n2: Number) -> Result { Ok(Number::Fixnum(n2)) } } - (Number::Integer(n1), Number::Integer(n2)) => { - if n1 < n2 { - Ok(Number::Integer(n1)) - } else { - Ok(Number::Integer(n2)) - } - } + (Number::Integer(n1), Number::Integer(n2)) => Ok(Number::Integer(cmp::min(n1, n2))), + (Number::Rational(r1), Number::Rational(r2)) => Ok(Number::Rational(cmp::min(r1, r2))), (n1, n2) => { let stub_gen = || { let min_atom = atom!("min"); @@ -515,7 +513,15 @@ pub(crate) fn min(n1: Number, n2: Number) -> Result { let f1 = try_numeric_result!(result_f(&n1), stub_gen)?; let f2 = try_numeric_result!(result_f(&n2), stub_gen)?; - Ok(Number::Float(cmp::min(OrderedFloat(f1), OrderedFloat(f2)))) + match OrderedFloat(f1).cmp(&OrderedFloat(f2)) { + cmp::Ordering::Less => Ok(n1), + cmp::Ordering::Equal => { + // Note: n1 and n2 were compared as floats, + // so we return the first argument as a floating point value. + Ok(Number::Float(OrderedFloat(f1))) + } + cmp::Ordering::Greater => Ok(n2), + } } } } @@ -623,103 +629,110 @@ pub(crate) fn int_floor_div( idiv(n1, n2, arena) } -pub(crate) fn shr(n1: Number, n2: Number, arena: &mut Arena) -> Result { +pub(crate) fn shr(lhs: Number, rhs: Number, arena: &mut Arena) -> Result { let stub_gen = || { let shr_atom = atom!(">>"); functor_stub(shr_atom, 2) }; - if n2.is_integer() && n2.is_negative() { - return shl(n1, neg(n2, arena), arena); + if rhs.is_integer() && rhs.is_negative() { + return shl(lhs, neg(rhs, arena), arena); } - match (n1, n2) { - (Number::Fixnum(n1), Number::Fixnum(n2)) => { - let n1_i = n1.get_num(); - let n2_i = n2.get_num(); - - // FIXME(arithmetic_overflow) - // what should this do for too large n2, - // - logical right shift should probably turn to 0 - // - arithmetic right shift should maybe differ for negative numbers - // - // note: negaitve n2 is already handled above - #[allow(arithmetic_overflow)] - if let Ok(n2) = usize::try_from(n2_i) { - Ok(Number::arena_from(n1_i >> n2, arena)) - } else { - Ok(Number::arena_from(n1_i >> usize::MAX, arena)) - } - } - (Number::Fixnum(n1), Number::Integer(n2)) => { - let n1 = Integer::from(n1.get_num()); - - let result: Result = (&*n2).try_into(); + match lhs { + Number::Fixnum(lhs) => { + let rhs = match rhs { + Number::Fixnum(fix) => fix.get_num().try_into().unwrap_or(u32::MAX), + Number::Integer(int) => (&*int).try_into().unwrap_or(u32::MAX), + other => { + return Err(numerical_type_error(ValidType::Integer, other, stub_gen)); + } + }; - match result { - Ok(n2) => Ok(Number::arena_from(n1 >> n2, arena)), - Err(_) => Ok(Number::arena_from(n1 >> usize::MAX, arena)), - } - } - (Number::Integer(n1), Number::Fixnum(n2)) => match usize::try_from(n2.get_num()) { - Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 >> n2), arena)), - _ => Ok(Number::arena_from(Integer::from(&*n1 >> usize::MAX), arena)), - }, - (Number::Integer(n1), Number::Integer(n2)) => { - let result: Result = (&*n2).try_into(); + let res = lhs.get_num().checked_shr(rhs).unwrap_or(0); + Ok(Number::arena_from(res, arena)) + } + Number::Integer(lhs) => { + // Note: bigints require `log(n)` bits of space. If `rhs > usize::MAX`, + // then this clamping only becomes an issue when `lhs < 2 ^ (usize::MAX)`: + // - on 32-bit systems, `lhs` would need to be 512MiB big (1/8th of the addressable memory) + // - on 64-bit systems, `lhs` would need to be 2EiB big (!!!) + let rhs = match rhs { + Number::Fixnum(fix) => fix.get_num().try_into().unwrap_or(usize::MAX), + Number::Integer(int) => (&*int).try_into().unwrap_or(usize::MAX), + other => { + return Err(numerical_type_error(ValidType::Integer, other, stub_gen)); + } + }; - match result { - Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 >> n2), arena)), - Err(_) => Ok(Number::arena_from(Integer::from(&*n1 >> usize::MAX), arena)), - } + Ok(Number::arena_from(Integer::from(&*lhs >> rhs), arena)) } - (Number::Integer(_), n2) => Err(numerical_type_error(ValidType::Integer, n2, stub_gen)), - (Number::Fixnum(_), n2) => Err(numerical_type_error(ValidType::Integer, n2, stub_gen)), - (n1, _) => Err(numerical_type_error(ValidType::Integer, n1, stub_gen)), + other => Err(numerical_type_error(ValidType::Integer, other, stub_gen)), } } -pub(crate) fn shl(n1: Number, n2: Number, arena: &mut Arena) -> Result { +pub(crate) fn shl(lhs: Number, rhs: Number, arena: &mut Arena) -> Result { let stub_gen = || { let shl_atom = atom!("<<"); functor_stub(shl_atom, 2) }; - if n2.is_integer() && n2.is_negative() { - return shr(n1, neg(n2, arena), arena); + if rhs.is_integer() && rhs.is_negative() { + return shr(lhs, neg(rhs, arena), arena); } - match (n1, n2) { - (Number::Fixnum(n1), Number::Fixnum(n2)) => { - let n1_i = n1.get_num(); - let n2_i = n2.get_num(); + let rhs = match rhs { + Number::Fixnum(fix) => fix.get_num().try_into().unwrap_or(usize::MAX), + Number::Integer(int) => (&*int).try_into().unwrap_or(usize::MAX), + other => { + return Err(numerical_type_error(ValidType::Integer, other, stub_gen)); + } + }; + + match lhs { + Number::Fixnum(lhs) => { + let lhs = lhs.get_num(); - if let Ok(n2) = usize::try_from(n2_i) { - Ok(Number::arena_from(n1_i << n2, arena)) + if let Some(res) = checked_signed_shl(lhs, rhs) { + Ok(Number::arena_from(res, arena)) } else { - let n1 = Integer::from(n1_i); - Ok(Number::arena_from(n1 << usize::MAX, arena)) + let lhs = Integer::from(lhs); + Ok(Number::arena_from( + Integer::from(lhs << (rhs as usize)), + arena, + )) } } - (Number::Fixnum(n1), Number::Integer(n2)) => { - let n1 = Integer::from(n1.get_num()); + Number::Integer(lhs) => Ok(Number::arena_from( + Integer::from(&*lhs << (rhs as usize)), + arena, + )), + other => Err(numerical_type_error(ValidType::Integer, other, stub_gen)), + } +} - match (&*n2).try_into() as Result { - Ok(n2) => Ok(Number::arena_from(n1 << n2, arena)), - _ => Ok(Number::arena_from(n1 << usize::MAX, arena)), - } +/// Returns `x << shift`, checking for overflow and for values of `shift` that are too big. +#[inline] +fn checked_signed_shl(x: i64, shift: usize) -> Option { + if shift == 0 { + return Some(x); + } + + if x >= 0 { + // Note: for unsigned integers, the condition would usually be spelled + // `shift <= x.leading_zeros()`, but since the MSB for signed integers + // controls the sign, we need to make sure that `shift` is at most + // `x.leading_zeros() - 1`. + if shift < x.leading_zeros() as usize { + Some(x << shift) + } else { + None } - (Number::Integer(n1), Number::Fixnum(n2)) => match usize::try_from(n2.get_num()) { - Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 << n2), arena)), - _ => Ok(Number::arena_from(Integer::from(&*n1 << usize::MAX), arena)), - }, - (Number::Integer(n1), Number::Integer(n2)) => match (&*n2).try_into() as Result { - Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 << n2), arena)), - _ => Ok(Number::arena_from(Integer::from(&*n1 << usize::MAX), arena)), - }, - (Number::Integer(_), n2) => Err(numerical_type_error(ValidType::Integer, n2, stub_gen)), - (Number::Fixnum(_), n2) => Err(numerical_type_error(ValidType::Integer, n2, stub_gen)), - (n1, _) => Err(numerical_type_error(ValidType::Integer, n1, stub_gen)), + } else { + let y = x.checked_neg()?; + // FIXME: incorrectly rejects `-2 ^ 62 << 1`. This is currently a non-issue, + // since the bitshift is then done as a `Number::Integer` + checked_signed_shl(y, shift).and_then(|res| res.checked_neg()) } } @@ -947,8 +960,7 @@ pub(crate) fn gcd(n1: Number, n2: Number, arena: &mut Arena) -> Result { - let n2: isize = (&*n2).try_into().unwrap(); - let value: Integer = (&*n1).gcd(&Integer::from(n2)).into(); + let value: Integer = (&*n1).gcd(&*n2).into(); Ok(Number::arena_from(value, arena)) } (Number::Float(f), _) | (_, Number::Float(f)) => { @@ -1044,7 +1056,12 @@ pub(crate) fn sqrt(n1: Number) -> Result { #[inline] pub(crate) fn floor(n1: Number, arena: &mut Arena) -> Number { - rnd_i(&n1, arena) + rnd_i(&n1, arena).unwrap_or_else(|_err| { + // FIXME: Currently floor/1 (and several call sites) are infallible, + // but the failing cases (when `n1` is `Number::Float(NAN)` or `Number::Float(INFINITY)`) + // are not reachable with standard is/2 operations. + todo!("Make floor/1 fallible"); + }) } #[inline] @@ -1067,16 +1084,22 @@ pub(crate) fn truncate(n: Number, arena: &mut Arena) -> Number { } } -pub(crate) fn round(n: Number, arena: &mut Arena) -> Result { - let stub_gen = || { - let is_atom = atom!("is"); - functor_stub(is_atom, 2) +pub(crate) fn round(num: Number, arena: &mut Arena) -> Result { + let res = match num { + Number::Fixnum(_) | Number::Integer(_) => num, + Number::Rational(rat) => Number::arena_from(rat.round(), arena), + Number::Float(f) => Number::Float(OrderedFloat((*f).round())), }; - let result = add(n, Number::Float(OrderedFloat(0.5f64)), arena); - let result = try_numeric_result!(result, stub_gen)?; + // FIXME: make round/1 return EvalError + rnd_i(&res, arena).map_err(|err| -> MachineStubGen { + Box::new(move |machine_st| { + let eval_error = machine_st.evaluation_error(err); + let stub = functor_stub(atom!("round"), 1); - Ok(floor(result, arena)) + machine_st.error_form(eval_error, stub) + }) + }) } pub(crate) fn bitwise_complement(n1: Number, arena: &mut Arena) -> Result { diff --git a/src/tests/arithmetic.pl b/src/tests/arithmetic.pl new file mode 100644 index 000000000..2e4872d47 --- /dev/null +++ b/src/tests/arithmetic.pl @@ -0,0 +1,684 @@ +:- module(arithmetic_tests, []). +:- use_module(test_framework). +:- use_module(library(pairs)). +:- use_module(library(iso_ext)). +:- use_module(library(lists)). +:- use_module(library(between)). + +test_value(X, Y, Expected) :- + R1 is 7 rdiv 8, + R2 is -9 rdiv 10, + pairs_keys_values(Pairs, [1, -2, 3.4, -5.6, R1, R2, 18446744073709551616, -9223372036854775808], Expected), + member(X-Y, Pairs). + +approx_eq(X, Y) :- + Delta is abs(X - Y), + Delta < 0.00001. + +test_abs(X, Exp) :- + Y is abs(X), + Y == Exp, + call(is, Y, abs(X)). + +test_neg(X, Exp) :- + Y is -X, + Y == Exp, + call(is, Y, -X). + +test_truncate(X, Exp) :- + Y is truncate(X), + Y == Exp, + call(is, Y, truncate(X)). + +test_floor(X, Exp) :- + Y is floor(X), + Y == Exp, + call(is, Y, floor(X)). + +test_ceiling(X, Exp) :- + Y is ceiling(X), + Y == Exp, + call(is, Y, ceiling(X)). + +test_round(X, Exp) :- + Y is round(X), + Y == Exp, + call(is, Y, round(X)). + +test_float(X, Exp) :- + Y is float(X), + Y == Exp, + call(is, Y, float(X)). + +test_plus(X) :- + Y is +X, + Y == X, + call(is, Y, +X). + +test_cos_sin(X) :- + Cos is cos(X), + Sin is sin(X), + ground(Cos), + ground(Sin), + call(is, Cos, cos(X)), + call(is, Sin, sin(X)), + + One is Cos * Cos + Sin * Sin, + arithmetic_tests:approx_eq(One, 1.0), + + Sin2 is cos(X - pi/2), + arithmetic_tests:approx_eq(Sin, Sin2), + call(is, Sin3, cos(X - pi/2)), + arithmetic_tests:approx_eq(Sin, Sin3), + + Cos2 is sin(X + pi/2), + arithmetic_tests:approx_eq(Cos, Cos2), + call(is, Cos3, sin(X + pi/2)), + arithmetic_tests:approx_eq(Cos, Cos3). + +test_tan(X) :- + Cos is cos(X), + Sin is sin(X), + Tan is tan(X), + Tan2 is Sin / Cos, + arithmetic_tests:approx_eq(Tan, Tan2), + call(is, Tan, tan(X)). + +test_float_fractional_part(X, Exp) :- + Y is float_fractional_part(X), + arithmetic_tests:approx_eq(Y, Exp), + call(is, Y, float_fractional_part(X)). + +test_float_integer_part(X, Exp) :- + Y is float_integer_part(X), + Y == Exp, + call(is, Y, float_integer_part(X)). + +test_sqrt(X) :- + Abs is abs(X), + Y is sqrt(Abs), + Y2 is Y * Y, + One is Y2 / Abs, + arithmetic_tests:approx_eq(One, 1.0), + call(is, Y, sqrt(abs(X))). + +test_log(X) :- + Abs is abs(X), + Y is log(Abs), + Y2 is e ^ Y, + One is Y2 / Abs, + arithmetic_tests:approx_eq(One, 1.0), + call(is, Y, log(abs(X))). + +test_exp(X) :- + Y is exp(X), + Y2 is e ^ X, + arithmetic_tests:approx_eq(Y2, Y), + call(is, Y, exp(X)). + +test_acos(X) :- + XMod is abs(X) - (floor(abs(X) / pi) * pi), + Cos is cos(XMod), + Y is acos(Cos), + arithmetic_tests:approx_eq(Y, XMod), + call(is, Y, acos(Cos)). + +test_asin(X) :- + XMod is abs(X) - (floor(abs(X) / (pi / 2)) * (pi / 2)), + Sin is sin(XMod), + Y is asin(Sin), + arithmetic_tests:approx_eq(Y, XMod), + call(is, Y, asin(Sin)). + +test_atan(X) :- + XMod is abs(X) - (floor(abs(X) / (pi / 2)) * (pi / 2)), + Tan is tan(XMod), + Y is atan(Tan), + arithmetic_tests:approx_eq(Y, XMod), + call(is, Y, atan(Tan)). + +test_bitwise_complement(X, Exp) :- + X2 is floor(X), + Y is \X2, + Y == Exp, + call(is, Y, \X2). + +test_sign(X, Exp) :- + Y is sign(X), + Y == Exp, + call(is, Y, sign(X)). + +test_add(X, Y, Z) :- + Z2 is X + Y, + Z == Z2, + call(is, Z3, X + Y), + Z == Z3, + Z is Y + X, + call(is, Z, Y + X). + +test_mul(X, Y, Z) :- + Z2 is X * Y, + Z == Z2, + call(is, Z3, X * Y), + Z == Z3, + Z is Y * X, + call(is, Z, Y * X). + +test_sub(X, Y) :- + Z is X + (-Y), + Z2 is X - Y, + Z == Z2, + call(is, Z3, X - Y), + Z == Z3. + +test_idiv :- + Z is -2 // 3, + Z == 0, + Z2 is -4 // 3, + Z2 == -1, + \+ catch(_ is 5.0 // 2, _, false), + \+ catch(_ is 5 // 2.0, _, false), + \+ catch(_ is 5 // 0, _, false), + \+ catch(_ is 36893488147419103232 // 0, _, false), + Z3 is 36893488147419103232 // 3, + Z3 == 12297829382473034410. + +test_div :- + Z is -2 div 3, + Z == -1, + Z2 is -4 div 3, + Z2 == -2, + \+ catch(_ is 5.0 div 2, _, false), + \+ catch(_ is 5 div 2.0, _, false), + \+ catch(_ is 5 div 0, _, false), + \+ catch(_ is 36893488147419103232 div 0, _, false), + Z3 is 36893488147419103232 div 3, + Z3 == 12297829382473034410. + +test_pow(X, Y, Z) :- + Z2 is X ** Y, + Z == Z2, + call(is, Z3, X ** Y), + Z == Z3. + +test_ipow(X, Y, Z) :- + Z2 is X ^ Y, + Z == Z2, + call(is, Z3, X ^ Y), + Z == Z3. + + +test_min_max(X, Y, L) :- + lists:nth1(X, L, XVal), + lists:nth1(Y, L, YVal), + Min is min(XVal, YVal), + call(is, Min2, min(XVal, YVal)), + Min == Min2, + Max is max(XVal, YVal), + call(is, Max2, max(XVal, YVal)), + Max == Max2, + ( + X < Y -> Min == XVal, Max == YVal + ; Min == YVal, Max == XVal + ). + + + +test_rdiv(X, Y) :- + Z is X rdiv Y, + call(is, Z2, X rdiv Y), + Z == Z2, + Z3 is float(Z) / (X / Y), + arithmetic_tests:approx_eq(Z3, 1.0). + + +test_shift(X, Y) :- + (Y >= 0 -> + ShlExpected is X * (2 ^ Y), + ShrExpected is X // (2 ^ Y) + ; + ShlExpected is X // (2 ^ -Y), + ShrExpected is X * (2 ^ -Y) + ), + Shl is X << Y, + Shr is X >> Y, + Shl == ShlExpected, + Shr == ShrExpected, + call(is, Shl2, X << Y), + call(is, Shr2, X >> Y), + Shl == Shl2, + Shr == Shr2. + +test_and_or_xor(X, Y, AndExpected, OrExpected, XorExpected) :- + And is X /\ Y, + And2 is Y /\ X, + And == AndExpected, + And == And2, + Or is X \/ Y, + Or2 is Y \/ X, + Or == OrExpected, + Or == Or2, + Xor is X xor Y, + Xor2 is Y xor X, + Xor == XorExpected, + Xor2 == Xor, + + call(is, And3, X /\ Y), + call(is, Or3, X \/ Y), + call(is, Xor3, X xor Y), + And3 == And, + Or3 == Or, + Xor3 == Xor. + +test_mod_rem(X, Y) :- + RemExpected is X - (X // Y) * Y, + ModExpected is X - (X div Y) * Y, + Mod is X mod Y, + Rem is X rem Y, + call(is, Mod2, X mod Y), + call(is, Rem2, X rem Y), + Mod2 == Mod, + Mod == ModExpected, + X2 is ((X - Mod) // Y) * Y + Mod, + X2 == X, + Rem == RemExpected, + Rem2 == Rem. + +test_atan2(Angle) :- + Cos is cos(Angle), + Sin is sin(Angle), + A is atan2(Sin, Cos), + arithmetic_tests:approx_eq(A, Angle), + call(is, A2, atan2(Sin, Cos)), + A == A2, + A3 is atan2(Sin * 1.5, Cos * 1.5), + arithmetic_tests:approx_eq(A3, Angle). + +test_gcd(X, Y, Expected) :- + Gcd is gcd(X, Y), + Gcd2 is gcd(Y, X), + call(is, Gcd3, gcd(X, Y)), + Gcd == Expected, + Gcd2 == Expected, + Gcd3 == Expected. + +test_bad_uninstantiated :- _ is _. +test_bad_uninstantiated2 :- _ is _ + 1. +test_bad_recursive :- X is 1 \/ X. +test_bad_corecursive :- X = Y, Y is 2 \/ X. +test_bad_corecursive2 :- X = 1 /\ Y, Y is 2 + X. + +% This is unfortunately a bit too spicy for the compiler as of now: +% insert_infinite(X, Inf, Inf) :- X == recursive. +% insert_infinite(X, _, X) :- nonvar(X) -> X \= recursive; true. + +% term_expansion(make_infinite(Name, X is Op), (Name :- X is Infinite)) :- +% Op =.. [OpName, Lhs, Rhs], +% insert_infinite(Lhs, Infinite, LhsInf), +% insert_infinite(Rhs, Infinite, RhsInf), +% Infinite =.. [OpName, LhsInf, RhsInf]. + +% :- dynamic(test_bad_recursive2/0). +% make_infinite(test_bad_recursive2, _ is 1 + recursive). + +test("test_value", ( + R1 is 7 rdiv 8, + R2 is -9 rdiv 10, + findall([X, Y], arithmetic_tests:test_value( + X, Y, + [1, -2, 3.4, -5.6, R1, R2, 18446744073709551616, -9223372036854775808] + ), L), + length(L, Len), + Len > 0 +)). + +test("abs", ( + R1 is 7 rdiv 8, + R2 is 9 rdiv 10, + forall(arithmetic_tests:test_value( + X, Exp, + [1, 2, 3.4, 5.6, R1, R2, 18446744073709551616, 9223372036854775808] + ), arithmetic_tests:test_abs(X, Exp)) +)). + +test("neg", ( + R1 is -7 rdiv 8, + R2 is 9 rdiv 10, + forall(arithmetic_tests:test_value( + X, Exp, + [-1, 2, -3.4, 5.6, R1, R2, -18446744073709551616, 9223372036854775808] + ), arithmetic_tests:test_neg(X, Exp)) +)). + +test("truncate", ( + forall(arithmetic_tests:test_value( + X, Exp, + [1, -2, 3, -5, 0, 0, 18446744073709551616, -9223372036854775808] + ), arithmetic_tests:test_truncate(X, Exp)) +)). + +test("floor", ( + forall(arithmetic_tests:test_value( + X, Exp, + [1, -2, 3, -6, 0, -1, 18446744073709551616, -9223372036854775808] + ), arithmetic_tests:test_floor(X, Exp)) +)). + +test("ceiling", ( + forall(arithmetic_tests:test_value( + X, Exp, + [1, -2, 4, -5, 1, 0, 18446744073709551616, -9223372036854775808] + ), arithmetic_tests:test_ceiling(X, Exp)) +)). + +test("round", ( + forall(arithmetic_tests:test_value( + X, Exp, + [1, -2, 3, -6, 1, -1, 18446744073709551616, -9223372036854775808] + ), arithmetic_tests:test_round(X, Exp)) +)). + +test("float", ( + forall(arithmetic_tests:test_value( + X, Exp, + [1.0, -2.0, 3.4, -5.6, 0.875, -0.9, 18446744073709551616.0, -9223372036854775808.0] + ), arithmetic_tests:test_float(X, Exp)) +)). + +test("plus", ( + forall(arithmetic_tests:test_value(X, _, _), arithmetic_tests:test_plus(X)) +)). + +test("cos_sin", ( + forall((arithmetic_tests:test_value(X, _, _), X < 100.0, X > -100.0), arithmetic_tests:test_cos_sin(X)) +)). + +test("tan", ( + forall(arithmetic_tests:test_value(X, _, _), arithmetic_tests:test_tan(X)) +)). + +test("float_fractional_part", ( + forall( + arithmetic_tests:test_value(X, Exp, [0.0, 0.0, 0.4, -0.6, 0.875, -0.9, 0.0, 0.0]), + arithmetic_tests:test_float_fractional_part(X, Exp) + ) +)). + +test("float_integer_part", ( + forall( + arithmetic_tests:test_value(X, Exp, [1.0, -2.0, 3.0, -5.0, 0.0, 0.0, 18446744073709551616.0, -9223372036854775808.0]), + arithmetic_tests:test_float_integer_part(X, Exp) + ) +)). + +test("sqrt", ( + forall(arithmetic_tests:test_value(X, _, _), arithmetic_tests:test_sqrt(X)), + \+ catch(_ is sqrt(-1.0), _, false) +)). + +test("log", ( + forall(arithmetic_tests:test_value(X, _, _), arithmetic_tests:test_log(X)), + \+ catch(_ is log(0.0), _, false), + \+ catch(_ is log(0), _, false), + \+ catch(_ is log(-1.0), _, false), + \+ catch(_ is log(-1), _, false) +)). + +test("exp", ( + forall((arithmetic_tests:test_value(X, _, _), X < 1000), arithmetic_tests:test_exp(X)), + \+ catch(_ is exp(10000), _, false) +)). + +test("acos", ( + forall( + (arithmetic_tests:test_value(X, _, _), X < 1000, X > -1000), + arithmetic_tests:test_acos(X) + ) +)). + +test("asin", ( + forall( + (arithmetic_tests:test_value(X, _, _), X < 1000, X > -1000), + arithmetic_tests:test_asin(X) + ) +)). + +test("atan", ( + forall( + (arithmetic_tests:test_value(X, _, _), X < 1000, X > -1000), + arithmetic_tests:test_atan(X) + ) +)). + +test("bitwise_complement", ( + forall(arithmetic_tests:test_value( + X, Exp, + [-2, 1, -4, 5, -1, 0, -18446744073709551617, 9223372036854775807] + ), arithmetic_tests:test_bitwise_complement(X, Exp)), + \+ catch(_ is \1.0, _, false) +)). + +test("sign", ( + forall( + arithmetic_tests:test_value(X, Exp, [1, -1, 1.0, -1.0, 1, -1, 1, -1]), + arithmetic_tests:test_sign(X, Exp) + ) +)). + +test("add", ( + R is 3 rdiv 7, + R2 is 17 rdiv 7, + B is 147573952589676412928, + BF is -147573952589676412928.0, + B1 is 147573952589676412929, % B + 1 + B2 is 295147905179352825856, + BR is 1033017668127734890499 rdiv 7, % B + R + forall( + lists:member([X, Y, Z], [ + [0, 0, 0], + [-100, 120, 20], + [0.5, -3, -2.5], + [R, 2, R2], + [B, 1, B1], + [B, B, B2], + [B, BF, 0.0], + [B, R, BR] + ]), + arithmetic_tests:test_add(X, Y, Z) + ) +)). + +test("mul", ( + R is 3 rdiv 4, + R2 is 3 rdiv 2, + RSquared is 9 rdiv 16, + forall( + lists:member([X, Y, Z], [ + [0, 0, 0], + [2, -3, -6], + [R, R, RSquared], + [R, 2, R2], + [R, 2.0, 1.5], + [1.5, -4.0, -6.0], + [4294967296, 4294967296, 18446744073709551616], + [18446744073709551616, 18446744073709551616, 340282366920938463463374607431768211456], + [18446744073709551616, R, 13835058055282163712], + [18446744073709551616, 2.0, 36893488147419103232.0] + ]), + arithmetic_tests:test_mul(X, Y, Z) + ) +)). + +test("sub", ( + R is 3 rdiv 4, + forall(( + lists:member(X, [0, 1, -7, 1.5, R, 18446744073709551616]), + lists:member(Y, [0, 1, -7, 1.5, R, 18446744073709551616]) + ), arithmetic_tests:test_sub(X, Y)) +)). + +test("idiv", test_idiv). + +test("div", test_div). + +test("pow", ( + R is 3 rdiv 2, + forall( + lists:member([X, Y, Z], [ + [0, 0, 1.0], + [2, 3, 8.0], + [-2, 3, -8.0], + [4294967296, 2, 18446744073709551616.0], + [4294967296, 2.0, 18446744073709551616.0], + [R, 2, 2.25], + [R, 2.0, 2.25] + ]), + arithmetic_tests:test_pow(X, Y, Z) + ) +)). + +test("ipow", ( + R is 3 rdiv 2, + forall( + lists:member([X, Y, Z], [ + [0, 0, 1], + [2, 3, 8], + [-2, 3, -8], + [4294967296, 2, 18446744073709551616], + [4294967296, 2.0, 18446744073709551616.0], + [R, 2, 2.25], % Note: Could be implemented to return a rational instead + [R, 2.0, 2.25], + [-1, 18446744073709551617, -1], + [18446744073709551616, 2, 340282366920938463463374607431768211456] + ]), + arithmetic_tests:test_ipow(X, Y, Z) + ), + \+ catch(X is -3 ^ -2, _, false), + \+ catch(X is -30000000000000000000000000 ^ -2, _, false), + \+ catch(X is -3 ^ -20000000000000000000000000, _, false) +)). + +test("min_max", ( + R1 is 3 rdiv 2, + R2 is -4 rdiv 7, + R3 is 5 rdiv 9, + L = [-46, R2, 0, R3, 1, R1, 1.6, 9223372036854775807, 9223372036854775808], + length(L, Len), + forall(( + between:between(1, Len, X), + between:between(1, Len, Y) + ), arithmetic_tests:test_min_max(X, Y, L)) +)). + +test("rdiv", ( + R is 3 rdiv 7, + forall(( + lists:member(X, [2, -3, R, 4.5, 9223372036854775807]), + lists:member(Y, [1, -17, R, 9223372036854775807]) + ), arithmetic_tests:test_rdiv(X, Y)), + \+ catch(_ is 5 rdiv 0, _, false), + \+ catch(_ is 36893488147419103232 rdiv 0, _, false) +)). + +test("shift", ( + forall(( + % Note: shifting negative integers is implementation-defined. + lists:member(X, [2, 3, 5, 9223372036854775807, 36893488147419103232]), + lists:member(Y, [1, 0, -1, 4, -4, 63, 64, -63, -64]) + ), arithmetic_tests:test_shift(X, Y)) +)). + +test("and_or_xor", ( + forall(lists:member([X, Y, AndExpected, OrExpected, XorExpected], [ + [0, 0, 0, 0, 0], + [0, 1, 0, 1, 1], + [1, 1, 1, 1, 0], + [3, 6, 2, 7, 5], + [2, -3, 0, -1, -1], + [-4, -7, -8, -3, 5], + [ + 55340232221128654848, + 110680464442257309696, + 36893488147419103232, + 129127208515966861312, + 92233720368547758080 + ], + [ + -55340232221128654849, + -110680464442257309697, + -129127208515966861313, + -36893488147419103233, + 92233720368547758080 + ] + ]), arithmetic_tests:test_and_or_xor(X, Y, AndExpected, OrExpected, XorExpected)), + \+ catch(_ is 1 /\ 2.0, _, false), + \+ catch(_ is 1 \/ 2.0, _, false), + \+ catch(_ is 1 xor 2.0, _, false) +)). + +test("mod_rem", ( + forall(( + lists:member(X, [2, -3, 7, 9223372036854775807, 9223372036854775809]), + lists:member(Y, [1, -17, 7, 9223372036854775807]) + ), arithmetic_tests:test_mod_rem(X, Y)), + + \+ catch(_ is 2 mod 0, _, false), + \+ catch(_ is 2 rem 0, _, false), + + \+ catch(_ is 2.0 mod 1, _, false), + \+ catch(_ is 2.0 rem 1, _, false), + + \+ catch(_ is 2 mod 1.0, _, false), + \+ catch(_ is 2 rem 1.0, _, false) +)). + +test("atan2", ( + forall(lists:member(Angle, [0, -1, 1, 3.14, -2.7]), arithmetic_tests:test_atan2(Angle)), + % ISO states that atan2(0, 0) should throw, but SWI-Prolog chooses to instead return zero. + \+ catch(X is atan2(0.0, 0.0), _, false), + \+ catch(X is atan2(0.0, 0), _, false), + \+ catch(X is atan2(0, 0.0), _, false) +)). + +test("gcd", ( + forall( + lists:member([X, Y, Expected], [ + [0, 0, 0], + [0, 1, 1], + [0, 4, 4], + [1, 4, 1], + [2, 4, 2], + [3, 7, 1], + [9223372036854775807, 343, 49], + [36893488147419103231, 145295143558111, 145295143558111], + [258254417031933722617, 36893488147419103231, 36893488147419103231], + [-9223372036854775808, -9223372036854775808, 9223372036854775808] + ]), + arithmetic_tests:test_gcd(X, Y, Expected) + ), + \+ catch(X is gcd(1.0, 1), _, false), + \+ catch(X is gcd(1 rdiv 2, 1), _, false) +)). + +test("bad", ( + % Uninstantiated variables: + \+ catch(test_bad_uninstantiated, _, false), + \+ catch(call(is, _, X), _, false), + \+ catch(test_bad_uninstantiated2, _, false), + \+ catch(call(is, _, X + 1), _, false), + + % Missing function: + \+ catch(test_bad_missing, _, false), + \+ catch(call(is, _, float(1, 2, 3)), _, false), + + % Recursive expression: + \+ catch((X = 1 /\ X, call(is, _, X)), _, false), + \+ catch(test_bad_recursive, _, false), + \+ catch(call(is, X, 1 /\ X), _, false), + + % Co-recursive expressions: + \+ catch(test_bad_corecursive, _, false), + \+ catch((X = 1 /\ Y, Y = 2 \/ X, _ is Y), _, false), + \+ catch(test_bad_corecursive2, _, false), + \+ catch((X = 1 /\ Y, Y is 2 \/ X), _, false) +)). diff --git a/tests/scryer/cli/src_tests/arithmetic.stderr b/tests/scryer/cli/src_tests/arithmetic.stderr new file mode 100644 index 000000000..e69de29bb diff --git a/tests/scryer/cli/src_tests/arithmetic.stdout b/tests/scryer/cli/src_tests/arithmetic.stdout new file mode 100644 index 000000000..4952cede6 --- /dev/null +++ b/tests/scryer/cli/src_tests/arithmetic.stdout @@ -0,0 +1 @@ +All tests passed \ No newline at end of file diff --git a/tests/scryer/cli/src_tests/arithmetic.toml b/tests/scryer/cli/src_tests/arithmetic.toml new file mode 100644 index 000000000..e8192458e --- /dev/null +++ b/tests/scryer/cli/src_tests/arithmetic.toml @@ -0,0 +1 @@ +args = ["-f", "--no-add-history", "src/tests/arithmetic.pl", "-f", "-g", "use_module(library(arithmetic_tests)), arithmetic_tests:main_quiet(arithmetic_tests)"]