The ghci implementation for :sprint ultimately uses unpackClosure# from ghc-prim to inspect a closure. This can be combined with knowledge of the format of heap objects to determine if a closure has been evaluated all the way to weak head normal form.
There are a few ways to reproduce the inspection done by the ghci implementation for :sprint. The GHC api exposes getClosureData :: DynFlags -> a -> IO Closure in RtClosureInspect. The vacuum package, which depends only on ghc-prim, reproduces the code from RtClosureInspect and exposes getClosure :: a -> IO Closure. It's not immediately obvious how to examine either of these Closure representations to, for example, follow an indirection. The ghc-heap-view package inspects closures and exposes both a getClosureData :: a -> IO Closure and a detailed view of the Closure. ghc-heap-view depends on the GHC api.
We can write evaluated in terms of getBoxedClosureData from ghc-heap-view.
import GHC.HeapView
evaluated :: a -> IO Bool
evaluated = go . asBox
where
go box = do
c <- getBoxedClosureData box
case c of
ThunkClosure {} -> return False
SelectorClosure {} -> return False
APClosure {} -> return False
APStackClosure {} -> return False
IndClosure {indirectee = b'} -> go b'
BlackholeClosure {indirectee = b'} -> go b'
_ -> return True
This handling of blackhole closures may be incorrect while the blackhole is being evaluated. The handling of selector closures may be incorrect. The assumption that AP closures aren't in weak head normal form may be incorrect. The assumption that all other closures are in WHNF is almost certainly incorrect.
Example
Our example will require two concurrent threads to observe in one thread that the other is evaluating expressions.
import Data.Char
import Control.Concurrent
We can communicate information sideways out of a function without resorting to anything unsafe by selectively forcing evaluation. The following builds a stream of pairs of thunks in which we can choose to force one or the other of the pair.
mkBitStream :: Integer -> [(Integer, Integer)]
mkBitStream a = (a+2, a+3) : mkBitStream (a+1)
zero forces the first one and one forces the second one.
zero :: [(x, y)] -> [(x, y)]
zero ((x, _):t) = x `seq` t
one :: [(x, y)] -> [(x, y)]
one ((_, y):t) = y `seq` t
copy is an evil identity function that has the side effect of forcing bits in a stream based on inspecting the data.
copy :: (a -> Bool) -> [(x, y)] -> [a] -> [a]
copy f bs [] = []
copy f bs (x:xs) = let bs' = if f x then one bs else zero bs
in bs' `seq` (x:copy f bs' xs)
readBs reads our bit stream by checking if each of the thunks in a pair has been evaluated.
readBs :: [(x, y)] -> IO ()
readBs bs@((f, t):bs') = do
f' <- evaluated f
if f'
then putStrLn "0" >> readBs bs'
else do
t' <- evaluated t
if t'
then putStrLn "1" >> readBs bs'
else readBs bs
Forcing copy when printing it has the side effect of printing the information observed about the read string.
main = do
let bs = mkBitStream 0
forkIO (readBs bs)
text <- getLine
putStrLn (copy isAlpha bs text)
getLine
If we run the program and provide the input abc123 we observe the side effect corresponding to checking if each of the characters isAlpha
abc123
abc123
1
1
1
0
0
0
