public
Last active

  • Download Gist
unsafeIsEvaluated.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
module Data.Evaluated where
 
import Data.Word
import GHC.Prim
import GHC.Exts
import Foreign
 
#include "ghcconfig.h"
 
 
#if SIZEOF_VOID_P == 8
type HalfWord = Word32
#else
type HalfWord = Word16
#endif
 
tablesNextToCode :: Bool
#if i386_BUILD_ARCH
#define TABLES_NEXT_TO_CODE
tablesNextToCode = True
#else
tablesNextToCode = False
#endif
 
getIPtr :: a -> Ptr ()
getIPtr i = case GHC.Prim.unpackClosure# i of (# iptr, _ , _ #) -> GHC.Exts.Ptr iptr
 
newtype ClosureType = ClosureType Int deriving Show
 
getClosureType :: a -> IO ClosureType
getClosureType a = do
let p = getIPtr a
#ifdef TABLES_NEXT_TO_CODE
(ClosureType . fromIntegral) `fmap` (peek (castPtr p `plusPtr` SIZEOF_INT) :: IO HalfWord)
#else
(ClosureType . fromIntegral) `fmap` (peek (castPtr p `plusPtr` (SIZEOF_INT*2)) :: IO HalfWord)
#endif
 
isConstr, isIndirection :: ClosureType -> Bool
isConstr (ClosureType i) = i >= 1 && i<= 8
isIndirection (ClosureType i) = i >= 28 && i <= 32
 
unsafeIsEvaluated = unsafePerformIO . fmap (\ct -> isConstr ct || isIndirection ct) . getClosureType

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.