float-multiply.tri (3697B)
1 -- Multiplication algorithm / source-form investigation. Reducer unchanged. 2 !import native_math as N 3 !import kernels as K 4 !import layouts as L 5 !import pipelines as P 6 !export * 7 triage = K.triage 8 lazy = K.lazy 9 choose = K.choose 10 head = K.head 11 tail = K.tail 12 map = K.map 13 node = K.node 14 double x = node t x 15 native = N.multiply 16 -- Same recurrence as native, but recursive state explicitly includes a. 17 hoisted a b = triage t (_ : t) 18 (bit rest : lazy (_ : N.add a (double (hoisted a rest))) 19 (_ : double (hoisted a rest)) bit) b 20 -- Highest represented bit is 1 on canonical naturals: return a directly. 21 topBit a b = triage t (_ : t) 22 (bit rest : lazy (_ : a) 23 (_ : lazy (_ : N.add a (double (topBit a rest))) 24 (_ : double (topBit a rest)) bit) (N.zero rest)) b 25 -- a + 2*p: column zero returns a's low bit with carry=0. 26 addShift a partial = node (head a) (N.add (tail a) partial) 27 fused a b = triage t (_ : t) 28 (bit rest : lazy (_ : a) 29 (_ : lazy (_ : addShift a (fused a rest)) 30 (_ : double (fused a rest)) bit) (N.zero rest)) b 31 -- Positive a permits noncanonical-zero checks to be omitted from shifts. 32 -- Intended ONLY for positive finite canonical a; b may be zero. 33 positive a b = triage t (_ : t) 34 (bit rest : lazy (_ : a) 35 (_ : lazy (_ : t (head a) (N.add (tail a) (positive a rest))) 36 (_ : t t (positive a rest)) bit) (N.zero rest)) b 37 -- Accumulate explicit state in the alternative evaluation direction. 38 accumulate a b = accumulateWalk a b 0 39 accumulateWalk factor remaining acc = triage acc (_ : acc) 40 (bit rest : accumulateWalk (double factor) rest (choose (N.add acc factor) acc bit)) remaining 41 low26 x = L.join16 x (L.join8 (L.drop16 x) (L.join2 (L.drop8 (L.drop16 x)) t)) 42 drop26 x = L.drop2 (L.drop8 (L.drop16 x)) 43 shift26 x = L.join16 t (L.join8 t (L.join2 t x)) 44 shift52 x = shift26 (shift26 x) 45 -- One Karatsuba split, with native schoolbook leaf products. 46 karatsuba a b = lazy (_ : 0) 47 (_ : let al = low26 a in let ah = drop26 a in 48 let bl = low26 b in let bh = drop26 b in 49 let low = N.multiply al bl in let high = N.multiply ah bh in 50 let middle = N.subtract (N.subtract (N.multiply (N.add al ah) (N.add bl bh)) low) high in 51 N.add low (N.add (shift26 middle) (shift52 high))) (N.zero b) 52 -- Normalized 53-bit operands imply a 105- or 106-bit exact product. 53 -- Use the invariant to determine the final rounding cut directly. 54 finish53 product = let cut = choose 53 52 (N.odd (L.drop1 (L.drop52 (L.drop52 product)))) in 55 let rounded = K.roundL cut product in let m = head rounded in 56 lazy (_ : t (N.successor cut) (t (tail m) (tail rounded))) 57 (_ : t cut rounded) (N.odd (L.drop1 (L.drop52 m))) 58 spin x = spin x 59 -- Full-adder Boolean functions expressed as selection on the first bit. 60 -- Implement the bit-level recurrence with Tree Calculus functions. 61 addMux a b carry = triage 62 (lazy (_ : N.successor b) (_ : b) carry) 63 (_ : t) 64 (abit ar : triage (lazy (_ : N.successor a) (_ : a) carry) (_ : t) 65 (bbit br : let neg = K.not carry in 66 t (choose (choose carry neg bbit) (choose neg carry bbit) abit) 67 (addMux ar br (choose (K.either bbit carry) (K.both bbit carry) abit))) b) a 68 mux a b = let rec 69 walk remaining = triage t (_ : t) 70 (bit rest : lazy (_ : addMux a (double (walk rest)) t) 71 (_ : double (walk rest)) bit) remaining 72 in walk b 73 -- Finite-input-only scheduling experiment: choose the sparser multiplier. 74 -- Computing popcounts intentionally inspects more input than native does. 75 popcount x = triage 0 (_ : 0) 76 (bit rest : choose (N.successor (popcount rest)) (popcount rest) bit) x 77 adaptive a b = lazy (_ : 0) 78 (_ : lazy (_ : N.multiply b a) (_ : N.multiply a b) (N.lt (popcount a) (popcount b))) (N.zero b)