tricu

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

float_boundary_driver.tri (2181B)

      1 !import binary64 as F
      2 !import binary64_kernels as K
      3 !import native_math as N
      4 !export *
      5 words xs = map (x : F.word? x 17) xs
      6 imports xs = map (x : F.fromBitsC x 17) xs
      7 accepted reply = K.head (K.tail reply)
      8 transport x = let reply = F.fromBits x in K.lazy
      9   (_ : t (t t) (t (F.toBits (accepted reply)) t)) (_ : reply) (K.head reply)
     10 transports xs = map transport xs
     11 adds xs = map (p : F.addBits (K.head p) (K.tail p)) xs
     12 subtracts xs = map (p : F.subtractBits (K.head p) (K.tail p)) xs
     13 multiplies xs = map (p : F.multiplyBits (K.head p) (K.tail p)) xs
     14 divides xs = map (p : F.divideBits (K.head p) (K.tail p)) xs
     15 -- Test-only driver: the corpus supplies valid words and valid instruction indices.
     16 imported w = accepted (F.fromBits w)
     17 step op a b = K.lazy (_ : F.add a b)
     18   (_ : K.lazy (_ : F.subtract a b)
     19     (_ : K.lazy (_ : F.multiply a b) (_ : F.divide a b) (N.equal op 2)) (N.equal op 1)) (N.zero op)
     20 walk pool instructions v flags = K.triage (t (F.toBits v) flags) (_ : t (F.toBits v) flags)
     21   (instruction rest : let next = step (K.head instruction) v (at (K.tail instruction) pool) in
     22     walk pool rest (F.value next) (F.mergeFlags flags (F.flags next))) instructions
     23 chain input = walk (map imported (K.head (K.tail input))) (drop2 input)
     24   (imported (K.head input)) F.clearFlags
     25 chains xs = map chain xs
     26 flagView f = t (F.invalid f) (t (F.divideByZero f) (t (F.overflow f) (t (F.underflow f) (F.inexact f))))
     27 flagViews xs = map flagView xs
     28 spin x = spin x
     29 prefix n rest = K.lazy (_ : rest) (_ : t (t t) (prefix (N.predecessor n) rest)) (N.zero n)
     30 leftDemand x = F.addBits (t (spin x)) (spin x)
     31 bitDemand x = F.fromBits (t (t (spin x) (spin x)) (spin x))
     32 widthDemand x = F.fromBits (prefix 64 (t (spin x) (spin x)))
     33 remainderDemand x = K.head (F.word? 18446744073709551615 (spin x))
     34 nanValidation x = F.addBits 9221120237041090561 (t (spin x))
     35 trustedNanDemand x = F.toBits (F.value (F.add (imported 9221120237041090561) (spin x)))
     36 
     37 map f xs = K.triage t (_ : t) (a b : t (f a) (map f b)) xs
     38 drop2 x = K.tail (K.tail x)
     39 at index xs = K.lazy (_ : K.head xs) (_ : at (N.predecessor index) (K.tail xs)) (N.zero index)
     40 highZeroDemand x = F.fromBits (prefix 63 (t t (spin x)))