Я злоупотребляю unsafePerformIO?

Чтобы ознакомиться с 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'

К моему удовольствию, в package называется Data.Unique выбрал тот же тип данных, как и я; с другой стороны, они выбрали тип newUnique :: IO Unique, но я хочу держаться подальше от IO, если это возможно.

Является ли эта реализация опасной? Может ли это привести GHC изменить семантику программы, которая ее использует?

Ответы

Ответ 1

Относитесь к unsafePerformIO как к обещанию компилятору. В нем говорится: "Я обещаю, что вы можете рассматривать это действие IO, как если бы это была чистая ценность, и ничего не пойдет не так". Это полезно, потому что есть время, когда вы можете создать чистый интерфейс для вычислений, реализованных с нечистыми операциями, но компилятор не может проверить, когда это так; вместо этого unsafePerformIO позволяет вам приложить руку к сердцу и поклясться, что вы подтвердили, что нечистое вычисление на самом деле чистое, поэтому компилятор может просто доверять этому.

В этом случае это обещание ложно. Если newUnique были чистой функцией, то let x = newUnique () in (x, x) и (newUnique (), newUnique ()) были бы эквивалентными выражениями. Но вы хотели бы, чтобы эти два выражения имели разные результаты; пара дубликатов одного и того же значения Unique в одном случае и пара двух разных значений Unique в другом. С вашим кодом нет никакого способа сказать, что означает выражение. Их можно понять только с учетом фактической последовательности операций, которые программа будет выполнять во время выполнения, и контролировать это именно то, что вы отказываетесь при использовании unsafePerformIO. unsafePerformIO говорит, что не имеет значения, скомпилировано ли какое-либо выражение как одно исполнение newUnique или два, и любая реализация Haskell может выбирать все, что ему нравится каждый раз, когда он сталкивается с таким кодом.

Ответ 2

Цель unsafePerformIO заключается в том, что ваша функция выполняет некоторые действия внутри себя, но не имеет побочных эффектов, которые наблюдатель заметил бы. Например, функция, которая принимает вектор, копирует его, быстро сортирует копию на месте, а затем возвращает копию. (см. комментарии). Каждая из этих операций имеет побочные эффекты, и поэтому она находится в IO, но общий результат не получается.

newUnique должен быть действием IO, потому что каждый раз он генерирует что-то другое. Это в основном определение IO, это означает глагол, в отличие от функций, которые являются прилагательными. Функция всегда возвращает тот же результат для тех же аргументов. Это называется ссылочной прозрачностью.

Для правильного использования unsafePerformIO см. этот вопрос.

Ответ 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 #-} не помогает, поэтому я не уверен, что происходит здесь...

1-е ОБНОВЛЕНИЕ

Глядя на ядро GHC, я вижу, что @LambdaFairy верна, что постоянное исключение подвыражения (CSE) вызвало мой newUnique () выражения, которые нужно снять. Тем не менее, предотвращение CSE с -fno-cse и добавление {-# NOINLINE counter #-} в Unique.hs не является достаточным для сделайте оптимизированную программу такой же, как и неоптимизированная программа! ~~В частности, кажется, что counter встроен даже с NOINLINE прагма в 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 pragma~~ (второе обновление: wrong! counter_rag не помечено [InlPrag=NOINLINE], но это doesn 't означает, что он был встроен, скорее, counter_rag - это просто название munged counter); NOINLINE для 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 }

Что здесь происходит?

2nd UPDATE

Пользователь @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 говорить о привязках с плавающей точкой, но тело 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.

Ответ 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 в командную строку, то он будет работать как ожидалось.