Основываясь на решении Альвина Кеслера, вот пример более практичного реального мира.
Предполагая, что список, разделенный запятыми, находится в my_table.list, и это список идентификаторов для my_other_table.id, вы можете сделать что-то вроде:
SELECT
*
FROM
my_other_table
WHERE
(SELECT list FROM my_table WHERE id = '1234') REGEXP CONCAT(',?', my_other_table.id, ',?');
Считайте unsafePerformIO
обещанием для компилятора. Он говорит: «Я обещаю, что вы можете рассматривать это действие ввода-вывода, как если бы оно было чистой ценностью, и ничто не пойдет не так». Это полезно, потому что бывают случаи, когда вы можете создать чистый интерфейс для вычислений, реализованных с нечистыми операциями, но для компилятора невозможно проверить, когда это так; вместо этого unsafePerformIO
позволяет вам положить руку на ваше сердце и поклясться, что вы убедились, что нечистые вычисления действительно чисты, поэтому компилятор может просто поверить, что это так.
newUnique
была чистой функцией, то let x = newUnique () in (x, x)
и (newUnique (), newUnique ())
были бы эквивалентными выражениями. Но вы бы хотели, чтобы эти два выражения имели разные результаты; пара дубликатов с одинаковым значением Unique
в одном случае и пара двух разных значений Unique
в другом. С вашим кодом действительно невозможно сказать, что означает любое выражение. Их можно понять только с учетом фактической последовательности операций, которые программа будет выполнять во время выполнения, и контроль над этим - именно то, от чего вы отказываетесь, когда используете unsafePerformIO
. unsafePerformIO
говорит, что не имеет значения , скомпилировано ли выражение как одно выполнение newUnique
или два, и любая реализация Haskell может свободно выбирать то, что ей нравится, каждый раз, когда встречается с таким кодом .
Цель unsafePerformIO
состоит в том, когда ваша функция выполняет некоторые внутренние действия, но не имеет побочных эффектов, которые наблюдатель заметил бы. Например, функция, которая берет вектор, копирует его, быстро сортирует копию на месте, а затем возвращает копию. strike> (см. комментарии) Каждая из этих операций имеет побочные эффекты, как и в IO
, но общего результата нет.
newUnique
должно быть действием IO
, потому что оно каждый раз генерирует что-то новое. Это в основном определение IO
, оно означает глагол , в отличие от функций, которые являются прилагательными . Функция всегда будет возвращать один и тот же результат для одинаковых аргументов. Это называется ссылочной прозрачностью.
Для правильного использования unsafePerformIO
см. этот вопрос .
Посмотрите другой пример, как это терпит неудачу:
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
в командную строку, тогда он будет работать как положено.
Да, ваш модуль опасен. Рассмотрим следующий пример:
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
встроен даже с прагмой NOINLINE
в Unique.hs
del>. Кто-нибудь понимает, почему?
Я загрузил полные версии следующих основных файлов на 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
прагму del> (2-е обновление: неправильно! counter_rag
не помечено [InlPrag=NOINLINE]
, но это не значит, что оно было встроено; скорее, counter_rag
- это просто ложное имя [ одна тысяча сто тридцать четыре]); 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 }
Что здесь происходит?
Пользователь @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
.