Я злоупотребляю 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 выбрал тот же тип данных, что и я; с другой стороны, они выбрали тип newUnique :: IO Unique, но я хочу держаться подальше от IO если возможно.

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

Answer 1

Лечить unsafePerformIO как обещание компилятору. Он говорит: "Я обещаю, что вы можете рассматривать это действие ввода-вывода, как если бы оно было чистой ценностью, и ничто не пойдет не так". Это полезно, потому что бывают случаи, когда вы можете создать чистый интерфейс для вычислений, реализованных с нечистыми операциями, но для компилятора невозможно проверить, когда это так; вместо 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 #-}не помогает, так что я не совсем уверен, что здесь происходит...

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 прагма (2-е обновление: неправильно! counter_rag не отмечен [InlPrag=NOINLINE], но это не значит, что он был встроен; скорее, counter_rag это просто обыденное имя 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 }

Что тут происходит?

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

Пользователь @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 снова, и мы видим разницу в том, что тело 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

А вот хелпер-работник - это спан, который можно оценить только один раз.

С уже рекомендованными прагмами NOINLINE, если вы добавите -fno-full-laziness в командной строке, то все работает как положено.