{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE MagicHash            #-}
{-# LANGUAGE UnboxedTuples        #-}
{-# LANGUAGE UnliftedFFITypes     #-}

module Data.Dup.Internal (
    dup#
  ) where

import GHC.Prim
import GHC.Exts

foreign import prim "dupClosure" dupClosure# ::
  forall s. Any -> State# s -> (# State# s, Any #)

{-# NOINLINE dup# #-}
dup# :: forall a s. a -> State# s -> (# State# s, a #)
dup# :: forall a s. a -> State# s -> (# State# s, a #)
dup# a
a State# s
s0 =
    case forall s. Any -> State# s -> (# State# s, Any #)
dupClosure# (unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# a
a) State# s
s0
      of (# State# s
s1, Any
x #) -> (# State# s
s1, unsafeCoerce# :: forall a b. a -> b
unsafeCoerce# Any
x #)