tricu

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

float-layouts.tri (4189B)

      1 -- Binary64 bit-container and field-access benchmarks.
      2 -- Fields are (Boolean sign, (biased exponent, raw 52-bit fraction)).
      3 !import native_math as N
      4 !export *
      5 triage leaf stem fork = t (t leaf stem) fork
      6 choose yes no value = triage no (_ : yes) (_ _ : yes) value
      7 head value = triage t (_ : t) (a _ : a) value
      8 tail value = triage t (_ : t) (_ b : b) value
      9 map f xs = triage t (_ : t) (a b : t (f a) (map f b)) xs
     10 -- Fixed shifts avoid a numeric loop counter on field-access paths.
     11 drop1 = tail
     12 drop2 x = drop1 (drop1 x)
     13 drop4 x = drop2 (drop2 x)
     14 drop8 x = drop4 (drop4 x)
     15 drop16 x = drop8 (drop8 x)
     16 drop32 x = drop16 (drop16 x)
     17 drop52 x = drop4 (drop16 (drop32 x))
     18 drop11 x = drop1 (drop2 (drop8 x))
     19 -- Canonical low-bit extraction, including all-zero fields.
     20 node bit rest = choose (t bit rest) (choose t (t bit rest) (N.zero rest)) bit
     21 takeBits count value = choose t (triage t (_ : t)
     22   (bit rest : node bit (takeBits (N.predecessor count) rest)) value) (N.zero count)
     23 -- Splice exactly k low bits onto a canonical high part, zero-extending low.
     24 join1 low high = node (head low) high
     25 join2 low high = join1 low (join1 (drop1 low) high)
     26 join4 low high = join2 low (join2 (drop2 low) high)
     27 join8 low high = join4 low (join4 (drop4 low) high)
     28 join16 low high = join8 low (join8 (drop8 low) high)
     29 join32 low high = join16 low (join16 (drop16 low) high)
     30 low7 x = join4 x (join2 (drop4 x) (join1 (drop2 (drop4 x)) t))
     31 low11 x = join8 x (join2 (drop8 x) (join1 (drop2 (drop8 x)) t))
     32 low20 x = join16 x (join4 (drop16 x) t)
     33 low52 x = join32 x (join16 (drop32 x) (join4 (drop16 (drop32 x)) t))
     34 fieldsSign x = head x
     35 fieldsExponent x = head (tail x)
     36 fieldsUnpack x = x
     37 packedSign x = N.odd (drop11 (drop52 x))
     38 packedExponent x = takeBits 11 (drop52 x)
     39 packedUnpack x = t (packedSign x) (t (packedExponent x) (takeBits 52 x))
     40 packedFastExponent x = low11 (drop52 x)
     41 packedFastUnpack x = let upper = drop52 x in
     42   t (N.odd (drop11 upper)) (t (low11 upper) (low52 x))
     43 -- Pair of natural low/high 32-bit words.
     44 wordsSign x = N.odd (drop11 (drop4 (drop16 (tail x))))
     45 wordsExponent x = takeBits 11 (drop4 (drop16 (tail x)))
     46 wordsUnpack x = t (wordsSign x) (t (wordsExponent x)
     47   (N.add (head x) (N.multiply 4294967296 (takeBits 20 (tail x)))))
     48 wordsFastExponent x = low11 (drop4 (drop16 (tail x)))
     49 wordsFastUnpack x = t (wordsSign x) (t (wordsFastExponent x)
     50   (join32 (head x) (low20 (tail x))))
     51 -- Proper list of eight canonical octets, little endian.
     52 byte6 x = head (tail (tail (drop4 x)))
     53 byte7 x = head (tail (tail (tail (drop4 x))))
     54 bytesSign x = N.odd (drop1 (drop2 (drop4 (byte7 x))))
     55 bytesExponent x = N.add (drop4 (byte6 x)) (N.multiply 16 (takeBits 7 (byte7 x)))
     56 bytesNatural xs = triage t (_ : t)
     57   (a b : N.add a (N.multiply 256 (bytesNatural b))) xs
     58 bytesUnpack x = packedUnpack (bytesNatural x)
     59 bytesFastExponent x = join4 (drop4 (byte6 x)) (low7 (byte7 x))
     60 -- Reconstruct the fraction bytes.
     61 bytesFraction6 x = join8 (head x) (join8 (head (tail x))
     62   (join8 (head (drop2 x)) (join8 (head (tail (drop2 x)))
     63   (join8 (head (drop4 x)) (join8 (head (tail (drop4 x)))
     64   (join4 (byte6 x) t))))))
     65 bytesFastUnpack x = t (bytesSign x) (t (bytesFastExponent x) (bytesFraction6 x))
     66 fieldSigns xs = map fieldsSign xs
     67 fieldExponents xs = map fieldsExponent xs
     68 fieldUnpacks xs = map fieldsUnpack xs
     69 packedSigns xs = map packedSign xs
     70 packedExponents xs = map packedExponent xs
     71 packedUnpacks xs = map packedUnpack xs
     72 wordSigns xs = map wordsSign xs
     73 wordExponents xs = map wordsExponent xs
     74 wordUnpacks xs = map wordsUnpack xs
     75 byteSigns xs = map bytesSign xs
     76 byteExponents xs = map bytesExponent xs
     77 byteUnpacks xs = map bytesUnpack xs
     78 packedFastExponents xs = map packedFastExponent xs
     79 packedFastUnpacks xs = map packedFastUnpack xs
     80 wordFastExponents xs = map wordsFastExponent xs
     81 wordFastUnpacks xs = map wordsFastUnpack xs
     82 byteFastExponents xs = map bytesFastExponent xs
     83 byteFastUnpacks xs = map bytesFastUnpack xs
     84 -- Bottom sentinels check that sign projection leaves other fields opaque.
     85 spin x = spin x
     86 fieldDemand x = fieldsSign (t (t t) (spin x))
     87 wordDemand x = wordsSign (t (spin x) 2147483648)
     88 -- Consumer baseline, same result shape as the sign workloads.
     89 constantSigns xs = map (_ : t t) xs