haskell - 我在滥用 unsafePerformIO 吗？

Question

为了熟悉unsafePerformIO（如何使用它以及何时使用它），我实现了一个用于生成唯一值的模块。

这是我所拥有的：

module Unique (newUnique) where

import Data.IORef
import System.IO.Unsafe (unsafePerformIO)

-- Type to represent a unique thing.
-- Show is derived just for testing purposes.
newtype Unique = U Integer
  deriving Show

-- I believe this is the Haskell'98 derived instance, but
-- I want to be explicit, since its Eq instance is the most
-- important part of Unique.
instance Eq Unique where
  (U x) == (U y) = x == y

counter :: IORef Integer
counter = unsafePerformIO $ newIORef 0

updateCounter :: IO ()
updateCounter = do
  x <- readIORef counter
  writeIORef counter (x+1)

readCounter :: IO Integer
readCounter = readIORef counter

newUnique' :: IO Unique
newUnique' = do { x <- readIORef counter
                ; writeIORef counter (x+1)
                ; return $ U x }

newUnique :: () -> Unique
newUnique () = unsafePerformIO newUnique'

令我高兴的是，名为的包Data.Unique选择了与我相同的数据类型。另一方面，他们选择了 type ，但如果可能newUnique :: IO Unique的话，我想远离。IO

这种实施危险吗？它可能会导致 GHC 改变使用它的程序的语义吗？

Answer 1

视为unsafePerformIO对编译器的承诺。它说“我保证您可以将此 IO 操作视为纯值，并且不会出错”。它很有用，因为有时您可以为使用不纯操作实现的计算构建纯接口，但编译器无法验证何时是这种情况；相反unsafePerformIO，您可以把手放在心上，发誓您已经验证了不纯的计算实际上是纯的，因此编译器可以简单地相信它是。

在这种情况下，承诺是错误的。ifnewUnique是一个纯函数 thenlet x = newUnique () in (x, x)并且(newUnique (), newUnique ())将是等价的表达式。但是你会希望这两个表达式有不同的结果；在一种情况下是一对相同Unique值的副本，在另一种情况下是一对两个不同的Unique值。使用您的代码，真的无法说出这两个表达式的含义。它们只能通过考虑程序在运行时执行的实际操作顺序来理解，而对它的控制正是您在使用unsafePerformIO. unsafePerformIO表示是否将任一表达式编译为一次执行并不重要newUnique或者两个，并且 Haskell 的任何实现在每次遇到此类代码时都可以自由选择它喜欢的任何内容。

Answer 2

的目的unsafePerformIO是当您的函数在内部执行某些操作，但没有观察者会注意到的副作用。例如，一个函数接受一个向量，复制它，就地快速排序副本，然后返回副本。（见评论）这些操作中的每一个都有副作用，在 中也是如此IO，但总体结果没有。

newUnique必须是一个IO动作，因为它每次都会产生不同的东西。这基本上是定义IO，它意味着一个动词，而不是形容词的功能。对于相同的参数，函数将始终返回相同的结果。这称为参照透明性。

有关 的有效用途unsafePerformIO，请参阅此问题。

Answer 3

是的，您的模块很危险。考虑这个例子：

module Main where
import Unique

main = do
  print $ newUnique ()
  print $ newUnique ()

编译并运行：

$ ghc Main.hs
$ ./Main
U 0
U 1

编译优化并运行：

$ \rm *.{hi,o}
$ ghc -O Main.hs
$ ./Main
U 0
U 0

哦哦！

添加{-# NOINLINE counter #-}and{-# NOINLINE newUnique #-} 并没有帮助，所以我实际上不确定这里发生了什么......

第一次更新

查看 GHC 核心，我看到 @LambdaFairy 是正确的，即常量子表达式消除 (CSE) 导致我的newUnique () 表达式被提升。-fno-cse但是，使用和添加{-# NOINLINE counter #-}来防止 CSE并Unique.hs不足以使优化的程序与未优化的程序打印相同！ 特别是，它似乎counter是内联的，即使使用了 NOINLINEpragma inUnique.hs. 有谁明白为什么？

我已在 https://gist.github.com/ntc2/6986500上传了以下核心文件的完整版本。

main编译时的（相关）核心-O：

main3 :: Unique.Unique
[GblId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=False, Expandable=False,
         Guidance=IF_ARGS [] 20 0}]
main3 = Unique.newUnique ()

main2 :: [Char]
[GblId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=False, Expandable=False,
         Guidance=IF_ARGS [] 40 0}]
