diff options
Diffstat (limited to 'testsuite/tests/ghc-api/T4891')
-rw-r--r-- | testsuite/tests/ghc-api/T4891/T4891.hs | 23 |
1 files changed, 12 insertions, 11 deletions
diff --git a/testsuite/tests/ghc-api/T4891/T4891.hs b/testsuite/tests/ghc-api/T4891/T4891.hs index b2f8cc464d..62edae0e78 100644 --- a/testsuite/tests/ghc-api/T4891/T4891.hs +++ b/testsuite/tests/ghc-api/T4891/T4891.hs @@ -5,8 +5,8 @@ import ByteCodeLink import CoreMonad import Data.Array import DataCon -import DebuggerUtils import GHC +import GHC.Exts.Heap import HscTypes import Linker import RtClosureInspect @@ -50,17 +50,18 @@ chaseConstructor :: (GhcMonad m) => HValue -> m () chaseConstructor !hv = do dflags <- getDynFlags liftIO $ putStrLn "=====" - closure <- liftIO $ getClosureData dflags hv - case tipe closure of - Indirection _ -> chaseConstructor (ptrs closure ! 0) - Constr -> do - withSession $ \hscEnv -> liftIO $ initTcForLookup hscEnv $ do - eDcname <- dataConInfoPtrToName (infoPtr closure) + 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 - liftIO $ putStrLn $ "Name: " ++ showPpr dflags dcName - liftIO $ putStrLn $ "OccString: " ++ "'" ++ getOccString dcName ++ "'" - dc <- tcLookupDataCon dcName - liftIO $ putStrLn $ "DataCon: " ++ showPpr dflags dc + putStrLn $ "Name: " ++ showPpr dflags dcName + putStrLn $ "OccString: " ++ "'" ++ getOccString dcName ++ "'" + dc <- ioLookupDataCon hscEnv dcName + putStrLn $ "DataCon: " ++ showPpr dflags dc _ -> return () |