tricu

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

float-boundary-driver.tri (2039B)

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