{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-} {-# OPTIONS_HADDOCK not-home #-} -- | -- Module : Data.Text.Internal.Unsafe -- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan -- License : BSD-style -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : portable -- -- /Warning/: this is an internal module, and does not have a stable -- API or name. Functions in this module may not check or enforce -- preconditions expected by public modules. Use at your own risk! -- -- A module containing /unsafe/ operations, for /very very careful/ use -- in /heavily tested/ code. module Data.Text.Internal.Unsafe ( inlineInterleaveST , inlinePerformIO ) where import GHC.ST (ST(..)) import GHC.IO (IO(IO)) import GHC.Base (realWorld#) -- | Just like unsafePerformIO, but we inline it. Big performance gains as -- it exposes lots of things to further inlining. /Very unsafe/. In -- particular, you should do no memory allocation inside an -- 'inlinePerformIO' block. -- {-# INLINE inlinePerformIO #-} inlinePerformIO :: IO a -> a inlinePerformIO :: forall a. IO a -> a inlinePerformIO (IO State# RealWorld -> (# State# RealWorld, a #) m) = case State# RealWorld -> (# State# RealWorld, a #) m State# RealWorld realWorld# of (# State# RealWorld _, a r #) -> a r -- | Allow an 'ST' computation to be deferred lazily. When passed an -- action of type 'ST' @s@ @a@, the action will only be performed when -- the value of @a@ is demanded. -- -- This function is identical to the normal unsafeInterleaveST, but is -- inlined and hence faster. -- -- /Note/: This operation is highly unsafe, as it can introduce -- externally visible non-determinism into an 'ST' action. inlineInterleaveST :: ST s a -> ST s a inlineInterleaveST :: forall s a. ST s a -> ST s a inlineInterleaveST (ST STRep s a m) = STRep s a -> ST s a forall s a. STRep s a -> ST s a ST (STRep s a -> ST s a) -> STRep s a -> ST s a forall a b. (a -> b) -> a -> b $ \ State# s s -> let r :: a r = case STRep s a m State# s s of (# State# s _, a res #) -> a res in (# State# s s, a r #) {-# INLINE inlineInterleaveST #-}