tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

fast.tri (1611B)

      1 -- Pure binary64 implementation; trusted internal helpers.
      2 !import native_math as N
      3 !import binary64_kernels as K
      4 !export pack
      5 !export shiftPositive
      6 !export shiftSelective
      7 !export zeros1
      8 !export zeros2
      9 
     10 drop2 x = K.tail (K.tail x)
     11 drop4 x = drop2 (drop2 x)
     12 drop8 x = drop4 (drop4 x)
     13 drop16 x = drop8 (drop8 x)
     14 drop32 x = drop16 (drop16 x)
     15 splice1 x suffix = t (K.head x) suffix
     16 splice2 x suffix = splice1 x (splice1 (K.tail x) suffix)
     17 splice4 x suffix = splice2 x (splice2 (drop2 x) suffix)
     18 splice8 x suffix = splice4 x (splice4 (drop4 x) suffix)
     19 splice16 x suffix = splice8 x (splice8 (drop8 x) suffix)
     20 splice32 x suffix = splice16 x (splice16 (drop16 x) suffix)
     21 pack exponent m = splice32 m (splice16 (drop32 m) (splice4 (drop16 (drop32 m)) exponent))
     22 zeros1 n = t t n
     23 zeros2 n = zeros1 (zeros1 n)
     24 zeros4 n = zeros2 (zeros2 n)
     25 zeros8 n = zeros4 (zeros4 n)
     26 zeros16 n = zeros8 (zeros8 n)
     27 zeros32 n = zeros16 (zeros16 n)
     28 shiftPositive count n =
     29   K.choose (zeros32 (shift16 count n)) (shift16 count n) (N.odd (K.tail (drop4 count)))
     30 shift16 count n = K.choose (zeros16 (shift8 count n)) (shift8 count n) (N.odd (drop4 count))
     31 shift8 count n = K.choose (zeros8 (shift4 count n)) (shift4 count n) (N.odd (K.tail (drop2 count)))
     32 shift4 count n = K.choose (zeros4 (shift2 count n)) (shift2 count n) (N.odd (drop2 count))
     33 shift2 count n = K.choose (zeros2 (shift1 count n)) (shift1 count n) (N.odd (K.tail count))
     34 shift1 count n = K.choose (zeros1 n) n (N.odd count)
     35 shiftSelective count n = K.triage n (_ : n)
     36   (bit rest : K.lazy (_ : K.choose (zeros1 n) n bit)
     37     (_ : shiftPositive count n) (N.zero rest)) count