    -----------------------------------------------------------------------------
    --
    -- GHCi Interactive debugging commands
    --
    -- Pepe Iborra (supported by Google SoC) 2006
    --
    -- ToDo: lots of violation of layering here.  This module should
    -- decide whether it is above the GHC API (import GHC and nothing
    -- else) or below it.
    --
    -----------------------------------------------------------------------------

    module GHC.Runtime.Debugger (pprintClosureCommand, showTerm, pprTypeAndContents) where

    import GHC.Prelude

    import GHC

    import GHC.Driver.Session
    import GHC.Driver.Ppr
    import GHC.Driver.Monad
    import GHC.Driver.Env

    import GHC.Linker.Loader

    import GHC.Runtime.Heap.Inspect
    import GHC.Runtime.Interpreter
    import GHC.Runtime.Context

    import GHC.Iface.Syntax ( showToHeader )
    import GHC.Iface.Env    ( newInteractiveBinder )
    import GHC.Core.Type

    import GHC.Utils.Outputable
    import GHC.Utils.Error
    import GHC.Utils.Monad
    import GHC.Utils.Exception
    import GHC.Utils.Logger

    import GHC.Types.Id
    import GHC.Types.Name
    import GHC.Types.Var hiding ( varName )
    import GHC.Types.Var.Set
    import GHC.Types.Unique.Set
    import GHC.Types.TyThing.Ppr
    import GHC.Types.TyThing

    import Control.Monad
    import Control.Monad.Catch as MC
    import Data.List ( (\\) )
    import Data.Maybe
    import Data.IORef

    -------------------------------------
    -- | The :print & friends commands
    -------------------------------------
    pprintClosureCommand :: GhcMonad m => Bool -> Bool -> String -> m ()
    pprintClosureCommand :: forall (m :: * -> *). GhcMonad m => Bool -> Bool -> String -> m ()
    pprintClosureCommand Bool
    bindThings Bool
    force String
    str = do
      [TyThing]
    tythings <- (forall a. [Maybe a] -> [a]
    catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat) forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM`
                     forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\String
    w -> forall (m :: * -> *). GhcMonad m => String -> m [Name]
    GHC.parseName String
    w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>=
                                    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM forall (m :: * -> *). GhcMonad m => Name -> m (Maybe TyThing)
    GHC.lookupName)
                          (String -> [String]
    words String
    str)
      let ids :: [Id]
    ids = [Id
    id | AnId Id
    id <- [TyThing]
    tythings]

      -- Obtain the terms and the recovered type information
      (TCvSubst
    subst, [Term]
    terms) <- forall (m :: * -> *) acc x y.
    Monad m =>
    (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
    mapAccumLM forall (m :: * -> *).
    GhcMonad m =>
    TCvSubst -> Id -> m (TCvSubst, Term)
    go TCvSubst
    emptyTCvSubst [Id]
    ids

      -- Apply the substitutions obtained after recovering the types
      forall (m :: * -> *). GhcMonad m => (HscEnv -> HscEnv) -> m ()
    modifySession forall a b. (a -> b) -> a -> b
    $ \HscEnv
    hsc_env ->
        HscEnv
    hsc_env{hsc_IC :: InteractiveContext
    hsc_IC = InteractiveContext -> TCvSubst -> InteractiveContext
    substInteractiveContext (HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env) TCvSubst
    subst}

      -- Finally, print the Terms
      PrintUnqualified
    unqual  <- forall (m :: * -> *). GhcMonad m => m PrintUnqualified
    GHC.getPrintUnqual
      [SDoc]
    docterms <- forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM forall (m :: * -> *). GhcMonad m => Term -> m SDoc
    showTerm [Term]
    terms
      DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      Logger
    logger <- forall (m :: * -> *). HasLogger m => m Logger
    getLogger
      forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ (Logger -> DynFlags -> PrintUnqualified -> SDoc -> IO ()
    printOutputForUser Logger
    logger DynFlags
    dflags PrintUnqualified
    unqual forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [SDoc] -> SDoc
    vcat)
               (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\Id
    id SDoc
    docterm -> forall a. Outputable a => a -> SDoc
    ppr Id
    id SDoc -> SDoc -> SDoc
    <+> Char -> SDoc
    char Char
    '=' SDoc -> SDoc -> SDoc
    <+> SDoc
    docterm)
                        [Id]
    ids
                        [SDoc]
    docterms)
     where
       -- Do the obtainTerm--bindSuspensions-computeSubstitution dance
       go :: GhcMonad m => TCvSubst -> Id -> m (TCvSubst, Term)
       go :: forall (m :: * -> *).
    GhcMonad m =>
    TCvSubst -> Id -> m (TCvSubst, Term)
    go TCvSubst
    subst Id
    id = do
           let id' :: Id
    id' = (Type -> Type) -> Id -> Id
    updateIdTypeAndMult (HasCallStack => TCvSubst -> Type -> Type
    substTy TCvSubst
    subst) Id
    id
               id_ty' :: Type
    id_ty' = Id -> Type
    idType Id
    id'
           Term
    term_    <- forall (m :: * -> *). GhcMonad m => Int -> Bool -> Id -> m Term
    GHC.obtainTermFromId forall a. Bounded a => a
    maxBound Bool
    force Id
    id'
           Term
    term     <- forall (m :: * -> *). GhcMonad m => Term -> m Term
    tidyTermTyVars Term
    term_
           Term
    term'    <- if Bool
    bindThings
                         then forall (m :: * -> *). GhcMonad m => Term -> m Term
    bindSuspensions Term
    term
                         else forall (m :: * -> *) a. Monad m => a -> m a
    return Term
    term
         -- Before leaving, we compare the type obtained to see if it's more specific
         --  Then, we extract a substitution,
         --  mapping the old tyvars to the reconstructed types.
           let reconstructed_type :: Type
    reconstructed_type = Term -> Type
    termType Term
    term
           HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
           case (HscEnv -> Type -> Type -> Maybe TCvSubst
    improveRTTIType HscEnv
    hsc_env Type
    id_ty' Type
    reconstructed_type) of
             Maybe TCvSubst
    Nothing     -> forall (m :: * -> *) a. Monad m => a -> m a
    return (TCvSubst
    subst, Term
    term')
             Just TCvSubst
    subst' -> do { DynFlags
    dflags <- forall (m :: * -> *). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
                               ; Logger
    logger <- forall (m :: * -> *). HasLogger m => m Logger
    getLogger
                               ; forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $
                                   Logger
    -> DynFlags -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_rtti String
    "RTTI"
                                     DumpFormat
    FormatText
                                     ([SDoc] -> SDoc
    fsep forall a b. (a -> b) -> a -> b
    $ [String -> SDoc
    text String
    "RTTI Improvement for", forall a. Outputable a => a -> SDoc
    ppr Id
    id,
                                      String -> SDoc
    text String
    "old substitution:" , forall a. Outputable a => a -> SDoc
    ppr TCvSubst
    subst,
                                      String -> SDoc
    text String
    "new substitution:" , forall a. Outputable a => a -> SDoc
    ppr TCvSubst
    subst'])
                               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (TCvSubst
    subst TCvSubst -> TCvSubst -> TCvSubst
    `unionTCvSubst` TCvSubst
    subst', Term
    term')}

       tidyTermTyVars :: GhcMonad m => Term -> m Term
       tidyTermTyVars :: forall (m :: * -> *). GhcMonad m => Term -> m Term
    tidyTermTyVars Term
    t =
         forall (m :: * -> *) a. GhcMonad m => (HscEnv -> m a) -> m a
    withSession forall a b. (a -> b) -> a -> b
    $ \HscEnv
    hsc_env -> do
         let env_tvs :: TyCoVarSet
    env_tvs      = [TyThing] -> TyCoVarSet
    tyThingsTyCoVars forall a b. (a -> b) -> a -> b
    $ InteractiveContext -> [TyThing]
    ic_tythings forall a b. (a -> b) -> a -> b
    $ HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env
             my_tvs :: TyCoVarSet
    my_tvs       = Term -> TyCoVarSet
    termTyCoVars Term
    t
             tvs :: TyCoVarSet
    tvs          = TyCoVarSet
    env_tvs TyCoVarSet -> TyCoVarSet -> TyCoVarSet
    `minusVarSet` TyCoVarSet
    my_tvs
             tyvarOccName :: Id -> OccName
    tyvarOccName = Name -> OccName
    nameOccName forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Name
    tyVarName
             tidyEnv :: (TidyOccEnv, UniqFM Id Id)
    tidyEnv      = ([OccName] -> TidyOccEnv
    initTidyOccEnv (forall a b. (a -> b) -> [a] -> [b]
    map Id -> OccName
    tyvarOccName (forall elt. UniqSet elt -> [elt]
    nonDetEltsUniqSet TyCoVarSet
    tvs))
               -- It's OK to use nonDetEltsUniqSet here because initTidyOccEnv
               -- forgets the ordering immediately by creating an env
                            , forall a. UniqSet a -> UniqFM a a
    getUniqSet forall a b. (a -> b) -> a -> b
    $ TyCoVarSet
    env_tvs TyCoVarSet -> TyCoVarSet -> TyCoVarSet
    `intersectVarSet` TyCoVarSet
    my_tvs)
         forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ (Type -> Type) -> Term -> Term
    mapTermType (forall a b. (a, b) -> b
    snd forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (TidyOccEnv, UniqFM Id Id)
    -> Type -> ((TidyOccEnv, UniqFM Id Id), Type)
    tidyOpenType (TidyOccEnv, UniqFM Id Id)
    tidyEnv) Term
    t

    -- | Give names, and bind in the interactive environment, to all the suspensions
    --   included (inductively) in a term
    bindSuspensions :: GhcMonad m => Term -> m Term
    bindSuspensions :: forall (m :: * -> *). GhcMonad m => Term -> m Term
    bindSuspensions Term
    t = do
          HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
          [TyThing]
    inScope <- forall (m :: * -> *). GhcMonad m => m [TyThing]
    GHC.getBindings
          let ictxt :: InteractiveContext
    ictxt        = HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env
              prefix :: String
    prefix       = String
    "_t"
              alreadyUsedNames :: [String]
    alreadyUsedNames = forall a b. (a -> b) -> [a] -> [b]
    map (OccName -> String
    occNameString forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> OccName
    nameOccName forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. NamedThing a => a -> Name
    getName) [TyThing]
    inScope
              availNames :: [String]
    availNames   = forall a b. (a -> b) -> [a] -> [b]
    map ((String
    prefixforall a. [a] -> [a] -> [a]
    ++) forall b c a. (b -> c) -> (a -> b) -> a -> c
    . forall a. Show a => a -> String
    show) [(Int
    1::Int)..] forall a. Eq a => [a] -> [a] -> [a]
    \\ [String]
    alreadyUsedNames
          IORef [String]
    availNames_var  <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ forall a. a -> IO (IORef a)
    newIORef [String]
    availNames
          (Term
    t', [(Name, Type, ForeignHValue)]
    stuff)     <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ forall a. TermFold a -> Term -> a
    foldTerm (HscEnv
    -> IORef [String]
    -> TermFold (IO (Term, [(Name, Type, ForeignHValue)]))
    nameSuspensionsAndGetInfos HscEnv
    hsc_env IORef [String]
    availNames_var) Term
    t
          let ([Name]
    names, [Type]
    tys, [ForeignHValue]
    fhvs) = forall a b c. [(a, b, c)] -> ([a], [b], [c])
    unzip3 [(Name, Type, ForeignHValue)]
    stuff
          let ids :: [Id]
    ids = [ Name -> Type -> Id
    mkVanillaGlobal Name
    name Type
    ty
                    | (Name
    name,Type
    ty) <- forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    names [Type]
    tys]
              new_ic :: InteractiveContext
    new_ic = InteractiveContext -> [Id] -> InteractiveContext
    extendInteractiveContextWithIds InteractiveContext
    ictxt [Id]
    ids
              interp :: Interp
    interp = HscEnv -> Interp
    hscInterp HscEnv
    hsc_env
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ Interp -> [(Name, ForeignHValue)] -> IO ()
    extendLoadedEnv Interp
    interp (forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    names [ForeignHValue]
    fhvs)
          forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
    setSession HscEnv
    hsc_env {hsc_IC :: InteractiveContext
    hsc_IC = InteractiveContext
    new_ic }
          forall (m :: * -> *) a. Monad m => a -> m a
    return Term
    t'
         where

    --    Processing suspensions. Give names and recopilate info
            nameSuspensionsAndGetInfos :: HscEnv -> IORef [String]
                                       -> TermFold (IO (Term, [(Name,Type,ForeignHValue)]))
            nameSuspensionsAndGetInfos :: HscEnv
    -> IORef [String]
    -> TermFold (IO (Term, [(Name, Type, ForeignHValue)]))
    nameSuspensionsAndGetInfos HscEnv
    hsc_env IORef [String]
    freeNames = TermFold
                          {
                            fSuspension :: ClosureType
    -> Type
    -> ForeignHValue
    -> Maybe Name
    -> IO (Term, [(Name, Type, ForeignHValue)])
    fSuspension = forall {p}.
    HscEnv
    -> IORef [String]
    -> ClosureType
    -> Type
    -> ForeignHValue
    -> p
    -> IO (Term, [(Name, Type, ForeignHValue)])
    doSuspension HscEnv
    hsc_env IORef [String]
    freeNames
                          , fTerm :: TermProcessor
      (IO (Term, [(Name, Type, ForeignHValue)]))
      (IO (Term, [(Name, Type, ForeignHValue)]))
    fTerm = \Type
    ty Either String DataCon
    dc ForeignHValue
    v [IO (Term, [(Name, Type, ForeignHValue)])]
    tt -> do
                                        [(Term, [(Name, Type, ForeignHValue)])]
    tt' <- forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [IO (Term, [(Name, Type, ForeignHValue)])]
    tt
                                        let ([Term]
    terms,[[(Name, Type, ForeignHValue)]]
    names) = forall a b. [(a, b)] -> ([a], [b])
    unzip [(Term, [(Name, Type, ForeignHValue)])]
    tt'
                                        forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> Either String DataCon -> ForeignHValue -> [Term] -> Term
    Term Type
    ty Either String DataCon
    dc ForeignHValue
    v [Term]
    terms, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(Name, Type, ForeignHValue)]]
    names)
                          , fPrim :: Type -> [Word] -> IO (Term, [(Name, Type, ForeignHValue)])
    fPrim    = \Type
    ty [Word]
    n ->forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> [Word] -> Term
    Prim Type
    ty [Word]
    n,[])
                          , fNewtypeWrap :: Type
    -> Either String DataCon
    -> IO (Term, [(Name, Type, ForeignHValue)])
    -> IO (Term, [(Name, Type, ForeignHValue)])
    fNewtypeWrap  =
                                    \Type
    ty Either String DataCon
    dc IO (Term, [(Name, Type, ForeignHValue)])
    t -> do
                                        (Term
    term, [(Name, Type, ForeignHValue)]
    names) <- IO (Term, [(Name, Type, ForeignHValue)])
    t
                                        forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> Either String DataCon -> Term -> Term
    NewtypeWrap Type
    ty Either String DataCon
    dc Term
    term, [(Name, Type, ForeignHValue)]
    names)
                          , fRefWrap :: Type
    -> IO (Term, [(Name, Type, ForeignHValue)])
    -> IO (Term, [(Name, Type, ForeignHValue)])
    fRefWrap = \Type
    ty IO (Term, [(Name, Type, ForeignHValue)])
    t -> do
                                        (Term
    term, [(Name, Type, ForeignHValue)]
    names) <- IO (Term, [(Name, Type, ForeignHValue)])
    t
                                        forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> Term -> Term
    RefWrap Type
    ty Term
    term, [(Name, Type, ForeignHValue)]
    names)
                          }
            doSuspension :: HscEnv
    -> IORef [String]
    -> ClosureType
    -> Type
    -> ForeignHValue
    -> p
    -> IO (Term, [(Name, Type, ForeignHValue)])
    doSuspension HscEnv
    hsc_env IORef [String]
    freeNames ClosureType
    ct Type
    ty ForeignHValue
    hval p
    _name = do
              String
    name <- forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef' IORef [String]
    freeNames (\[String]
    x->(forall a. [a] -> [a]
    tail [String]
    x, forall a. [a] -> a
    head [String]
    x))
              Name
    n <- forall (m :: * -> *). MonadIO m => HscEnv -> String -> m Name
    newGrimName HscEnv
    hsc_env String
    name
              forall (m :: * -> *) a. Monad m => a -> m a
    return (ClosureType -> Type -> ForeignHValue -> Maybe Name -> Term
    Suspension ClosureType
    ct Type
    ty ForeignHValue
    hval (forall a. a -> Maybe a
    Just Name
    n), [(Name
    n,Type
    ty,ForeignHValue
    hval)])

    --  A custom Term printer to enable the use of Show instances
    showTerm :: GhcMonad m => Term -> m SDoc
    showTerm :: forall (m :: * -> *). GhcMonad m => Term -> m SDoc
    showTerm Term
    term = do
        DynFlags
    dflags       <- forall (m :: * -> *). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
        if GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_PrintEvldWithShow DynFlags
    dflags
           then forall (m :: * -> *).
    Monad m =>
    CustomTermPrinter m -> Term -> m SDoc
    cPprTerm (forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 forall a. [a] -> [a] -> [a]
    (++) (\TermPrinterM m
    _y->[forall {m :: * -> *} {t}.
    (GhcMonad m, Ord t, Num t) =>
    t -> Term -> m (Maybe SDoc)
    cPprShowable]) forall (m :: * -> *). Monad m => CustomTermPrinter m
    cPprTermBase) Term
    term
           else forall (m :: * -> *).
    Monad m =>
    CustomTermPrinter m -> Term -> m SDoc
    cPprTerm forall (m :: * -> *). Monad m => CustomTermPrinter m
    cPprTermBase Term
    term
     where
      cPprShowable :: t -> Term -> m (Maybe SDoc)
    cPprShowable t
    prec t :: Term
    t@Term{ty :: Term -> Type
    ty=Type
    ty, val :: Term -> ForeignHValue
    val=ForeignHValue
    fhv} =
        if Bool -> Bool
    not (Term -> Bool
    isFullyEvaluatedTerm Term
    t)
         then forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing
         else do
            let set_session :: m (HscEnv, Name)
    set_session = do
                    HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
                    (HscEnv
    new_env, Name
    bname) <- forall {m :: * -> *}.
    MonadIO m =>
    HscEnv -> Type -> String -> m (HscEnv, Name)
    bindToFreshName HscEnv
    hsc_env Type
    ty String
    "showme"
                    forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
    setSession HscEnv
    new_env

                    -- this disables logging of errors
                    let noop_log :: p -> p -> p -> p -> p -> m ()
    noop_log p
    _ p
    _ p
    _ p
    _ p
    _ = forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                    forall (m :: * -> *).
    GhcMonad m =>
    (LogAction -> LogAction) -> m ()
    pushLogHookM (forall a b. a -> b -> a
    const forall {m :: * -> *} {p} {p} {p} {p} {p}.
    Monad m =>
    p -> p -> p -> p -> p -> m ()
    noop_log)

                    forall (m :: * -> *) a. Monad m => a -> m a
    return (HscEnv
    hsc_env, Name
    bname)

                reset_session :: (HscEnv, b) -> m ()
    reset_session (HscEnv
    old_env,b
    _) = forall (m :: * -> *). GhcMonad m => HscEnv -> m ()
    setSession HscEnv
    old_env

            forall (m :: * -> *) a c b.
    MonadMask m =>
    m a -> (a -> m c) -> (a -> m b) -> m b
    MC.bracket m (HscEnv, Name)
    set_session forall {m :: * -> *} {b}. GhcMonad m => (HscEnv, b) -> m ()
    reset_session forall a b. (a -> b) -> a -> b
    $ \(HscEnv
    _,Name
    bname) -> do
               HscEnv
    hsc_env <- forall (m :: * -> *). GhcMonad m => m HscEnv
    getSession
               DynFlags
    dflags  <- forall (m :: * -> *). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
               let expr :: String
    expr = String
    "Prelude.return (Prelude.show " forall a. [a] -> [a] -> [a]
    ++
                             forall a. Outputable a => DynFlags -> a -> String
    showPpr DynFlags
    dflags Name
    bname forall a. [a] -> [a] -> [a]
    ++
                          String
    ") :: Prelude.IO Prelude.String"
                   interp :: Interp
    interp = HscEnv -> Interp
    hscInterp HscEnv
    hsc_env
               ForeignHValue
    txt_ <- forall (m :: * -> *) a.
    ExceptionMonad m =>
    Interp -> [(Name, ForeignHValue)] -> m a -> m a
    withExtendedLoadedEnv Interp
    interp
                                           [(Name
    bname, ForeignHValue
    fhv)]
                                           (forall (m :: * -> *). GhcMonad m => String -> m ForeignHValue
    GHC.compileExprRemote String
    expr)
               let myprec :: t
    myprec = t
    10 -- application precedence. TODO Infix constructors
               String
    txt <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ Interp -> ForeignHValue -> IO String
    evalString Interp
    interp ForeignHValue
    txt_
               if Bool -> Bool
    not (forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    txt) then
                 forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall a. a -> Maybe a
    Just forall a b. (a -> b) -> a -> b
    $ Bool -> SDoc -> SDoc
    cparen (t
    prec forall a. Ord a => a -> a -> Bool
    >= t
    myprec Bool -> Bool -> Bool
    && String -> Bool
    needsParens String
    txt)
                                        (String -> SDoc
    text String
    txt)
                else forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing

      cPprShowable t
    prec NewtypeWrap{ty :: Term -> Type
    ty=Type
    new_ty,wrapped_term :: Term -> Term
    wrapped_term=Term
    t} =
          t -> Term -> m (Maybe SDoc)
    cPprShowable t
    prec Term
    t{ty :: Type
    ty=Type
    new_ty}
      cPprShowable t
    _ Term
    _ = forall (m :: * -> *) a. Monad m => a -> m a
    return forall a. Maybe a
    Nothing

      needsParens :: String -> Bool
    needsParens (Char
    '"':String
    _) = Bool
    False   -- some simple heuristics to see whether parens
                                    -- are redundant in an arbitrary Show output
      needsParens (Char
    '(':String
    _) = Bool
    False
      needsParens String
    txt = Char
    ' ' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    txt

      bindToFreshName :: HscEnv -> Type -> String -> m (HscEnv, Name)
    bindToFreshName HscEnv
    hsc_env Type
    ty String
    userName = do
        Name
    name <- forall (m :: * -> *). MonadIO m => HscEnv -> String -> m Name
    newGrimName HscEnv
    hsc_env String
    userName
        let id :: Id
    id       = Name -> Type -> Id
    mkVanillaGlobal Name
    name Type
    ty
            new_ic :: InteractiveContext
    new_ic   = InteractiveContext -> [Id] -> InteractiveContext
    extendInteractiveContextWithIds (HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env) [Id
    id]
        forall (m :: * -> *) a. Monad m => a -> m a
    return (HscEnv
    hsc_env {hsc_IC :: InteractiveContext
    hsc_IC = InteractiveContext
    new_ic }, Name
    name)

    --    Create new uniques and give them sequentially numbered names
    newGrimName :: MonadIO m => HscEnv -> String -> m Name
    newGrimName :: forall (m :: * -> *). MonadIO m => HscEnv -> String -> m Name
    newGrimName HscEnv
    hsc_env String
    userName
      = forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (HscEnv -> OccName -> SrcSpan -> IO Name
    newInteractiveBinder HscEnv
    hsc_env OccName
    occ SrcSpan
    noSrcSpan)
      where
        occ :: OccName
    occ = NameSpace -> String -> OccName
    mkOccName NameSpace
    varName String
    userName

    pprTypeAndContents :: GhcMonad m => Id -> m SDoc
    pprTypeAndContents :: forall (m :: * -> *). GhcMonad m => Id -> m SDoc
    pprTypeAndContents Id
    id = do
      DynFlags
    dflags  <- forall (m :: * -> *). GhcMonad m => m DynFlags
    GHC.getSessionDynFlags
      let pcontents :: Bool
    pcontents = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_PrintBindContents DynFlags
    dflags
          pprdId :: SDoc
    pprdId    = (ShowSub -> TyThing -> SDoc
    pprTyThing ShowSub
    showToHeader forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> TyThing
    AnId) Id
    id
      if Bool
    pcontents
        then do
          let depthBound :: Int
    depthBound = Int
    100
          -- If the value is an exception, make sure we catch it and
          -- show the exception, rather than propagating the exception out.
          Either SomeException Term
    e_term <- forall (m :: * -> *) e a.
    (MonadCatch m, Exception e) =>
    m a -> m (Either e a)
    MC.try forall a b. (a -> b) -> a -> b
    $ forall (m :: * -> *). GhcMonad m => Int -> Bool -> Id -> m Term
    GHC.obtainTermFromId Int
    depthBound Bool
    False Id
    id
          SDoc
    docs_term <- case Either SomeException Term
    e_term of
                          Right Term
    term -> forall (m :: * -> *). GhcMonad m => Term -> m SDoc
    showTerm Term
    term
                          Left  SomeException
    exn  -> forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> SDoc
    text String
    "*** Exception:" SDoc -> SDoc -> SDoc
    <+>
                                                String -> SDoc
    text (forall a. Show a => a -> String
    show (SomeException
    exn :: SomeException)))
          forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ SDoc
    pprdId SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> SDoc
    docs_term
        else forall (m :: * -> *) a. Monad m => a -> m a
    return SDoc
    pprdId