main2 =
  Unique.$w$cshowsPrec 0 main3 ([] @ Char)

main4 :: [Char]
[GblId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=False, Expandable=False,
         Guidance=IF_ARGS [] 40 0}]
main4 =
  Unique.$w$cshowsPrec 0 main3 ([] @ Char)

main1
  :: State# RealWorld
     -> (# State# RealWorld, () #)
[GblId,
 Arity=1,

 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=IF_ARGS [0] 110 0}]
main1 =
  \ (eta_B1 :: State# RealWorld) ->
    case Handle.Text.hPutStr2
           Handle.FD.stdout main4 True eta_B1
    of _ { (# new_s_atQ, _ #) ->
    Handle.Text.hPutStr2
      Handle.FD.stdout main2 True new_s_atQ
    }

请注意，newUnique ()呼叫已被解除并绑定到 main3.

现在编译时-O -fno-cse：

main3 :: Unique.Unique
[GblId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=False, Expandable=False,
         Guidance=IF_ARGS [] 20 0}]
main3 = Unique.newUnique ()

main2 :: [Char]
[GblId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=False, Expandable=False,
         Guidance=IF_ARGS [] 40 0}]
main2 =
  Unique.$w$cshowsPrec 0 main3 ([] @ Char)

main5 :: Unique.Unique
[GblId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=False, Expandable=False,
         Guidance=IF_ARGS [] 20 0}]
main5 = Unique.newUnique ()

main4 :: [Char]
[GblId,
 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=0, Value=False,
         ConLike=False, Cheap=False, Expandable=False,
         Guidance=IF_ARGS [] 40 0}]
main4 =
  Unique.$w$cshowsPrec 0 main5 ([] @ Char)

