Magic.hs

{-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}
module Control.DeepSeq.Magic where
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.DeepSeq.Magic
-- Copyright   :  Public Domain
-- License     :  Public Domain
--
-- Maintainer  :  ezyang@cs.stanford.edu
-- Stability   :  stable
-- Portability :  portable
--
-- The functions in this module are exactly the same as
-- 'Control.DeepSeq', but without the need for an 'NFData' instance.
--
-- The semantics are not terribly well defined, since they are based on
-- what 'unpackClosure#' returns in its pointer list, but it appears
-- that we NEVER recurse into AP or PAP objects.

import GHC.Exts

-- NOTE: This is a bit slower than a normal NFData instance
-- because unpackClosure# has to allocate arrays to report
-- the results.  I tried writing a hand-rolled loop but it
-- was tricky. If this is a bottleneck I'll try again.
--
-- NOTE: Thankfully, unpackClosure# doesn't look through
-- thunks/function closures, so this behavior is actually
-- somewhat reasonable.
rnf :: a -> ()
rnf a = a `seq` rest `seq` () where
    rest = case unpackClosure# a of
            (# _, ptrs#, _ #)->
                let s = I# (sizeofArray# ptrs#)
                    -- Despite the mucking about with unboxed integers,
                    -- use normal equality because the API changed
                    -- backwards incompatibly in 7.10.  The optimizer
                    -- can figure out how to get the unboxed version.
                    go n@(I# n#) | n == s = ()
                                 | otherwise =
                                    case indexArray# ptrs# n# of
                                      (# a #) -> rnf a `seq` go (n + 1)
                in go 0

infixr 0 $!!

deepseq :: a -> b -> b
deepseq a b = rnf a `seq` b

($!!) :: (a -> b) -> a -> b
f $!! x = x `deepseq` f x

force :: a -> a
force x = x `deepseq` x