diff --git a/haskell-debugger/GHC/Debugger/Runtime.hs b/haskell-debugger/GHC/Debugger/Runtime.hs index 76c1a6f..1116171 100644 --- a/haskell-debugger/GHC/Debugger/Runtime.hs +++ b/haskell-debugger/GHC/Debugger/Runtime.hs @@ -14,6 +14,20 @@ import GHC.Debugger.Runtime.Term.Key import GHC.Debugger.Runtime.Term.Cache import GHC.Debugger.Monad +import GHC.Core.TyCon +import GHC.Core.Type +import GHC.Types.Name +import GHC.Core.Class +import GHC.Core.InstEnv +import Debug.Trace +import qualified GHC.Linker.Loader as Loader +import GHC.Driver.Env +import GHC.Types.Var +import GHC.Driver.Config +import GHCi.Message +import GHC.Runtime.Interpreter +import GHC.Utils.Outputable + -- | Obtain the runtime 'Term' from a 'TermKey'. -- -- The 'TermKey' will be looked up in the 'TermCache' to avoid recomputing the @@ -73,4 +87,30 @@ isBoringTy :: Type -> Bool isBoringTy t = isDoubleTy t || isFloatTy t || isIntTy t || isWordTy t || isStringTy t || isIntegerTy t || isNaturalTy t || isCharTy t +onDebugInstance :: Term -> Type -> Debugger Bool +onDebugInstance term t = do + hsc_env <- getSession + instances <- getInstancesForType t + + case filter ((== "Debug") . occNameString . occName . tyConName . classTyCon . is_cls) instances of + (c:_) -> do + let methods = (classOpItems . is_cls) c + traceM ("Found Debug instance with methods: " ++ (show . map (occNameString . occName . fst)) methods ++ "") + case filter ((== "debugDisplayTree") . occNameString . occName . fst) methods of + (m:_) -> do + let dfun = is_dfun c + traceM $ "Dictionary function: " ++ showSDocUnsafe (ppr dfun) ++ " :: " ++ showSDocUnsafe (ppr (varType dfun)) + + let method_id = fst m :: Id + traceM $ "debugDisplayTree method: " ++ showSDocUnsafe (ppr method_id) ++ " :: " ++ showSDocUnsafe (ppr (varType method_id)) + + (method_hv, _, _) <- liftIO $ Loader.loadName (hscInterp hsc_env) hsc_env (GHC.Types.Var.varName method_id) + (dfun_hv, _, _) <- liftIO $ Loader.loadName (hscInterp hsc_env) hsc_env (GHC.Types.Var.varName dfun) + + -- this call fails + ev <- liftIO $ evalStmt (hscInterp hsc_env) (initEvalOpts (hsc_dflags hsc_env) EvalStepNone) (EvalApp (EvalApp (EvalThis method_hv) (EvalThis dfun_hv)) (EvalThis (val term))) + return True + [] -> return False + return False + _ -> return False diff --git a/haskell-debugger/GHC/Debugger/Stopped/Variables.hs b/haskell-debugger/GHC/Debugger/Stopped/Variables.hs index 57eeaae..c11d7f1 100644 --- a/haskell-debugger/GHC/Debugger/Stopped/Variables.hs +++ b/haskell-debugger/GHC/Debugger/Stopped/Variables.hs @@ -116,7 +116,9 @@ termToVarInfo key term0 = do -- Pass type as value for functions since actual value is useless varValue <- if isFn then pure $ " :: " ++ varType - else display =<< GHCD.showTerm (termHead term) + else do + _ <- onDebugInstance term ty + display =<< GHCD.showTerm (termHead term) -- liftIO $ print (varName, varType, varValue, GHCI.isFullyEvaluatedTerm term) -- The VarReference allows user to expand variable structure and inspect its value.