content: {-# LANGUAGE BangPatterns #-}
  module Main where
  
  import GHC.ByteCode.Linker
  import GHC.Core.Opt.Monad
  import Data.Array
  import GHC.Core.DataCon
  import GHC
  import GHC.Exts.Heap
  import GHC.Driver.Ppr
  import GHC.Linker.Loader
  import GHC.Runtime.Heap.Inspect
  import GHC.Tc.Utils.Env
  import GHC.Core.Type
  import GHC.Tc.Utils.Monad
  import GHC.Tc.Utils.TcType
  import Control.Applicative
  import GHC.Types.Name (getOccString)
  import Unsafe.Coerce
  import Control.Monad
  import Data.Maybe
  import GHC.Data.Bag
  import GHC.Utils.Outputable
  import GHC.Driver.Monad
  import X
  
  import System.Environment
  
  main :: IO ()
  main = do [libdir] <- getArgs
            runGhc (Just libdir) doit
  
  doit :: Ghc ()
  doit = do
    dflags' <- getSessionDynFlags
    primPackages <- setSessionDynFlags dflags'
    dflags <- getSessionDynFlags
    target <- guessTarget "X.hs" Nothing Nothing
    setTargets [target]
    load LoadAllTargets
  
    () <- chaseConstructor (unsafeCoerce False)
    () <- chaseConstructor (unsafeCoerce [1,2,3])
    () <- chaseConstructor (unsafeCoerce (3 :-> 2))
    () <- chaseConstructor (unsafeCoerce (4 :->. 4))
    () <- chaseConstructor (unsafeCoerce (4 :->.+ 4))
    return ()
  
  chaseConstructor :: (GhcMonad m) => HValue -> m ()
  chaseConstructor !hv = do
    dflags <- getDynFlags
    liftIO $ putStrLn "====="
    closure <- liftIO $ getClosureData hv
    case closure of
      IndClosure{indirectee=ind} ->
        (\(Box a) -> chaseConstructor (unsafeCoerce a)) ind
      ConstrClosure{} -> do
        withSession $ \hscEnv -> liftIO $ do
          eDcname <- constrClosToName hscEnv closure
          case eDcname of
            Left _       -> return ()
            Right dcName -> do
              putStrLn $ "Name: "      ++ showPpr dflags dcName
              putStrLn $ "OccString: " ++ "'" ++ getOccString dcName ++ "'"
              dc <- lookupGlobal hscEnv dcName
              putStrLn $ "DataCon: "   ++ showPpr dflags dc
      _ -> return ()
  