Demo.hs

   1 {-# LANGUAGE MagicHash, BangPatterns #-}
   2
   3 import GHC.Exts
   4 import GHC.HeapView
   5 import Control.DeepSeq
   6
   7 import System.Environment
   8 import System.Mem
   9
  10 l = [1,2,3]
  11
  12 main = do
  13     args <- map length `fmap` getArgs
  14     let l2 = 4:l
  15     (l ++ l2 ++ args) `deepseq` return ()
  16
  17     let x = l ++ l2 ++ args
  18     performGC
  19     putStrLn "ghc-heap-view-demo"
  20     putStrLn ""
  21     putStrLn "Here are a four different lists, where the first three are already evaluated."
  22     putStrLn "The first one, l, was defined as a top level constant as "
  23     putStrLn "> l = [1,2,3]"
  24     putStrLn $ "and is now found at " ++ show (asBox l) ++ " (where the /2 is the pointer tag information) and fully evaluated:"
  25     getClosureData l >>= printInd
  26     putStrLn $ "The second one, l2, is locally defined"
  27     putStrLn "> let l2 = 4:l"
  28     putStrLn $ "and now found at " ++ show (asBox l2) ++ ". See how the cons-cell references l!"
  29     getClosureData l2 >>= printInd
  30     putStrLn "And the binding"
  31     putStrLn "> args <- map length `fmap` getArgs"
  32     putStrLn $ "gives us at " ++ show (asBox args) ++ " a static, but at compile time unknown list:"
  33     getClosureData args >>= printInd
  34     getClosureData [] >>= printInd
  35     putStrLn $ "And now we have, at " ++ show (asBox x) ++ ", the concatenation of them, but unevaluated:"
  36     putStrLn "> let x = l ++ l2 ++ args"
  37     putStrLn "The thunk keeps a reference to l2 and args, but not l, as that is at a static address, unless you are running this in GHCi:"
  38     getClosureData x >>= printInd
  39
  40     putStrLn ""
  41     putStrLn "Now to some more closure types. m and m' locally bound of type the unboxed type Int#, with values 42 resp. 23."
  42     putStrLn "> let f = \\x n -> take (I# m + I# x) n ++ args"
  43     putStrLn "      t = f m' l2"
  44     let !(I# m) = length args + 42
  45     let !(I# m') = length args + 23
  46     let f = \x n -> take (I# m + I# x) n ++ args
  47         t = f m' l2
  48     putStrLn $ "So here is (" ++ show (asBox f) ++ "), referencing its free variables args and 42:"
  49     getClosureData f >>= printInd
  50     putStrLn "And t is a thunk that applies f (also referenced here) to an unboxed value (23) and l2:"
  51     getClosureData t >>= printInd
  52
  53     putStrLn ""
  54     putStrLn "Lastly, here is the standard example for self reference:"
  55     putStrLn "> let x = id (:) () x"
  56     let x = id (:) () x
  57     putStrLn $ "This is what x (" ++ show (asBox x) ++ ") looks like, at least without -O:"
  58     getClosureData x >>= printInd
  59     x `seq` return ()
  60     putStrLn $ "So it is unevaluated. Let us evaluate it using seq. Now we have, still at " ++ show (asBox x) ++ ":"
  61     getClosureData x >>= printInd
  62     IndClosure {indirectee = target} <- getClosureData x
  63     putStrLn $ "The thunk was replaced by an indirection. If we look at the target, " ++ show target ++ ", we see that it is a newly created cons-cell referencing the original location of x:"
  64     getBoxedClosureData target >>= printInd
  65     performGC
  66     putStrLn $ "After running the garbage collector (performGC), we find that the address of x is now " ++ show (asBox x) ++ " and that the self-reference is without indirections:"
  67     getClosureData x >>= printInd
  68
  69 printInd :: Show a => a -> IO ()
  70 printInd x = putStrLn $ "    " ++ show x
  71
  72 recurse :: Int -> Box -> IO ()
  73 recurse m = go 0
  74   where go i b = if i >= m then return () else do
  75             putStrLn $ ind ++ show b
  76             c <- getBoxedClosureData b
  77             putStrLn $ ind ++ show c
  78             mapM_ (go (succ i)) (allPtrs c)
  79           where
  80             ind = concat $ replicate i "  "