First shot at a "smart" nqp::pow_I opcode

The idea is to return either a bigint or a float (for the +-Inf case,
and when the exponent is negative).

The float part isn't tested yet, so likely wrong. The part that returns
bigints has sparse test coverage, so it might be not too far off.

Author: moritz

src/PAST/NQP.pir

@@ -455,6 +455,7 @@ entry to produce the node to be returned.
     maphash['mod_I']    = 'nqp_bigint_mod__PPP'
     maphash['mod_n']    = 'mod__Nnn'
     maphash['pow_n']    = 'pow__Nnn'
+    maphash['pow_I']    = 'nqp_bigint_pow__PPPP'
     maphash['neg_i']    = 'neg__Ii'
     maphash['neg_I']    = 'nqp_bigint_neg__PP'
     maphash['neg_n']    = 'neg__Nn'

src/ops/nqp_bigint.ops

@@ -318,3 +318,64 @@ inline op nqp_bigint_radix(out PMC, in INT, in STR, in INT, in INT, in PMC) :bas
     VTABLE_set_pmc_keyed_int(interp, out, 2, pos_obj);
     $1 = out;
 }
+
+/* calculates $1 = $2 ** $3
+ * if it either overflows ($3 being too big), or $2 is negative,
+ * a float is returned. $4 should contain the type object to box the
+ * float into.
+ */
+inline op nqp_bigint_pow(out PMC, in PMC, in PMC, in PMC) :base_core {
+    mp_digit exponent_d = 0;
+    mp_int *exponent = get_bigint(interp, $3);
+    mp_int *base     = get_bigint(interp, $2);
+    int cmp          = mp_cmp_d(exponent, 0);
+    if (cmp == MP_EQ || MP_EQ == mp_cmp_d(base, 1)) {
+        /* $x ** 0 or 1 ** $x */
+        $1 = REPR($2)->allocate(interp, STABLE($2));
+        REPR($1)->initialize(interp, STABLE($1), OBJECT_BODY($1));
+        mp_set_int(get_bigint(interp, $1), 1);
+    }
+    else if (cmp == MP_GT) {
+        exponent_d = mp_get_int(exponent);
+        if (MP_GT == mp_cmp_d(exponent, exponent_d)) {
+            /* the exponent is larger than what fits into an int register...
+             * that's scary, and should be treated with care */
+
+
+            /* XXX a bit ugly that it reuses cmp, but safe for now */
+            cmp = mp_cmp_d(base, 0)
+            if (MP_EQ == cmp || MP_EQ == mp_cmp_d(base, 1)) {
+                /* 0 ** $big_number and 1 ** big_number are easy to do: */
+                $1 = REPR($2)->allocate(interp, STABLE($2));
+                REPR($1)->initialize(interp, STABLE($1), OBJECT_BODY($1));
+                mp_copy(base, get_bigint(interp, $1));
+            }
+            else {
+                $1 = REPR($4)->allocate(interp, STABLE($4));
+                REPR($1)->initialize(interp, STABLE($1), OBJECT_BODY($1));
+                /* TODO: better ways to create +- Inf */
+                if (MP_GT == cmp) {
+                    REPR($1)->set_num(interp, STABLE($1), OBJECT_BODY($1), (FLOATVAL) 1.0/0.0);
+                }
+                else {
+                    REPR($1)->set_num(interp, STABLE($1), OBJECT_BODY($1), (FLOATVAL) -1.0/0.0);
+                }
+            }
+        }
+        else {
+            /* since the exponent fits into a digit, mp_expt_d is fine */
+            $1 = REPR($2)->allocate(interp, STABLE($2));
+            REPR($1)->initialize(interp, STABLE($1), OBJECT_BODY($1));
+            mp_expt_d(get_bigint(interp, $2), exponent_d, get_bigint(interp, $1));
+        }
+    }
+    else {
+        /* TODO: better way to get floats out of mp_int */
+        FLOATVAL f_base = (FLOATVAL) REPR($2)->get_int(interp, STABLE($2), OBJECT_BODY($2));
+        FLOATVAL f_exp  = (FLOATVAL) REPR($3)->get_int(interp, STABLE($3), OBJECT_BODY($3));
+        $1 = REPR($4)->allocate(interp, STABLE($4));
+        REPR($1)->initialize(interp, STABLE($1), OBJECT_BODY($1));
+        REPR($1)->set_num(interp, STABLE($1), OBJECT_BODY($1), pow(f_base, f_exp));
+    }
+}
+

t/nqp/60-bigint.t

@@ -1,14 +1,14 @@
 #! nqp
 use nqpmo;
 
-plan(19);
+plan(22);
 
 pir::nqp_bigint_setup__v();
 
 my $knowhow := pir::get_knowhow__P();
 my $bi_type := $knowhow.new_type(:name('TestBigInt'), :repr('P6bigint'));
 $bi_type.HOW.compose($bi_type);
-sub s($x) { pir::nqp_bigint_to_str__SP($x) };
+sub str($x) { pir::nqp_bigint_to_str__SP($x) };
 sub iseq($x, $y) { nqp::iseq_I($x, nqp::box_i($y, $bi_type)) }
 sub box($x) { nqp::box_i($x, $bi_type) }
 
@@ -17,8 +17,8 @@ my $one := box(1);
 my $b := pir::nqp_bigint_from_str__PPS($one, '-123');
 my $c := box(-123);
 
-ok(s($b) eq '-123', 'can round-trip negative number (string)');
-ok(s($c) eq '-123', 'can round-trip negative number (string) by boxing');
+ok(str($b) eq '-123', 'can round-trip negative number (string)');
+ok(str($c) eq '-123', 'can round-trip negative number (string) by boxing');
 ok(nqp::unbox_i($b) == -123, 'can round-trip negative number by unboxing');
 ok(!nqp::iseq_I($one, $b), 'nqp::iseq_I can return false');
 ok(nqp::iseq_I($one, $one), 'nqp::iseq_I can return true');
@@ -51,3 +51,12 @@ ok(iseq($box_val_1, 4), 'can box to a complex type with a P6bigint target');
 my $box_val_2 := pir::nqp_bigint_from_str__PPS($bi_boxer, '38');
 ok(iseq($box_val_2, 38), 'can get a bigint from a string with boxing type');
 ok(iseq(nqp::add_I($box_val_1, $box_val_2), 42), 'addition works on boxing type');
+
+
+# Note that the last argument to pow_I should be capable of boxing a num,
+# so $bi_type is wrong here. But so far we only test the integer case,
+# so we can get away with it.
+my $big := nqp::pow_I($c, box(42), $bi_type);
+ok(str($big) eq '5970554685064519004265641008828923248442340700473500698131071806779372733915289638628729', 'pow (int, positive)');
+ok(iseq(nqp::pow_I(box(0), $big, $bi_type), 0), 'pow 0 ** large_number');
+ok(iseq(nqp::pow_I($one, $big, $bi_type), 1), 'pow 1 ** large_number');