Merge pull request #2777 from adri326/fix-2772-rnd_i-clipping

Fix invalid casts in is/2

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<Number, EvalError> {
     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<f64> = 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)))
             }
         }
     }

src/machine/arithmetic_ops.rs

@@ -455,13 +455,8 @@ pub(crate) fn max(n1: Number, n2: Number) -> Result<Number, MachineStubGen> {
                 Ok(Number::Fixnum(n2))
             }
         }
-        (Number::Integer(n1), Number::Integer(n2)) => {
+        (Number::Integer(n1), Number::Integer(n2)) => Ok(Number::Integer(cmp::max(n1, n2))),
-            if n1 > n2 {
+        (Number::Rational(r1), Number::Rational(r2)) => Ok(Number::Rational(cmp::max(r1, r2))),
-                Ok(Number::Integer(n1))
-            } else {
-                Ok(Number::Integer(n2))
-            }
-        }
         (n1, n2) => {
             let stub_gen = || {
                 let max_atom = atom!("max");
@@ -471,7 +466,15 @@ pub(crate) fn max(n1: Number, n2: Number) -> Result<Number, MachineStubGen> {
             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<Number, MachineStubGen> {
                 Ok(Number::Fixnum(n2))
             }
         }
-        (Number::Integer(n1), Number::Integer(n2)) => {
+        (Number::Integer(n1), Number::Integer(n2)) => Ok(Number::Integer(cmp::min(n1, n2))),
-            if n1 < n2 {
+        (Number::Rational(r1), Number::Rational(r2)) => Ok(Number::Rational(cmp::min(r1, r2))),
-                Ok(Number::Integer(n1))
-            } else {
-                Ok(Number::Integer(n2))
-            }
-        }
         (n1, n2) => {
             let stub_gen = || {
                 let min_atom = atom!("min");
@@ -515,7 +513,15 @@ pub(crate) fn min(n1: Number, n2: Number) -> Result<Number, MachineStubGen> {
             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<Number, MachineStubGen> {
+pub(crate) fn shr(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number, MachineStubGen> {
     let stub_gen = || {
         let shr_atom = atom!(">>");
         functor_stub(shr_atom, 2)
     };
 
-    if n2.is_integer() && n2.is_negative() {
+    if rhs.is_integer() && rhs.is_negative() {
-        return shl(n1, neg(n2, arena), arena);
+        return shl(lhs, neg(rhs, arena), arena);
     }
 
-    match (n1, n2) {
+    match lhs {
-        (Number::Fixnum(n1), Number::Fixnum(n2)) => {
+        Number::Fixnum(lhs) => {
-            let n1_i = n1.get_num();
+            let rhs = match rhs {
-            let n2_i = n2.get_num();
+                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));
+                }
+            };
 
-            // FIXME(arithmetic_overflow)
+            let res = lhs.get_num().checked_shr(rhs).unwrap_or(0);
-            // what should this do for too large n2,
+            Ok(Number::arena_from(res, arena))
-            // - 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)) => {
+        Number::Integer(lhs) => {
-            let n1 = Integer::from(n1.get_num());
+            // 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));
+                }
+            };
 
-            let result: Result<usize, _> = (&*n2).try_into();
+            Ok(Number::arena_from(Integer::from(&*lhs >> rhs), arena))
-
-            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()) {
+        other => Err(numerical_type_error(ValidType::Integer, other, stub_gen)),
-            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<usize, _> = (&*n2).try_into();
-
-            match result {
-                Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 >> n2), arena)),
-                Err(_) => 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)),
     }
 }
 
-pub(crate) fn shl(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, MachineStubGen> {
+pub(crate) fn shl(lhs: Number, rhs: Number, arena: &mut Arena) -> Result<Number, MachineStubGen> {
     let stub_gen = || {
         let shl_atom = atom!("<<");
         functor_stub(shl_atom, 2)
     };
 
-    if n2.is_integer() && n2.is_negative() {
+    if rhs.is_integer() && rhs.is_negative() {
-        return shr(n1, neg(n2, arena), arena);
+        return shr(lhs, neg(rhs, arena), arena);
     }
 
-    match (n1, n2) {
+    let rhs = match rhs {
-        (Number::Fixnum(n1), Number::Fixnum(n2)) => {
+        Number::Fixnum(fix) => fix.get_num().try_into().unwrap_or(usize::MAX),
-            let n1_i = n1.get_num();
+        Number::Integer(int) => (&*int).try_into().unwrap_or(usize::MAX),
-            let n2_i = n2.get_num();
+        other => {
+            return Err(numerical_type_error(ValidType::Integer, other, stub_gen));
+        }
+    };
 
-            if let Ok(n2) = usize::try_from(n2_i) {
+    match lhs {
-                Ok(Number::arena_from(n1_i << n2, arena))
+        Number::Fixnum(lhs) => {
+            let lhs = lhs.get_num();
+
+            if let Some(res) = checked_signed_shl(lhs, rhs) {
+                Ok(Number::arena_from(res, arena))
             } else {
-                let n1 = Integer::from(n1_i);
+                let lhs = Integer::from(lhs);
-                Ok(Number::arena_from(n1 << usize::MAX, arena))
+                Ok(Number::arena_from(
+                    Integer::from(lhs << (rhs as usize)),
+                    arena,
+                ))
             }
         }
-        (Number::Fixnum(n1), Number::Integer(n2)) => {
+        Number::Integer(lhs) => Ok(Number::arena_from(
-            let n1 = Integer::from(n1.get_num());
+            Integer::from(&*lhs << (rhs as usize)),
+            arena,
+        )),
+        other => Err(numerical_type_error(ValidType::Integer, other, stub_gen)),
+    }
+}
 
-            match (&*n2).try_into() as Result<usize, _> {
+/// Returns `x << shift`, checking for overflow and for values of `shift` that are too big.
-                Ok(n2) => Ok(Number::arena_from(n1 << n2, arena)),
+#[inline]
-                _ => Ok(Number::arena_from(n1 << usize::MAX, arena)),
+fn checked_signed_shl(x: i64, shift: usize) -> Option<i64> {
-            }
+    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()) {
+    } else {
-            Ok(n2) => Ok(Number::arena_from(Integer::from(&*n1 << n2), arena)),
+        let y = x.checked_neg()?;
-            _ => Ok(Number::arena_from(Integer::from(&*n1 << usize::MAX), arena)),
+        // FIXME: incorrectly rejects `-2 ^ 62 << 1`. This is currently a non-issue,
-        },
+        // since the bitshift is then done as a `Number::Integer`
-        (Number::Integer(n1), Number::Integer(n2)) => match (&*n2).try_into() as Result<usize, _> {
+        checked_signed_shl(y, shift).and_then(|res| res.checked_neg())
-            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)),
     }
 }
 
@@ -947,8 +960,7 @@ pub(crate) fn gcd(n1: Number, n2: Number, arena: &mut Arena) -> Result<Number, M
             Ok(Number::arena_from(Integer::from(n2_clone.gcd(&n1)), arena))
         }
         (Number::Integer(n1), Number::Integer(n2)) => {
-            let n2: isize = (&*n2).try_into().unwrap();
+            let value: Integer = (&*n1).gcd(&*n2).into();
-            let value: Integer = (&*n1).gcd(&Integer::from(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<f64, MachineStubGen> {
 
 #[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<Number, MachineStubGen> {
+pub(crate) fn round(num: Number, arena: &mut Arena) -> Result<Number, MachineStubGen> {
-    let stub_gen = || {
+    let res = match num {
-        let is_atom = atom!("is");
+        Number::Fixnum(_) | Number::Integer(_) => num,
-        functor_stub(is_atom, 2)
+        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);
+    // FIXME: make round/1 return EvalError
-    let result = try_numeric_result!(result, stub_gen)?;
+    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<Number, MachineStubGen> {

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)
+)).

tests/scryer/cli/src_tests/arithmetic.stdout

@@ -0,0 +1 @@
+All tests passed

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)"]