diff --git a/AUTHORS.txt b/AUTHORS.txt
new file mode 100644
--- /dev/null
+++ b/AUTHORS.txt
@@ -0,0 +1,13 @@
+Vacuum was originally written in 2009 by Matt Morrow. Matt has since
+disappeared and with it, the original darcs repository holding his
+code and changeset history.
+
+Austin Seipp (mad.one -at- gmail.com) is the current
+maintainer.
+
+Various people have contributed to vacuum over the years; the
+following list is in no order, and is in no way comprehensive. If
+you've contributed, please tell me and I'll add you:
+
+* Conrad Parker
+* Ivan Lazar Miljenovic
diff --git a/LICENSE b/LICENSE
deleted file mode 100644
--- a/LICENSE
+++ /dev/null
@@ -1,165 +0,0 @@
- GNU LESSER GENERAL PUBLIC LICENSE
- Version 3, 29 June 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc.
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-
- This version of the GNU Lesser General Public License incorporates
-the terms and conditions of version 3 of the GNU General Public
-License, supplemented by the additional permissions listed below.
-
- 0. Additional Definitions.
-
- As used herein, "this License" refers to version 3 of the GNU Lesser
-General Public License, and the "GNU GPL" refers to version 3 of the GNU
-General Public License.
-
- "The Library" refers to a covered work governed by this License,
-other than an Application or a Combined Work as defined below.
-
- An "Application" is any work that makes use of an interface provided
-by the Library, but which is not otherwise based on the Library.
-Defining a subclass of a class defined by the Library is deemed a mode
-of using an interface provided by the Library.
-
- A "Combined Work" is a work produced by combining or linking an
-Application with the Library. The particular version of the Library
-with which the Combined Work was made is also called the "Linked
-Version".
-
- The "Minimal Corresponding Source" for a Combined Work means the
-Corresponding Source for the Combined Work, excluding any source code
-for portions of the Combined Work that, considered in isolation, are
-based on the Application, and not on the Linked Version.
-
- The "Corresponding Application Code" for a Combined Work means the
-object code and/or source code for the Application, including any data
-and utility programs needed for reproducing the Combined Work from the
-Application, but excluding the System Libraries of the Combined Work.
-
- 1. Exception to Section 3 of the GNU GPL.
-
- You may convey a covered work under sections 3 and 4 of this License
-without being bound by section 3 of the GNU GPL.
-
- 2. Conveying Modified Versions.
-
- If you modify a copy of the Library, and, in your modifications, a
-facility refers to a function or data to be supplied by an Application
-that uses the facility (other than as an argument passed when the
-facility is invoked), then you may convey a copy of the modified
-version:
-
- a) under this License, provided that you make a good faith effort to
- ensure that, in the event an Application does not supply the
- function or data, the facility still operates, and performs
- whatever part of its purpose remains meaningful, or
-
- b) under the GNU GPL, with none of the additional permissions of
- this License applicable to that copy.
-
- 3. Object Code Incorporating Material from Library Header Files.
-
- The object code form of an Application may incorporate material from
-a header file that is part of the Library. You may convey such object
-code under terms of your choice, provided that, if the incorporated
-material is not limited to numerical parameters, data structure
-layouts and accessors, or small macros, inline functions and templates
-(ten or fewer lines in length), you do both of the following:
-
- a) Give prominent notice with each copy of the object code that the
- Library is used in it and that the Library and its use are
- covered by this License.
-
- b) Accompany the object code with a copy of the GNU GPL and this license
- document.
-
- 4. Combined Works.
-
- You may convey a Combined Work under terms of your choice that,
-taken together, effectively do not restrict modification of the
-portions of the Library contained in the Combined Work and reverse
-engineering for debugging such modifications, if you also do each of
-the following:
-
- a) Give prominent notice with each copy of the Combined Work that
- the Library is used in it and that the Library and its use are
- covered by this License.
-
- b) Accompany the Combined Work with a copy of the GNU GPL and this license
- document.
-
- c) For a Combined Work that displays copyright notices during
- execution, include the copyright notice for the Library among
- these notices, as well as a reference directing the user to the
- copies of the GNU GPL and this license document.
-
- d) Do one of the following:
-
- 0) Convey the Minimal Corresponding Source under the terms of this
- License, and the Corresponding Application Code in a form
- suitable for, and under terms that permit, the user to
- recombine or relink the Application with a modified version of
- the Linked Version to produce a modified Combined Work, in the
- manner specified by section 6 of the GNU GPL for conveying
- Corresponding Source.
-
- 1) Use a suitable shared library mechanism for linking with the
- Library. A suitable mechanism is one that (a) uses at run time
- a copy of the Library already present on the user's computer
- system, and (b) will operate properly with a modified version
- of the Library that is interface-compatible with the Linked
- Version.
-
- e) Provide Installation Information, but only if you would otherwise
- be required to provide such information under section 6 of the
- GNU GPL, and only to the extent that such information is
- necessary to install and execute a modified version of the
- Combined Work produced by recombining or relinking the
- Application with a modified version of the Linked Version. (If
- you use option 4d0, the Installation Information must accompany
- the Minimal Corresponding Source and Corresponding Application
- Code. If you use option 4d1, you must provide the Installation
- Information in the manner specified by section 6 of the GNU GPL
- for conveying Corresponding Source.)
-
- 5. Combined Libraries.
-
- You may place library facilities that are a work based on the
-Library side by side in a single library together with other library
-facilities that are not Applications and are not covered by this
-License, and convey such a combined library under terms of your
-choice, if you do both of the following:
-
- a) Accompany the combined library with a copy of the same work based
- on the Library, uncombined with any other library facilities,
- conveyed under the terms of this License.
-
- b) Give prominent notice with the combined library that part of it
- is a work based on the Library, and explaining where to find the
- accompanying uncombined form of the same work.
-
- 6. Revised Versions of the GNU Lesser General Public License.
-
- The Free Software Foundation may publish revised and/or new versions
-of the GNU Lesser General Public License from time to time. Such new
-versions will be similar in spirit to the present version, but may
-differ in detail to address new problems or concerns.
-
- Each version is given a distinguishing version number. If the
-Library as you received it specifies that a certain numbered version
-of the GNU Lesser General Public License "or any later version"
-applies to it, you have the option of following the terms and
-conditions either of that published version or of any later version
-published by the Free Software Foundation. If the Library as you
-received it does not specify a version number of the GNU Lesser
-General Public License, you may choose any version of the GNU Lesser
-General Public License ever published by the Free Software Foundation.
-
- If the Library as you received it specifies that a proxy can decide
-whether future versions of the GNU Lesser General Public License shall
-apply, that proxy's public statement of acceptance of any version is
-permanent authorization for you to choose that version for the
-Library.
diff --git a/LICENSE.txt b/LICENSE.txt
new file mode 100644
--- /dev/null
+++ b/LICENSE.txt
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,54 @@
+# Vacuum: visualising the GHC heap
+
+Vacuum is a library for extracting graph representations of values
+from the GHC heap, at runtime. Those graphs may then be further
+processed or translated to various representations for visualization
+-- like Graphviz, or Ubigraph.
+
+[travis-ci.org](http://travis-ci.org) results: [](http://travis-ci.org/thoughtpolice/vacuum)
+
+# Installation
+
+It's just a `cabal install` away on [Hackage][]:
+
+~~~~~~~~
+$ cabal install vacuum
+# also install the graphviz package, for SVG/PNG rendering:
+$ cabal install vacuum-graphviz
+~~~~~~~~
+
+# Gallery of examples
+
+Want to try before you buy, and see what Vacuum output looks like?
+Here are some examples:
+
+ * Vacuuming the linked list `[1, 2]` - [Results][e1]
+
+More examples will come in the future.
+
+# Join in
+
+File bugs in the GitHub [issue tracker][].
+
+Master [git repository][gh]:
+
+ * `git clone https://github.com/thoughtpolice/vacuum.git`
+
+There's also a [BitBucket mirror][bb]:
+
+ * `git clone https://bitbucket.org/thoughtpolice/vacuum.git`
+
+# Authors
+
+See [AUTHORS.txt](https://raw.github.com/thoughtpolice/vacuum/master/AUTHORS.txt).
+
+# License
+
+LGPLv3. See `LICENSE.txt` for details.
+
+[main page]: http://thoughtpolice.github.com/vacuum
+[issue tracker]: http://github.com/thoughtpolice/vacuum/issues
+[gh]: http://github.com/thoughtpolice/vacuum
+[bb]: http://bitbucket.org/thoughtpolice/vacuum
+[Hackage]: http://hackage.haskell.org/package/pcap-conduit
+[e1]: https://raw.github.com/thoughtpolice/vacuum/master/gallery/list.png
diff --git a/Setup.lhs b/Setup.lhs
--- a/Setup.lhs
+++ b/Setup.lhs
diff --git a/src/GHC/Vacuum.hs b/src/GHC/Vacuum.hs
--- a/src/GHC/Vacuum.hs
+++ b/src/GHC/Vacuum.hs
@@ -1,51 +1,34 @@
{-# LANGUAGE BangPatterns, UnboxedTuples, MagicHash #-}
-
-{- |
->
-> ghci> toAdjList $ vacuum (fix (0:))
-> [(0,[1,0]),(1,[])]
->
-> ghci> ppHs $ vacuum (fix (0:))
-> fromList
-> [(0,
-> HNode{nodePtrs = [1, 0], nodeLits = [40425920],
-> nodeInfo =
-> ConInfo{itabPkg = "ghc-prim", itabMod = "GHC.Types", itabCon = ":",
-> itabPtrs = 2, itabLits = 0, itabType = CONSTR_2_0, itabSrtLen = 1,
-> itabCode =
-> [72, 131, 195, 2, 255, 101, 0, 144, 224, 30, 0, 0, 0, 0, 0, 0]}}),
-> (1,
-> HNode{nodePtrs = [], nodeLits = [0, 40425920],
-> nodeInfo =
-> ConInfo{itabPkg = "integer", itabMod = "GHC.Integer.Internals",
-> itabCon = "S#", itabPtrs = 0, itabLits = 1, itabType = CONSTR_0_1,
-> itabSrtLen = 0,
-> itabCode =
-> [72, 255, 195, 255, 101, 0, 102, 144, 152, 0, 0, 0, 0, 0, 0, 0]}})]
->
-> ghci> ppDot . nameGraph $ vacuum (fix (0:))
-> digraph g {
-> graph [rankdir=LR, splines=true];
-> node [label="\N", shape=none, fontcolor=blue, fontname=courier];
-> edge [color=black, style=dotted, fontname=courier, arrowname=onormal];
-> ":|0" -> {"S#|1";":|0"}
-> "S#|1" -> {}
-> }
->
-> ghci> let a = [0..]
-> ghci> toAdjList $ vacuumLazy a
-> [(0,[])]
-> ghci> take 2 a
-> [0,1]
-> ghci> toAdjList $ vacuumLazy a
-> [(0,[1,2]),(1,[]),(2,[3,4]),(3,[]),(4,[])]
-> ghci> take 3 a
-> [0,1,2]
-> ghci> toAdjList $ vacuumLazy a
-> [(0,[1,2]),(1,[]),(2,[3,4]),(3,[]),(4,[5,6]),(5,[]),(6,[])]
->
--}
-
+-- |
+-- Module : GHC.Vacuum
+-- Copyright : (c) Matt Morrow 2009, Austin Seipp 2011-2012
+-- License : LGPLv3
+--
+-- Maintainer : mad.one@gmail.com
+-- Stability : experimental
+-- Portability : non-portable (GHC only)
+--
+-- @vacuum@ is a library that allows you to look at the graph
+-- representation of an arbitrary value or expression.
+--
+-- Evaluation in Haskell proceeds by /graph reduction/, where values
+-- on the GHC heap are represented in a graph structure, and where
+-- nodes in the graph represent things like constructors or regular
+-- values. With this library, you can extract the graph representation
+-- of said heap values, and display them in meaningful ways to observe
+-- properties like sharing, or a birds eye view of how much memory
+-- you're using.
+--
+-- By itself, this module and package is not very useful to
+-- the end user - it is meant to be consumed by those who
+-- would want to visualise the abstract graph output in some
+-- meaningful way, using graphviz or ubigraph, for example.
+--
+-- If you are an end user who wants to visualize their data
+-- structures and nothing more, please look at the @vacuum-graphviz@
+-- package, which exports convenient APIs for rendering the output
+-- graphs into pretty PNG/SVG files.
+--
module GHC.Vacuum (
HNodeId
,HNode(..)
@@ -57,8 +40,6 @@
,nameGraph
,ShowHNode(..)
,showHNodes
- --,ppHs
- ,ppDot
,Draw(..),G(..)
,draw,printDraw,split
,Closure(..)
@@ -71,25 +52,18 @@
,nodePkg,nodeMod
,nodeName,itabName
,HValue
- --,module GHC.Vacuum.Q
) where
import GHC.Vacuum.Q
-import GHC.Vacuum.Util
import GHC.Vacuum.Types
import GHC.Vacuum.Pretty
import GHC.Vacuum.ClosureType
import GHC.Vacuum.Internal as GHC
import Data.List
-import Data.Char
-import Data.Word
-import Data.Bits
-import Data.Map(Map)
+import Data.Maybe (fromJust, isJust)
import Data.IntMap(IntMap)
import qualified Data.IntMap as IM
-import qualified Data.Map as M
-import Data.Monoid(Monoid(..))
import System.IO.Unsafe
import Control.Monad
import Control.Applicative
@@ -97,8 +71,7 @@
import Prelude hiding(catch)
import Control.Concurrent
-import Foreign hiding (unsafePerformIO)
-import GHC.Arr(Array(..))
+import Foreign hiding (unsafePerformIO, void)
import GHC.Exts
import System.Mem.StableName
@@ -164,23 +137,23 @@
getClosure_ a =
case unpackClosure# a of
(# iptr
- ,ptrs
- ,nptrs #) -> do
+ ,ptrs'
+ ,nptrs' #) -> do
let iptr' | ghciTablesNextToCode = Ptr iptr
| otherwise = Ptr iptr `plusPtr` negate wORD_SIZE
itab <- peekInfoTab iptr'
let elems = fromIntegral (itabPtrs itab)
- ptrs0 = dumpArray# ptrs 0 elems
- lits = [W# (indexWordArray# nptrs i)
+ ptrs0 = dumpArray# ptrs' 0 elems
+ lits = [W# (indexWordArray# nptrs' i)
| I# i <- [0.. fromIntegral (itabLits itab-1)] ]
case itab of
-- follow indirections, because mkStableName follows
-- indirections as well.
- OtherInfo { itabType = tipe }
- | tipe == IND || tipe == IND_OLDGEN || tipe == IND_PERM ||
- tipe == IND_OLDGEN_PERM || tipe == IND_STATIC ->
+ OtherInfo { itabType = tipe' }
+ | tipe' == IND || tipe' == IND_PERM || tipe' == IND_STATIC ->
case ptrs0 of
(dest : _) -> getClosure_ dest
+ [] -> error "GHC.Vacuum.getClosure: indirection had 0 pointers!"
_ -> return (Closure ptrs0 lits itab)
-- using indexArray# makes sure that the HValue is looked up without
@@ -234,12 +207,12 @@
hasName :: StgInfoTable -> Bool
hasName stg = let ct = (toEnum . fromIntegral . GHC.tipe) stg :: ClosureType
lits = (fromIntegral . GHC.nptrs) stg :: Int
- ptrs = (fromIntegral . GHC.ptrs) stg :: Int
+ ptrs' = (fromIntegral . GHC.ptrs) stg :: Int
in isCon ct
- && lits < 1024 -- It seems the ptrs info the ItblEnv
- && ptrs < 1024 -- gotten from ByteCodeItbls are borked
- -- in some way, *OR* (and more likely)
- -- there's some caveat i'm not aware of.
+ && lits < 1024 -- It seems the ptrs info the ItblEnv
+ && ptrs' < 1024 -- gotten from ByteCodeItbls are borked
+ -- in some way, *OR* (and more likely)
+ -- there's some caveat i'm not aware of.
------------------------------------------------
@@ -264,16 +237,9 @@
streamH :: (Q (Maybe a) -> H b) -> IO [a]
streamH m = do
q <- newQ
- tid <- forkIO (runH_ (m q) `finally` putQ q Nothing)
+ void $ forkIO (runH_ (m q) `finally` putQ q Nothing)
fmap fromJust <$> takeWhileQ isJust q
-fromJust :: Maybe a -> a
-fromJust (Just a) = a
-
-isJust :: Maybe a -> Bool
-isJust (Just{}) = True
-isJust _ = False
-
------------------------------------------------
-- | Walk the reachable heap (sub)graph rooted at @a@,
@@ -281,8 +247,8 @@
vacuumH :: (HValue -> H [HNodeId]) -> a -> H ()
vacuumH scan a = go =<< rootH a
where go :: HValue -> H ()
- go a = do
- ids <- scan a
+ go x = do
+ ids <- scan x
case ids of
[] -> return ()
_ -> mapM_ go =<< mapM getHVal ids
@@ -303,11 +269,11 @@
dumpToH n a = go (n-1) =<< rootH a
where go :: Int -> HValue -> H ()
go 0 _ = return ()
- go n a = do
- ids <- nodeH a
+ go m x = do
+ ids <- nodeH x
case ids of
[] -> return ()
- _ -> mapM_ (go (n-1)) =<< mapM getHVal ids
+ _ -> mapM_ (go (m-1)) =<< mapM getHVal ids
-- | Turn the root into an @HValue@ to start off.
rootH :: a -> H HValue
@@ -321,9 +287,9 @@
-> (HValue -> H (HNodeId, Bool))
-> (HNodeId -> HNode -> H ())
-> HValue -> H [HNodeId]
-scanNodeH getNode getId withNode a = do
- (i,clos,ptrs) <- getNode a
- xs <- mapM getId ptrs
+scanNodeH getNode getID withNode a = do
+ (i,clos,ptrs') <- getNode a
+ xs <- mapM getID ptrs'
let news = (fmap fst . fst . partition snd) xs
n = HNode (fmap fst xs)
(closLits clos)
@@ -346,23 +312,23 @@
clos <- io (getClosure a)
(i, _) <- getId a
let itab = closITab clos
- ptrs = closPtrs clos
+ ptrs' = closPtrs clos
case itabType itab of
t -- IMPORTANT: Following any of the pointer(s)
-- inside a @THUNK@ results in the chop (aka segfault).
| isThunk t -> return (i,clos,[])
- | otherwise -> return (i,clos,ptrs)
+ | otherwise -> return (i,clos,ptrs')
getNodeH' :: HValue -> H (HNodeId, Closure, [HValue])
getNodeH' a = do
clos <- io (getClosure a)
let itab = closITab clos
- ptrs = closPtrs clos
+ ptrs' = closPtrs clos
case itabType itab of
t | isThunk t -> getNodeH' =<< io (defined a)
| otherwise -> do
(i, _) <- getId a
- return (i,clos,ptrs)
+ return (i,clos,ptrs')
------------------------------------------------
diff --git a/src/GHC/Vacuum/ClosureType.hs b/src/GHC/Vacuum/ClosureType.hs
--- a/src/GHC/Vacuum/ClosureType.hs
+++ b/src/GHC/Vacuum/ClosureType.hs
@@ -1,8 +1,39 @@
-module GHC.Vacuum.ClosureType (
- isFun,isThunk,isCon
- ,ClosureType(..)
-) where
+{-# LANGUAGE CPP #-}
+-- |
+-- Module : GHC.Vacuum.ClosureType
+-- Copyright : (c) Matt Morrow 2009, Austin Seipp 2011-2012
+-- License : LGPLv3
+--
+-- Maintainer : mad.one@gmail.com
+-- Stability : experimental
+-- Portability : non-portable (GHC only)
+--
+-- This module exports the different kind of closure types there
+-- are per GHC version.
+--
+-- NOTE: the 'ClosureType' datatype is automatically generated, based
+-- on the version of GHC, and the proper one is included for you.
+--
+module GHC.Vacuum.ClosureType
+ ( ClosureType(..)
+ , isFun -- :: ClosureType -> Bool
+ , isThunk -- :: ClosureType -> Bool
+ , isCon -- :: ClosureType -> Bool
+ ) where
+-- Import the correct ClosureType datatype based on
+-- the version
+
+#if __GLASGOW_HASKELL__ == 700
+import GHC.Vacuum.ClosureType.V700 (ClosureType(..))
+#elif __GLASGOW_HASKELL__ == 702
+import GHC.Vacuum.ClosureType.V702 (ClosureType(..))
+#elif __GLASGOW_HASKELL__ == 704
+import GHC.Vacuum.ClosureType.V704 (ClosureType(..))
+#else
+#error Unsupported GHC version in ClosureTypes.hs!
+#endif
+
------------------------------------------------
isFun :: ClosureType -> Bool
@@ -37,228 +68,3 @@
isCon CONSTR_STATIC = True
isCon CONSTR_NOCAF_STATIC = True
isCon _ = False
-
-------------------------------------------------
-
-data ClosureType
- = INVALID_OBJECT
- | CONSTR
- | CONSTR_1_0
- | CONSTR_0_1
- | CONSTR_2_0
- | CONSTR_1_1
- | CONSTR_0_2
- | CONSTR_STATIC
- | CONSTR_NOCAF_STATIC
- | FUN
- | FUN_1_0
- | FUN_0_1
- | FUN_2_0
- | FUN_1_1
- | FUN_0_2
- | FUN_STATIC
- | THUNK
- | THUNK_1_0
- | THUNK_0_1
- | THUNK_2_0
- | THUNK_1_1
- | THUNK_0_2
- | THUNK_STATIC
- | THUNK_SELECTOR
- | BCO
- | AP
- | PAP
- | AP_STACK
- | IND
- | IND_OLDGEN
- | IND_PERM
- | IND_OLDGEN_PERM
- | IND_STATIC
- | RET_BCO
- | RET_SMALL
- | RET_BIG
- | RET_DYN
- | RET_FUN
- | UPDATE_FRAME
- | CATCH_FRAME
- | STOP_FRAME
- | CAF_BLACKHOLE
- | BLACKHOLE
- | SE_BLACKHOLE
- | SE_CAF_BLACKHOLE
- | MVAR_CLEAN
- | 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
- | STABLE_NAME
- | TSO
- | BLOCKED_FETCH
- | FETCH_ME
- | FETCH_ME_BQ
- | RBH
- | REMOTE_REF
- | TVAR_WATCH_QUEUE
- | INVARIANT_CHECK_QUEUE
- | ATOMIC_INVARIANT
- | TVAR
- | TREC_CHUNK
- | TREC_HEADER
- | ATOMICALLY_FRAME
- | CATCH_RETRY_FRAME
- | CATCH_STM_FRAME
- | WHITEHOLE
- deriving(Eq,Ord,Read,Show)
-
-instance Enum ClosureType where
- fromEnum INVALID_OBJECT = 0
- fromEnum CONSTR = 1
- fromEnum CONSTR_1_0 = 2
- fromEnum CONSTR_0_1 = 3
- fromEnum CONSTR_2_0 = 4
- fromEnum CONSTR_1_1 = 5
- fromEnum CONSTR_0_2 = 6
- fromEnum CONSTR_STATIC = 7
- fromEnum CONSTR_NOCAF_STATIC = 8
- fromEnum FUN = 9
- fromEnum FUN_1_0 = 10
- fromEnum FUN_0_1 = 11
- fromEnum FUN_2_0 = 12
- fromEnum FUN_1_1 = 13
- fromEnum FUN_0_2 = 14
- fromEnum FUN_STATIC = 15
- fromEnum THUNK = 16
- fromEnum THUNK_1_0 = 17
- fromEnum THUNK_0_1 = 18
- fromEnum THUNK_2_0 = 19
- fromEnum THUNK_1_1 = 20
- fromEnum THUNK_0_2 = 21
- fromEnum THUNK_STATIC = 22
- fromEnum THUNK_SELECTOR = 23
- fromEnum BCO = 24
- fromEnum AP = 25
- fromEnum PAP = 26
- fromEnum AP_STACK = 27
- fromEnum IND = 28
- fromEnum IND_OLDGEN = 29
- fromEnum IND_PERM = 30
- fromEnum IND_OLDGEN_PERM = 31
- fromEnum IND_STATIC = 32
- fromEnum RET_BCO = 33
- fromEnum RET_SMALL = 34
- fromEnum RET_BIG = 35
- fromEnum RET_DYN = 36
- fromEnum RET_FUN = 37
- fromEnum UPDATE_FRAME = 38
- fromEnum CATCH_FRAME = 39
- fromEnum STOP_FRAME = 40
- fromEnum CAF_BLACKHOLE = 41
- fromEnum BLACKHOLE = 42
- fromEnum SE_BLACKHOLE = 43
- fromEnum SE_CAF_BLACKHOLE = 44
- fromEnum MVAR_CLEAN = 45
- fromEnum MVAR_DIRTY = 46
- fromEnum ARR_WORDS = 47
- fromEnum MUT_ARR_PTRS_CLEAN = 48
- fromEnum MUT_ARR_PTRS_DIRTY = 49
- fromEnum MUT_ARR_PTRS_FROZEN0 = 50
- fromEnum MUT_ARR_PTRS_FROZEN = 51
- fromEnum MUT_VAR_CLEAN = 52
- fromEnum MUT_VAR_DIRTY = 53
- fromEnum WEAK = 54
- fromEnum STABLE_NAME = 55
- fromEnum TSO = 56
- fromEnum BLOCKED_FETCH = 57
- fromEnum FETCH_ME = 58
- fromEnum FETCH_ME_BQ = 59
- fromEnum RBH = 60
- fromEnum REMOTE_REF = 62
- fromEnum TVAR_WATCH_QUEUE = 63
- fromEnum INVARIANT_CHECK_QUEUE = 64
- fromEnum ATOMIC_INVARIANT = 65
- fromEnum TVAR = 66
- fromEnum TREC_CHUNK = 67
- fromEnum TREC_HEADER = 68
- fromEnum ATOMICALLY_FRAME = 69
- fromEnum CATCH_RETRY_FRAME = 70
- fromEnum CATCH_STM_FRAME = 71
- fromEnum WHITEHOLE = 72
- toEnum 0 = INVALID_OBJECT
- toEnum 1 = CONSTR
- toEnum 2 = CONSTR_1_0
- toEnum 3 = CONSTR_0_1
- toEnum 4 = CONSTR_2_0
- toEnum 5 = CONSTR_1_1
- toEnum 6 = CONSTR_0_2
- toEnum 7 = CONSTR_STATIC
- toEnum 8 = CONSTR_NOCAF_STATIC
- toEnum 9 = FUN
- toEnum 10 = FUN_1_0
- toEnum 11 = FUN_0_1
- toEnum 12 = FUN_2_0
- toEnum 13 = FUN_1_1
- toEnum 14 = FUN_0_2
- toEnum 15 = FUN_STATIC
- toEnum 16 = THUNK
- toEnum 17 = THUNK_1_0
- toEnum 18 = THUNK_0_1
- toEnum 19 = THUNK_2_0
- toEnum 20 = THUNK_1_1
- toEnum 21 = THUNK_0_2
- toEnum 22 = THUNK_STATIC
- toEnum 23 = THUNK_SELECTOR
- toEnum 24 = BCO
- toEnum 25 = AP
- toEnum 26 = PAP
- toEnum 27 = AP_STACK
- toEnum 28 = IND
- toEnum 29 = IND_OLDGEN
- toEnum 30 = IND_PERM
- toEnum 31 = IND_OLDGEN_PERM
- toEnum 32 = IND_STATIC
- toEnum 33 = RET_BCO
- toEnum 34 = RET_SMALL
- toEnum 35 = RET_BIG
- toEnum 36 = RET_DYN
- toEnum 37 = RET_FUN
- toEnum 38 = UPDATE_FRAME
- toEnum 39 = CATCH_FRAME
- toEnum 40 = STOP_FRAME
- toEnum 41 = CAF_BLACKHOLE
- toEnum 42 = BLACKHOLE
- toEnum 43 = SE_BLACKHOLE
- toEnum 44 = SE_CAF_BLACKHOLE
- toEnum 45 = MVAR_CLEAN
- toEnum 46 = MVAR_DIRTY
- toEnum 47 = ARR_WORDS
- toEnum 48 = MUT_ARR_PTRS_CLEAN
- toEnum 49 = MUT_ARR_PTRS_DIRTY
- toEnum 50 = MUT_ARR_PTRS_FROZEN0
- toEnum 51 = MUT_ARR_PTRS_FROZEN
- toEnum 52 = MUT_VAR_CLEAN
- toEnum 53 = MUT_VAR_DIRTY
- toEnum 54 = WEAK
- toEnum 55 = STABLE_NAME
- toEnum 56 = TSO
- toEnum 57 = BLOCKED_FETCH
- toEnum 58 = FETCH_ME
- toEnum 59 = FETCH_ME_BQ
- toEnum 60 = RBH
- toEnum 62 = REMOTE_REF
- toEnum 63 = TVAR_WATCH_QUEUE
- toEnum 64 = INVARIANT_CHECK_QUEUE
- toEnum 65 = ATOMIC_INVARIANT
- toEnum 66 = TVAR
- toEnum 67 = TREC_CHUNK
- toEnum 68 = TREC_HEADER
- toEnum 69 = ATOMICALLY_FRAME
- toEnum 70 = CATCH_RETRY_FRAME
- toEnum 71 = CATCH_STM_FRAME
- toEnum 72 = WHITEHOLE
- toEnum n = error ("toEnum: ClosureType: invalid ClosureType: " ++ show n)
-
diff --git a/src/GHC/Vacuum/ClosureType/V700.hs b/src/GHC/Vacuum/ClosureType/V700.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Vacuum/ClosureType/V700.hs
@@ -0,0 +1,190 @@
+module GHC.Vacuum.ClosureType.V700 ( ClosureType(..) ) where
+
+
+data ClosureType
+ = INVALID_OBJECT
+ | CONSTR
+ | CONSTR_1_0
+ | CONSTR_0_1
+ | CONSTR_2_0
+ | CONSTR_1_1
+ | CONSTR_0_2
+ | CONSTR_STATIC
+ | CONSTR_NOCAF_STATIC
+ | FUN
+ | FUN_1_0
+ | FUN_0_1
+ | FUN_2_0
+ | FUN_1_1
+ | FUN_0_2
+ | FUN_STATIC
+ | THUNK
+ | THUNK_1_0
+ | THUNK_0_1
+ | THUNK_2_0
+ | THUNK_1_1
+ | THUNK_0_2
+ | THUNK_STATIC
+ | THUNK_SELECTOR
+ | BCO
+ | AP
+ | PAP
+ | AP_STACK
+ | IND
+ | IND_PERM
+ | IND_STATIC
+ | RET_BCO
+ | RET_SMALL
+ | RET_BIG
+ | RET_DYN
+ | RET_FUN
+ | UPDATE_FRAME
+ | CATCH_FRAME
+ | STOP_FRAME
+ | BLOCKING_QUEUE
+ | BLACKHOLE
+ | MVAR_CLEAN
+ | 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
+ | PRIM
+ | MUT_PRIM
+ | TSO
+ | TREC_CHUNK
+ | ATOMICALLY_FRAME
+ | CATCH_RETRY_FRAME
+ | CATCH_STM_FRAME
+ | WHITEHOLE
+ | N_CLOSURE_TYPES
+ deriving (Eq, Ord, Show, Read)
+
+instance Enum ClosureType where
+ fromEnum INVALID_OBJECT = 0
+ fromEnum CONSTR = 1
+ fromEnum CONSTR_1_0 = 2
+ fromEnum CONSTR_0_1 = 3
+ fromEnum CONSTR_2_0 = 4
+ fromEnum CONSTR_1_1 = 5
+ fromEnum CONSTR_0_2 = 6
+ fromEnum CONSTR_STATIC = 7
+ fromEnum CONSTR_NOCAF_STATIC = 8
+ fromEnum FUN = 9
+ fromEnum FUN_1_0 = 10
+ fromEnum FUN_0_1 = 11
+ fromEnum FUN_2_0 = 12
+ fromEnum FUN_1_1 = 13
+ fromEnum FUN_0_2 = 14
+ fromEnum FUN_STATIC = 15
+ fromEnum THUNK = 16
+ fromEnum THUNK_1_0 = 17
+ fromEnum THUNK_0_1 = 18
+ fromEnum THUNK_2_0 = 19
+ fromEnum THUNK_1_1 = 20
+ fromEnum THUNK_0_2 = 21
+ fromEnum THUNK_STATIC = 22
+ fromEnum THUNK_SELECTOR = 23
+ fromEnum BCO = 24
+ fromEnum AP = 25
+ fromEnum PAP = 26
+ fromEnum AP_STACK = 27
+ fromEnum IND = 28
+ fromEnum IND_PERM = 29
+ fromEnum IND_STATIC = 30
+ fromEnum RET_BCO = 31
+ fromEnum RET_SMALL = 32
+ fromEnum RET_BIG = 33
+ fromEnum RET_DYN = 34
+ fromEnum RET_FUN = 35
+ fromEnum UPDATE_FRAME = 36
+ fromEnum CATCH_FRAME = 37
+ fromEnum STOP_FRAME = 38
+ fromEnum BLOCKING_QUEUE = 39
+ fromEnum BLACKHOLE = 40
+ fromEnum MVAR_CLEAN = 41
+ fromEnum MVAR_DIRTY = 42
+ fromEnum ARR_WORDS = 43
+ fromEnum MUT_ARR_PTRS_CLEAN = 44
+ fromEnum MUT_ARR_PTRS_DIRTY = 45
+ fromEnum MUT_ARR_PTRS_FROZEN0 = 46
+ fromEnum MUT_ARR_PTRS_FROZEN = 47
+ fromEnum MUT_VAR_CLEAN = 48
+ fromEnum MUT_VAR_DIRTY = 49
+ fromEnum WEAK = 50
+ fromEnum PRIM = 51
+ fromEnum MUT_PRIM = 52
+ fromEnum TSO = 53
+ fromEnum TREC_CHUNK = 54
+ fromEnum ATOMICALLY_FRAME = 55
+ fromEnum CATCH_RETRY_FRAME = 56
+ fromEnum CATCH_STM_FRAME = 57
+ fromEnum WHITEHOLE = 58
+ fromEnum N_CLOSURE_TYPES = 59
+
+ toEnum 0 = INVALID_OBJECT
+ toEnum 1 = CONSTR
+ toEnum 2 = CONSTR_1_0
+ toEnum 3 = CONSTR_0_1
+ toEnum 4 = CONSTR_2_0
+ toEnum 5 = CONSTR_1_1
+ toEnum 6 = CONSTR_0_2
+ toEnum 7 = CONSTR_STATIC
+ toEnum 8 = CONSTR_NOCAF_STATIC
+ toEnum 9 = FUN
+ toEnum 10 = FUN_1_0
+ toEnum 11 = FUN_0_1
+ toEnum 12 = FUN_2_0
+ toEnum 13 = FUN_1_1
+ toEnum 14 = FUN_0_2
+ toEnum 15 = FUN_STATIC
+ toEnum 16 = THUNK
+ toEnum 17 = THUNK_1_0
+ toEnum 18 = THUNK_0_1
+ toEnum 19 = THUNK_2_0
+ toEnum 20 = THUNK_1_1
+ toEnum 21 = THUNK_0_2
+ toEnum 22 = THUNK_STATIC
+ toEnum 23 = THUNK_SELECTOR
+ toEnum 24 = BCO
+ toEnum 25 = AP
+ toEnum 26 = PAP
+ toEnum 27 = AP_STACK
+ toEnum 28 = IND
+ toEnum 29 = IND_PERM
+ toEnum 30 = IND_STATIC
+ toEnum 31 = RET_BCO
+ toEnum 32 = RET_SMALL
+ toEnum 33 = RET_BIG
+ toEnum 34 = RET_DYN
+ toEnum 35 = RET_FUN
+ toEnum 36 = UPDATE_FRAME
+ toEnum 37 = CATCH_FRAME
+ toEnum 38 = STOP_FRAME
+ toEnum 39 = BLOCKING_QUEUE
+ toEnum 40 = BLACKHOLE
+ toEnum 41 = MVAR_CLEAN
+ toEnum 42 = MVAR_DIRTY
+ toEnum 43 = ARR_WORDS
+ toEnum 44 = MUT_ARR_PTRS_CLEAN
+ toEnum 45 = MUT_ARR_PTRS_DIRTY
+ toEnum 46 = MUT_ARR_PTRS_FROZEN0
+ toEnum 47 = MUT_ARR_PTRS_FROZEN
+ toEnum 48 = MUT_VAR_CLEAN
+ toEnum 49 = MUT_VAR_DIRTY
+ toEnum 50 = WEAK
+ toEnum 51 = PRIM
+ toEnum 52 = MUT_PRIM
+ toEnum 53 = TSO
+ toEnum 54 = TREC_CHUNK
+ toEnum 55 = ATOMICALLY_FRAME
+ toEnum 56 = CATCH_RETRY_FRAME
+ toEnum 57 = CATCH_STM_FRAME
+ toEnum 58 = WHITEHOLE
+ toEnum 59 = N_CLOSURE_TYPES
+ toEnum n = error ("toEnum: ClosureType: invalid ClosureType: " ++ show n)
+
diff --git a/src/GHC/Vacuum/ClosureType/V702.hs b/src/GHC/Vacuum/ClosureType/V702.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Vacuum/ClosureType/V702.hs
@@ -0,0 +1,196 @@
+module GHC.Vacuum.ClosureType.V702 ( ClosureType(..) ) where
+
+
+data ClosureType
+ = INVALID_OBJECT
+ | CONSTR
+ | CONSTR_1_0
+ | CONSTR_0_1
+ | CONSTR_2_0
+ | CONSTR_1_1
+ | CONSTR_0_2
+ | CONSTR_STATIC
+ | CONSTR_NOCAF_STATIC
+ | FUN
+ | FUN_1_0
+ | FUN_0_1
+ | FUN_2_0
+ | FUN_1_1
+ | FUN_0_2
+ | FUN_STATIC
+ | THUNK
+ | THUNK_1_0
+ | THUNK_0_1
+ | THUNK_2_0
+ | THUNK_1_1
+ | THUNK_0_2
+ | THUNK_STATIC
+ | THUNK_SELECTOR
+ | BCO
+ | AP
+ | PAP
+ | AP_STACK
+ | IND
+ | IND_PERM
+ | IND_STATIC
+ | RET_BCO
+ | RET_SMALL
+ | RET_BIG
+ | RET_DYN
+ | RET_FUN
+ | UPDATE_FRAME
+ | CATCH_FRAME
+ | UNDERFLOW_FRAME
+ | STOP_FRAME
+ | BLOCKING_QUEUE
+ | BLACKHOLE
+ | MVAR_CLEAN
+ | 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
+ | PRIM
+ | MUT_PRIM
+ | TSO
+ | STACK
+ | TREC_CHUNK
+ | ATOMICALLY_FRAME
+ | CATCH_RETRY_FRAME
+ | CATCH_STM_FRAME
+ | WHITEHOLE
+ | N_CLOSURE_TYPES
+ deriving (Eq, Ord, Show, Read)
+
+instance Enum ClosureType where
+ fromEnum INVALID_OBJECT = 0
+ fromEnum CONSTR = 1
+ fromEnum CONSTR_1_0 = 2
+ fromEnum CONSTR_0_1 = 3
+ fromEnum CONSTR_2_0 = 4
+ fromEnum CONSTR_1_1 = 5
+ fromEnum CONSTR_0_2 = 6
+ fromEnum CONSTR_STATIC = 7
+ fromEnum CONSTR_NOCAF_STATIC = 8
+ fromEnum FUN = 9
+ fromEnum FUN_1_0 = 10
+ fromEnum FUN_0_1 = 11
+ fromEnum FUN_2_0 = 12
+ fromEnum FUN_1_1 = 13
+ fromEnum FUN_0_2 = 14
+ fromEnum FUN_STATIC = 15
+ fromEnum THUNK = 16
+ fromEnum THUNK_1_0 = 17
+ fromEnum THUNK_0_1 = 18
+ fromEnum THUNK_2_0 = 19
+ fromEnum THUNK_1_1 = 20
+ fromEnum THUNK_0_2 = 21
+ fromEnum THUNK_STATIC = 22
+ fromEnum THUNK_SELECTOR = 23
+ fromEnum BCO = 24
+ fromEnum AP = 25
+ fromEnum PAP = 26
+ fromEnum AP_STACK = 27
+ fromEnum IND = 28
+ fromEnum IND_PERM = 29
+ fromEnum IND_STATIC = 30
+ fromEnum RET_BCO = 31
+ fromEnum RET_SMALL = 32
+ fromEnum RET_BIG = 33
+ fromEnum RET_DYN = 34
+ fromEnum RET_FUN = 35
+ fromEnum UPDATE_FRAME = 36
+ fromEnum CATCH_FRAME = 37
+ fromEnum UNDERFLOW_FRAME = 38
+ fromEnum STOP_FRAME = 39
+ fromEnum BLOCKING_QUEUE = 40
+ fromEnum BLACKHOLE = 41
+ fromEnum MVAR_CLEAN = 42
+ fromEnum MVAR_DIRTY = 43
+ fromEnum ARR_WORDS = 44
+ fromEnum MUT_ARR_PTRS_CLEAN = 45
+ fromEnum MUT_ARR_PTRS_DIRTY = 46
+ fromEnum MUT_ARR_PTRS_FROZEN0 = 47
+ fromEnum MUT_ARR_PTRS_FROZEN = 48
+ fromEnum MUT_VAR_CLEAN = 49
+ fromEnum MUT_VAR_DIRTY = 50
+ fromEnum WEAK = 51
+ fromEnum PRIM = 52
+ fromEnum MUT_PRIM = 53
+ fromEnum TSO = 54
+ fromEnum STACK = 55
+ fromEnum TREC_CHUNK = 56
+ fromEnum ATOMICALLY_FRAME = 57
+ fromEnum CATCH_RETRY_FRAME = 58
+ fromEnum CATCH_STM_FRAME = 59
+ fromEnum WHITEHOLE = 60
+ fromEnum N_CLOSURE_TYPES = 61
+
+ toEnum 0 = INVALID_OBJECT
+ toEnum 1 = CONSTR
+ toEnum 2 = CONSTR_1_0
+ toEnum 3 = CONSTR_0_1
+ toEnum 4 = CONSTR_2_0
+ toEnum 5 = CONSTR_1_1
+ toEnum 6 = CONSTR_0_2
+ toEnum 7 = CONSTR_STATIC
+ toEnum 8 = CONSTR_NOCAF_STATIC
+ toEnum 9 = FUN
+ toEnum 10 = FUN_1_0
+ toEnum 11 = FUN_0_1
+ toEnum 12 = FUN_2_0
+ toEnum 13 = FUN_1_1
+ toEnum 14 = FUN_0_2
+ toEnum 15 = FUN_STATIC
+ toEnum 16 = THUNK
+ toEnum 17 = THUNK_1_0
+ toEnum 18 = THUNK_0_1
+ toEnum 19 = THUNK_2_0
+ toEnum 20 = THUNK_1_1
+ toEnum 21 = THUNK_0_2
+ toEnum 22 = THUNK_STATIC
+ toEnum 23 = THUNK_SELECTOR
+ toEnum 24 = BCO
+ toEnum 25 = AP
+ toEnum 26 = PAP
+ toEnum 27 = AP_STACK
+ toEnum 28 = IND
+ toEnum 29 = IND_PERM
+ toEnum 30 = IND_STATIC
+ toEnum 31 = RET_BCO
+ toEnum 32 = RET_SMALL
+ toEnum 33 = RET_BIG
+ toEnum 34 = RET_DYN
+ toEnum 35 = RET_FUN
+ toEnum 36 = UPDATE_FRAME
+ toEnum 37 = CATCH_FRAME
+ toEnum 38 = UNDERFLOW_FRAME
+ toEnum 39 = STOP_FRAME
+ toEnum 40 = BLOCKING_QUEUE
+ toEnum 41 = BLACKHOLE
+ toEnum 42 = MVAR_CLEAN
+ toEnum 43 = MVAR_DIRTY
+ toEnum 44 = ARR_WORDS
+ toEnum 45 = MUT_ARR_PTRS_CLEAN
+ toEnum 46 = MUT_ARR_PTRS_DIRTY
+ toEnum 47 = MUT_ARR_PTRS_FROZEN0
+ toEnum 48 = MUT_ARR_PTRS_FROZEN
+ toEnum 49 = MUT_VAR_CLEAN
+ toEnum 50 = MUT_VAR_DIRTY
+ toEnum 51 = WEAK
+ toEnum 52 = PRIM
+ toEnum 53 = MUT_PRIM
+ toEnum 54 = TSO
+ toEnum 55 = STACK
+ toEnum 56 = TREC_CHUNK
+ toEnum 57 = ATOMICALLY_FRAME
+ toEnum 58 = CATCH_RETRY_FRAME
+ toEnum 59 = CATCH_STM_FRAME
+ toEnum 60 = WHITEHOLE
+ toEnum 61 = N_CLOSURE_TYPES
+ toEnum n = error ("toEnum: ClosureType: invalid ClosureType: " ++ show n)
+
diff --git a/src/GHC/Vacuum/ClosureType/V704.hs b/src/GHC/Vacuum/ClosureType/V704.hs
new file mode 100644
--- /dev/null
+++ b/src/GHC/Vacuum/ClosureType/V704.hs
@@ -0,0 +1,196 @@
+module GHC.Vacuum.ClosureType.V704 ( ClosureType(..) ) where
+
+
+data ClosureType
+ = INVALID_OBJECT
+ | CONSTR
+ | CONSTR_1_0
+ | CONSTR_0_1
+ | CONSTR_2_0
+ | CONSTR_1_1
+ | CONSTR_0_2
+ | CONSTR_STATIC
+ | CONSTR_NOCAF_STATIC
+ | FUN
+ | FUN_1_0
+ | FUN_0_1
+ | FUN_2_0
+ | FUN_1_1
+ | FUN_0_2
+ | FUN_STATIC
+ | THUNK
+ | THUNK_1_0
+ | THUNK_0_1
+ | THUNK_2_0
+ | THUNK_1_1
+ | THUNK_0_2
+ | THUNK_STATIC
+ | THUNK_SELECTOR
+ | BCO
+ | AP
+ | PAP
+ | AP_STACK
+ | IND
+ | IND_PERM
+ | IND_STATIC
+ | RET_BCO
+ | RET_SMALL
+ | RET_BIG
+ | RET_DYN
+ | RET_FUN
+ | UPDATE_FRAME
+ | CATCH_FRAME
+ | UNDERFLOW_FRAME
+ | STOP_FRAME
+ | BLOCKING_QUEUE
+ | BLACKHOLE
+ | MVAR_CLEAN
+ | 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
+ | PRIM
+ | MUT_PRIM
+ | TSO
+ | STACK
+ | TREC_CHUNK
+ | ATOMICALLY_FRAME
+ | CATCH_RETRY_FRAME
+ | CATCH_STM_FRAME
+ | WHITEHOLE
+ | N_CLOSURE_TYPES
+ deriving (Eq, Ord, Show, Read)
+
+instance Enum ClosureType where
+ fromEnum INVALID_OBJECT = 0
+ fromEnum CONSTR = 1
+ fromEnum CONSTR_1_0 = 2
+ fromEnum CONSTR_0_1 = 3
+ fromEnum CONSTR_2_0 = 4
+ fromEnum CONSTR_1_1 = 5
+ fromEnum CONSTR_0_2 = 6
+ fromEnum CONSTR_STATIC = 7
+ fromEnum CONSTR_NOCAF_STATIC = 8
+ fromEnum FUN = 9
+ fromEnum FUN_1_0 = 10
+ fromEnum FUN_0_1 = 11
+ fromEnum FUN_2_0 = 12
+ fromEnum FUN_1_1 = 13
+ fromEnum FUN_0_2 = 14
+ fromEnum FUN_STATIC = 15
+ fromEnum THUNK = 16
+ fromEnum THUNK_1_0 = 17
+ fromEnum THUNK_0_1 = 18
+ fromEnum THUNK_2_0 = 19
+ fromEnum THUNK_1_1 = 20
+ fromEnum THUNK_0_2 = 21
+ fromEnum THUNK_STATIC = 22
+ fromEnum THUNK_SELECTOR = 23
+ fromEnum BCO = 24
+ fromEnum AP = 25
+ fromEnum PAP = 26
+ fromEnum AP_STACK = 27
+ fromEnum IND = 28
+ fromEnum IND_PERM = 29
+ fromEnum IND_STATIC = 30
+ fromEnum RET_BCO = 31
+ fromEnum RET_SMALL = 32
+ fromEnum RET_BIG = 33
+ fromEnum RET_DYN = 34
+ fromEnum RET_FUN = 35
+ fromEnum UPDATE_FRAME = 36
+ fromEnum CATCH_FRAME = 37
+ fromEnum UNDERFLOW_FRAME = 38
+ fromEnum STOP_FRAME = 39
+ fromEnum BLOCKING_QUEUE = 40
+ fromEnum BLACKHOLE = 41
+ fromEnum MVAR_CLEAN = 42
+ fromEnum MVAR_DIRTY = 43
+ fromEnum ARR_WORDS = 44
+ fromEnum MUT_ARR_PTRS_CLEAN = 45
+ fromEnum MUT_ARR_PTRS_DIRTY = 46
+ fromEnum MUT_ARR_PTRS_FROZEN0 = 47
+ fromEnum MUT_ARR_PTRS_FROZEN = 48
+ fromEnum MUT_VAR_CLEAN = 49
+ fromEnum MUT_VAR_DIRTY = 50
+ fromEnum WEAK = 51
+ fromEnum PRIM = 52
+ fromEnum MUT_PRIM = 53
+ fromEnum TSO = 54
+ fromEnum STACK = 55
+ fromEnum TREC_CHUNK = 56
+ fromEnum ATOMICALLY_FRAME = 57
+ fromEnum CATCH_RETRY_FRAME = 58
+ fromEnum CATCH_STM_FRAME = 59
+ fromEnum WHITEHOLE = 60
+ fromEnum N_CLOSURE_TYPES = 61
+
+ toEnum 0 = INVALID_OBJECT
+ toEnum 1 = CONSTR
+ toEnum 2 = CONSTR_1_0
+ toEnum 3 = CONSTR_0_1
+ toEnum 4 = CONSTR_2_0
+ toEnum 5 = CONSTR_1_1
+ toEnum 6 = CONSTR_0_2
+ toEnum 7 = CONSTR_STATIC
+ toEnum 8 = CONSTR_NOCAF_STATIC
+ toEnum 9 = FUN
+ toEnum 10 = FUN_1_0
+ toEnum 11 = FUN_0_1
+ toEnum 12 = FUN_2_0
+ toEnum 13 = FUN_1_1
+ toEnum 14 = FUN_0_2
+ toEnum 15 = FUN_STATIC
+ toEnum 16 = THUNK
+ toEnum 17 = THUNK_1_0
+ toEnum 18 = THUNK_0_1
+ toEnum 19 = THUNK_2_0
+ toEnum 20 = THUNK_1_1
+ toEnum 21 = THUNK_0_2
+ toEnum 22 = THUNK_STATIC
+ toEnum 23 = THUNK_SELECTOR
+ toEnum 24 = BCO
+ toEnum 25 = AP
+ toEnum 26 = PAP
+ toEnum 27 = AP_STACK
+ toEnum 28 = IND
+ toEnum 29 = IND_PERM
+ toEnum 30 = IND_STATIC
+ toEnum 31 = RET_BCO
+ toEnum 32 = RET_SMALL
+ toEnum 33 = RET_BIG
+ toEnum 34 = RET_DYN
+ toEnum 35 = RET_FUN
+ toEnum 36 = UPDATE_FRAME
+ toEnum 37 = CATCH_FRAME
+ toEnum 38 = UNDERFLOW_FRAME
+ toEnum 39 = STOP_FRAME
+ toEnum 40 = BLOCKING_QUEUE
+ toEnum 41 = BLACKHOLE
+ toEnum 42 = MVAR_CLEAN
+ toEnum 43 = MVAR_DIRTY
+ toEnum 44 = ARR_WORDS
+ toEnum 45 = MUT_ARR_PTRS_CLEAN
+ toEnum 46 = MUT_ARR_PTRS_DIRTY
+ toEnum 47 = MUT_ARR_PTRS_FROZEN0
+ toEnum 48 = MUT_ARR_PTRS_FROZEN
+ toEnum 49 = MUT_VAR_CLEAN
+ toEnum 50 = MUT_VAR_DIRTY
+ toEnum 51 = WEAK
+ toEnum 52 = PRIM
+ toEnum 53 = MUT_PRIM
+ toEnum 54 = TSO
+ toEnum 55 = STACK
+ toEnum 56 = TREC_CHUNK
+ toEnum 57 = ATOMICALLY_FRAME
+ toEnum 58 = CATCH_RETRY_FRAME
+ toEnum 59 = CATCH_STM_FRAME
+ toEnum 60 = WHITEHOLE
+ toEnum 61 = N_CLOSURE_TYPES
+ toEnum n = error ("toEnum: ClosureType: invalid ClosureType: " ++ show n)
+
diff --git a/src/GHC/Vacuum/Internal.hs b/src/GHC/Vacuum/Internal.hs
--- a/src/GHC/Vacuum/Internal.hs
+++ b/src/GHC/Vacuum/Internal.hs
@@ -1,5 +1,15 @@
{-# LANGUAGE CPP, MagicHash, RankNTypes #-}
-
+-- |
+-- Module : GHC.Vacuum.Internal
+-- Copyright : (c) Matt Morrow 2009, Austin Seipp 2011-2012
+-- License : LGPLv3
+--
+-- Maintainer : mad.one@gmail.com
+-- Stability : experimental
+-- Portability : non-portable (GHC only)
+--
+-- Internal vacuum module. You probably shouldn't be here.
+--
module GHC.Vacuum.Internal (
HValue
,HalfWord
@@ -11,22 +21,13 @@
,hALF_WORD_SIZE
,S(..),get,gets,set,io,modify,runS
) where
-
+import Prelude hiding (mod)
import Data.Char
import Data.Word
-import Data.List
-import Data.IORef
-import Data.Array.IArray
-import Control.Monad
import Control.Monad.Fix
import Foreign
import Data.List
-import Data.Map(Map)
-import Data.Set(Set)
-import qualified Data.Set as S
-import qualified Data.Map as M
-import Data.Monoid(Monoid(..))
import GHC.Prim
import GHC.Exts
@@ -58,6 +59,7 @@
type StgWord = Word
-- hmmmmmm. Is there any way to tell this?
+opt_SccProfilingOn :: Bool
opt_SccProfilingOn = False
-- ghci> wORD_SIZE
@@ -112,7 +114,7 @@
#endif
]
- alignment itbl
+ alignment _
= SIZEOF_VOID_P
poke a0 itbl
@@ -135,24 +137,24 @@
#ifndef GHCI_TABLES_NEXT_TO_CODE
entry <- load
#endif
- ptrs <- load
- nptrs <- load
- tipe <- load
- srtlen <- load
+ ptrs' <- load
+ nptrs' <- load
+ tipe' <- load
+ srtlen' <- load
#ifdef GHCI_TABLES_NEXT_TO_CODE
- code <- sequence (replicate itblCodeLength load)
+ code' <- sequence (replicate itblCodeLength load)
#endif
return
StgInfoTable {
#ifndef GHCI_TABLES_NEXT_TO_CODE
entry = entry,
#endif
- ptrs = ptrs,
- nptrs = nptrs,
- tipe = tipe,
- srtlen = srtlen
+ ptrs = ptrs',
+ nptrs = nptrs',
+ tipe = tipe',
+ srtlen = srtlen'
#ifdef GHCI_TABLES_NEXT_TO_CODE
- ,code = code
+ ,code = code'
#endif
}
@@ -190,7 +192,7 @@
mfix f = S (\k s ->
uncurry k =<< mfix (\ ~(a,_) ->
-- the lazy pattern is ESSENTIAL, otherwise <>
- unS (f a) (\a s -> return (a,s)) s))
+ unS (f a) (\a' s' -> return (a',s')) s))
get :: S s s
get = S (\k s -> k s s)
gets :: (s -> a) -> S s a
@@ -205,8 +207,8 @@
runS (S g) = g (\a -> return . (,) a)
evalS :: S s a -> s -> IO a
evalS (S g) = g (\a _ -> return a)
-execS :: S s a -> s -> IO s
-execS (S g) = g (\_ -> return)
+--execS :: S s a -> s -> IO s
+--execS (S g) = g (\_ -> return)
-----------------------------------------------------------------------------
@@ -225,6 +227,7 @@
mkJumpToAddr :: Ptr () -> [ItblCode]
+ptrToInt :: Ptr a -> Int
ptrToInt (Ptr a#) = I# (addr2Int# a#)
#if sparc_TARGET_ARCH
@@ -357,6 +360,7 @@
stdInfoTableSizeB :: ByteOff
stdInfoTableSizeB = stdInfoTableSizeW * wORD_SIZE
+{--
stdSrtBitmapOffset :: ByteOff
-- Byte offset of the SRT bitmap half-word which is
-- in the *higher-addressed* part of the type_lit
@@ -369,7 +373,7 @@
stdPtrsOffset, stdNonPtrsOffset :: ByteOff
stdPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE
stdNonPtrsOffset = stdInfoTableSizeB - 2*wORD_SIZE + hALF_WORD_SIZE
-
+--}
------------------------------------------------
-- * This section is taken from Linker.lhs
diff --git a/src/GHC/Vacuum/Pretty.hs b/src/GHC/Vacuum/Pretty.hs
--- a/src/GHC/Vacuum/Pretty.hs
+++ b/src/GHC/Vacuum/Pretty.hs
@@ -1,24 +1,32 @@
+-- |
+-- Module : GHC.Vacuum.Pretty
+-- Copyright : (c) Matt Morrow 2009, Austin Seipp 2011-2012
+-- License : LGPLv3
+--
+-- Maintainer : mad.one@gmail.com
+-- Stability : experimental
+-- Portability : non-portable (GHC only)
+--
+--
+--
+{-# LANGUAGE RecordWildCards #-}
module GHC.Vacuum.Pretty (
module GHC.Vacuum.Pretty
- ,module GHC.Vacuum.Pretty.Dot
) where
+import Control.Arrow (second)
import Data.List
-import Data.IntMap(IntMap)
-import Data.Monoid(Monoid(..))
+import Data.IntMap (IntMap)
+import Data.Monoid (Monoid(..))
import qualified Data.IntMap as IM
-import Text.PrettyPrint(Doc,text,render)
---import Language.Haskell.Meta.Utils(pretty)
-import Control.Monad
-import GHC.Vacuum.Util
+import Control.Monad
import GHC.Vacuum.Types
-import GHC.Vacuum.Pretty.Dot
-----------------------------------------------------------------------------
toAdjPair :: (HNodeId, HNode) -> (Int, [Int])
-toAdjPair = mapsnd nodePtrs
+toAdjPair = second nodePtrs
toAdjList :: IntMap HNode -> [(Int, [Int])]
toAdjList = fmap toAdjPair . IM.toList
@@ -42,17 +50,6 @@
-----------------------------------------------------------------------------
---ppHs :: (Show a) => a -> Doc
---ppHs = text . pretty
-
-ppDot :: [(String, [String])] -> Doc
-ppDot = graphToDot id
-
-renderDot :: [(String, [String])] -> String
-renderDot = render . ppDot
-
------------------------------------------------------------------------------
-
-- | To assist in \"rendering\"
-- the graph to some source.
data Draw e v m a = Draw
@@ -64,12 +61,12 @@
deriving(Eq,Ord,Read,Show)
draw :: (Monad m) => Draw e v m a -> IntMap a -> m (G e v)
-draw (Draw mkV mkE succs) g = do
+draw Draw{..} g = do
vs <- IM.fromList `liftM` forM (IM.toList g)
(\(i,a) -> do v <- mkV i a
return (i,(v,succs a)))
(G . IM.fromList) `liftM` forM (IM.toList vs)
- (\(i,(v,ps)) -> do let us = fmap (vs IM.!) ps
+ (\(i,(v,ps)) -> do --let us = fmap (vs IM.!) ps
es <- IM.fromList `liftM` forM ps
(\p -> do e <- mkE v (fst (vs IM.! p))
return (p,e))
@@ -86,7 +83,7 @@
split :: (a -> [Int]) -> IntMap a -> IntMap ([Int],[Int])
split f = flip IM.foldWithKey mempty (\i a m ->
let ps = f a
- in foldl' (\m p -> IM.insertWith mappend p ([i],[]) m)
+ in foldl' (\m' p -> IM.insertWith mappend p ([i],[]) m')
(IM.insertWith mappend i ([],ps) m)
ps)
diff --git a/src/GHC/Vacuum/Pretty/Dot.hs b/src/GHC/Vacuum/Pretty/Dot.hs
deleted file mode 100644
--- a/src/GHC/Vacuum/Pretty/Dot.hs
+++ /dev/null
@@ -1,65 +0,0 @@
-module GHC.Vacuum.Pretty.Dot (
- graphToDot
- ,ppGraph,ppEdge,gStyle
--- ,Doc,text,render
-) where
-
-import Text.PrettyPrint
-
-------------------------------------------------
-
--- | .
-graphToDot :: (a -> String) -> [(a, [a])] -> Doc
-graphToDot f = ppGraph . fmap (f *** fmap f)
- where f *** g = \(a, b)->(f a, g b)
-
-------------------------------------------------
-
-gStyle :: String
-gStyle = unlines
- [" graph [rankdir=LR, splines=true];"
- ," node [label=\"\\N\", shape=none, fontcolor=blue, fontname=courier];"
- ," edge [color=black, style=dotted, fontname=courier, arrowname=onormal];"]
-
-ppGraph :: [(String, [String])] -> Doc
-ppGraph xs = (text "digraph g" <+> text "{")
- $+$ text gStyle
- $+$ nest indent (vcat . fmap ppEdge $ xs)
- $+$ text "}"
- where indent = 2
-
-ppEdge :: (String, [String]) -> Doc
-ppEdge (x,xs) = (dQText x) <+> (text "->")
- <+> (braces . hcat . punctuate semi
- . fmap dQText $ xs)
-
-dQText :: String -> Doc
-dQText = doubleQuotes . text
-
-{-
-import System.Cmd
-import System.Exit
-graphToDotPng :: FilePath -> [(String,[String])] -> IO Bool
-graphToDotPng fpre g = do
- let [dot,png] = fmap (fpre++) [".dot",".png"]
- writeFile dot
- . render . ppGraph
- -- . fmap (show***fmap show)
- $ g
- ((==ExitSuccess) `fmap`) .system . intercalate " " $
- -- ["cat",dot,"|","dot -Tpng",">",png,"2>/dev/null;","gliv",png,"&"]
- ["cat",dot,"|","dot -Tpng",">",png,"2>/dev/null;","display",png,"&"]
-
-graphToDotPdf :: FilePath -> [(String,[String])] -> IO Bool
-graphToDotPdf fpre g = do
- let [dot,png] = fmap (fpre++) [".dot",".pdf"]
- writeFile dot
- . render . ppGraph
- -- . fmap (show***fmap show)
- $ g
- ((==ExitSuccess) `fmap`) .system . intercalate " " $
- -- ["cat",dot,"|","dot -Tpng",">",png,"2>/dev/null;","gliv",png,"&"]
- ["cat",dot,"tred","|","dot -Tpdf",">",png,"2>/dev/null;","evince",png,"&"]
--}
-
-------------------------------------------------
diff --git a/src/GHC/Vacuum/Q.hs b/src/GHC/Vacuum/Q.hs
--- a/src/GHC/Vacuum/Q.hs
+++ b/src/GHC/Vacuum/Q.hs
@@ -1,21 +1,42 @@
{-# LANGUAGE BangPatterns, PostfixOperators #-}
-
-module GHC.Vacuum.Q (
- Ref,ref,(!),(.=),(!=)
- ,Q,isEmptyQ,newQ,putQ,takeQ,tryTakeQ
- ,drainQ,getQContents,takeWhileQ
-) where
+-- |
+-- Module : GHC.Vacuum.Q
+-- Copyright : (c) Matt Morrow 2009, Austin Seipp 2011-2012
+-- License : LGPLv3
+--
+-- Maintainer : mad.one@gmail.com
+-- Stability : experimental
+-- Portability : non-portable (GHC only)
+--
+--
+--
+module GHC.Vacuum.Q
+ ( Ref
+ , ref
+ , (!)
+ , (.=)
+ , (!=)
+ , Q
+ , isEmptyQ
+ , newQ
+ , putQ
+ , takeQ
+ , tryTakeQ
+ , drainQ
+ , getQContents
+ , takeWhileQ
+ ) where
+import Prelude hiding (last)
import Data.IORef
import Control.Monad
import Control.Concurrent
import Control.Applicative
-import System.IO.Unsafe(unsafeInterleaveIO)
+import System.IO.Unsafe (unsafeInterleaveIO)
------------------------------------------------
-newtype Ref a = Ref
- {unRef :: IORef a}
+newtype Ref a = Ref (IORef a)
ref :: a -> IO (Ref a)
ref a = Ref <$> newIORef a
@@ -72,7 +93,7 @@
return a
tryTakeQ :: Q a -> IO (Maybe a)
-tryTakeQ q@(Q rd _) = do
+tryTakeQ (Q rd _) = do
o <- tryTakeMVar rd
case o of
Nothing -> return Nothing
@@ -89,8 +110,8 @@
a <- tryTakeQ q
case a of
Nothing -> return []
- Just a -> do as <- unsafeInterleaveIO (drainQ q)
- return (a:as)
+ Just b -> do as <- unsafeInterleaveIO (drainQ q)
+ return (b:as)
getQContents :: Q a -> IO [a]
getQContents q = do
diff --git a/src/GHC/Vacuum/Types.hs b/src/GHC/Vacuum/Types.hs
--- a/src/GHC/Vacuum/Types.hs
+++ b/src/GHC/Vacuum/Types.hs
@@ -1,5 +1,16 @@
{-# LANGUAGE TypeSynonymInstances #-}
-
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- |
+-- Module : GHC.Vacuum.Types
+-- Copyright : (c) Matt Morrow 2009, Austin Seipp 2011-2012
+-- License : LGPLv3
+--
+-- Maintainer : mad.one@gmail.com
+-- Stability : experimental
+-- Portability : non-portable (GHC only)
+--
+--
+--
module GHC.Vacuum.Types (
module GHC.Vacuum.Types
) where
@@ -7,11 +18,9 @@
import GHC.Vacuum.ClosureType
import GHC.Vacuum.Internal(HValue)
-import Data.List
import Data.Word
import Data.IntMap(IntMap)
import Data.Monoid(Monoid(..))
-import qualified Data.IntMap as IM
import System.Mem.StableName
------------------------------------------------
@@ -39,8 +48,11 @@
nodeMod = snd3 . itabName . nodeInfo
nodeName = trd3 . itabName . nodeInfo
+fst3 :: (a, b, c) -> a
fst3 (x,_,_) = x
+snd3 :: (a, b, c) -> b
snd3 (_,x,_) = x
+trd3 :: (a, b, c) -> c
trd3 (_,_,x) = x
itabName :: InfoTab -> (String, String, String)
diff --git a/src/GHC/Vacuum/Util.hs b/src/GHC/Vacuum/Util.hs
deleted file mode 100644
--- a/src/GHC/Vacuum/Util.hs
+++ /dev/null
@@ -1,81 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-
-module GHC.Vacuum.Util (
- module GHC.Vacuum.Util
-) where
-
-import Data.List
-import Data.Char
-import Data.Bits
-import Data.Array.IArray hiding ((!))
-import qualified Data.Array.IArray as A
-
-hash :: String -> Int
-hash [] = 0
-hash s = go 0 (fmap ord s)
- where go !h [] = h
- go !h (n:ns) =
- let a = (h `shiftL` 4)
- b = a + n
- c = b .&. 0xf0000000
- !d = case c==0 of
- False -> let !e = c `shiftR` 24
- in b `xor` e
- True -> b
- !e = complement c
- !f = d .&. e
- in go f ns
-
-{-
-unsigned long
-elfhash(const char *s)
-{
- unsigned long h=0, g;
- while (*s){
- h = (h << 4) + *s++;
- if((g = h & 0xf0000000))
- h ^= g >> 24;
- h &= ~g;
- }
- return h;
-}
--}
-
-------------------------------------------------
-{-
-look :: HValue -> [(HValue, a)] -> Maybe a
-look _ [] = Nothing
-look hval ((x,i):xs)
- | hval .==. x = Just i
- | otherwise = look hval xs
-
-(.==.) :: HValue -> HValue -> Bool
-a .==. b = a `seq` b `seq`
- (0 /= I# (reallyUnsafePtrEquality# a b))
-
-lookLazy :: HValue -> [(HValue, a)] -> Maybe a
-lookLazy _ [] = Nothing
-lookLazy hval ((x,i):xs)
- | hval =.= x = Just i
- | otherwise = lookLazy hval xs
-
-(=.=) :: HValue -> HValue -> Bool
-a =.= b = (0 /= I# (reallyUnsafePtrEquality# a b))
-
-dumpArray :: Array Int a -> [a]
-dumpArray a = let (m,n) = bounds a
- in fmap (a A.!) [m..n]
--}
-
-mapfst f = \(a,b) -> (f a,b)
-mapsnd f = \(a,b) -> (a,f b)
-f *** g = \(a, b) -> (f a, g b)
-
-{-
-p2i :: Ptr a -> Int
-i2p :: Int -> Ptr a
-p2i (Ptr a#) = I# (addr2Int# a#)
-i2p (I# n#) = Ptr (int2Addr# n#)
--}
-
-------------------------------------------------
diff --git a/vacuum.cabal b/vacuum.cabal
--- a/vacuum.cabal
+++ b/vacuum.cabal
@@ -1,40 +1,64 @@
name: vacuum
-version: 1.0.0.2
-cabal-version: >= 1.6
-build-type: Simple
-license: LGPL
-license-file: LICENSE
-category: Debug, GHC
+version: 2.0.0.0
+synopsis: Graph representation of the GHC heap
+description:
+ Vacuum is a library for extracting graph representations of values
+ from the GHC heap at runtime. Those graphs may then be further
+ processed or translated to various representations for visualization --
+ like Graphviz, or Ubigraph.
+ .
+ By itself this library is not of much use to most users, unless you
+ want to use the raw graph data to visualize the heap in some (new)
+ way. Most people will want to translate the graph representation to
+ something like GraphViz format, which can then be rendered to a
+ pretty PNG or SVG file for viewing. See the @vacuum-graphviz@
+ package for more.
+homepage: http://thoughtpolice.github.com/vacuum
+bug-reports: http://github.com/thoughtpolice/vacuum/issues
+license: LGPL-3
+license-file: LICENSE.txt
+copyright: Copyright (c) Matt Morrow 2009,
+ (c) Austin Seipp 2011-2012
author: Matt Morrow
-copyright: (c) Matt Morrow 2009
--- Maintained through https://github.com/haskell-pkg-janitors. Join us!
-maintainer: Conrad Parker
-homepage: http://web.archive.org/web/20100410115820/http://moonpatio.com/vacuum/
+maintainer: Austin Seipp
+category: Debug, GHC
stability: experimental
-synopsis: Extract graph representations of ghc heap values.
-description:
-
-library
- hs-source-dirs: src
- ghc-options: -funbox-strict-fields
- extensions: CPP, BangPatterns
- includes: ghcautoconf.h
- build-depends: base==4.*, ghc-prim, array,
- containers, pretty
- -- haskell-src-meta
+build-type: Simple
+cabal-version: >= 1.10
+tested-with: GHC==7.2.1, GHC==7.4.2
- exposed-modules: GHC.Vacuum,
- GHC.Vacuum.ClosureType,
- GHC.Vacuum.Internal,
- GHC.Vacuum.Q,
- GHC.Vacuum.Types,
- GHC.Vacuum.Util,
- GHC.Vacuum.Pretty,
- GHC.Vacuum.Pretty.Dot
+extra-source-files:
+ AUTHORS.txt, README.md
-------------------------------------------------------------------------
--- Git repo
---
source-repository head
type: git
- location: git://github.com/haskell-pkg-janitors/vacuum.git
+ location: git://github.com/thoughtpolice/vacuum.git
+
+library
+ exposed-modules:
+ GHC.Vacuum
+ GHC.Vacuum.ClosureType
+ GHC.Vacuum.Internal
+ GHC.Vacuum.Q
+ GHC.Vacuum.Pretty
+ GHC.Vacuum.Types
+ build-depends:
+ ghc-prim,
+ base > 3 && < 5,
+ array >= 0.3,
+ containers >= 0.4
+ -- haskell-src-meta
+
+ -- We need the correct ClosureType definitions
+ if impl(ghc == 7.0.*)
+ exposed-modules: GHC.Vacuum.ClosureType.V700
+ if impl(ghc == 7.2.*)
+ exposed-modules: GHC.Vacuum.ClosureType.V702
+ if impl(ghc == 7.4.*)
+ exposed-modules: GHC.Vacuum.ClosureType.V704
+
+ hs-source-dirs: src
+ ghc-options: -Wall -O2 -fwarn-tabs -funbox-strict-fields
+ default-language: Haskell2010
+ default-extensions: CPP
+ includes: ghcautoconf.h