main1
  :: State# RealWorld
     -> (# State# RealWorld, () #)
[GblId,
 Arity=1,

 Unf=Unf{Src=<vanilla>, TopLvl=True, Arity=1, Value=True,
         ConLike=True, Cheap=True, Expandable=True,
         Guidance=IF_ARGS [0] 110 0}]
main1 =
  \ (eta_B1 :: State# RealWorld) ->
    case Handle.Text.hPutStr2
           Handle.FD.stdout main4 True eta_B1
    of _ { (# new_s_atV, _ #) ->
    Handle.Text.hPutStr2
      Handle.FD.stdout main2 True new_s_atV
    }

请注意，main3andmain5是两个单独的newUnique () 调用。

然而：

rm *.hi *o Main
ghc -O -fno-cse Main.hs && ./Main
U 0
U 0

查看此修改的核心Unique.hs：

module Unique (newUnique) where

import Data.IORef
import System.IO.Unsafe (unsafePerformIO)

-- Type to represent a unique thing.
-- Show is derived just for testing purposes.
newtype Unique = U Integer
  deriving Show

{-# NOINLINE counter #-}
counter :: IORef Integer
counter = unsafePerformIO $ newIORef 0

newUnique' :: IO Unique
newUnique' = do { x <- readIORef counter
                ; writeIORef counter (x+1)
                ; return $ U x }

{-# NOINLINE newUnique #-}
newUnique :: () -> Unique
newUnique () = unsafePerformIO newUnique'

尽管有编译指示，但它似乎counter被内联为counter_ragNOINLINE（第二次更新：错误！counter_rag没有标记[InlPrag=NOINLINE]，但这并不意味着它已被内联；相反，counter_rag它只是 的 munged 名称counter）；虽然NOINLINEfornewUnique受到尊重：

counter_rag :: IORef Type.Integer

counter_rag =
  unsafeDupablePerformIO
    @ (IORef Type.Integer)
    (lvl1_rvg
     `cast` (Sym
               (NTCo:IO <IORef Type.Integer>)
             :: (State# RealWorld
                 -> (# State# RealWorld,
                       IORef Type.Integer #))
                  ~#
                IO (IORef Type.Integer)))

[...]

lvl3_rvi
  :: State# RealWorld
     -> (# State# RealWorld, Unique.Unique #)
[GblId, Arity=1]
lvl3_rvi =
  \ (s_aqi :: State# RealWorld) ->
    case noDuplicate# s_aqi of s'_aqj { __DEFAULT ->
    case counter_rag
         `cast` (NTCo:IORef <Type.Integer>
                 :: IORef Type.Integer
                      ~#
                    STRef RealWorld Type.Integer)
    of _ { STRef var#_au4 ->
    case readMutVar#
           @ RealWorld @ Type.Integer var#_au4 s'_aqj
    of _ { (# new_s_atV, a_atW #) ->
    case writeMutVar#
           @ RealWorld
           @ Type.Integer
           var#_au4
           (Type.plusInteger a_atW lvl2_rvh)
           new_s_atV
    of s2#_auo { __DEFAULT ->
    (# s2#_auo,
       a_atW
       `cast` (Sym (Unique.NTCo:Unique)
               :: Type.Integer ~# Unique.Unique) #)
    }
    }
    }
    }

lvl4_rvj :: Unique.Unique

lvl4_rvj =
  unsafeDupablePerformIO
    @ Unique.Unique
    (lvl3_rvi
     `cast` (Sym (NTCo:IO <Unique.Unique>)
             :: (State# RealWorld
                 -> (# State# RealWorld, Unique.Unique #))
                  ~#
                IO Unique.Unique))

Unique.newUnique [InlPrag=NOINLINE] :: () -> Unique.Unique

Unique.newUnique =
  \ (ds_dq8 :: ()) -> case ds_dq8 of _ { () -> lvl4_rvj }

这里发生了什么？

第二次更新

用户@errge想通了。仔细观察上面粘贴的最后一个核心输出，我们看到大部分的主体Unique.newUnique已经浮动到顶层，如lvl4_rvj. 然而，lvl4_rvj是一个常量表达式，而不是一个函数，所以它只计算一次，解释了重复的U 0输出main。

的确：

rm *.hi *o Main
ghc -O -fno-cse -fno-full-laziness Main.hs && ./Main
U 0
U 1

我不明白-ffull-laziness优化到底是做什么的 ——GHC 文档 谈论浮动的 let 绑定，但主体lvl4_rvj似乎不是 let 绑定——但我们至少可以将上述核心与生成的核心进行比较-fno-full-laziness并且看到现在身体没有被抬起：

Unique.newUnique [InlPrag=NOINLINE] :: () -> Unique.Unique

Unique.newUnique =
  \ (ds_drR :: ()) ->
    case ds_drR of _ { () ->
    unsafeDupablePerformIO
      @ Unique.Unique
      ((\ (s_as1 :: State# RealWorld) ->
          case noDuplicate# s_as1 of s'_as2 { __DEFAULT ->
          case counter_rfj
               `cast` (<NTCo:IORef> <Type.Integer>
                       :: IORef Type.Integer
                            ~#
                          STRef RealWorld Type.Integer)
          of _ { STRef var#_avI ->
          case readMutVar#
                 @ RealWorld @ Type.Integer var#_avI s'_as2
          of _ { (# ipv_avz, ipv1_avA #) ->
          case writeMutVar#
                 @ RealWorld
                 @ Type.Integer
                 var#_avI
                 (Type.plusInteger ipv1_avA (__integer 1))
                 ipv_avz
          of s2#_aw2 { __DEFAULT ->
          (# s2#_aw2,
             ipv1_avA
             `cast` (Sym <(Unique.NTCo:Unique)>
                     :: Type.Integer ~# Unique.Unique) #)
          }
          }
          }
          })
       `cast` (Sym <(NTCo:IO <Unique.Unique>)>
               :: (State# RealWorld
                   -> (# State# RealWorld, Unique.Unique #))
                    ~#
                  IO Unique.Unique))
    }

这里再次counter_rfj对应counter，我们看到不同的是，bodyUnique.newUnique没有被提升，所以每次调用都会运行引用更新( readMutVar, )代码。writeMutVarUnique.newUnique

我已经更新了要点以包含新的-fno-full-laziness核心文件。较早的核心文件是在另一台计算机上生成的，因此这里的一些细微差别与-fno-full-laziness.

Answer 4

请参阅另一个示例如何失败：

module Main where
import Unique

helper :: Int -> Unique
-- noinline pragma here doesn't matter
helper x = newUnique ()

main = do
  print $ helper 3
  print $ helper 4

使用此代码，效果与 ntc2 示例中的效果相同：使用 -O0 时正确，但使用 -O 时不正确。但是在这段代码中没有“要消除的公共子表达式”。

这里实际发生的是newUnique ()表达式“浮动”到顶层，因为它不依赖于函数的参数。在 GHC 中，这是-ffull-laziness（默认情况下使用-O开启，可以使用 关闭-O -fno-full-laziness）。

所以代码实际上变成了这样：

helperworker = newUnique ()
helper x = helperworker

而这里的 helperworker 是一个只能被评估一次的 thunk。

使用已经推荐的 NOINLINE 编译指示，如果您添加-fno-full-laziness到命令行，那么它会按预期工作。