tricu

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

Clock.hs (1114B)

      1 -- Native monotonic observations and interruptible relative waits. No wall-clock
      2 -- epoch, deadline scheduler, race combinator or ordering guarantee is implied.
      3 module IO.Clock (monotonicNanoseconds, sleepMilliseconds, sleepWith, sleepLimit) where
      4 
      5 import Control.Concurrent (threadDelay)
      6 import GHC.Clock (getMonotonicTimeNSec)
      7 
      8 sleepLimit :: Integer
      9 sleepLimit = 9223372036854775807
     10 
     11 monotonicNanoseconds :: IO Integer
     12 monotonicNanoseconds = toInteger <$> getMonotonicTimeNSec
     13 
     14 -- Driver validates canonical [0,sleepLimit] milliseconds before entry. Keep each
     15 -- host delay <= one second: no Int overflow even on a narrower host, and no giant
     16 -- conversion to microseconds. Delays may run late; cancellation interrupts them.
     17 -- Injectable waiter supports deterministic chunk/overflow tests, not fault flags.
     18 sleepWith :: (Int -> IO ()) -> Integer -> IO ()
     19 sleepWith wait = go
     20   where
     21     go 0 = pure ()
     22     go remaining = do
     23       let chunk = min remaining 1000
     24       wait (fromInteger (chunk * 1000))
     25       go (remaining - chunk)
     26 
     27 sleepMilliseconds :: Integer -> IO ()
     28 sleepMilliseconds = sleepWith threadDelay