Проверить, было ли значение оценено как нормальная форма слабой головы

Я не уверен, что для этого есть что-нибудь готовое. Однако его можно закодировать:

import Data.IORef
import System.IO.Unsafe

track :: a -> IO (a, IO Bool)
track val = do
    ref <- newIORef False
    return
        ( unsafePerformIO (writeIORef ref True) `seq` val
        , readIORef ref
        )

Вот пример использования в ghci:

*NFTrack> (value, isEvaluated) <- track (undefined:undefined)
*NFTrack> isEvaluated
False
*NFTrack> case value of _:_ -> "neat!"
"neat!"
*NFTrack> isEvaluated
True

Конечно, это будет отслеживать, оценивается ли преобразователь завернутого с записью и затем-возвратом исходного значения в WHNF, а не на то, оценивается ли вещь, переданная в track, в WHNF, поэтому вы я хочу поместить это как можно ближе к интересующему вас преобразователю - например, он не сможет сказать вам, был ли созданный кем-то преобразователь уже кем-то оценен до начала отслеживания. И, конечно, подумайте об использовании MVar вместо IORef, если вам нужна потокобезопасность.

ghci для :sprint в конечном итоге использует unpackClosure# из ghc-prim для проверки закрытия. Это можно объединить со знанием формата объектов кучи, чтобы определить, закрытие оценивалось полностью до нормальной формы слабой головы.

Есть несколько способов воспроизвести проверку, выполненную реализацией ghci для :sprint. API GHC предоставляет доступ к getClosureData :: DynFlags -> a -> IO Closure в RtClosureInspect. Пакет вакуум, который зависит только от ghc-prim, воспроизводит код из RtClosureInspect и предоставляет getClosure :: a -> IO Closure. Не сразу очевидно, как исследовать любое из этих Closure представлений, чтобы, например, проследить косвенное обращение. Пакет ghc-heap-view проверяет закрытие и предоставляет как getClosureData :: a -> IO Closure и подробный вид Closure. ghc-heap-view зависит от API GHC.

Мы можем написать evaluated в терминах _12 _ из 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

Такая обработка закрытий черной дыры может быть неправильной во время оценки черной дыры. Обработка замыканий селектора может быть неправильной. Предположение, что замыкания AP не в нормальной форме слабой головы, может быть неверным. Предположение, что все другие замыкания находятся в WHNF, почти наверняка неверно.

Пример

В нашем примере потребуется, чтобы два параллельных потока наблюдали в одном потоке, что другой оценивает выражения.

import Data.Char
import Control.Concurrent

Мы можем передавать информацию вне функции, не прибегая ни к чему unsafe, путем выборочного принудительного вычисления. Следующее создает поток пар преобразователей, в котором мы можем выбрать принудительное включение одного или другого из пары.

mkBitStream :: Integer -> [(Integer, Integer)]
mkBitStream a = (a+2, a+3) : mkBitStream (a+1)

zero форсирует первую, а one форсирует вторую.

zero :: [(x, y)] -> [(x, y)]
zero ((x, _):t) = x `seq` t

one :: [(x, y)] -> [(x, y)]
one ((_, y):t) = y `seq` t

copy - злая функция идентификации, побочным эффектом которой является форсирование битов в потоке на основе проверки данных.

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 читает наш битовый поток, проверяя, был ли каждый из преобразователей в паре 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

Принудительное copy при печати имеет побочный эффект печати информации, наблюдаемой о прочитанной строке.

main = do
    let bs = mkBitStream 0
    forkIO (readBs bs)
    text <- getLine
    putStrLn (copy isAlpha bs text)
    getLine

Если мы запустим программу и предоставим ввод abc123, мы увидим побочный эффект, соответствующий проверке каждого из символов isAlpha

abc123
abc123
1
1
1
0
0
0

Отрицательный ответ для записи: не представляется возможным повторно использовать механизм sprint, потому что он тесно связан с интерпретируемым интерактивным вычислением, в отличие от примитивных структур времени выполнения - насколько я могу судить; Я никогда раньше не смотрел на внутреннее устройство GHC.

Я начал с поиска «sprint» в источнике GHC на GitHub, который, как оказалось, поделился реализацией с «print» команда, но для флага Bool с именем force, и следовала определениям, пока не добрался до RtClosureInspect.hs#L654Inspect. cvObtainTerm, который, похоже, является специализированным оценщиком.

Недавно было предложение, может быть, оно где-то уже реализовано https://mail.haskell.org/pipermail/libraries/2015-FebFebruary/024917.html.