isevaluated 0.2 → 0.3
raw patch · 4 files changed
+106/−61 lines, 4 filesdep ~basedep ~vacuumsetup-changednew-uploaderPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, vacuum
API changes (from Hackage documentation)
Files
- Data/IsEvaluated.hs +68/−43
- LICENSE +19/−0
- Setup.lhs +2/−2
- isevaluated.cabal +17/−16
Data/IsEvaluated.hs view
@@ -1,47 +1,72 @@-module Data.IsEvaluated(isEvaluated) where+{-# LANGUAGE MagicHash, UnboxedTuples, CPP #-} -import GHC.Vacuum-import GHC.Vacuum.ClosureType+-- |+-- Module : Data.IsEvaluated+-- Copyright : (c) 2009 Bertram Felgenhauer+-- License : MIT+--+-- Maintainer : Bertram Felgenhauer <int-e@gmx.de>+-- Stability : experimental+-- Portability : ghc only+--+-- 'isEvaluated' allows checking for expressions that have already been+-- reduced to weak heaf normal form. This can be useful for racing+-- computations against one another; if one computation can be shown to+-- terminate instantly, there's no need to set up any threads for the race. --- |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.+-- The code below is based on compiler/ghci/RtClosureInspect.hs++#include "ClosureTypes.h"++module Data.IsEvaluated (+ isEvaluated+) where++import Foreign+import GHC.Exts++#if 0+-- for use with the ghc package:+import qualified Util as X (ghciTablesNextToCode)+import qualified Constants as X (wORD_SIZE)+import qualified ByteCodeItbls as X (StgInfoTable(..))+#else+-- for use with the vacuum package:+import qualified GHC.Vacuum.Internal as X+#endif++-- |+-- If @isEvaluated a@ returns 'True', the given value is in whnf. ----- Use case: if isEvaluated foo returns True, then evaluate foo will never--- throw an exception, or indeed take more than constant (small) time.+-- It may produce false negatives.+{-# NOINLINE isEvaluated #-} 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+isEvaluated a = case unpackClosure# a of+ (# iptr, ptrs, nptrs #) -> do+ let iptr' | X.ghciTablesNextToCode = Ptr iptr+ | otherwise = Ptr iptr `plusPtr`+ negate X.wORD_SIZE+ itbl <- peek iptr'+ let tipe = fromIntegral (X.tipe itbl)+ case () of+ _ | tipe >= IND && tipe <= IND_STATIC+ -- We found an indirection. Follow it.+ --+ -- We can not assume that this value is fully evaluated:+ -- If a CAF evaluates to bottom, we end up with a IND_STATIC+ -- indirection pointing to a thunk that evaluates to bottom again.+ --+ -- We have to be careful to actually do the array lookup without+ -- forcing the found element - this rules out using GHC.Arr.!+ -> case indexArray# ptrs 0# of+ (# a #) -> isEvaluated a+ | tipe >= CONSTR && tipe <= CONSTR_NOCAF_STATIC ||+ tipe >= FUN && tipe <= FUN_STATIC ||+ tipe == PAP+ -- We have an evaluated value.+ -> return True+ | otherwise+ -- We have a thunk, black hole, AP or AP_STACK node, or an RTS+ -- internal type like MutVar# that we usually only see wrapped+ -- in some data type.+ -> return False
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2009 Svein Ove Aas and Bertram Felgenhauer++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.
Setup.lhs view
@@ -1,3 +1,3 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple+#! /usr/bin/env runghc+> import Distribution.Simple (defaultMain) > main = defaultMain
isevaluated.cabal view
@@ -1,18 +1,19 @@-name: isevaluated-version: 0.2-synopsis: Check whether a value has been evaluated-description: An IO action to check whether some value has been evaluated.- .- If isEvaluated returns True, evaluating it to weak-head- normal form won't throw exceptions or take time.-category: Control, Data, GHC, Debug-license: PublicDomain-author: Svein Ove Aas-maintainer: svein.ove@aas.no-build-type: Simple-cabal-version: >= 1.2-stability: experimental+Name: isevaluated+Version: 0.3+Category: Data, GHC+Stability: experimental+Copyright: (c) 2009 Svein Ove Aas and Bertram Felgenhauer+Maintainer: Bertram Felgenhauer <int-e@gmx.de>+License: MIT+License-File: LICENSE+Synopsis: Check whether a value has been evaluated+Description: An IO action to check whether some value has been evaluated.+ .+ If isEvaluated returns True, evaluating it to weak-head normal+ form won't throw exceptions and take constant time.+Cabal-Version: >= 1.4+Build-Type: Simple Library- build-depends: base, vacuum- Exposed-Modules: Data.IsEvaluated+ Exposed-Modules: Data.IsEvaluated+ Build-Depends: base >= 4 && < 5, vacuum >= 0.0.94 && < 0.0.95