记住满足约束的结果

Question

我正在寻找一个功能

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstraintKinds #-}

memoC :: (c => a) -> (c => a)

这样生成的a仅针对提供的约束进行一次计算。

另一个简短版本

如何制作某种类型a的值，只有在出现某种约束证明c时才能检查？

动机

我长期以来一直在寻求记住表格价值的一般解决方案：

C a => a

其中C是一些约束，a范围超过所有类型。通过Typeable上的a约束以及一些智能构造函数，可以通过在Typeable a => b上构建一个trie来安全地为TypeRep的trie记忆。这个问题是关于更难的部分，在这样一个特里的叶子上放什么。

如果我们可以以某种方式将a放入叶子中，则trie的叶子最初需要为某个具体类型C a => a设置值a，因为类的字典可以'从类型中查找。查找trie中的值将需要C a的字典。这似乎相当于根据传入的字典修改了trie叶子上的值。

如果我们无法以某种方式将a放入树叶中，那么对于单个C a => b，树叶会有更加可怕的b类型，并且在提供字典时我们会需要证明类型a（以及字典）可以由b中的内容确定，这不会比TypeRep更强大。

恶

很容易进入bag of evil构建一个构造函数来保持trie的叶子。如果每个约束只有一个字典可用，那么根据传入的字典修改trie叶子上保存的值并不是邪恶的。

对此的任何“解决方案”都可能是非常邪恶的。我假设任何约束都只有一个字典。可以为约束构造多个字典的反射gives us another evil。

劝我脱离这种邪恶。

实施例

以下内容不应（并且不会）记住提供约束TracedC String的结果。

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}

import Debug.Trace (trace)

class TracedC a where
    tracedC :: () -> a  -- The () argument keeps a from being memoized in the dictionary for `TracedC a`

instance TracedC [Char] where
    tracedC _ = trace "tracedC :: String" "Yes"

newtype Memoized c a = Memoized { getMemoized :: c => a }

example :: Memoized (TracedC a) a
example = Memoized (tracedC ())

main = do
    let memo = example :: Memoized (TracedC [Char]) String
    putStrLn $ getMemoized memo
    putStrLn $ getMemoized memo

输出

tracedC :: String
Yes
tracedC :: String
Yes

解决方案会接受类似的示例，但只会在仅输出

时评估tracedC () :: TracedC [Char] -> String

tracedC :: String
Yes
Yes

相关尝试

A map from types to values f a可以在monadic memoization中使用，但有明显的副作用。

Answer 1

Pure Evil

我们围绕一个缺少约束和MVar的值创建一个严格的构造函数。

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ConstraintKinds #-}

import System.IO.Unsafe (unsafePerformIO)
import Control.Concurrent.MVar

data UpToSingle c a = UpToSingle (c => a) !(MVar a)

它只会被智能构造函数和解构器使用。在模块中，我们不会导出UpToSingle构造函数。

我们为它提供了一个聪明的构造函数;构造构造函数等同于分配MVar。

upToSingle :: (c => a) -> UpToSingle c a
upToSingle a = UpToSingle a $ unsafePerformIO newEmptyMVar

我们还提供智能解构器。它使用那里的任何值或用提供的字典计算一个值。它依赖于c有一个可能的字典。

fillMVar :: MVar a -> a -> IO a
fillMVar mvar a = do
    tryPutMVar mvar a
    readMVar mvar

withSingle :: c => UpToSingle c a -> a
withSingle (UpToSingle a mvar) = unsafePerformIO $ fillMVar mvar a

邪恶示例

使用与问题中相同的示例跟踪代码。

{-# LANGUAGE FlexibleInstances #-}

import Debug.Trace (trace)

class TracedC a where
    tracedC :: () -> a  -- The () argument keeps a from being memoized in the dictionary for `TracedC a`

instance TracedC [Char] where
    tracedC _ = trace "tracedC :: String" "Yes"

而UpToSingle代替Memoized，upToSingle代替Memoized构造函数，withSingle代替getMemoized

example :: UpToSingle (TracedC a) a
example = upToSingle (tracedC ())

main = do
    let memo = example :: UpToSingle (TracedC [Char]) String
    putStrLn $ withSingle memo
    putStrLn $ withSingle memo

我们得到了所需的输出

tracedC :: String
Yes
Yes

Doubly Evil

结合reflection显示UpToSingle或Given的邪恶。最后两行都应该打印相同的东西。通过替换它们都是give 9 (withSingle (upToSingle given))。

main = do
    let g1 = upToSingle given :: UpToSingle (Given Integer) Integer
    let g2 = upToSingle given :: UpToSingle (Given Integer) Integer
    print $ give 7 (withSingle g1)
    print $ give 9 (withSingle g2)
    print $ give 9 (withSingle g1)

他们实际打印以下内容：

7
9
7

give 7在give 9之前将Given Integer字典传递给g1而不是give 9的{​​{1}}进行评估，并且会产生改变结果的副作用give 9 (withSingle (upToSingle given))。 UpToSingle假设词典是唯一的，或give是构建新的非唯一词典的邪恶，这两者都是邪恶的。

从TypeRep到Typeable

当发现约束时，我们可以使用相同的延迟技巧来为Typeable a => f a构建备忘录的叶子。从概念上讲，trie的叶子都是以下GDynamic中的一个。

{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.Typeable
import Control.Monad (liftM)

data GDynamic f where
    GDynamic :: Typeable a => f a -> GDynamic f

unGDynamic :: Typeable a => GDynamic f -> Maybe (f a)
unGDynamic (GDynamic f) = gcast f

在构建trie时，我们没有构建Typeable a所需的GDynamic个实例。我们只有一个TypeRep。相反，我们将窃取访问该值时提供的Typeable a实例。最高GDynamic个实例的Typeable a值为TypeRep，值为forall a.的定义以及用于保存实际MVar的{​​{1}}

GDynamic

我们不会导出data UpToTypeable f = UpToTypeable TypeRep (forall a. Typeable a => f a) !(MVar (GDynamic f)) 构造函数，而只导出智能构造函数和解构函数。构建UpToTypeable后，我们会分配UpToTypeable。

MVar

解构后，用户会提供upToTypeable :: TypeRep -> (forall a. Typeable a => f a) -> UpToTypeable f upToTypeable r f = UpToTypeable r f $ unsafePerformIO newEmptyMVar 个实例。如果它与Typeable a中存储的TypeRep具有相同的UpToTypeable，则我们接受该类型相同的证据，并使用提供的Typeable a实例来填充{{1}的值}}

GDynamic

这应该是安全的，因为未来的GHC版本将禁止用户为withTypeable :: forall f a. Typeable a => UpToTypeable f -> Maybe (f a) withTypeable (UpToTypeable r f mvar) = unsafePerformIO $ do if typeRep (Proxy :: Proxy a) == r then liftM unGDynamic $ fillMVar mvar (GDynamic (f :: f a)) else return Nothing 提供的实例。