{-# LANGUAGE UnboxedTuples, PatternSynonyms, DerivingVia #-}
module GHC.Types.Unique.DSM
  (
  -- * Threading a deterministic supply
    DUniqSupply
  , UniqDSM(UDSM)
  , DUniqResult
  , pattern DUniqResult

  -- ** UniqDSM and DUniqSupply operations
  , getUniqueDSM
  , runUniqueDSM
  , takeUniqueFromDSupply
  , initDUniqSupply

  -- ** Tag operations
  , newTagDUniqSupply
  , getTagDUniqSupply

  -- * A transfomer threading a deterministic supply
  , UniqDSMT(UDSMT)

  -- ** UniqDSMT operations
  , runUDSMT
  , withDUS
  , hoistUDSMT
  , liftUDSMT

  -- ** Tags
  , setTagUDSMT

  -- * Monad class for deterministic supply threading
  , MonadGetUnique(..)
  , MonadUniqDSM(..)

  )
  where

import GHC.Exts (oneShot)
import GHC.Prelude
import GHC.Word
import Control.Monad.Fix
import GHC.Types.Unique
import qualified GHC.Utils.Monad.State.Strict as Strict
import qualified GHC.Types.Unique.Supply as USM
import Control.Monad.IO.Class

{-
Note [Deterministic Uniques in the CG]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC produces fully deterministic object code. To achieve this, there is a key
pass (detRenameCmmGroup) which renames all non-deterministic uniques in
the Cmm code right after StgToCmm. See Note [Object determinism] for the big
picture and some details.

The code generation pipeline that processes this renamed, deterministic, Cmm,
however, may still need to generate new uniques. If we were to resort to the
non-deterministic unique supply used in the rest of the compiler, our renaming
efforts would be for naught.

Therefore, after having renamed Cmm deterministically, we must ensure that all
uniques created by the code generation pipeline use a deterministic source of uniques.
Most often, this means don't use `UniqSM` in the Cmm passes, use `UniqDSM`:

`UniqDSM` is a pure state monad with an incrementing counter from which we
source new uniques. Unlike `UniqSM`, there's no way to `split` the supply, but
it turns out this was rarely really needed for code generation and migrating
from UniqSM to UniqDSM was easy.

Secondly, the `DUniqSupply` used to run a `UniqDSM` must be threaded through
all passes to guarantee uniques in different passes are unique amongst them
altogether.
Specifically, the same `DUniqSupply` must be threaded through the CG Streaming
pipeline, starting with Driver.Main calling `StgToCmm.codeGen`, `cmmPipeline`,
`cmmToRawCmm`, and `codeOutput` in sequence.

To thread resources through the `Stream` abstraction, we use the `UniqDSMT`
transformer on top of `IO` as the Monad underlying the Stream. `UniqDSMT` will
thread the `DUniqSupply` through every pass applied to the `Stream`, for every
element. We use @type CgStream = Stream (UniqDSMT IO)@ for the Stream used in
code generation which that carries through the deterministic unique supply.

Unlike non-deterministic unique supplies which can be split into supplies using
different tags, or where a new supply with a new tag can be brought from the
void, a `DUniqSupply` needs to be sampled iteratively. To use a different tag
during a specific pass (to more easily identify uniques created in it), the tag
should be manually set and then reset on the unique supply. There's also the
auxiliary `setTagUDSMT` which sets the tag for all uniques supplied in the given
action, and resets it implicitly.

See also Note [Object determinism] in GHC.StgToCmm
-}

-- See Note [Deterministic Uniques in the CG]
newtype DUniqSupply = DUS Word64 -- supply uniques iteratively
type DUniqResult result = (# result, DUniqSupply #)

pattern DUniqResult :: a -> DUniqSupply -> (# a, DUniqSupply #)
pattern $mDUniqResult :: forall {r} {a}.
(# a, DUniqSupply #)
-> (a -> DUniqSupply -> r) -> ((# #) -> r) -> r
$bDUniqResult :: forall a. a -> DUniqSupply -> (# a, DUniqSupply #)
DUniqResult x y = (# x, y #)
{-# COMPLETE DUniqResult #-}

-- | A monad which just gives the ability to obtain 'Unique's deterministically.
-- There's no splitting.
newtype UniqDSM result = UDSM' { forall result. UniqDSM result -> DUniqSupply -> DUniqResult result
unUDSM :: DUniqSupply -> DUniqResult result }
  deriving ((forall a b. (a -> b) -> UniqDSM a -> UniqDSM b)
-> (forall a b. a -> UniqDSM b -> UniqDSM a) -> Functor UniqDSM
forall a b. a -> UniqDSM b -> UniqDSM a
forall a b. (a -> b) -> UniqDSM a -> UniqDSM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> UniqDSM a -> UniqDSM b
fmap :: forall a b. (a -> b) -> UniqDSM a -> UniqDSM b
$c<$ :: forall a b. a -> UniqDSM b -> UniqDSM a
<$ :: forall a b. a -> UniqDSM b -> UniqDSM a
Functor, Functor UniqDSM
Functor UniqDSM =>
(forall a. a -> UniqDSM a)
-> (forall a b. UniqDSM (a -> b) -> UniqDSM a -> UniqDSM b)
-> (forall a b c.
    (a -> b -> c) -> UniqDSM a -> UniqDSM b -> UniqDSM c)
-> (forall a b. UniqDSM a -> UniqDSM b -> UniqDSM b)
-> (forall a b. UniqDSM a -> UniqDSM b -> UniqDSM a)
-> Applicative UniqDSM
forall a. a -> UniqDSM a
forall a b. UniqDSM a -> UniqDSM b -> UniqDSM a
forall a b. UniqDSM a -> UniqDSM b -> UniqDSM b
forall a b. UniqDSM (a -> b) -> UniqDSM a -> UniqDSM b
forall a b c. (a -> b -> c) -> UniqDSM a -> UniqDSM b -> UniqDSM c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> UniqDSM a
pure :: forall a. a -> UniqDSM a
$c<*> :: forall a b. UniqDSM (a -> b) -> UniqDSM a -> UniqDSM b
<*> :: forall a b. UniqDSM (a -> b) -> UniqDSM a -> UniqDSM b
$cliftA2 :: forall a b c. (a -> b -> c) -> UniqDSM a -> UniqDSM b -> UniqDSM c
liftA2 :: forall a b c. (a -> b -> c) -> UniqDSM a -> UniqDSM b -> UniqDSM c
$c*> :: forall a b. UniqDSM a -> UniqDSM b -> UniqDSM b
*> :: forall a b. UniqDSM a -> UniqDSM b -> UniqDSM b
$c<* :: forall a b. UniqDSM a -> UniqDSM b -> UniqDSM a
<* :: forall a b. UniqDSM a -> UniqDSM b -> UniqDSM a
Applicative, Applicative UniqDSM
Applicative UniqDSM =>
(forall a b. UniqDSM a -> (a -> UniqDSM b) -> UniqDSM b)
-> (forall a b. UniqDSM a -> UniqDSM b -> UniqDSM b)
-> (forall a. a -> UniqDSM a)
-> Monad UniqDSM
forall a. a -> UniqDSM a
forall a b. UniqDSM a -> UniqDSM b -> UniqDSM b
forall a b. UniqDSM a -> (a -> UniqDSM b) -> UniqDSM b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. UniqDSM a -> (a -> UniqDSM b) -> UniqDSM b
>>= :: forall a b. UniqDSM a -> (a -> UniqDSM b) -> UniqDSM b
$c>> :: forall a b. UniqDSM a -> UniqDSM b -> UniqDSM b
>> :: forall a b. UniqDSM a -> UniqDSM b -> UniqDSM b
$creturn :: forall a. a -> UniqDSM a
return :: forall a. a -> UniqDSM a
Monad) via (Strict.State DUniqSupply)

instance MonadFix UniqDSM where
  mfix :: forall a. (a -> UniqDSM a) -> UniqDSM a
mfix a -> UniqDSM a
m = (DUniqSupply -> DUniqResult a) -> UniqDSM a
forall a. (DUniqSupply -> DUniqResult a) -> UniqDSM a
UDSM (\DUniqSupply
us0 -> let (a
r,DUniqSupply
us1) = DUniqSupply -> UniqDSM a -> (a, DUniqSupply)
forall a. DUniqSupply -> UniqDSM a -> (a, DUniqSupply)
runUniqueDSM DUniqSupply
us0 (a -> UniqDSM a
m a
r) in a -> DUniqSupply -> DUniqResult a
forall a. a -> DUniqSupply -> (# a, DUniqSupply #)
DUniqResult a
r DUniqSupply
us1)

-- See Note [The one-shot state monad trick] in GHC.Utils.Monad
pattern UDSM :: (DUniqSupply -> DUniqResult a) -> UniqDSM a
pattern $mUDSM :: forall {r} {a}.
UniqDSM a
-> ((DUniqSupply -> DUniqResult a) -> r) -> ((# #) -> r) -> r
$bUDSM :: forall a. (DUniqSupply -> DUniqResult a) -> UniqDSM a
UDSM m <- UDSM' m
  where
    UDSM DUniqSupply -> DUniqResult a
m = (DUniqSupply -> DUniqResult a) -> UniqDSM a
forall a. (DUniqSupply -> DUniqResult a) -> UniqDSM a
UDSM' ((DUniqSupply -> DUniqResult a) -> DUniqSupply -> DUniqResult a
forall a b. (a -> b) -> a -> b
oneShot ((DUniqSupply -> DUniqResult a) -> DUniqSupply -> DUniqResult a)
-> (DUniqSupply -> DUniqResult a) -> DUniqSupply -> DUniqResult a
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
s -> DUniqSupply -> DUniqResult a
m DUniqSupply
s)
{-# COMPLETE UDSM #-}

getUniqueDSM :: UniqDSM Unique
getUniqueDSM :: UniqDSM Unique
getUniqueDSM = (DUniqSupply -> DUniqResult Unique) -> UniqDSM Unique
forall a. (DUniqSupply -> DUniqResult a) -> UniqDSM a
UDSM (\(DUS Word64
us0) -> Unique -> DUniqSupply -> DUniqResult Unique
forall a. a -> DUniqSupply -> (# a, DUniqSupply #)
DUniqResult (Word64 -> Unique
mkUniqueGrimily Word64
us0) (Word64 -> DUniqSupply
DUS (Word64 -> DUniqSupply) -> Word64 -> DUniqSupply
forall a b. (a -> b) -> a -> b
$ Word64
us0Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+Word64
1))

takeUniqueFromDSupply :: DUniqSupply -> (Unique, DUniqSupply)
takeUniqueFromDSupply :: DUniqSupply -> (Unique, DUniqSupply)
takeUniqueFromDSupply DUniqSupply
d =
  case UniqDSM Unique -> DUniqSupply -> DUniqResult Unique
forall result. UniqDSM result -> DUniqSupply -> DUniqResult result
unUDSM UniqDSM Unique
getUniqueDSM DUniqSupply
d of
    DUniqResult Unique
x DUniqSupply
y -> (Unique
x, DUniqSupply
y)

-- | Initialize a deterministic unique supply with the given Tag and initial unique.
initDUniqSupply :: Char -> Word64 -> DUniqSupply
initDUniqSupply :: Char -> Word64 -> DUniqSupply
initDUniqSupply Char
c Word64
firstUniq =
  let !tag :: Word64
tag = Char -> Word64
mkTag Char
c
  in Word64 -> DUniqSupply
DUS (Word64
tag Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64
firstUniq)

runUniqueDSM :: DUniqSupply -> UniqDSM a -> (a, DUniqSupply)
runUniqueDSM :: forall a. DUniqSupply -> UniqDSM a -> (a, DUniqSupply)
runUniqueDSM DUniqSupply
ds (UDSM DUniqSupply -> DUniqResult a
f) =
  case DUniqSupply -> DUniqResult a
f DUniqSupply
ds of
    DUniqResult a
uq DUniqSupply
us -> (a
uq, DUniqSupply
us)

-- | Set the tag of uniques generated from this deterministic unique supply
newTagDUniqSupply :: Char -> DUniqSupply -> DUniqSupply
newTagDUniqSupply :: Char -> DUniqSupply -> DUniqSupply
newTagDUniqSupply Char
c (DUS Word64
w) = Word64 -> DUniqSupply
DUS (Word64 -> DUniqSupply) -> Word64 -> DUniqSupply
forall a b. (a -> b) -> a -> b
$ Unique -> Word64
getKey (Unique -> Word64) -> Unique -> Word64
forall a b. (a -> b) -> a -> b
$ Unique -> Char -> Unique
newTagUnique (Word64 -> Unique
mkUniqueGrimily Word64
w) Char
c

-- | Get the tag uniques generated from this deterministic unique supply would have
getTagDUniqSupply :: DUniqSupply -> Char
getTagDUniqSupply :: DUniqSupply -> Char
getTagDUniqSupply (DUS Word64
w) = (Char, Word64) -> Char
forall a b. (a, b) -> a
fst ((Char, Word64) -> Char) -> (Char, Word64) -> Char
forall a b. (a -> b) -> a -> b
$ Unique -> (Char, Word64)
unpkUnique (Word64 -> Unique
mkUniqueGrimily Word64
w)

-- | Get a unique from a monad that can access a unique supply.
--
-- Crucially, because 'MonadGetUnique' doesn't allow you to get the
-- 'UniqSupply' (unlike 'MonadUnique'), an instance such as 'UniqDSM' can use a
-- deterministic unique supply to return deterministic uniques without allowing
-- for the 'UniqSupply' to be shared.
class Monad m => MonadGetUnique m where
  getUniqueM :: m Unique

instance MonadGetUnique UniqDSM where
  getUniqueM :: UniqDSM Unique
getUniqueM = UniqDSM Unique
getUniqueDSM

-- non deterministic instance
instance MonadGetUnique USM.UniqSM where
  getUniqueM :: UniqSM Unique
getUniqueM = UniqSM Unique
forall (m :: * -> *). MonadUnique m => m Unique
USM.getUniqueM

--------------------------------------------------------------------------------
-- UniqDSMT
--------------------------------------------------------------------------------

-- | Transformer version of 'UniqDSM' to use when threading a deterministic
-- uniq supply over a Monad. Specifically, it is used in the `Stream` of Cmm
-- decls.
newtype UniqDSMT m result = UDSMT' (DUniqSupply -> m (result, DUniqSupply))
  deriving ((forall a b. (a -> b) -> UniqDSMT m a -> UniqDSMT m b)
-> (forall a b. a -> UniqDSMT m b -> UniqDSMT m a)
-> Functor (UniqDSMT m)
forall a b. a -> UniqDSMT m b -> UniqDSMT m a
forall a b. (a -> b) -> UniqDSMT m a -> UniqDSMT m b
forall (m :: * -> *) a b.
Functor m =>
a -> UniqDSMT m b -> UniqDSMT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> UniqDSMT m a -> UniqDSMT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> UniqDSMT m a -> UniqDSMT m b
fmap :: forall a b. (a -> b) -> UniqDSMT m a -> UniqDSMT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> UniqDSMT m b -> UniqDSMT m a
<$ :: forall a b. a -> UniqDSMT m b -> UniqDSMT m a
Functor)

-- Similar to GHC.Utils.Monad.State.Strict, using Note [The one-shot state monad trick]
-- Using the one-shot trick is necessary for performance.
-- Using transfomer's strict `StateT` regressed some performance tests in 1-2%.
-- The one-shot trick here fixes those regressions.

pattern UDSMT :: (DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
pattern $mUDSMT :: forall {r} {m :: * -> *} {result}.
UniqDSMT m result
-> ((DUniqSupply -> m (result, DUniqSupply)) -> r)
-> ((# #) -> r)
-> r
$bUDSMT :: forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT m <- UDSMT' m
  where
    UDSMT DUniqSupply -> m (result, DUniqSupply)
m = (DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT' ((DUniqSupply -> m (result, DUniqSupply))
-> DUniqSupply -> m (result, DUniqSupply)
forall a b. (a -> b) -> a -> b
oneShot ((DUniqSupply -> m (result, DUniqSupply))
 -> DUniqSupply -> m (result, DUniqSupply))
-> (DUniqSupply -> m (result, DUniqSupply))
-> DUniqSupply
-> m (result, DUniqSupply)
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
s -> DUniqSupply -> m (result, DUniqSupply)
m DUniqSupply
s)
{-# COMPLETE UDSMT #-}

instance Monad m => Applicative (UniqDSMT m) where
  pure :: forall a. a -> UniqDSMT m a
pure a
x = (DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a
forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT ((DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a)
-> (DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
s -> (a, DUniqSupply) -> m (a, DUniqSupply)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
x, DUniqSupply
s)
  UDSMT DUniqSupply -> m (a -> b, DUniqSupply)
f <*> :: forall a b. UniqDSMT m (a -> b) -> UniqDSMT m a -> UniqDSMT m b
<*> UDSMT DUniqSupply -> m (a, DUniqSupply)
x = (DUniqSupply -> m (b, DUniqSupply)) -> UniqDSMT m b
forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT ((DUniqSupply -> m (b, DUniqSupply)) -> UniqDSMT m b)
-> (DUniqSupply -> m (b, DUniqSupply)) -> UniqDSMT m b
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
s0 -> do
    (f', s1) <- DUniqSupply -> m (a -> b, DUniqSupply)
f DUniqSupply
s0
    (x', s2) <- x s1
    pure (f' x', s2)

instance Monad m => Monad (UniqDSMT m) where
  UDSMT DUniqSupply -> m (a, DUniqSupply)
x >>= :: forall a b. UniqDSMT m a -> (a -> UniqDSMT m b) -> UniqDSMT m b
>>= a -> UniqDSMT m b
f = (DUniqSupply -> m (b, DUniqSupply)) -> UniqDSMT m b
forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT ((DUniqSupply -> m (b, DUniqSupply)) -> UniqDSMT m b)
-> (DUniqSupply -> m (b, DUniqSupply)) -> UniqDSMT m b
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
s0 -> do
    (x', s1) <- DUniqSupply -> m (a, DUniqSupply)
x DUniqSupply
s0
    case f x' of UDSMT DUniqSupply -> m (b, DUniqSupply)
y -> DUniqSupply -> m (b, DUniqSupply)
y DUniqSupply
s1

instance MonadIO m => MonadIO (UniqDSMT m) where
  liftIO :: forall a. IO a -> UniqDSMT m a
liftIO IO a
x = (DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a
forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT ((DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a)
-> (DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
s -> (,DUniqSupply
s) (a -> (a, DUniqSupply)) -> m a -> m (a, DUniqSupply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
x

instance Monad m => MonadGetUnique (UniqDSMT m) where
  getUniqueM :: UniqDSMT m Unique
getUniqueM = (DUniqSupply -> m (Unique, DUniqSupply)) -> UniqDSMT m Unique
forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT ((DUniqSupply -> m (Unique, DUniqSupply)) -> UniqDSMT m Unique)
-> (DUniqSupply -> m (Unique, DUniqSupply)) -> UniqDSMT m Unique
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
us -> do
    let (Unique
u, DUniqSupply
us') = DUniqSupply -> (Unique, DUniqSupply)
takeUniqueFromDSupply DUniqSupply
us
    (Unique, DUniqSupply) -> m (Unique, DUniqSupply)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Unique
u, DUniqSupply
us')

-- | Set the tag of the running @UniqDSMT@ supply to the given tag and run an action with it.
-- All uniques produced in the given action will use this tag, until the tag is changed
-- again.
setTagUDSMT :: Monad m => Char {-^ Tag -} -> UniqDSMT m a -> UniqDSMT m a
setTagUDSMT :: forall (m :: * -> *) a.
Monad m =>
Char -> UniqDSMT m a -> UniqDSMT m a
setTagUDSMT Char
tag (UDSMT DUniqSupply -> m (a, DUniqSupply)
act) = (DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a
forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT ((DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a)
-> (DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
us -> do
  let origtag :: Char
origtag = DUniqSupply -> Char
getTagDUniqSupply DUniqSupply
us
      new_us :: DUniqSupply
new_us  = Char -> DUniqSupply -> DUniqSupply
newTagDUniqSupply Char
tag DUniqSupply
us
  (a, us') <- DUniqSupply -> m (a, DUniqSupply)
act DUniqSupply
new_us
  let us'_origtag = Char -> DUniqSupply -> DUniqSupply
newTagDUniqSupply Char
origtag DUniqSupply
us'
      -- restore original tag
  return (a, us'_origtag)

-- | Like 'runUniqueDSM' but for 'UniqDSMT'
runUDSMT :: DUniqSupply -> UniqDSMT m a -> m (a, DUniqSupply)
runUDSMT :: forall (m :: * -> *) a.
DUniqSupply -> UniqDSMT m a -> m (a, DUniqSupply)
runUDSMT DUniqSupply
dus (UDSMT DUniqSupply -> m (a, DUniqSupply)
st) = DUniqSupply -> m (a, DUniqSupply)
st DUniqSupply
dus

-- | Lift an IO action that depends on, and threads through, a unique supply
-- into UniqDSMT IO.
withDUS :: (DUniqSupply -> IO (a, DUniqSupply)) -> UniqDSMT IO a
withDUS :: forall a. (DUniqSupply -> IO (a, DUniqSupply)) -> UniqDSMT IO a
withDUS DUniqSupply -> IO (a, DUniqSupply)
f = (DUniqSupply -> IO (a, DUniqSupply)) -> UniqDSMT IO a
forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT ((DUniqSupply -> IO (a, DUniqSupply)) -> UniqDSMT IO a)
-> (DUniqSupply -> IO (a, DUniqSupply)) -> UniqDSMT IO a
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
us -> do
  (a, us') <- IO (a, DUniqSupply) -> IO (a, DUniqSupply)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (DUniqSupply -> IO (a, DUniqSupply)
f DUniqSupply
us)
  return (a, us')

-- | Change the monad underyling an applied @UniqDSMT@, i.e. transform a
-- @UniqDSMT m@ into a @UniqDSMT n@ given @m ~> n@.
hoistUDSMT :: (forall x. m x -> n x) -> UniqDSMT m a -> UniqDSMT n a
hoistUDSMT :: forall (m :: * -> *) (n :: * -> *) a.
(forall x. m x -> n x) -> UniqDSMT m a -> UniqDSMT n a
hoistUDSMT forall x. m x -> n x
nt (UDSMT DUniqSupply -> m (a, DUniqSupply)
m) = (DUniqSupply -> n (a, DUniqSupply)) -> UniqDSMT n a
forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT ((DUniqSupply -> n (a, DUniqSupply)) -> UniqDSMT n a)
-> (DUniqSupply -> n (a, DUniqSupply)) -> UniqDSMT n a
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
s -> m (a, DUniqSupply) -> n (a, DUniqSupply)
forall x. m x -> n x
nt (DUniqSupply -> m (a, DUniqSupply)
m DUniqSupply
s)

-- | Lift a monadic action @m a@ into an @UniqDSMT m a@
liftUDSMT :: Functor m => m a -> UniqDSMT m a
liftUDSMT :: forall (m :: * -> *) a. Functor m => m a -> UniqDSMT m a
liftUDSMT m a
m = (DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a
forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT ((DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a)
-> (DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
s -> (,DUniqSupply
s) (a -> (a, DUniqSupply)) -> m a -> m (a, DUniqSupply)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
m

--------------------------------------------------------------------------------
-- MonadUniqDSM
--------------------------------------------------------------------------------

class (Monad m) => MonadUniqDSM m where
  -- | Lift a pure 'UniqDSM' action into a 'MonadUniqDSM' such as 'UniqDSMT'
  liftUniqDSM :: UniqDSM a -> m a

instance MonadUniqDSM UniqDSM where
  liftUniqDSM :: forall a. UniqDSM a -> UniqDSM a
liftUniqDSM = UniqDSM a -> UniqDSM a
forall a. a -> a
id

instance Monad m => MonadUniqDSM (UniqDSMT m) where
  liftUniqDSM :: forall a. UniqDSM a -> UniqDSMT m a
liftUniqDSM UniqDSM a
act = (DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a
forall (m :: * -> *) result.
(DUniqSupply -> m (result, DUniqSupply)) -> UniqDSMT m result
UDSMT ((DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a)
-> (DUniqSupply -> m (a, DUniqSupply)) -> UniqDSMT m a
forall a b. (a -> b) -> a -> b
$ \DUniqSupply
us -> (a, DUniqSupply) -> m (a, DUniqSupply)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, DUniqSupply) -> m (a, DUniqSupply))
-> (a, DUniqSupply) -> m (a, DUniqSupply)
forall a b. (a -> b) -> a -> b
$ DUniqSupply -> UniqDSM a -> (a, DUniqSupply)
forall a. DUniqSupply -> UniqDSM a -> (a, DUniqSupply)
runUniqueDSM DUniqSupply
us UniqDSM a
act