compiler/main/InteractiveEval.hs

   1 -- -----------------------------------------------------------------------------
   2 --
   3 -- (c) The University of Glasgow, 2005-2007
   4 --
   5 -- Running statements interactively
   6 --
   7 -- -----------------------------------------------------------------------------
   8
   9 module InteractiveEval (
  10 #ifdef GHCI
  11         RunResult(..), Status(..), Resume(..),
  12         runStmt, stepStmt, -- traceStmt,
  13         resume,  stepResume, -- traceResume,
  14         abandon, abandonAll,
  15         getResumeContext,
  16         setContext, getContext,
  17         nameSetToGlobalRdrEnv,
  18         getNamesInScope,
  19         getRdrNamesInScope,
  20         moduleIsInterpreted,
  21         getInfo,
  22         exprType,
  23         typeKind,
  24         parseName,
  25         showModule,
  26         isModuleInterpreted,
  27         compileExpr, dynCompileExpr,
  28         lookupName,
  29         obtainTerm, obtainTerm1
  30 #endif
  31         ) where
  32
  33 #ifdef GHCI
  34
  35 #include "HsVersions.h"
  36
  37 import HscMain          hiding (compileExpr)
  38 import HscTypes
  39 import TcRnDriver
  40 import Type             hiding (typeKind)
  41 import TcType           hiding (typeKind)
  42 import InstEnv
  43 import Var              hiding (setIdType)
  44 import Id
  45 import IdInfo
  46 import Name             hiding ( varName )
  47 import NameSet
  48 import RdrName
  49 import VarSet
  50 import VarEnv
  51 import ByteCodeInstr
  52 import Linker
  53 import DynFlags
  54 import Unique
  55 import Module
  56 import Panic
  57 import UniqFM
  58 import Maybes
  59 import Util
  60 import SrcLoc
  61 import RtClosureInspect
  62 import Packages
  63 import BasicTypes
  64 import Outputable
  65
  66 import Data.Dynamic
  67 import Control.Monad
  68 import Foreign
  69 import GHC.Exts
  70 import Data.Array
  71 import Control.Exception as Exception
  72 import Control.Concurrent
  73 import Data.IORef
  74 import Foreign.StablePtr
  75
  76 -- -----------------------------------------------------------------------------
  77 -- running a statement interactively
  78
  79 data RunResult
  80   = RunOk [Name]                -- ^ names bound by this evaluation
  81   | RunFailed                   -- ^ statement failed compilation
  82   | RunException Exception      -- ^ statement raised an exception
  83   | RunBreak ThreadId [Name] BreakInfo
  84
  85 data Status
  86    = Break HValue BreakInfo ThreadId
  87           -- ^ the computation hit a breakpoint
  88    | Complete (Either Exception [HValue])
  89           -- ^ the computation completed with either an exception or a value
  90
  91 data Resume
  92    = Resume {
  93        resumeStmt      :: String,       -- the original statement
  94        resumeThreadId  :: ThreadId,     -- thread running the computation
  95        resumeBreakMVar :: MVar (),
  96        resumeStatMVar  :: MVar Status,
  97        resumeBindings  :: ([Id], TyVarSet),
  98        resumeFinalIds  :: [Id],         -- [Id] to bind on completion
  99        resumeApStack   :: HValue,       -- The object from which we can get
 100                                         -- value of the free variables.
 101        resumeBreakInfo :: BreakInfo,    -- the breakpoint we stopped at.
 102        resumeSpan      :: SrcSpan       -- just a cache, otherwise it's a pain
 103                                         -- to fetch the ModDetails & ModBreaks
 104                                         -- to get this.
 105    }
 106
 107 getResumeContext :: Session -> IO [Resume]
 108 getResumeContext s = withSession s (return . ic_resume . hsc_IC)
 109
 110 data SingleStep
 111    = RunToCompletion
 112    | SingleStep
 113    | RunAndLogSteps
 114
 115 isStep RunToCompletion = False
 116 isStep _ = True
 117
 118 -- type History = [HistoryItem]
 119 --
 120 -- data HistoryItem = HistoryItem HValue BreakInfo
 121 --
 122 -- historyBreakInfo :: HistoryItem -> BreakInfo
 123 -- historyBreakInfo (HistoryItem _ bi) = bi
 124 --
 125 -- setContextToHistoryItem :: Session -> HistoryItem -> IO ()
 126 -- setContextToHistoryItem
 127
 128 -- We need to track two InteractiveContexts:
 129 --      - the IC before runStmt, which is restored on each resume
 130 --      - the IC binding the results of the original statement, which
 131 --        will be the IC when runStmt returns with RunOk.
 132
 133 -- | Run a statement in the current interactive context.  Statement
 134 -- may bind multple values.
 135 runStmt :: Session -> String -> IO RunResult
 136 runStmt session expr = runStmt_ session expr RunToCompletion
 137
 138 -- | Run a statement, stopping at the first breakpoint location encountered
 139 -- (regardless of whether the breakpoint is enabled).
 140 stepStmt :: Session -> String -> IO RunResult
 141 stepStmt session expr = runStmt_ session expr SingleStep
 142
 143 -- | Run a statement, logging breakpoints passed, and stopping when either
 144 -- an enabled breakpoint is reached, or the statement completes.
 145 -- traceStmt :: Session -> String -> IO (RunResult, History)
 146 -- traceStmt session expr = runStmt_ session expr RunAndLogSteps
 147
 148 runStmt_ (Session ref) expr step
 149    = do
 150         hsc_env <- readIORef ref
 151
 152         breakMVar  <- newEmptyMVar  -- wait on this when we hit a breakpoint
 153         statusMVar <- newEmptyMVar  -- wait on this when a computation is running
 154
 155         -- Turn off -fwarn-unused-bindings when running a statement, to hide
 156         -- warnings about the implicit bindings we introduce.
 157         let dflags'  = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
 158             hsc_env' = hsc_env{ hsc_dflags = dflags' }
 159
 160         maybe_stuff <- hscStmt hsc_env' expr
 161
 162         case maybe_stuff of
 163            Nothing -> return RunFailed
 164            Just (ids, hval) -> do
 165
 166               when (isStep step) $ setStepFlag
 167
 168               -- set the onBreakAction to be performed when we hit a
 169               -- breakpoint this is visible in the Byte Code
 170               -- Interpreter, thus it is a global variable,
 171               -- implemented with stable pointers
 172               withBreakAction breakMVar statusMVar $ do
 173
 174               let thing_to_run = unsafeCoerce# hval :: IO [HValue]
 175               status <- sandboxIO statusMVar thing_to_run
 176
 177               let ic = hsc_IC hsc_env
 178                   bindings = (ic_tmp_ids ic, ic_tyvars ic)
 179               handleRunStatus expr ref bindings ids breakMVar statusMVar status
 180
 181 handleRunStatus expr ref bindings final_ids breakMVar statusMVar status =
 182    case status of
 183       -- did we hit a breakpoint or did we complete?
 184       (Break apStack info tid) -> do
 185         hsc_env <- readIORef ref
 186         let
 187             mod_name    = moduleName (breakInfo_module info)
 188             mod_details = fmap hm_details (lookupUFM (hsc_HPT hsc_env) mod_name)
 189             breaks      = md_modBreaks (expectJust "handlRunStatus" mod_details)
 190         --
 191         (hsc_env1, names, span) <- bindLocalsAtBreakpoint hsc_env
 192                                         apStack info breaks
 193         let
 194             resume = Resume expr tid breakMVar statusMVar
 195                               bindings final_ids apStack info span
 196             hsc_env2 = pushResume hsc_env1 resume
 197         --
 198         writeIORef ref hsc_env2
 199         return (RunBreak tid names info)
 200       (Complete either_hvals) ->
 201         case either_hvals of
 202             Left e -> return (RunException e)
 203             Right hvals -> do
 204                 hsc_env <- readIORef ref
 205                 let final_ic = extendInteractiveContext (hsc_IC hsc_env)
 206                                         final_ids emptyVarSet
 207                         -- the bound Ids never have any free TyVars
 208                     final_names = map idName final_ids
 209                 writeIORef ref hsc_env{hsc_IC=final_ic}
 210                 Linker.extendLinkEnv (zip final_names hvals)
 211                 return (RunOk final_names)
 212
 213 {-
 214 traceRunStatus ref final_ids
 215                breakMVar statusMVar status history = do
 216   hsc_env <- readIORef ref
 217   case status of
 218      -- when tracing, if we hit a breakpoint that is not explicitly
 219      -- enabled, then we just log the event in the history and continue.
 220      (Break apStack info tid) | not (isBreakEnabled hsc_env info) -> do
 221         let history' = consBL (apStack,info) history
 222         withBreakAction breakMVar statusMVar $ do
 223            status <- withInterruptsSentTo
 224                 (do putMVar breakMVar ()  -- this awakens the stopped thread...
 225                     return tid)
 226                 (takeMVar statusMVar)     -- and wait for the result
 227
 228            traceRunStatus ref final_ids
 229                           breakMVar statusMVar status history'
 230      _other ->
 231         handleRunStatus ref final_ids
 232                         breakMVar statusMVar status
 233
 234 -}
 235
 236 foreign import ccall "rts_setStepFlag" setStepFlag :: IO ()
 237
 238 -- this points to the IO action that is executed when a breakpoint is hit
 239 foreign import ccall "&breakPointIOAction"
 240         breakPointIOAction :: Ptr (StablePtr (BreakInfo -> HValue -> IO ()))
 241
 242 -- When running a computation, we redirect ^C exceptions to the running
 243 -- thread.  ToDo: we might want a way to continue even if the target
 244 -- thread doesn't die when it receives the exception... "this thread
 245 -- is not responding".
 246 sandboxIO :: MVar Status -> IO [HValue] -> IO Status
 247 sandboxIO statusMVar thing =
 248   withInterruptsSentTo
 249         (forkIO (do res <- Exception.try thing
 250                     putMVar statusMVar (Complete res)))
 251         (takeMVar statusMVar)
 252
 253 withInterruptsSentTo :: IO ThreadId -> IO r -> IO r
 254 withInterruptsSentTo io get_result = do
 255   ts <- takeMVar interruptTargetThread
 256   child <- io
 257   putMVar interruptTargetThread (child:ts)
 258   get_result `finally` modifyMVar_ interruptTargetThread (return.tail)
 259
 260 withBreakAction breakMVar statusMVar io
 261  = bracket setBreakAction resetBreakAction (\_ -> io)
 262  where
 263    setBreakAction = do
 264      stablePtr <- newStablePtr onBreak
 265      poke breakPointIOAction stablePtr
 266      return stablePtr
 267
 268    onBreak info apStack = do
 269      tid <- myThreadId
 270      putMVar statusMVar (Break apStack info tid)
 271      takeMVar breakMVar
 272
 273    resetBreakAction stablePtr = do
 274      poke breakPointIOAction noBreakStablePtr
 275      freeStablePtr stablePtr
 276
 277 noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
 278 noBreakAction info apStack = putStrLn "*** Ignoring breakpoint"
 279
 280 resume :: Session -> IO RunResult
 281 resume session = resume_ session RunToCompletion
 282
 283 stepResume :: Session -> IO RunResult
 284 stepResume session = resume_ session SingleStep
 285
 286 -- traceResume :: Session -> IO RunResult
 287 -- traceResume session handle = resume_ session handle RunAndLogSteps
 288
 289 resume_ :: Session -> SingleStep -> IO RunResult
 290 resume_ (Session ref) step
 291  = do
 292    hsc_env <- readIORef ref
 293    let ic = hsc_IC hsc_env
 294        resume = ic_resume ic
 295
 296    case resume of
 297      [] -> throwDyn (ProgramError "not stopped at a breakpoint")
 298      (r:rs) -> do
 299         -- unbind the temporary locals by restoring the TypeEnv from
 300         -- before the breakpoint, and drop this Resume from the
 301         -- InteractiveContext.
 302         let (resume_tmp_ids, resume_tyvars) = resumeBindings r
 303             ic' = ic { ic_tmp_ids  = resume_tmp_ids,
 304                        ic_tyvars   = resume_tyvars,
 305                        ic_resume   = rs }
 306         writeIORef ref hsc_env{ hsc_IC = ic' }
 307
 308         -- remove any bindings created since the breakpoint from the
 309         -- linker's environment
 310         let new_names = map idName (filter (`notElem` resume_tmp_ids)
 311                                            (ic_tmp_ids ic))
 312         Linker.deleteFromLinkEnv new_names
 313
 314
 315         when (isStep step) $ setStepFlag
 316         case r of
 317           Resume expr tid breakMVar statusMVar bindings
 318               final_ids apStack info _ -> do
 319                 withBreakAction breakMVar statusMVar $ do
 320                 status <- withInterruptsSentTo
 321                              (do putMVar breakMVar ()
 322                                       -- this awakens the stopped thread...
 323                                  return tid)
 324                              (takeMVar statusMVar)
 325                                       -- and wait for the result
 326                 handleRunStatus expr ref bindings final_ids
 327                                 breakMVar statusMVar status
 328
 329 -- -----------------------------------------------------------------------------
 330 -- After stopping at a breakpoint, add free variables to the environment
 331
 332 bindLocalsAtBreakpoint
 333         :: HscEnv
 334         -> HValue
 335         -> BreakInfo
 336         -> ModBreaks
 337         -> IO (HscEnv, [Name], SrcSpan)
 338 bindLocalsAtBreakpoint hsc_env apStack info breaks = do
 339
 340    let
 341        index     = breakInfo_number info
 342        vars      = breakInfo_vars info
 343        result_ty = breakInfo_resty info
 344        occs      = modBreaks_vars breaks ! index
 345        span      = modBreaks_locs breaks ! index
 346
 347    -- filter out any unboxed ids; we can't bind these at the prompt
 348    let pointers = filter (\(id,_) -> isPointer id) vars
 349        isPointer id | PtrRep <- idPrimRep id = True
 350                     | otherwise              = False
 351
 352    let (ids, offsets) = unzip pointers
 353    hValues <- mapM (getIdValFromApStack apStack) offsets
 354    new_ids <- zipWithM mkNewId occs ids
 355    let names = map idName ids
 356
 357    -- make an Id for _result.  We use the Unique of the FastString "_result";
 358    -- we don't care about uniqueness here, because there will only be one
 359    -- _result in scope at any time.
 360    let result_fs = FSLIT("_result")
 361        result_name = mkInternalName (getUnique result_fs)
 362                           (mkVarOccFS result_fs) (srcSpanStart span)
 363        result_id   = Id.mkLocalId result_name result_ty
 364
 365    -- for each Id we're about to bind in the local envt:
 366    --    - skolemise the type variables in its type, so they can't
 367    --      be randomly unified with other types.  These type variables
 368    --      can only be resolved by type reconstruction in RtClosureInspect
 369    --    - tidy the type variables
 370    --    - globalise the Id (Ids are supposed to be Global, apparently).
 371    --
 372    let all_ids | isPointer result_id = result_id : ids
 373                | otherwise           = ids
 374        (id_tys, tyvarss) = mapAndUnzip (skolemiseTy.idType) all_ids
 375        (_,tidy_tys) = tidyOpenTypes emptyTidyEnv id_tys
 376        new_tyvars = unionVarSets tyvarss
 377        new_ids = zipWith setIdType all_ids tidy_tys
 378        global_ids = map (globaliseId VanillaGlobal) new_ids
 379
 380    let   ictxt0 = hsc_IC hsc_env
 381          ictxt1 = extendInteractiveContext ictxt0 global_ids new_tyvars
 382
 383    Linker.extendLinkEnv (zip names hValues)
 384    Linker.extendLinkEnv [(result_name, unsafeCoerce# apStack)]
 385    return (hsc_env{ hsc_IC = ictxt1 }, result_name:names, span)
 386   where
 387    mkNewId :: OccName -> Id -> IO Id
 388    mkNewId occ id = do
 389      let uniq = idUnique id
 390          loc = nameSrcLoc (idName id)
 391          name = mkInternalName uniq occ loc
 392          ty = tidyTopType (idType id)
 393          new_id = Id.mkGlobalId VanillaGlobal name ty (idInfo id)
 394      return new_id
 395
 396 skolemiseTy :: Type -> (Type, TyVarSet)
 397 skolemiseTy ty = (substTy subst ty, mkVarSet new_tyvars)
 398   where env           = mkVarEnv (zip tyvars new_tyvar_tys)
 399         subst         = mkTvSubst emptyInScopeSet env
 400         tyvars        = varSetElems (tyVarsOfType ty)
 401         new_tyvars    = map skolemiseTyVar tyvars
 402         new_tyvar_tys = map mkTyVarTy new_tyvars
 403
 404 skolemiseTyVar :: TyVar -> TyVar
 405 skolemiseTyVar tyvar = mkTcTyVar (tyVarName tyvar) (tyVarKind tyvar)
 406                                  (SkolemTv RuntimeUnkSkol)
 407
 408 -- Todo: turn this into a primop, and provide special version(s) for
 409 -- unboxed things
 410 foreign import ccall unsafe "rts_getApStackVal"
 411         getApStackVal :: StablePtr a -> Int -> IO (StablePtr b)
 412
 413 getIdValFromApStack :: a -> Int -> IO HValue
 414 getIdValFromApStack apStack stackDepth = do
 415      apSptr <- newStablePtr apStack
 416      resultSptr <- getApStackVal apSptr (stackDepth - 1)
 417      result <- deRefStablePtr resultSptr
 418      freeStablePtr apSptr
 419      freeStablePtr resultSptr
 420      return (unsafeCoerce# result)
 421
 422 pushResume :: HscEnv -> Resume -> HscEnv
 423 pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }
 424   where
 425         ictxt0 = hsc_IC hsc_env
 426         ictxt1 = ictxt0 { ic_resume = resume : ic_resume ictxt0 }
 427
 428 -- -----------------------------------------------------------------------------
 429 -- Abandoning a resume context
 430
 431 abandon :: Session -> IO Bool
 432 abandon (Session ref) = do
 433    hsc_env <- readIORef ref
 434    let ic = hsc_IC hsc_env
 435        resume = ic_resume ic
 436    case resume of
 437       []    -> return False
 438       _:rs  -> do
 439          writeIORef ref hsc_env{ hsc_IC = ic { ic_resume = rs } }
 440          return True
 441
 442 abandonAll :: Session -> IO Bool
 443 abandonAll (Session ref) = do
 444    hsc_env <- readIORef ref
 445    let ic = hsc_IC hsc_env
 446        resume = ic_resume ic
 447    case resume of
 448       []    -> return False
 449       _:rs  -> do
 450          writeIORef ref hsc_env{ hsc_IC = ic { ic_resume = [] } }
 451          return True
 452
 453 -- -----------------------------------------------------------------------------
 454 -- Bounded list, optimised for repeated cons
 455
 456 data BoundedList a = BL
 457                         {-# UNPACK #-} !Int  -- length
 458                         {-# UNPACK #-} !Int  -- bound
 459                         [a] -- left
 460                         [a] -- right,  list is (left ++ reverse right)
 461
 462 consBL a (BL len bound left right)
 463   | len < bound = BL (len+1) bound (a:left) right
 464   | null right  = BL len     bound [] $! tail (reverse left)
 465   | otherwise   = BL len     bound [] $! tail right
 466
 467 toListBL (BL _ _ left right) = left ++ reverse right
 468
 469 lenBL (BL len _ _ _) = len
 470
 471 -- -----------------------------------------------------------------------------
 472 -- | Set the interactive evaluation context.
 473 --
 474 -- Setting the context doesn't throw away any bindings; the bindings
 475 -- we've built up in the InteractiveContext simply move to the new
 476 -- module.  They always shadow anything in scope in the current context.
 477 setContext :: Session
 478            -> [Module]  -- entire top level scope of these modules
 479            -> [Module]  -- exports only of these modules
 480            -> IO ()
 481 setContext sess@(Session ref) toplev_mods export_mods = do
 482   hsc_env <- readIORef ref
 483   let old_ic  = hsc_IC     hsc_env
 484       hpt     = hsc_HPT    hsc_env
 485   --
 486   export_env  <- mkExportEnv hsc_env export_mods
 487   toplev_envs <- mapM (mkTopLevEnv hpt) toplev_mods
 488   let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
 489   writeIORef ref hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplev_mods,
 490                                             ic_exports      = export_mods,
 491                                             ic_rn_gbl_env   = all_env }}
 492
 493 -- Make a GlobalRdrEnv based on the exports of the modules only.
 494 mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
 495 mkExportEnv hsc_env mods = do
 496   stuff <- mapM (getModuleExports hsc_env) mods
 497   let
 498         (_msgs, mb_name_sets) = unzip stuff
 499         gres = [ nameSetToGlobalRdrEnv (availsToNameSet avails) (moduleName mod)
 500                | (Just avails, mod) <- zip mb_name_sets mods ]
 501   --
 502   return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres
 503
 504 nameSetToGlobalRdrEnv :: NameSet -> ModuleName -> GlobalRdrEnv
 505 nameSetToGlobalRdrEnv names mod =
 506   mkGlobalRdrEnv [ GRE  { gre_name = name, gre_prov = vanillaProv mod }
 507                  | name <- nameSetToList names ]
 508
 509 vanillaProv :: ModuleName -> Provenance
 510 -- We're building a GlobalRdrEnv as if the user imported
 511 -- all the specified modules into the global interactive module
 512 vanillaProv mod_name = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}]
 513   where
 514     decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name,
 515                          is_qual = False,
 516                          is_dloc = srcLocSpan interactiveSrcLoc }
 517
 518 mkTopLevEnv :: HomePackageTable -> Module -> IO GlobalRdrEnv
 519 mkTopLevEnv hpt modl
 520   = case lookupUFM hpt (moduleName modl) of
 521       Nothing -> throwDyn (ProgramError ("mkTopLevEnv: not a home module " ++
 522                                                 showSDoc (ppr modl)))
 523       Just details ->
 524          case mi_globals (hm_iface details) of
 525                 Nothing  ->
 526                    throwDyn (ProgramError ("mkTopLevEnv: not interpreted "
 527                                                 ++ showSDoc (ppr modl)))
 528                 Just env -> return env
 529
 530 -- | Get the interactive evaluation context, consisting of a pair of the
 531 -- set of modules from which we take the full top-level scope, and the set
 532 -- of modules from which we take just the exports respectively.
 533 getContext :: Session -> IO ([Module],[Module])
 534 getContext s = withSession s (\HscEnv{ hsc_IC=ic } ->
 535                                 return (ic_toplev_scope ic, ic_exports ic))
 536
 537 -- | Returns 'True' if the specified module is interpreted, and hence has
 538 -- its full top-level scope available.
 539 moduleIsInterpreted :: Session -> Module -> IO Bool
 540 moduleIsInterpreted s modl = withSession s $ \h ->
 541  if modulePackageId modl /= thisPackage (hsc_dflags h)
 542         then return False
 543         else case lookupUFM (hsc_HPT h) (moduleName modl) of
 544                 Just details       -> return (isJust (mi_globals (hm_iface details)))
 545                 _not_a_home_module -> return False
 546
 547 -- | Looks up an identifier in the current interactive context (for :info)
 548 getInfo :: Session -> Name -> IO (Maybe (TyThing,Fixity,[Instance]))
 549 getInfo s name = withSession s $ \hsc_env -> tcRnGetInfo hsc_env name
 550
 551 -- | Returns all names in scope in the current interactive context
 552 getNamesInScope :: Session -> IO [Name]
 553 getNamesInScope s = withSession s $ \hsc_env -> do
 554   return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
 555
 556 getRdrNamesInScope :: Session -> IO [RdrName]
 557 getRdrNamesInScope  s = withSession s $ \hsc_env -> do
 558   let
 559       ic = hsc_IC hsc_env
 560       gbl_rdrenv = ic_rn_gbl_env ic
 561       ids = ic_tmp_ids ic
 562       gbl_names = concat (map greToRdrNames (globalRdrEnvElts gbl_rdrenv))
 563       lcl_names = map (mkRdrUnqual.nameOccName.idName) ids
 564   --
 565   return (gbl_names ++ lcl_names)
 566
 567
 568 -- ToDo: move to RdrName
 569 greToRdrNames :: GlobalRdrElt -> [RdrName]
 570 greToRdrNames GRE{ gre_name = name, gre_prov = prov }
 571   = case prov of
 572      LocalDef -> [unqual]
 573      Imported specs -> concat (map do_spec (map is_decl specs))
 574   where
 575     occ = nameOccName name
 576     unqual = Unqual occ
 577     do_spec decl_spec
 578         | is_qual decl_spec = [qual]
 579         | otherwise         = [unqual,qual]
 580         where qual = Qual (is_as decl_spec) occ
 581
 582 -- | Parses a string as an identifier, and returns the list of 'Name's that
 583 -- the identifier can refer to in the current interactive context.
 584 parseName :: Session -> String -> IO [Name]
 585 parseName s str = withSession s $ \hsc_env -> do
 586    maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
 587    case maybe_rdr_name of
 588         Nothing -> return []
 589         Just (L _ rdr_name) -> do
 590             mb_names <- tcRnLookupRdrName hsc_env rdr_name
 591             case mb_names of
 592                 Nothing -> return []
 593                 Just ns -> return ns
 594                 -- ToDo: should return error messages
 595
 596 -- | Returns the 'TyThing' for a 'Name'.  The 'Name' may refer to any
 597 -- entity known to GHC, including 'Name's defined using 'runStmt'.
 598 lookupName :: Session -> Name -> IO (Maybe TyThing)
 599 lookupName s name = withSession s $ \hsc_env -> tcRnLookupName hsc_env name
 600
 601 -- -----------------------------------------------------------------------------
 602 -- Getting the type of an expression
 603
 604 -- | Get the type of an expression
 605 exprType :: Session -> String -> IO (Maybe Type)
 606 exprType s expr = withSession s $ \hsc_env -> do
 607    maybe_stuff <- hscTcExpr hsc_env expr
 608    case maybe_stuff of
 609         Nothing -> return Nothing
 610         Just ty -> return (Just tidy_ty)
 611              where
 612                 tidy_ty = tidyType emptyTidyEnv ty
 613
 614 -- -----------------------------------------------------------------------------
 615 -- Getting the kind of a type
 616
 617 -- | Get the kind of a  type
 618 typeKind  :: Session -> String -> IO (Maybe Kind)
 619 typeKind s str = withSession s $ \hsc_env -> do
 620    maybe_stuff <- hscKcType hsc_env str
 621    case maybe_stuff of
 622         Nothing -> return Nothing
 623         Just kind -> return (Just kind)
 624
 625 -----------------------------------------------------------------------------
 626 -- cmCompileExpr: compile an expression and deliver an HValue
 627
 628 compileExpr :: Session -> String -> IO (Maybe HValue)
 629 compileExpr s expr = withSession s $ \hsc_env -> do
 630   maybe_stuff <- hscStmt hsc_env ("let __cmCompileExpr = "++expr)
 631   case maybe_stuff of
 632         Nothing -> return Nothing
 633         Just (ids, hval) -> do
 634                         -- Run it!
 635                 hvals <- (unsafeCoerce# hval) :: IO [HValue]
 636
 637                 case (ids,hvals) of
 638                   ([n],[hv]) -> return (Just hv)
 639                   _          -> panic "compileExpr"
 640
 641 -- -----------------------------------------------------------------------------
 642 -- Compile an expression into a dynamic
 643
 644 dynCompileExpr :: Session -> String -> IO (Maybe Dynamic)
 645 dynCompileExpr ses expr = do
 646     (full,exports) <- getContext ses
 647     setContext ses full $
 648         (mkModule
 649             (stringToPackageId "base") (mkModuleName "Data.Dynamic")
 650         ):exports
 651     let stmt = "let __dynCompileExpr = Data.Dynamic.toDyn (" ++ expr ++ ")"
 652     res <- withSession ses (flip hscStmt stmt)
 653     setContext ses full exports
 654     case res of
 655         Nothing -> return Nothing
 656         Just (ids, hvals) -> do
 657             vals <- (unsafeCoerce# hvals :: IO [Dynamic])
 658             case (ids,vals) of
 659                 (_:[], v:[])    -> return (Just v)
 660                 _               -> panic "dynCompileExpr"
 661
 662 -----------------------------------------------------------------------------
 663 -- show a module and it's source/object filenames
 664
 665 showModule :: Session -> ModSummary -> IO String
 666 showModule s mod_summary = withSession s $                        \hsc_env ->
 667                            isModuleInterpreted s mod_summary >>=  \interpreted ->
 668                            return (showModMsg (hscTarget(hsc_dflags hsc_env)) interpreted mod_summary)
 669
 670 isModuleInterpreted :: Session -> ModSummary -> IO Bool
 671 isModuleInterpreted s mod_summary = withSession s $ \hsc_env ->
 672   case lookupUFM (hsc_HPT hsc_env) (ms_mod_name mod_summary) of
 673         Nothing       -> panic "missing linkable"
 674         Just mod_info -> return (not obj_linkable)
 675                       where
 676                          obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
 677
 678 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
 679 obtainTerm1 sess force mb_ty x = withSession sess $ \hsc_env -> cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x)
 680
 681 obtainTerm :: Session -> Bool -> Id -> IO (Maybe Term)
 682 obtainTerm sess force id = withSession sess $ \hsc_env -> do
 683               mb_v <- Linker.getHValue (varName id)
 684               case mb_v of
 685                 Just v  -> fmap Just$ cvObtainTerm hsc_env force (Just$ idType id) v
 686                 Nothing -> return Nothing
 687
 688 #endif /* GHCI */