isevaluated-0.2: Data/IsEvaluated.hs

module Data.IsEvaluated(isEvaluated) where

import GHC.Vacuum
import GHC.Vacuum.ClosureType

-- |Checks whether Control.Exception.evaluate (or rwhnf) would do no work
-- when applied to the value. May produce false negatives (where isEvaluated
-- thinks it would, but it actually wouldn't) in some cases.
--
-- Use case: if isEvaluated foo returns True, then evaluate foo will never
-- throw an exception, or indeed take more than constant (small) time.
isEvaluated :: a -> IO Bool
isEvaluated a = discriminate `fmap` closureType a
    where
      discriminate CONSTR              = True
      discriminate CONSTR_1_0          = True
      discriminate CONSTR_0_1          = True
      discriminate CONSTR_2_0          = True
      discriminate CONSTR_1_1          = True
      discriminate CONSTR_0_2          = True
      discriminate CONSTR_STATIC       = True
      discriminate CONSTR_NOCAF_STATIC = True
      discriminate FUN                 = True
      discriminate FUN_1_0             = True
      discriminate FUN_0_1             = True
      discriminate FUN_2_0             = True
      discriminate FUN_1_1             = True
      discriminate FUN_0_2             = True
      discriminate FUN_STATIC          = True
      discriminate PAP                 = True
      discriminate IND                 = True
      discriminate IND_OLDGEN          = True
      discriminate IND_PERM            = True
      discriminate IND_OLDGEN_PERM     = True
      discriminate IND_STATIC          = True
-- MVAR_CLEAN  -- These are questionable
-- MVAR_DIRTY
-- ARR_WORDS
-- MUT_ARR_PTRS_CLEAN	
-- MUT_ARR_PTRS_DIRTY	
-- MUT_ARR_PTRS_FROZEN0	
-- MUT_ARR_PTRS_FROZEN	
-- MUT_VAR_CLEAN	
-- MUT_VAR_DIRTY
-- WEAK
      -- It might be possible to handle THUNK_SELECTOR specially
      discriminate _               = False