我滥用不安全的PerformIO吗？

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选择了与我相同的数据类型; 另一方面,他们选择了这种类型newUnique :: IO Unique,但是IO如果可能的话我想要远离它.

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

Answer 1

对待unsafePerformIO作为承诺的编译器.它说:"我保证你可以把这个IO动作视为纯粹的价值而不会出错".它很有用,因为有时你可以为使用不纯操作实现的计算构建一个纯接口,但编译器不可能验证何时是这种情况; 相反unsafePerformIO,你可以把手放在心上,并发誓你已经证实不纯的计算实际上是纯粹的,所以编译器可以简单地相信它是.

在这种情况下,承诺是错误的.如果newUnique是一个纯函数,然后let 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 #-}并{-# NOINLINE newUnique #-} 没有帮助,所以我真的不确定这里发生了什么......

第一次更新

看看GHC核心,我看到@LambdaFairy是正确的,因为常量子表达式消除(CSE)导致我的newUnique () 表达式被解除.然而,预防与CSE -fno-cse和添加{-# NOINLINE counter #-}到Unique.hs不足以使优化程序打印一样的未经优化的程序! 特别是,counter即使有了NOINLINEpragma ,它似乎也被内联 了Unique.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
    }

需要注意的是main3和main5是两个独立的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_rag,尽管NOINLINE编译(第二次更新:错误!counter_rag没有标记[InlPrag=NOINLINE],但这并不意味着它已经被内联;相反,counter_rag它只是被称为的名字counter); 尽管如此,NOINLINEfor for newUnique受到了尊重:

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看起来似乎没有绑定 - 但我们至少可以将上面的核心与生成的核心进行比较-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,我们看到的不同之处在于Unique.newUnique尚未解除主体,因此每次调用时都会运行引用更新(readMutVar,writeMutVar)代码Unique.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到命令行，那么它会按预期工作。