    {-
    (c) The University of Glasgow 2006
    (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE MagicHash #-}
    {-# LANGUAGE PatternSynonyms #-}
    {-# LANGUAGE UnboxedTuples #-}

    module GHC.Types.Unique.Supply (
            -- * Main data type
            UniqSupply, -- Abstractly

            -- ** Operations on supplies
            uniqFromSupply, uniqsFromSupply, -- basic ops
            takeUniqFromSupply, uniqFromTag,

            mkSplitUniqSupply,
            splitUniqSupply, listSplitUniqSupply,

            -- * Unique supply monad and its abstraction
            UniqSM, MonadUnique(..),

            -- ** Operations on the monad
            initUs, initUs_,

            -- * Set supply strategy
            initUniqSupply
      ) where

    import GHC.Prelude

    import GHC.Types.Unique
    import GHC.Utils.Panic.Plain

    import GHC.IO

    import GHC.Utils.Monad
    import Control.Monad
    import Data.Word
    import GHC.Exts( Ptr(..), noDuplicate#, oneShot )
    import Foreign.Storable

    #include "MachDeps.h"

    #if WORD_SIZE_IN_BITS != 64
    #define NO_FETCH_ADD
    #endif

    #if defined(NO_FETCH_ADD)
    import GHC.Exts ( atomicCasWord64Addr#, eqWord64#, readWord64OffAddr# )
    #else
    import GHC.Exts( fetchAddWordAddr#, word64ToWord# )
    #endif

    import GHC.Exts ( Addr#, State#, Word64#, RealWorld )
    import GHC.Int ( Int(..) )
    import GHC.Word( Word64(..) )
    import GHC.Exts( plusWord64#, int2Word#, wordToWord64# )

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Splittable Unique supply: @UniqSupply@}
    *                                                                      *
    ************************************************************************
    -}

    {- Note [How the unique supply works]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The basic idea (due to Lennart Augustsson) is that a UniqSupply is
    lazily-evaluated infinite tree.

    * At each MkSplitUniqSupply node is a unique Word64, and two
      sub-trees (see data UniqSupply)

    * takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
      returns the unique Word64 and one of the sub-trees

    * splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply)
      returns the two sub-trees

    * When you poke on one of the thunks, it does a foreign call
      to get a fresh Word64 from a thread-safe counter, and returns
      a fresh MkSplitUniqSupply node.  This has to be as efficient
      as possible: it should allocate only
         * The fresh node
         * A thunk for each sub-tree

    Note [How unique supplies are used]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The general design (used throughout GHC) is to:

    * For creating new uniques either a UniqSupply is used and threaded through
      or for monadic code a MonadUnique instance might conjure up uniques using
      `uniqFromTag`.
    * Different parts of the compiler will use a UniqSupply or MonadUnique instance
      with a specific tag. This way the different parts of the compiler will
      generate uniques with different tags.

    If different code shares the same tag then care has to be taken that all uniques
    still get distinct numbers. Usually this is done by relying on genSym which
    has *one* counter per GHC invocation that is relied on by all calls to it.
    But using something like the address for pinned objects works as well and in fact is done
    for fast strings.

    This is important for example in the simplifier. Most passes of the simplifier use
    the same tag 's'. However in some places we create a unique supply using `mkSplitUniqSupply`
    and thread it through the code, while in GHC.Core.Opt.Simplify.Monad  we use the
    `instance MonadUnique SimplM`, which uses `mkSplitUniqSupply` in getUniqueSupplyM
    and `uniqFromTag` in getUniqueM.

    Ultimately all these boil down to each new unique consisting of the tag and the result from
    a call to `genSym`. The latter producing a distinct number for each invocation ensuring
    uniques are distinct.

    Note [Optimising the unique supply]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The inner loop of mkSplitUniqSupply is a function closure

         mk_supply s0 =
            case noDuplicate# s0 of { s1 ->
            case unIO genSym s1 of { (# s2, u #) ->
            case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s2 of { (# s3, x #) ->
            case unIO (unsafeDupableInterleaveIO (IO mk_supply)) s3 of { (# s4, y #) ->
            (# s4, MkSplitUniqSupply (tag .|. u) x y #)
            }}}}

    It's a classic example of an IO action that is captured and then called
    repeatedly (see #18238 for some discussion). It mustn't allocate!  The test
    perf/should_run/UniqLoop keeps track of this loop.  Watch it carefully.

    We used to write it as:

         mk_supply :: IO UniqSupply
         mk_supply = unsafeInterleaveIO $
                     genSym      >>= \ u ->
                     mk_supply   >>= \ s1 ->
                     mk_supply   >>= \ s2 ->
                     return (MkSplitUniqSupply (tag .|. u) s1 s2)

    and to rely on -fno-state-hack, full laziness and inlining to get the same
    result. It was very brittle and required enabling -fno-state-hack globally. So
    it has been rewritten using lower level constructs to explicitly state what we
    want.

    Note [Optimising use of unique supplies]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When it comes to having a way to generate new Uniques
    there are generally three ways to deal with this:

    For pure code the only good approach is to take an UniqSupply
    as argument. Then  thread it through the code splitting it
    for sub-passes or when creating uniques.
    The code for this is about as optimized as it gets, but we can't
    get around the need to allocate one `UniqSupply` for each Unique
    we need.

    For code in IO we can improve on this by threading only the *tag*
    we are going to use for Uniques. Using `uniqFromTag` to
    generate uniques as needed. This gets rid of the overhead of
    allocating a new UniqSupply for each unique generated. It also avoids
    frequent state updates when the Unique/Tag is part of the state in a
    state monad.

    For monadic code in IO which always uses the same tag we can go further
    and hardcode the tag into the MonadUnique instance. On top of all the
    benefits of threading the tag this *also* has the benefit of avoiding
    the tag getting captured in thunks, or being passed around at runtime.
    It does however come at the cost of having to use a fixed tag for all
    code run in this Monad. But remember, the tag is purely cosmetic:
    See Note [Uniques and tags].

    NB: It's *not* an optimization to pass around the UniqSupply inside an
    IORef instead of the tag. While this would avoid frequent state updates
    it still requires allocating one UniqSupply per Unique. On top of some
    overhead for reading/writing to/from the IORef.

    All of this hinges on the assumption that UniqSupply and
    uniqFromTag use the same source of distinct numbers (`genSym`) which
    allows both to be used at the same time, with the same tag, while still
    ensuring distinct uniques.
    One might consider this fact to be an "accident". But GHC worked like this
    as far back as source control history goes. It also allows the later two
    optimizations to be used. So it seems safe to depend on this fact.

    -}

    -- | Unique Supply
    --
    -- A value of type 'UniqSupply' is unique, and it can
    -- supply /one/ distinct 'Unique'.  Also, from the supply, one can
    -- also manufacture an arbitrary number of further 'UniqueSupply' values,
    -- which will be distinct from the first and from all others.
    data UniqSupply
      = MkSplitUniqSupply {-# UNPACK #-} !Word64 -- make the Unique with this
                       UniqSupply UniqSupply
                                    -- when split => these two supplies

    mkSplitUniqSupply :: Char -> IO UniqSupply
    -- ^ Create a unique supply out of thin air.
    -- The "tag" (Char) supplied is purely cosmetic, making it easier
    -- to figure out where a Unique was born. See
    -- Note [Uniques and tags].
    --
    -- The payload part of the Uniques allocated from this UniqSupply are
    -- guaranteed distinct wrt all other supplies, regardless of their "tag".
    -- This is achieved by allocating the payload part from
    -- a single source of Uniques, namely `genSym`, shared across
    -- all UniqSupply's.

    -- See Note [How the unique supply works]
    -- See Note [Optimising the unique supply]
    mkSplitUniqSupply :: Char -> IO UniqSupply
    mkSplitUniqSupply Char
    c
      = IO UniqSupply -> IO UniqSupply
    forall a. IO a -> IO a
    unsafeDupableInterleaveIO ((State# RealWorld -> (# State# RealWorld, UniqSupply #))
    -> IO UniqSupply
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO State# RealWorld -> (# State# RealWorld, UniqSupply #)
    mk_supply)

      where
         !tag :: Word64
    tag = Char -> Word64
    mkTag Char
    c

            -- Here comes THE MAGIC: see Note [How the unique supply works]
            -- This is one of the most hammered bits in the whole compiler
            -- See Note [Optimising the unique supply]
            -- NB: Use noDuplicate# for thread-safety.
         mk_supply :: State# RealWorld -> (# State# RealWorld, UniqSupply #)
    mk_supply State# RealWorld
    s0 =
            case State# RealWorld -> State# RealWorld
    forall d. State# d -> State# d
    noDuplicate# State# RealWorld
    s0 of { State# RealWorld
    s1 ->
            case IO Word64 -> State# RealWorld -> (# State# RealWorld, Word64 #)
    forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
    unIO IO Word64
    genSym State# RealWorld
    s1 of { (# State# RealWorld
    s2, Word64
    u #) ->
            -- deferred IO computations
            case IO UniqSupply
    -> State# RealWorld -> (# State# RealWorld, UniqSupply #)
    forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
    unIO (IO UniqSupply -> IO UniqSupply
    forall a. IO a -> IO a
    unsafeDupableInterleaveIO ((State# RealWorld -> (# State# RealWorld, UniqSupply #))
    -> IO UniqSupply
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO State# RealWorld -> (# State# RealWorld, UniqSupply #)
    mk_supply)) State# RealWorld
    s2 of { (# State# RealWorld
    s3, UniqSupply
    x #) ->
            case IO UniqSupply
    -> State# RealWorld -> (# State# RealWorld, UniqSupply #)
    forall a. IO a -> State# RealWorld -> (# State# RealWorld, a #)
    unIO (IO UniqSupply -> IO UniqSupply
    forall a. IO a -> IO a
    unsafeDupableInterleaveIO ((State# RealWorld -> (# State# RealWorld, UniqSupply #))
    -> IO UniqSupply
    forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
    IO State# RealWorld -> (# State# RealWorld, UniqSupply #)
    mk_supply)) State# RealWorld
    s3 of { (# State# RealWorld
    s4, UniqSupply
    y #) ->
            (# State# RealWorld
    s4, Word64 -> UniqSupply -> UniqSupply -> UniqSupply
    MkSplitUniqSupply (Word64
    tag Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .|. Word64
    u) UniqSupply
    x UniqSupply
    y #)
            }}}}

    #if defined(NO_FETCH_ADD)
    -- GHC currently does not provide this operation on 32-bit platforms,
    -- hence the CAS-based implementation.
    fetchAddWord64Addr# :: Addr# -> Word64# -> State# RealWorld
                        -> (# State# RealWorld, Word64# #)
    fetchAddWord64Addr# = go
      where
        go ptr inc s0 =
          case readWord64OffAddr# ptr 0# s0 of
            (# s1, n0 #) ->
              case atomicCasWord64Addr# ptr n0 (n0 `plusWord64#` inc) s1 of
                (# s2, res #)
                  | 1# <- res `eqWord64#` n0 -> (# s2, n0 #)
                  | otherwise -> go ptr inc s2
    #else
    fetchAddWord64Addr# :: Addr# -> Word64# -> State# RealWorld
                        -> (# State# RealWorld, Word64# #)
    fetchAddWord64Addr# :: Addr#
    -> Word64# -> State# RealWorld -> (# State# RealWorld, Word64# #)
    fetchAddWord64Addr# Addr#
    addr Word64#
    inc State# RealWorld
    s0 =
        case Addr# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #)
    forall d. Addr# -> Word# -> State# d -> (# State# d, Word# #)
    fetchAddWordAddr# Addr#
    addr (Word64# -> Word#
    word64ToWord# Word64#
    inc) State# RealWorld
    s0 of
          (# State# RealWorld
    s1, Word#
    res #) -> (# State# RealWorld
    s1, Word# -> Word64#
    wordToWord64# Word#
    res #)
    #endif

    genSym :: IO Word64
    genSym :: IO Word64
    genSym = do
        let !mask :: Word64
    mask = (Word64
    1 Word64 -> Int -> Word64
    forall a. Bits a => a -> Int -> a
    `unsafeShiftL` Int
    uNIQUE_BITS) Word64 -> Word64 -> Word64
    forall a. Num a => a -> a -> a
    - Word64
    1
        let !(Ptr Addr#
    counter) = Ptr Word64
    ghc_unique_counter64
        I# inc# <- Ptr Int -> IO Int
    forall a. Storable a => Ptr a -> IO a
    peek Ptr Int
    ghc_unique_inc
        let !inc = Word# -> Word64#
    wordToWord64# (Int# -> Word#
    int2Word# Int#
    inc#)
        u <- IO $ \State# RealWorld
    s1 -> case Addr#
    -> Word64# -> State# RealWorld -> (# State# RealWorld, Word64# #)
    fetchAddWord64Addr# Addr#
    counter Word64#
    inc State# RealWorld
    s1 of
                (# State# RealWorld
    s2, Word64#
    val #) ->
                    let !u :: Word64
    u = Word64# -> Word64
    W64# (Word64#
    val Word64# -> Word64# -> Word64#
    `plusWord64#` Word64#
    inc) Word64 -> Word64 -> Word64
    forall a. Bits a => a -> a -> a
    .&. Word64
    mask
                    in (# State# RealWorld
    s2, Word64
    u #)
    #if defined(DEBUG)
        -- Uh oh! We will overflow next time a unique is requested.
        -- (Note that if the increment isn't 1 we may miss this check)
        massert (u /= mask)
    #endif
        return u

    foreign import ccall unsafe "&ghc_unique_counter64" ghc_unique_counter64 :: Ptr Word64
    foreign import ccall unsafe "&ghc_unique_inc"       ghc_unique_inc       :: Ptr Int

    initUniqSupply :: Word64 -> Int -> IO ()
    initUniqSupply :: Word64 -> Int -> IO ()
    initUniqSupply Word64
    counter Int
    inc = do
        Ptr Word64 -> Word64 -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr Word64
    ghc_unique_counter64 Word64
    counter
        Ptr Int -> Int -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr Int
    ghc_unique_inc       Int
    inc

    uniqFromTag :: Char -> IO Unique
    uniqFromTag :: Char -> IO Unique
    uniqFromTag !Char
    tag
      = do { uqNum <- IO Word64
    genSym
           ; return $! mkUnique tag uqNum }
    {-# NOINLINE uniqFromTag #-} -- We'll unbox everything, but we don't want to inline it

    splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply)
    -- ^ Build two 'UniqSupply' from a single one, each of which
    -- can supply its own 'Unique'.
    listSplitUniqSupply :: UniqSupply -> [UniqSupply]
    -- ^ Create an infinite list of 'UniqSupply' from a single one
    uniqFromSupply  :: UniqSupply -> Unique
    -- ^ Obtain the 'Unique' from this particular 'UniqSupply'
    uniqsFromSupply :: UniqSupply -> [Unique] -- Infinite
    -- ^ Obtain an infinite list of 'Unique' that can be generated by constant splitting of the supply
    takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
    -- ^ Obtain the 'Unique' from this particular 'UniqSupply', and a new supply

    splitUniqSupply :: UniqSupply -> (UniqSupply, UniqSupply)
    splitUniqSupply (MkSplitUniqSupply Word64
    _ UniqSupply
    s1 UniqSupply
    s2) = (UniqSupply
    s1, UniqSupply
    s2)
    listSplitUniqSupply :: UniqSupply -> [UniqSupply]
    listSplitUniqSupply  (MkSplitUniqSupply Word64
    _ UniqSupply
    s1 UniqSupply
    s2) = UniqSupply
    s1 UniqSupply -> [UniqSupply] -> [UniqSupply]
    forall a. a -> [a] -> [a]
    : UniqSupply -> [UniqSupply]
    listSplitUniqSupply UniqSupply
    s2

    uniqFromSupply :: UniqSupply -> Unique
    uniqFromSupply  (MkSplitUniqSupply Word64
    n UniqSupply
    _ UniqSupply
    _)  = Word64 -> Unique
    mkUniqueGrimily Word64
    n
    uniqsFromSupply :: UniqSupply -> [Unique]
    uniqsFromSupply (MkSplitUniqSupply Word64
    n UniqSupply
    _ UniqSupply
    s2) = Word64 -> Unique
    mkUniqueGrimily Word64
    n Unique -> [Unique] -> [Unique]
    forall a. a -> [a] -> [a]
    : UniqSupply -> [Unique]
    uniqsFromSupply UniqSupply
    s2
    takeUniqFromSupply :: UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply (MkSplitUniqSupply Word64
    n UniqSupply
    s1 UniqSupply
    _) = (Word64 -> Unique
    mkUniqueGrimily Word64
    n, UniqSupply
    s1)

    {-
    ************************************************************************
    *                                                                      *
    \subsubsection[UniqSupply-monad]{@UniqSupply@ monad: @UniqSM@}
    *                                                                      *
    ************************************************************************
    -}

    type UniqResult result = (# result, UniqSupply #)

    pattern UniqResult :: a -> b -> (# a, b #)
    pattern $mUniqResult :: forall {r} {a} {b}.
    (# a, b #) -> (a -> b -> r) -> ((# #) -> r) -> r
    $bUniqResult :: forall a b. a -> b -> (# a, b #)
    UniqResult x y = (# x, y #)
    {-# COMPLETE UniqResult #-}

    -- | A monad which just gives the ability to obtain 'Unique's
    newtype UniqSM result = USM { forall result. UniqSM result -> UniqSupply -> UniqResult result
    unUSM :: UniqSupply -> UniqResult result }

    -- See Note [The one-shot state monad trick] for why we don't derive this.
    instance Functor UniqSM where
      fmap :: forall a b. (a -> b) -> UniqSM a -> UniqSM b
    fmap a -> b
    f (USM UniqSupply -> UniqResult a
    m) = (UniqSupply -> UniqResult b) -> UniqSM b
    forall a. (UniqSupply -> UniqResult a) -> UniqSM a
    mkUniqSM ((UniqSupply -> UniqResult b) -> UniqSM b)
    -> (UniqSupply -> UniqResult b) -> UniqSM b
    forall a b. (a -> b) -> a -> b
    $ \UniqSupply
    us ->
          case UniqSupply -> UniqResult a
    m UniqSupply
    us of
            (# a
    r, UniqSupply
    us' #) -> b -> UniqSupply -> UniqResult b
    forall a b. a -> b -> (# a, b #)
    UniqResult (a -> b
    f a
    r) UniqSupply
    us'

    -- | Smart constructor for 'UniqSM', as described in Note [The one-shot state
    -- monad trick].
    mkUniqSM :: (UniqSupply -> UniqResult a) -> UniqSM a
    mkUniqSM :: forall a. (UniqSupply -> UniqResult a) -> UniqSM a
    mkUniqSM UniqSupply -> UniqResult a
    f = (UniqSupply -> UniqResult a) -> UniqSM a
    forall a. (UniqSupply -> UniqResult a) -> UniqSM a
    USM ((UniqSupply -> UniqResult a) -> UniqSupply -> UniqResult a
    forall a b. (a -> b) -> a -> b
    oneShot UniqSupply -> UniqResult a
    f)
    {-# INLINE mkUniqSM #-}

    instance Monad UniqSM where
      >>= :: forall a b. UniqSM a -> (a -> UniqSM b) -> UniqSM b
    (>>=) = UniqSM a -> (a -> UniqSM b) -> UniqSM b
    forall a b. UniqSM a -> (a -> UniqSM b) -> UniqSM b
    thenUs
      >> :: forall a b. UniqSM a -> UniqSM b -> UniqSM b
    (>>)  = UniqSM a -> UniqSM b -> UniqSM b
    forall a b. UniqSM a -> UniqSM b -> UniqSM b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    (*>)

    instance Applicative UniqSM where
        pure :: forall a. a -> UniqSM a
    pure = a -> UniqSM a
    forall a. a -> UniqSM a
    returnUs
        (USM UniqSupply -> UniqResult (a -> b)
    f) <*> :: forall a b. UniqSM (a -> b) -> UniqSM a -> UniqSM b
    <*> (USM UniqSupply -> UniqResult a
    x) = (UniqSupply -> UniqResult b) -> UniqSM b
    forall a. (UniqSupply -> UniqResult a) -> UniqSM a
    mkUniqSM ((UniqSupply -> UniqResult b) -> UniqSM b)
    -> (UniqSupply -> UniqResult b) -> UniqSM b
    forall a b. (a -> b) -> a -> b
    $ \UniqSupply
    us0 -> case UniqSupply -> UniqResult (a -> b)
    f UniqSupply
    us0 of
                                UniqResult a -> b
    ff UniqSupply
    us1 -> case UniqSupply -> UniqResult a
    x UniqSupply
    us1 of
                                  UniqResult a
    xx UniqSupply
    us2 -> b -> UniqSupply -> UniqResult b
    forall a b. a -> b -> (# a, b #)
    UniqResult (a -> b
    ff a
    xx) UniqSupply
    us2
        *> :: forall a b. UniqSM a -> UniqSM b -> UniqSM b
    (*>) = UniqSM a -> UniqSM b -> UniqSM b
    forall a b. UniqSM a -> UniqSM b -> UniqSM b
    thenUs_

    -- TODO: try to get rid of this instance
    instance MonadFail UniqSM where
        fail :: forall a. String -> UniqSM a
    fail = String -> UniqSM a
    forall a. HasCallStack => String -> a
    panic

    -- | Run the 'UniqSM' action, returning the final 'UniqSupply'
    initUs :: UniqSupply -> UniqSM a -> (a, UniqSupply)
    initUs :: forall a. UniqSupply -> UniqSM a -> (a, UniqSupply)
    initUs UniqSupply
    init_us UniqSM a
    m = case UniqSM a -> UniqSupply -> UniqResult a
    forall result. UniqSM result -> UniqSupply -> UniqResult result
    unUSM UniqSM a
    m UniqSupply
    init_us of { UniqResult a
    r UniqSupply
    us -> (a
    r, UniqSupply
    us) }

    -- | Run the 'UniqSM' action, discarding the final 'UniqSupply'
    initUs_ :: UniqSupply -> UniqSM a -> a
    initUs_ :: forall a. UniqSupply -> UniqSM a -> a
    initUs_ UniqSupply
    init_us UniqSM a
    m = case UniqSM a -> UniqSupply -> UniqResult a
    forall result. UniqSM result -> UniqSupply -> UniqResult result
    unUSM UniqSM a
    m UniqSupply
    init_us of { UniqResult a
    r UniqSupply
    _ -> a
    r }

    {-# INLINE thenUs #-}
    {-# INLINE returnUs #-}
    {-# INLINE splitUniqSupply #-}

    -- @thenUs@ is where we split the @UniqSupply@.

    liftUSM :: UniqSM a -> UniqSupply -> (a, UniqSupply)
    liftUSM :: forall a. UniqSM a -> UniqSupply -> (a, UniqSupply)
    liftUSM (USM UniqSupply -> UniqResult a
    m) UniqSupply
    us0 = case UniqSupply -> UniqResult a
    m UniqSupply
    us0 of UniqResult a
    a UniqSupply
    us1 -> (a
    a, UniqSupply
    us1)

    instance MonadFix UniqSM where
        mfix :: forall a. (a -> UniqSM a) -> UniqSM a
    mfix a -> UniqSM a
    m = (UniqSupply -> UniqResult a) -> UniqSM a
    forall a. (UniqSupply -> UniqResult a) -> UniqSM a
    mkUniqSM (\UniqSupply
    us0 -> let (a
    r,UniqSupply
    us1) = UniqSM a -> UniqSupply -> (a, UniqSupply)
    forall a. UniqSM a -> UniqSupply -> (a, UniqSupply)
    liftUSM (a -> UniqSM a
    m a
    r) UniqSupply
    us0 in a -> UniqSupply -> UniqResult a
    forall a b. a -> b -> (# a, b #)
    UniqResult a
    r UniqSupply
    us1)

    thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b
    thenUs :: forall a b. UniqSM a -> (a -> UniqSM b) -> UniqSM b
    thenUs (USM UniqSupply -> UniqResult a
    expr) a -> UniqSM b
    cont
      = (UniqSupply -> UniqResult b) -> UniqSM b
    forall a. (UniqSupply -> UniqResult a) -> UniqSM a
    mkUniqSM (\UniqSupply
    us0 -> case (UniqSupply -> UniqResult a
    expr UniqSupply
    us0) of
                       UniqResult a
    result UniqSupply
    us1 -> UniqSM b -> UniqSupply -> UniqResult b
    forall result. UniqSM result -> UniqSupply -> UniqResult result
    unUSM (a -> UniqSM b
    cont a
    result) UniqSupply
    us1)

    thenUs_ :: UniqSM a -> UniqSM b -> UniqSM b
    thenUs_ :: forall a b. UniqSM a -> UniqSM b -> UniqSM b
    thenUs_ (USM UniqSupply -> UniqResult a
    expr) (USM UniqSupply -> UniqResult b
    cont)
      = (UniqSupply -> UniqResult b) -> UniqSM b
    forall a. (UniqSupply -> UniqResult a) -> UniqSM a
    mkUniqSM (\UniqSupply
    us0 -> case (UniqSupply -> UniqResult a
    expr UniqSupply
    us0) of { UniqResult a
    _ UniqSupply
    us1 -> UniqSupply -> UniqResult b
    cont UniqSupply
    us1 })

    returnUs :: a -> UniqSM a
    returnUs :: forall a. a -> UniqSM a
    returnUs a
    result = (UniqSupply -> UniqResult a) -> UniqSM a
    forall a. (UniqSupply -> UniqResult a) -> UniqSM a
    mkUniqSM (\UniqSupply
    us -> a -> UniqSupply -> UniqResult a
    forall a b. a -> b -> (# a, b #)
    UniqResult a
    result UniqSupply
    us)

    getUs :: UniqSM UniqSupply
    getUs :: UniqSM UniqSupply
    getUs = (UniqSupply -> UniqResult UniqSupply) -> UniqSM UniqSupply
    forall a. (UniqSupply -> UniqResult a) -> UniqSM a
    mkUniqSM (\UniqSupply
    us0 -> case UniqSupply -> (UniqSupply, UniqSupply)
    splitUniqSupply UniqSupply
    us0 of (UniqSupply
    us1,UniqSupply
    us2) -> UniqSupply -> UniqSupply -> UniqResult UniqSupply
    forall a b. a -> b -> (# a, b #)
    UniqResult UniqSupply
    us1 UniqSupply
    us2)

    -- | A monad for generating unique identifiers
    class Monad m => MonadUnique m where
        -- | Get a new UniqueSupply
        getUniqueSupplyM :: m UniqSupply
        -- | Get a new unique identifier
        getUniqueM  :: m Unique
        -- | Get an infinite list of new unique identifiers
        getUniquesM :: m [Unique]

        -- This default definition of getUniqueM, while correct, is not as
        -- efficient as it could be since it needlessly generates and throws away
        -- an extra Unique. For your instances consider providing an explicit
        -- definition for 'getUniqueM' which uses 'takeUniqFromSupply' directly.
        getUniqueM  = (UniqSupply -> Unique) -> m UniqSupply -> m Unique
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM UniqSupply -> Unique
    uniqFromSupply  m UniqSupply
    forall (m :: * -> *). MonadUnique m => m UniqSupply
    getUniqueSupplyM
        getUniquesM = (UniqSupply -> [Unique]) -> m UniqSupply -> m [Unique]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM UniqSupply -> [Unique]
    uniqsFromSupply m UniqSupply
    forall (m :: * -> *). MonadUnique m => m UniqSupply
    getUniqueSupplyM

    instance MonadUnique UniqSM where
        getUniqueSupplyM :: UniqSM UniqSupply
    getUniqueSupplyM = UniqSM UniqSupply
    getUs
        getUniqueM :: UniqSM Unique
    getUniqueM  = UniqSM Unique
    getUniqueUs
        getUniquesM :: UniqSM [Unique]
    getUniquesM = UniqSM [Unique]
    getUniquesUs

    getUniqueUs :: UniqSM Unique
    getUniqueUs :: UniqSM Unique
    getUniqueUs = (UniqSupply -> UniqResult Unique) -> UniqSM Unique
    forall a. (UniqSupply -> UniqResult a) -> UniqSM a
    mkUniqSM (\UniqSupply
    us0 -> case UniqSupply -> (Unique, UniqSupply)
    takeUniqFromSupply UniqSupply
    us0 of
                               (Unique
    u,UniqSupply
    us1) -> Unique -> UniqSupply -> UniqResult Unique
    forall a b. a -> b -> (# a, b #)
    UniqResult Unique
    u UniqSupply
    us1)

    getUniquesUs :: UniqSM [Unique]
    getUniquesUs :: UniqSM [Unique]
    getUniquesUs = (UniqSupply -> UniqResult [Unique]) -> UniqSM [Unique]
    forall a. (UniqSupply -> UniqResult a) -> UniqSM a
    mkUniqSM (\UniqSupply
    us0 -> case UniqSupply -> (UniqSupply, UniqSupply)
    splitUniqSupply UniqSupply
    us0 of
                                (UniqSupply
    us1,UniqSupply
    us2) -> [Unique] -> UniqSupply -> UniqResult [Unique]
    forall a b. a -> b -> (# a, b #)
    UniqResult (UniqSupply -> [Unique]
    uniqsFromSupply UniqSupply
    us1) UniqSupply
    us2)