tricu

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

core-retention.tri (1033B)

      1 !import base as B
      2 !import native_math as N
      3 !import io as IO
      4 !export joined
      5 !export discarded
      6 
      7 -- Each child creates a different, forced 4096-cell payload. A constant or
      8 -- unevaluated payload would conceal an archive of completed task results.
      9 make 0 _ = []
     10 make count value = B.pair value (make (N.predecessor count) value)
     11 count [] acc = acc
     12 count [_ | rest] acc = count rest (N.successor acc)
     13 count _ _ = 0
     14 checked payload = case N.equal (count payload 0) 4096 of
     15   (t t) = IO.pure payload
     16   _ = IO.fail "incomplete fresh payload"
     17 step mode seed = IO.scope (_ : IO.require
     18   (IO.spawn 0 1 [] (_ : checked (make 4096 seed))) (spawned : case spawned of
     19     [task ticket] = case mode of
     20       0 = IO.require (IO.join ticket) (_ : IO.pure t)
     21       _ = IO.require (IO.discard ticket) (_ : IO.pure t)
     22     _ = IO.fail "invalid spawn reply"))
     23 loop _ 0 = IO.pure t
     24 loop mode left = IO.bind (step mode left) (_ : loop mode (N.predecessor left))
     25 joined iterations = IO.io (loop 0 iterations)
     26 discarded iterations = IO.io (loop 1 iterations)