logo标签列表

测试一个值是否已经被求值为弱头部正常形式

haskelllazy-evaluationthunkweak-head-normal-form
18
在Haskell中，是否可以测试一个值是否已经被求值为弱头正常形式？如果函数已经存在，我会期望它的签名像这样：

evaluated :: a -> IO Bool

有几个地方有类似的功能。
一个 先前的答案 向我介绍了 :sprint ghci 命令，它将仅打印已经强制转换为弱头正常形式的值的部分。:sprint 可以观察一个值是否已被评估:
> let l = ['a'..]
> :sprint l
l = _
> head l
'a'
> :sprint l
l = 'a' : _

在IO中，可以检查那些本来无法访问的属性。例如，可以在IO中比较两个值是否来自同一声明。这是由System.Mem.StableName中的StableName提供的，被广泛用于解决data-reify中的可观察共享问题。相关的StablePtr不提供检查引用值是否处于弱头正常形式的机制。
有趣的是，这已经是谷歌搜索“haskell check if whnf”的第二个结果了，至少对我来说是这样的 :)。 - Tikhon Jelvis
3
有希望的是，GHC Commentary指出每个堆对象信息表都包括闭包类型，看起来这应该满足你所寻找的类型。但不太乐观的是，我感觉 GHC 的取消装箱转换会让整个想法变得更加难以捉摸。 - dfeuer
@dfeuer 谢谢。 GHC Commentary 对编写 近似答案 很有帮助。 - Cirdec
4个回答
12

我不确定有没有现成的解决方案。但是，可以编写代码来实现：

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”的内容时进行跟踪，因此您应该尽可能靠近感兴趣的惰性求值来放置它--例如，它将无法告诉您由其他人制作的延迟已经在跟踪开始之前由其他人评估了。当然，如果您需要线程安全，请考虑使用MVar而不是IORef。
2
我相信通常需要在unsafePerformIO周围加上NOINLINE（以及石棉内衣）以防止其被优化掉。 - dfeuer
4
在我看来，这里的False表示该值不在弱头规范型（WHNF）中，而True则表示它要么在弱头规范型中，要么正在被求值（并且尚未产生弱头规范型）。也许使用val `seq` unsafePerformIO (writeIORef ref True) `seq` val可以得到相反的保证（True保证弱头规范型，而False表示非弱头规范型/评估正在进行中）。使用3状态状态机甚至可以更精确地表示：未评估/评估中/弱头规范型。 - chi
9
ghci实现的:sprint最终使用了来自ghc-prim的unpackClosure#来检查一个闭包。这可以与对堆对象格式的了解相结合，以确定一个闭包是否已经被完全评估到弱头归一范式。

有几种方法可以重现ghci实现:sprint所做的检查。 GHC api在RtClosureInspect中公开了getClosureData :: DynFlags -> a -> IO Closure。仅依赖于ghc-prim的vacuum软件包复制了RtClosureInspect中的代码，并公开了getClosure :: a -> IO Closure。不明显如何检查这些Closure表示的任何一个，例如跟随间接引用。 ghc-heap-view软件包检查闭包并公开了getClosureData :: a -> IO Closure和详细查看Closure。ghc-heap-view依赖于GHC api。

我们可以使用ghc-heap-view中的getBoxedClosureData编写evaluated。

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

我们可以通过选择性地强制求值，而无需使用任何不安全的方法来在函数外侧传递信息。以下代码构建了一个thunk对的流，在其中我们可以选择强制求值其中一个或另一个thunk。
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 函数通过检查一对thunk是否已经被 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
我认为你可以通过添加至少最相关的闭包类型的简要描述来改进这个答案。 - dfeuer
7
谢谢。这对编写近似答案很有帮助。在RtClosureInspect中使用的闭包检查代码在GHC api中公开。 - Cirdec
1
网页内容由stack overflow 提供, 点击上面的
可以查看英文原文，
原文链接