wat bignums (tag 10): closes whitepaper §2.1 — (expt 2 1024) exact on all 3 tiers

Variable-length signed bignums on the asm-wasm tier. Layout:
  [tag=10, sign:i32, n_limbs:i32, limbs[]:u32]
Little-endian u32 limbs (base 2^32). i64 used for limb-pair products
in bn_mul and for the (rem << 32) | limb shift in bn_divmod_small.

Promotion: num_add/sub/mul/cmp inspect operands and pick the right
representation (fixnum, rational, bignum). Fixnum overflow in +/-/* is
detected by computing in i64 and checking against the 30-bit fixnum
range — outside that, operands lift to bignums.

(expt 2 1024) uses exponentiation-by-squaring through num_mul so
intermediate products auto-promote, returning the exact 309-digit value.

Reader: digit parsing accumulates via num_add/num_mul, so a literal of
any length reads as the narrowest representation that holds it.

Parity corpus: KNOWN_DIVERGE is now empty. 237/237 passing across
python (ref), c-wasm, and asm-wasm. New asserts pin the bignum surface
so a regression breaks make wasm-test immediately.
This commit is contained in:
russell@unturf.com 2026-06-14 16:13:33 -04:00
parent 84ee18bac3
commit 988c7cbec7
No known key found for this signature in database
4 changed files with 569 additions and 126 deletions

View file

@ -200,7 +200,413 @@
(func $is_number (param $v i32) (result i32)
(if (result i32) (call $is_fixnum (local.get $v))
(then (i32.const 1))
(else (call $is_rational (local.get $v)))))
(else
(if (result i32) (call $is_rational (local.get $v))
(then (i32.const 1))
(else (call $is_bignum (local.get $v)))))))
(func $is_integer (param $v i32) (result i32)
(if (result i32) (call $is_fixnum (local.get $v))
(then (i32.const 1))
(else (call $is_bignum (local.get $v)))))
;; ─── Bignums (tag=10) ──────────────────────────────────────────
;; Variable-length signed integers. Layout:
;; [tag=10, sign:i32, n_limbs:i32, limb_0:i32, limb_1:i32, ...]
;; sign = 0 for positive, 1 for negative; n_limbs is the number of u32
;; limbs that follow; the array is little-endian (limb_0 = least
;; significant). A bignum with n_limbs=0 represents 0 (positive).
;;
;; The total size is 12 + 4*n_limbs bytes.
(func $is_bignum (param $v i32) (result i32)
(if (result i32) (call $is_fixnum (local.get $v))
(then (i32.const 0))
(else
(if (result i32) (call $is_immediate (local.get $v))
(then (i32.const 0))
(else (i32.eq (call $obj_tag (local.get $v)) (i32.const 10)))))))
(func $bn_sign (param $v i32) (result i32)
(i32.load offset=4 (local.get $v)))
(func $bn_n (param $v i32) (result i32)
(i32.load offset=8 (local.get $v)))
(func $bn_limb (param $v i32) (param $i i32) (result i32)
(i32.load (i32.add (i32.add (local.get $v) (i32.const 12))
(i32.mul (local.get $i) (i32.const 4)))))
(func $bn_set_limb (param $v i32) (param $i i32) (param $w i32)
(i32.store (i32.add (i32.add (local.get $v) (i32.const 12))
(i32.mul (local.get $i) (i32.const 4)))
(local.get $w)))
(func $bn_set_sign (param $v i32) (param $s i32)
(i32.store offset=4 (local.get $v) (local.get $s)))
(func $bn_set_n (param $v i32) (param $n i32)
(i32.store offset=8 (local.get $v) (local.get $n)))
(func $make_bignum_raw (param $n_limbs i32) (result i32)
(local $p i32)
(local.set $p (call $alloc
(i32.add (i32.const 12) (i32.mul (local.get $n_limbs) (i32.const 4)))))
(i32.store (local.get $p) (i32.const 10))
(i32.store offset=4 (local.get $p) (i32.const 0))
(i32.store offset=8 (local.get $p) (local.get $n_limbs))
(local.get $p))
;; Trim trailing zero limbs, fix sign for zero, and collapse to a
;; fixnum when the value fits in 31 bits (low bit set encoding).
(func $bn_normalize (param $v i32) (result i32)
(local $n i32)
(local $val i32)
(local.set $n (call $bn_n (local.get $v)))
(block $done
(loop $l
(br_if $done (i32.eqz (local.get $n)))
(br_if $done (i32.ne (call $bn_limb (local.get $v) (i32.sub (local.get $n) (i32.const 1)))
(i32.const 0)))
(local.set $n (i32.sub (local.get $n) (i32.const 1)))
(br $l)))
(call $bn_set_n (local.get $v) (local.get $n))
(if (i32.eqz (local.get $n))
(then
(call $bn_set_sign (local.get $v) (i32.const 0))
(return (call $make_fixnum (i32.const 0)))))
;; Single-limb that fits in 30 bits collapses to a fixnum.
(if (i32.eq (local.get $n) (i32.const 1))
(then
(local.set $val (call $bn_limb (local.get $v) (i32.const 0)))
(if (i32.lt_u (local.get $val) (i32.const 0x40000000))
(then
(if (call $bn_sign (local.get $v))
(then (local.set $val (i32.sub (i32.const 0) (local.get $val)))))
(return (call $make_fixnum (local.get $val)))))))
(local.get $v))
;; Convert a fixnum to a fresh bignum (no normalize collapse).
(func $bn_from_fixnum (param $n i32) (result i32)
(local $bn i32)
(local $abs i32)
(if (i32.eqz (local.get $n))
(then (return (call $make_bignum_raw (i32.const 0)))))
(local.set $abs (local.get $n))
(local.set $bn (call $make_bignum_raw (i32.const 1)))
(if (i32.lt_s (local.get $n) (i32.const 0))
(then
(call $bn_set_sign (local.get $bn) (i32.const 1))
(local.set $abs (i32.sub (i32.const 0) (local.get $n)))))
(call $bn_set_limb (local.get $bn) (i32.const 0) (local.get $abs))
(local.get $bn))
;; Coerce a Value to a bignum (no normalize). Caller guarantees v is
;; either a fixnum or a bignum.
(func $to_bignum (param $v i32) (result i32)
(if (call $is_bignum (local.get $v))
(then (return (local.get $v))))
(call $bn_from_fixnum (call $fixnum_val (local.get $v))))
;; Compare magnitudes (signs ignored). Returns -1 / 0 / 1.
(func $bn_cmp_abs (param $a i32) (param $b i32) (result i32)
(local $na i32)
(local $nb i32)
(local $i i32)
(local $la i32)
(local $lb i32)
(local.set $na (call $bn_n (local.get $a)))
(local.set $nb (call $bn_n (local.get $b)))
(if (i32.gt_s (local.get $na) (local.get $nb)) (then (return (i32.const 1))))
(if (i32.lt_s (local.get $na) (local.get $nb)) (then (return (i32.const -1))))
(local.set $i (local.get $na))
(block $done
(loop $l
(br_if $done (i32.eqz (local.get $i)))
(local.set $i (i32.sub (local.get $i) (i32.const 1)))
(local.set $la (call $bn_limb (local.get $a) (local.get $i)))
(local.set $lb (call $bn_limb (local.get $b) (local.get $i)))
(if (i32.gt_u (local.get $la) (local.get $lb)) (then (return (i32.const 1))))
(if (i32.lt_u (local.get $la) (local.get $lb)) (then (return (i32.const -1))))
(br $l)))
(i32.const 0))
;; Unsigned addition: |a| + |b|. Returns a fresh bignum (sign=0).
(func $bn_add_abs (param $a i32) (param $b i32) (result i32)
(local $na i32)
(local $nb i32)
(local $n i32)
(local $r i32)
(local $i i32)
(local $carry i64)
(local $sum i64)
(local $la i32)
(local $lb i32)
(local.set $na (call $bn_n (local.get $a)))
(local.set $nb (call $bn_n (local.get $b)))
(local.set $n (local.get $na))
(if (i32.gt_s (local.get $nb) (local.get $n))
(then (local.set $n (local.get $nb))))
(local.set $r (call $make_bignum_raw (i32.add (local.get $n) (i32.const 1))))
(local.set $carry (i64.const 0))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_s (local.get $i) (local.get $n)))
(local.set $la (i32.const 0))
(if (i32.lt_s (local.get $i) (local.get $na))
(then (local.set $la (call $bn_limb (local.get $a) (local.get $i)))))
(local.set $lb (i32.const 0))
(if (i32.lt_s (local.get $i) (local.get $nb))
(then (local.set $lb (call $bn_limb (local.get $b) (local.get $i)))))
(local.set $sum
(i64.add
(i64.add (i64.extend_i32_u (local.get $la))
(i64.extend_i32_u (local.get $lb)))
(local.get $carry)))
(call $bn_set_limb (local.get $r) (local.get $i)
(i32.wrap_i64 (local.get $sum)))
(local.set $carry (i64.shr_u (local.get $sum) (i64.const 32)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(call $bn_set_limb (local.get $r) (local.get $n) (i32.wrap_i64 (local.get $carry)))
(local.get $r))
;; Unsigned subtraction assuming |a| >= |b|. Returns a fresh bignum
;; with sign=0.
(func $bn_sub_abs (param $a i32) (param $b i32) (result i32)
(local $na i32)
(local $nb i32)
(local $r i32)
(local $i i32)
(local $borrow i64)
(local $diff i64)
(local $la i32)
(local $lb i32)
(local.set $na (call $bn_n (local.get $a)))
(local.set $nb (call $bn_n (local.get $b)))
(local.set $r (call $make_bignum_raw (local.get $na)))
(local.set $borrow (i64.const 0))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_s (local.get $i) (local.get $na)))
(local.set $la (call $bn_limb (local.get $a) (local.get $i)))
(local.set $lb (i32.const 0))
(if (i32.lt_s (local.get $i) (local.get $nb))
(then (local.set $lb (call $bn_limb (local.get $b) (local.get $i)))))
(local.set $diff
(i64.sub
(i64.sub (i64.extend_i32_u (local.get $la))
(i64.extend_i32_u (local.get $lb)))
(local.get $borrow)))
(call $bn_set_limb (local.get $r) (local.get $i)
(i32.wrap_i64 (local.get $diff)))
;; Borrow if the high 32 bits of diff are nonzero (sign-extended -1).
(if (i64.lt_s (local.get $diff) (i64.const 0))
(then (local.set $borrow (i64.const 1)))
(else (local.set $borrow (i64.const 0))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(local.get $r))
;; Signed addition: a + b, returns a normalized Value (fixnum or bignum).
(func $bn_add (param $a i32) (param $b i32) (result i32)
(local $r i32)
(local $cmp i32)
(if (i32.eq (call $bn_sign (local.get $a)) (call $bn_sign (local.get $b)))
(then
(local.set $r (call $bn_add_abs (local.get $a) (local.get $b)))
(call $bn_set_sign (local.get $r) (call $bn_sign (local.get $a)))
(return (call $bn_normalize (local.get $r)))))
;; Signs differ — subtract the smaller magnitude from the larger.
(local.set $cmp (call $bn_cmp_abs (local.get $a) (local.get $b)))
(if (i32.eqz (local.get $cmp))
(then (return (call $make_fixnum (i32.const 0)))))
(if (i32.gt_s (local.get $cmp) (i32.const 0))
(then
(local.set $r (call $bn_sub_abs (local.get $a) (local.get $b)))
(call $bn_set_sign (local.get $r) (call $bn_sign (local.get $a))))
(else
(local.set $r (call $bn_sub_abs (local.get $b) (local.get $a)))
(call $bn_set_sign (local.get $r) (call $bn_sign (local.get $b)))))
(call $bn_normalize (local.get $r)))
;; a - b = a + (-b)
(func $bn_sub (param $a i32) (param $b i32) (result i32)
(local $nb i32)
(local $r i32)
(local $i i32)
(local $n i32)
;; clone b with flipped sign — cheaper than reallocating: we just
;; copy the limbs and toggle sign.
(local.set $n (call $bn_n (local.get $b)))
(local.set $nb (call $make_bignum_raw (local.get $n)))
(call $bn_set_sign (local.get $nb) (i32.xor (call $bn_sign (local.get $b)) (i32.const 1)))
(local.set $i (i32.const 0))
(block $done
(loop $l
(br_if $done (i32.ge_s (local.get $i) (local.get $n)))
(call $bn_set_limb (local.get $nb) (local.get $i)
(call $bn_limb (local.get $b) (local.get $i)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $l)))
(call $bn_add (local.get $a) (local.get $nb)))
;; Schoolbook multiplication. Result n_limbs = na + nb.
(func $bn_mul (param $a i32) (param $b i32) (result i32)
(local $na i32)
(local $nb i32)
(local $r i32)
(local $i i32)
(local $j i32)
(local $carry i64)
(local $prod i64)
(local $la i32)
(local $lb i32)
(local $cur i32)
(local.set $na (call $bn_n (local.get $a)))
(local.set $nb (call $bn_n (local.get $b)))
(if (i32.or (i32.eqz (local.get $na)) (i32.eqz (local.get $nb)))
(then (return (call $make_fixnum (i32.const 0)))))
(local.set $r (call $make_bignum_raw (i32.add (local.get $na) (local.get $nb))))
;; All limbs start at zero (alloc zero-fills).
(local.set $i (i32.const 0))
(block $outerdone
(loop $outer
(br_if $outerdone (i32.ge_s (local.get $i) (local.get $na)))
(local.set $la (call $bn_limb (local.get $a) (local.get $i)))
(local.set $carry (i64.const 0))
(local.set $j (i32.const 0))
(block $innerdone
(loop $inner
(br_if $innerdone (i32.ge_s (local.get $j) (local.get $nb)))
(local.set $lb (call $bn_limb (local.get $b) (local.get $j)))
(local.set $cur (call $bn_limb (local.get $r) (i32.add (local.get $i) (local.get $j))))
(local.set $prod
(i64.add
(i64.add
(i64.mul (i64.extend_i32_u (local.get $la))
(i64.extend_i32_u (local.get $lb)))
(i64.extend_i32_u (local.get $cur)))
(local.get $carry)))
(call $bn_set_limb (local.get $r) (i32.add (local.get $i) (local.get $j))
(i32.wrap_i64 (local.get $prod)))
(local.set $carry (i64.shr_u (local.get $prod) (i64.const 32)))
(local.set $j (i32.add (local.get $j) (i32.const 1)))
(br $inner)))
;; Propagate the final carry into the next slot.
(call $bn_set_limb (local.get $r)
(i32.add (local.get $i) (local.get $nb))
(i32.wrap_i64 (local.get $carry)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $outer)))
(call $bn_set_sign (local.get $r) (i32.xor (call $bn_sign (local.get $a)) (call $bn_sign (local.get $b))))
(call $bn_normalize (local.get $r)))
;; Divide |a| by a small u32 d (non-zero). Quotient is written into the
;; existing bignum `q` (caller alloc'd big enough). Remainder returned.
(func $bn_divmod_small (param $a i32) (param $d i32) (param $q i32) (result i32)
(local $n i32)
(local $i i32)
(local $rem i64)
(local $cur i64)
(local $quo i64)
(local.set $n (call $bn_n (local.get $a)))
(local.set $rem (i64.const 0))
(local.set $i (local.get $n))
(block $done
(loop $l
(br_if $done (i32.eqz (local.get $i)))
(local.set $i (i32.sub (local.get $i) (i32.const 1)))
(local.set $cur
(i64.or
(i64.shl (local.get $rem) (i64.const 32))
(i64.extend_i32_u (call $bn_limb (local.get $a) (local.get $i)))))
(local.set $quo (i64.div_u (local.get $cur) (i64.extend_i32_u (local.get $d))))
(local.set $rem (i64.rem_u (local.get $cur) (i64.extend_i32_u (local.get $d))))
(call $bn_set_limb (local.get $q) (local.get $i)
(i32.wrap_i64 (local.get $quo)))
(br $l)))
(call $bn_set_n (local.get $q) (local.get $n))
(i32.wrap_i64 (local.get $rem)))
;; Print a bignum in base 10 to the output buffer.
(func $print_bignum (param $v i32)
(local $work i32)
(local $n i32)
(local $i i32)
(local $rem i32)
(local $buf i32)
(local $bi i32)
(local $j i32)
;; Zero case.
(if (i32.eqz (call $bn_n (local.get $v)))
(then (call $out_char (i32.const 48)) (return))) ;; "0"
;; Working copy so we can destroy it.
(local.set $n (call $bn_n (local.get $v)))
(local.set $work (call $make_bignum_raw (local.get $n)))
(local.set $i (i32.const 0))
(block $cpdone
(loop $cp
(br_if $cpdone (i32.ge_s (local.get $i) (local.get $n)))
(call $bn_set_limb (local.get $work) (local.get $i)
(call $bn_limb (local.get $v) (local.get $i)))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $cp)))
(call $bn_set_n (local.get $work) (local.get $n))
;; Decimal scratch area.
(local.set $buf (i32.const 0x300))
(local.set $bi (i32.const 0))
(block $ddone
(loop $dl
(br_if $ddone (i32.eqz (call $bn_n (local.get $work))))
(local.set $rem (call $bn_divmod_small (local.get $work)
(i32.const 1000000000)
(local.get $work)))
;; Trim leading zero limbs after the divmod.
(local.set $n (call $bn_n (local.get $work)))
(block $trimdone
(loop $trim
(br_if $trimdone (i32.eqz (local.get $n)))
(br_if $trimdone (i32.ne (call $bn_limb (local.get $work) (i32.sub (local.get $n) (i32.const 1))) (i32.const 0)))
(local.set $n (i32.sub (local.get $n) (i32.const 1)))
(br $trim)))
(call $bn_set_n (local.get $work) (local.get $n))
;; Push 9 digits if more limbs remain, else just the natural digits.
(if (i32.eqz (call $bn_n (local.get $work)))
(then
(block $ldone
(loop $ldl
(br_if $ldone (i32.eqz (local.get $rem)))
(i32.store8 (i32.add (local.get $buf) (local.get $bi))
(i32.add (i32.const 48)
(i32.rem_u (local.get $rem) (i32.const 10))))
(local.set $rem (i32.div_u (local.get $rem) (i32.const 10)))
(local.set $bi (i32.add (local.get $bi) (i32.const 1)))
(br $ldl))))
(else
;; Always pad to 9 digits when more limbs follow.
(local.set $j (i32.const 0))
(block $padone
(loop $padl
(br_if $padone (i32.ge_s (local.get $j) (i32.const 9)))
(i32.store8 (i32.add (local.get $buf) (local.get $bi))
(i32.add (i32.const 48)
(i32.rem_u (local.get $rem) (i32.const 10))))
(local.set $rem (i32.div_u (local.get $rem) (i32.const 10)))
(local.set $bi (i32.add (local.get $bi) (i32.const 1)))
(local.set $j (i32.add (local.get $j) (i32.const 1)))
(br $padl)))))
(br $dl)))
(if (call $bn_sign (local.get $v))
(then (call $out_char (i32.const 45)))) ;; "-"
;; Drain buffer in reverse.
(block $emdone
(loop $em
(br_if $emdone (i32.eqz (local.get $bi)))
(local.set $bi (i32.sub (local.get $bi) (i32.const 1)))
(call $out_char (i32.load8_u (i32.add (local.get $buf) (local.get $bi))))
(br $em))))
(func $rat_num (param $v i32) (result i32)
(i32.load offset=4 (local.get $v)))
@ -680,6 +1086,8 @@
(local $len i32)
(if (call $is_fixnum (local.get $v))
(then (call $out_int (call $fixnum_val (local.get $v))) (return)))
(if (call $is_bignum (local.get $v))
(then (call $print_bignum (local.get $v)) (return)))
(if (call $is_rational (local.get $v))
(then
(call $out_int (call $rat_num (local.get $v)))
@ -941,22 +1349,32 @@
(local.set $byte (i32.load8_u (i32.add (local.get $start) (i32.const 1))))))
(if (call $is_digit (local.get $byte))
(then
(local.set $n (i32.const 0))
;; Accumulate via num_add/num_mul so literals beyond fixnum range
;; auto-promote to a bignum mid-parse. This is the same path the
;; runtime arithmetic uses, so a literal 10^20 reads the same way
;; (expt 10 20) computes it.
(local.set $sym (call $make_fixnum (i32.const 0)))
(block $num_done
(loop $num_loop
(br_if $num_done (i32.ge_u (local.get $i) (local.get $len)))
(local.set $byte (i32.load8_u (i32.add (local.get $start) (local.get $i))))
(br_if $num_done (i32.eqz (call $is_digit (local.get $byte))))
(local.set $n (i32.add (i32.mul (local.get $n) (i32.const 10))
(i32.sub (local.get $byte) (i32.const 48))))
(local.set $sym
(call $num_add
(call $num_mul (local.get $sym) (call $make_fixnum (i32.const 10)))
(call $make_fixnum (i32.sub (local.get $byte) (i32.const 48)))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $num_loop)))
(if (i32.eq (local.get $i) (local.get $len))
(then
(if (local.get $neg)
(then (local.set $n (i32.sub (i32.const 0) (local.get $n)))))
(return (call $make_fixnum (local.get $n)))))
(then (local.set $sym
(call $num_sub (call $make_fixnum (i32.const 0)) (local.get $sym)))))
(return (local.get $sym))))
;; Try rational form: numerator '/' denominator (e.g. 67/7).
;; The numerator may have promoted to a bignum during parsing;
;; rationals here are 31-bit num/den, so a bignum numerator
;; (>30 bits) falls through to be returned as the bignum itself.
(if (i32.and
(i32.lt_u (local.get $i) (local.get $len))
(i32.eq (i32.load8_u (i32.add (local.get $start) (local.get $i))) (i32.const 47)))
@ -973,11 +1391,14 @@
(i32.sub (local.get $byte) (i32.const 48))))
(local.set $i (i32.add (local.get $i) (i32.const 1)))
(br $den_loop)))
;; Require: consumed all bytes AND denominator had at least 1 digit.
;; Require: consumed all bytes, denominator > 0, numerator fits fixnum.
(if (i32.and
(i32.eq (local.get $i) (local.get $len))
(i32.gt_s (local.get $i) (local.get $den_start)))
(i32.and
(i32.eq (local.get $i) (local.get $len))
(i32.gt_s (local.get $i) (local.get $den_start)))
(call $is_fixnum (local.get $sym)))
(then
(local.set $n (call $fixnum_val (local.get $sym)))
(if (local.get $neg)
(then (local.set $n (i32.sub (i32.const 0) (local.get $n)))))
(return (call $make_rational (local.get $n) (local.get $den)))))))))
@ -1150,9 +1571,11 @@
(local $params i32)
(local $body i32)
;; Self-evaluating: fixnum, rational, immediate, string, char, closure, primitive
;; Self-evaluating: fixnum, bignum, rational, immediate, string, char, closure, primitive
(if (call $is_fixnum (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_bignum (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_rational (local.get $expr))
(then (return (local.get $expr))))
(if (call $is_immediate (local.get $expr))
@ -2229,6 +2652,97 @@
(br $l)))
(local.get $out))
;; ─── Numeric promotion helpers ────────────────────────────────
;; These take any two Values (fixnum / bignum / rational) and return
;; the result as the narrowest representation that holds it.
(func $num_add (param $a i32) (param $b i32) (result i32)
(local $av i64)
(local $bv i64)
(local $sum i64)
(if (i32.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then (return (call $rat_add (local.get $a) (local.get $b)))))
(if (i32.or (call $is_bignum (local.get $a)) (call $is_bignum (local.get $b)))
(then (return (call $bn_add (call $to_bignum (local.get $a))
(call $to_bignum (local.get $b))))))
(local.set $av (i64.extend_i32_s (call $fixnum_val (local.get $a))))
(local.set $bv (i64.extend_i32_s (call $fixnum_val (local.get $b))))
(local.set $sum (i64.add (local.get $av) (local.get $bv)))
;; Fixnum range is [-2^30, 2^30 - 1].
(if (i32.and
(i64.ge_s (local.get $sum) (i64.const -1073741824))
(i64.lt_s (local.get $sum) (i64.const 1073741824)))
(then (return (call $make_fixnum (i32.wrap_i64 (local.get $sum))))))
(call $bn_add (call $to_bignum (local.get $a)) (call $to_bignum (local.get $b))))
(func $num_sub (param $a i32) (param $b i32) (result i32)
(local $av i64)
(local $bv i64)
(local $diff i64)
(if (i32.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then (return (call $rat_sub (local.get $a) (local.get $b)))))
(if (i32.or (call $is_bignum (local.get $a)) (call $is_bignum (local.get $b)))
(then (return (call $bn_sub (call $to_bignum (local.get $a))
(call $to_bignum (local.get $b))))))
(local.set $av (i64.extend_i32_s (call $fixnum_val (local.get $a))))
(local.set $bv (i64.extend_i32_s (call $fixnum_val (local.get $b))))
(local.set $diff (i64.sub (local.get $av) (local.get $bv)))
(if (i32.and
(i64.ge_s (local.get $diff) (i64.const -1073741824))
(i64.lt_s (local.get $diff) (i64.const 1073741824)))
(then (return (call $make_fixnum (i32.wrap_i64 (local.get $diff))))))
(call $bn_sub (call $to_bignum (local.get $a)) (call $to_bignum (local.get $b))))
(func $num_mul (param $a i32) (param $b i32) (result i32)
(local $av i64)
(local $bv i64)
(local $prod i64)
(if (i32.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then (return (call $rat_mul (local.get $a) (local.get $b)))))
(if (i32.or (call $is_bignum (local.get $a)) (call $is_bignum (local.get $b)))
(then (return (call $bn_mul (call $to_bignum (local.get $a))
(call $to_bignum (local.get $b))))))
(local.set $av (i64.extend_i32_s (call $fixnum_val (local.get $a))))
(local.set $bv (i64.extend_i32_s (call $fixnum_val (local.get $b))))
(local.set $prod (i64.mul (local.get $av) (local.get $bv)))
(if (i32.and
(i64.ge_s (local.get $prod) (i64.const -1073741824))
(i64.lt_s (local.get $prod) (i64.const 1073741824)))
(then (return (call $make_fixnum (i32.wrap_i64 (local.get $prod))))))
(call $bn_mul (call $to_bignum (local.get $a)) (call $to_bignum (local.get $b))))
;; Compare two number Values. Returns -1, 0, or +1.
(func $num_cmp (param $a i32) (param $b i32) (result i32)
(local $av i32)
(local $bv i32)
(local $abn i32)
(local $bbn i32)
(local $diff i32)
(if (i32.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then
(if (call $rat_eq (local.get $a) (local.get $b))
(then (return (i32.const 0))))
(if (call $rat_lt (local.get $a) (local.get $b))
(then (return (i32.const -1))))
(return (i32.const 1))))
(if (i32.or (call $is_bignum (local.get $a)) (call $is_bignum (local.get $b)))
(then
(local.set $abn (call $to_bignum (local.get $a)))
(local.set $bbn (call $to_bignum (local.get $b)))
(if (i32.ne (call $bn_sign (local.get $abn)) (call $bn_sign (local.get $bbn)))
(then
(if (call $bn_sign (local.get $abn)) (then (return (i32.const -1))))
(return (i32.const 1))))
(local.set $diff (call $bn_cmp_abs (local.get $abn) (local.get $bbn)))
(if (call $bn_sign (local.get $abn))
(then (return (i32.sub (i32.const 0) (local.get $diff)))))
(return (local.get $diff))))
(local.set $av (call $fixnum_val (local.get $a)))
(local.set $bv (call $fixnum_val (local.get $b)))
(if (i32.eq (local.get $av) (local.get $bv)) (then (return (i32.const 0))))
(if (i32.lt_s (local.get $av) (local.get $bv)) (then (return (i32.const -1))))
(i32.const 1))
;; ─── Primitives ────────────────────────────────────────────────
(func $apply_primitive (param $id i32) (param $args i32) (result i32)
(local $a i32)
@ -2256,96 +2770,47 @@
(if (i32.ne (call $cdr (local.get $args)) (global.get $NIL))
(then (local.set $b (call $car (call $cdr (local.get $args))))))))
;; + — variadic; promotes to rational if any arg is rational.
;; + — variadic; num_add picks the right representation per step.
(if (i32.eq (local.get $id) (i32.const 1))
(then
(local.set $sum (i32.const 0))
(local.set $a (call $make_fixnum (i32.const 0)))
(local.set $cur (local.get $args))
(local.set $any_rat (i32.const 0))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $b (call $car (local.get $cur)))
(if (i32.and (call $is_rational (local.get $b)) (i32.eqz (local.get $any_rat)))
(then
;; First rational encountered: lift the fixnum sum into a.
(local.set $a (call $make_fixnum (local.get $sum)))
(local.set $any_rat (i32.const 1))))
(if (local.get $any_rat)
(then (local.set $a (call $rat_add (local.get $a) (local.get $b))))
(else (local.set $sum (i32.add (local.get $sum) (call $fixnum_val (local.get $b))))))
(local.set $a (call $num_add (local.get $a) (call $car (local.get $cur))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(if (local.get $any_rat)
(then (return (local.get $a))))
(return (call $make_fixnum (local.get $sum)))))
(return (local.get $a))))
;; -
;; - — variadic; num_sub handles fixnum/bignum/rational promotion.
(if (i32.eq (local.get $id) (i32.const 2))
(then
;; Unary case: negate.
;; Unary negate: 0 - a.
(if (i32.eq (call $cdr (local.get $args)) (global.get $NIL))
(then
(if (call $is_rational (local.get $a))
(then (return (call $make_rational
(i32.sub (i32.const 0) (call $rat_num (local.get $a)))
(call $rat_den (local.get $a))))))
(return (call $make_fixnum (i32.sub (i32.const 0) (call $fixnum_val (local.get $a)))))))
;; Variadic difference. Scan rest looking for any rational.
(local.set $any_rat2 (call $is_rational (local.get $a)))
(local.set $cur (call $cdr (local.get $args)))
(block $rscan
(loop $rl
(br_if $rscan (i32.eq (local.get $cur) (global.get $NIL)))
(if (call $is_rational (call $car (local.get $cur)))
(then (local.set $any_rat2 (i32.const 1))))
(local.set $cur (call $cdr (local.get $cur)))
(br $rl)))
(if (local.get $any_rat2)
(then
(local.set $cur (call $cdr (local.get $args)))
(block $rdone
(loop $rsub
(br_if $rdone (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $a (call $rat_sub (local.get $a) (call $car (local.get $cur))))
(local.set $cur (call $cdr (local.get $cur)))
(br $rsub)))
(return (local.get $a))))
(local.set $sum (call $fixnum_val (local.get $a)))
(return (call $num_sub (call $make_fixnum (i32.const 0)) (local.get $a)))))
(local.set $cur (call $cdr (local.get $args)))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $sum (i32.sub (local.get $sum)
(call $fixnum_val (call $car (local.get $cur)))))
(local.set $a (call $num_sub (local.get $a) (call $car (local.get $cur))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(return (call $make_fixnum (local.get $sum)))))
(return (local.get $a))))
;; *
;; * — variadic; num_mul promotes to bignum on overflow.
(if (i32.eq (local.get $id) (i32.const 3))
(then
(local.set $sum (i32.const 1))
(local.set $a (call $make_fixnum (i32.const 1)))
(local.set $cur (local.get $args))
(local.set $any_rat3 (i32.const 0))
(block $done
(loop $loop
(br_if $done (i32.eq (local.get $cur) (global.get $NIL)))
(local.set $b (call $car (local.get $cur)))
(if (i32.and (call $is_rational (local.get $b)) (i32.eqz (local.get $any_rat3)))
(then
(local.set $a (call $make_fixnum (local.get $sum)))
(local.set $any_rat3 (i32.const 1))))
(if (local.get $any_rat3)
(then (local.set $a (call $rat_mul (local.get $a) (local.get $b))))
(else (local.set $sum (i32.mul (local.get $sum) (call $fixnum_val (local.get $b))))))
(local.set $a (call $num_mul (local.get $a) (call $car (local.get $cur))))
(local.set $cur (call $cdr (local.get $cur)))
(br $loop)))
(if (local.get $any_rat3)
(then (return (local.get $a))))
(return (call $make_fixnum (local.get $sum)))))
(return (local.get $a))))
;; / — promotes int/int to rational when the result isn't integral
;; (matches python lumbda and the C tier's recent fix).
@ -2356,65 +2821,30 @@
(return (call $make_rational (call $fixnum_val (local.get $a))
(call $fixnum_val (local.get $b))))))
;; =
;; = / < / > / <= / >= — num_cmp gives -1/0/+1 across all number kinds.
(if (i32.eq (local.get $id) (i32.const 5))
(then
(if (i32.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then
(if (call $rat_eq (local.get $a) (local.get $b))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
(if (i32.eq (call $fixnum_val (local.get $a)) (call $fixnum_val (local.get $b)))
(if (i32.eqz (call $num_cmp (local.get $a) (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; <
(if (i32.eq (local.get $id) (i32.const 6))
(then
(if (i32.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then
(if (call $rat_lt (local.get $a) (local.get $b))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
(if (i32.lt_s (call $fixnum_val (local.get $a)) (call $fixnum_val (local.get $b)))
(if (i32.lt_s (call $num_cmp (local.get $a) (local.get $b)) (i32.const 0))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; >
(if (i32.eq (local.get $id) (i32.const 7))
(then
(if (i32.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then
(if (call $rat_lt (local.get $b) (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
(if (i32.gt_s (call $fixnum_val (local.get $a)) (call $fixnum_val (local.get $b)))
(if (i32.gt_s (call $num_cmp (local.get $a) (local.get $b)) (i32.const 0))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; <=
(if (i32.eq (local.get $id) (i32.const 8))
(then
(if (i32.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then
(if (i32.or (call $rat_lt (local.get $a) (local.get $b))
(call $rat_eq (local.get $a) (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
(if (i32.le_s (call $fixnum_val (local.get $a)) (call $fixnum_val (local.get $b)))
(if (i32.le_s (call $num_cmp (local.get $a) (local.get $b)) (i32.const 0))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; >=
(if (i32.eq (local.get $id) (i32.const 9))
(then
(if (i32.or (call $is_rational (local.get $a)) (call $is_rational (local.get $b)))
(then
(if (i32.or (call $rat_lt (local.get $b) (local.get $a))
(call $rat_eq (local.get $a) (local.get $b)))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
(if (i32.ge_s (call $fixnum_val (local.get $a)) (call $fixnum_val (local.get $b)))
(if (i32.ge_s (call $num_cmp (local.get $a) (local.get $b)) (i32.const 0))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
@ -2561,19 +2991,25 @@
(br $loop)))
(return (call $make_fixnum (local.get $sum)))))
;; expt (29): integer exponent (positive)
;; expt (29): exponentiation by squaring. Result accumulates via
;; num_mul so an intermediate that exceeds the 30-bit fixnum range
;; auto-promotes to a bignum — (expt 2 1024) returns the exact value
;; here, matching python lumbda and whitepaper §2.1.
(if (i32.eq (local.get $id) (i32.const 29))
(then
(local.set $base (call $fixnum_val (local.get $a)))
(local.set $exp_n (call $fixnum_val (local.get $b)))
(local.set $result (i32.const 1))
(local.set $result (call $make_fixnum (i32.const 1)))
(local.set $sum (local.get $a)) ;; running power of base
(block $done
(loop $loop
(br_if $done (i32.le_s (local.get $exp_n) (i32.const 0)))
(local.set $result (i32.mul (local.get $result) (local.get $base)))
(local.set $exp_n (i32.sub (local.get $exp_n) (i32.const 1)))
(if (i32.and (local.get $exp_n) (i32.const 1))
(then (local.set $result (call $num_mul (local.get $result) (local.get $sum)))))
(local.set $exp_n (i32.shr_s (local.get $exp_n) (i32.const 1)))
(if (local.get $exp_n)
(then (local.set $sum (call $num_mul (local.get $sum) (local.get $sum)))))
(br $loop)))
(return (call $make_fixnum (local.get $result)))))
(return (local.get $result))))
;; even? (30)
(if (i32.eq (local.get $id) (i32.const 30))
@ -2633,11 +3069,11 @@
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))
;; integer? (39) — fixnum only (a normalized rational with den=1
;; collapses to fixnum, so this implicitly handles 14/2 → 7).
;; integer? (39) — fixnum or bignum (a rational with den=1 collapses
;; to one of those during normalization, so 14/2 → 7 is integer).
(if (i32.eq (local.get $id) (i32.const 39))
(then
(if (call $is_fixnum (local.get $a))
(if (call $is_integer (local.get $a))
(then (return (global.get $TRUE)))
(else (return (global.get $FALSE))))))

View file

@ -32,6 +32,13 @@ export const CORPUS = [
expected: "717897987691852588770249" },
{ tag: "big-arith", src: "(* 12345678901234567890 12345678901234567890)",
expected: "152415787532388367501905199875019052100" },
{ tag: "expt-2-1024", src: "(expt 2 1024)",
expected: "179769313486231590772930519078902473361797697894230657273430081157732675805500963132708477322407536021120113879871393357658789768814416622492847430639474124377767893424865485276302219601246094119453082952085005768838150682342462881473913110540827237163350510684586298239947245938479716304835356329624224137216" },
{ tag: "big-zero", src: "(- (expt 2 100) (expt 2 100))", expected: "0" },
{ tag: "big-cmp", src: "(< 99999999999 1000000000000)", expected: "#t" },
{ tag: "big-eq", src: "(= (expt 2 100) (* (expt 2 50) (expt 2 50)))", expected: "#t" },
{ tag: "big-int?", src: "(integer? (expt 2 100))", expected: "#t" },
{ tag: "big-num?", src: "(number? (expt 2 100))", expected: "#t" },
// ─── division semantics ──────────────────────────────────────────
{ tag: "quotient-pos", src: "(quotient 17 5)", expected: "3" },
@ -123,9 +130,9 @@ export const CORPUS = [
// Tiers where each tag is known to diverge today. Keep this short and
// remove entries as the gaps close — that's how we track "% to parity".
export const KNOWN_DIVERGE = {
// Asm-WASM has 31-bit fixnum num/den rationals; no bignums yet.
"expt-2-100": ["asm"],
"expt-3-50": ["asm"],
"big-arith": ["asm"],
};
// As of the WAT bignum landing (tag 10 + num_add/sub/mul/cmp promotion),
// the corpus has zero known divergences and the whitepaper §2.1 claim
// "(expt 2 1024) returns the exact value across all three tiers" is
// satisfied. New tests that surface a fresh gap get added here so the
// regression suite stays green.
export const KNOWN_DIVERGE = {};

Binary file not shown.

Binary file not shown.