1 -- -----------------------------------------------------------------------------
3 -- (c) The University of Glasgow, 2005-2007
5 -- Running statements interactively
7 -- -----------------------------------------------------------------------------
9 module InteractiveEval (
11 RunResult(..), Status(..), Resume(..), History(..),
12 runStmt, SingleStep(..),
18 setContext, getContext,
19 nameSetToGlobalRdrEnv,
29 compileExpr, dynCompileExpr,
31 obtainTerm, obtainTerm1
37 #include "HsVersions.h"
39 import HscMain hiding (compileExpr)
42 import Type hiding (typeKind)
43 import TcType hiding (typeKind)
45 import Var hiding (setIdType)
48 import Name hiding ( varName )
65 import RtClosureInspect
76 import Control.Exception as Exception
77 import Control.Concurrent
79 import Foreign.StablePtr
81 -- -----------------------------------------------------------------------------
82 -- running a statement interactively
85 = RunOk [Name] -- ^ names bound by this evaluation
86 | RunFailed -- ^ statement failed compilation
87 | RunException Exception -- ^ statement raised an exception
88 | RunBreak ThreadId [Name] (Maybe BreakInfo)
91 = Break Bool HValue BreakInfo ThreadId
92 -- ^ the computation hit a breakpoint (Bool <=> was an exception)
93 | Complete (Either Exception [HValue])
94 -- ^ the computation completed with either an exception or a value
98 resumeStmt :: String, -- the original statement
99 resumeThreadId :: ThreadId, -- thread running the computation
100 resumeBreakMVar :: MVar (),
101 resumeStatMVar :: MVar Status,
102 resumeBindings :: ([Id], TyVarSet),
103 resumeFinalIds :: [Id], -- [Id] to bind on completion
104 resumeApStack :: HValue, -- The object from which we can get
105 -- value of the free variables.
106 resumeBreakInfo :: Maybe BreakInfo,
107 -- the breakpoint we stopped at
108 -- (Nothing <=> exception)
109 resumeSpan :: SrcSpan, -- just a cache, otherwise it's a pain
110 -- to fetch the ModDetails & ModBreaks
112 resumeHistory :: [History],
113 resumeHistoryIx :: Int -- 0 <==> at the top of the history
116 getResumeContext :: Session -> IO [Resume]
117 getResumeContext s = withSession s (return . ic_resume . hsc_IC)
124 isStep RunToCompletion = False
129 historyApStack :: HValue,
130 historyBreakInfo :: BreakInfo
133 getHistorySpan :: Session -> History -> IO SrcSpan
134 getHistorySpan s hist = withSession s $ \hsc_env -> do
135 let inf = historyBreakInfo hist
136 num = breakInfo_number inf
137 case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
138 Just hmi -> return (modBreaks_locs (md_modBreaks (hm_details hmi)) ! num)
139 _ -> panic "getHistorySpan"
141 -- | Run a statement in the current interactive context. Statement
142 -- may bind multple values.
143 runStmt :: Session -> String -> SingleStep -> IO RunResult
144 runStmt (Session ref) expr step
146 hsc_env <- readIORef ref
148 breakMVar <- newEmptyMVar -- wait on this when we hit a breakpoint
149 statusMVar <- newEmptyMVar -- wait on this when a computation is running
151 -- Turn off -fwarn-unused-bindings when running a statement, to hide
152 -- warnings about the implicit bindings we introduce.
153 let dflags' = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
154 hsc_env' = hsc_env{ hsc_dflags = dflags' }
156 maybe_stuff <- hscStmt hsc_env' expr
159 Nothing -> return RunFailed
160 Just (ids, hval) -> do
162 withBreakAction (isStep step) dflags' breakMVar statusMVar $ do
164 let thing_to_run = unsafeCoerce# hval :: IO [HValue]
165 status <- sandboxIO statusMVar thing_to_run
167 let ic = hsc_IC hsc_env
168 bindings = (ic_tmp_ids ic, ic_tyvars ic)
172 traceRunStatus expr ref bindings ids
173 breakMVar statusMVar status emptyHistory
175 handleRunStatus expr ref bindings ids
176 breakMVar statusMVar status emptyHistory
179 emptyHistory = nilBL 50 -- keep a log of length 50
181 handleRunStatus expr ref bindings final_ids breakMVar statusMVar status
184 -- did we hit a breakpoint or did we complete?
185 (Break is_exception apStack info tid) -> do
186 hsc_env <- readIORef ref
187 let mb_info | is_exception = Nothing
188 | otherwise = Just info
189 (hsc_env1, names, span) <- bindLocalsAtBreakpoint hsc_env
192 resume = Resume expr tid breakMVar statusMVar
193 bindings final_ids apStack mb_info span
195 hsc_env2 = pushResume hsc_env1 resume
197 writeIORef ref hsc_env2
198 return (RunBreak tid names mb_info)
199 (Complete either_hvals) ->
201 Left e -> return (RunException e)
203 hsc_env <- readIORef ref
204 let final_ic = extendInteractiveContext (hsc_IC hsc_env)
205 final_ids emptyVarSet
206 -- the bound Ids never have any free TyVars
207 final_names = map idName final_ids
208 writeIORef ref hsc_env{hsc_IC=final_ic}
209 Linker.extendLinkEnv (zip final_names hvals)
210 return (RunOk final_names)
213 traceRunStatus expr ref bindings final_ids
214 breakMVar statusMVar status history = do
215 hsc_env <- readIORef ref
217 -- when tracing, if we hit a breakpoint that is not explicitly
218 -- enabled, then we just log the event in the history and continue.
219 (Break is_exception apStack info tid) | not is_exception -> do
220 b <- isBreakEnabled hsc_env info
224 let history' = consBL (History apStack info) history
225 -- probably better make history strict here, otherwise
226 -- our BoundedList will be pointless.
228 status <- withBreakAction True (hsc_dflags hsc_env)
229 breakMVar statusMVar $ do
231 (do putMVar breakMVar () -- awaken the stopped thread
233 (takeMVar statusMVar) -- and wait for the result
234 traceRunStatus expr ref bindings final_ids
235 breakMVar statusMVar status history'
239 handle_normally = handleRunStatus expr ref bindings final_ids
240 breakMVar statusMVar status history
243 isBreakEnabled :: HscEnv -> BreakInfo -> IO Bool
244 isBreakEnabled hsc_env inf =
245 case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
247 w <- getBreak (modBreaks_flags (md_modBreaks (hm_details hmi)))
248 (breakInfo_number inf)
249 case w of Just n -> return (n /= 0); _other -> return False
254 foreign import ccall "&rts_stop_next_breakpoint" stepFlag :: Ptr CInt
255 foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
257 setStepFlag = poke stepFlag 1
258 resetStepFlag = poke stepFlag 0
260 -- this points to the IO action that is executed when a breakpoint is hit
261 foreign import ccall "&rts_breakpoint_io_action"
262 breakPointIOAction :: Ptr (StablePtr (Bool -> BreakInfo -> HValue -> IO ()))
264 -- When running a computation, we redirect ^C exceptions to the running
265 -- thread. ToDo: we might want a way to continue even if the target
266 -- thread doesn't die when it receives the exception... "this thread
267 -- is not responding".
268 sandboxIO :: MVar Status -> IO [HValue] -> IO Status
269 sandboxIO statusMVar thing =
271 (forkIO (do res <- Exception.try (rethrow thing)
272 putMVar statusMVar (Complete res)))
273 (takeMVar statusMVar)
275 -- | this just re-throws any exceptions received. The point of this
276 -- is that if -fbreak-on-excepsions is on, we only get a chance to break
277 -- for synchronous exceptions, and this turns an async exception into
278 -- a sync exception, so for instance a ^C exception will break right here
279 -- unless it is caught elsewhere.
280 rethrow :: IO a -> IO a
281 rethrow io = Exception.catch io Exception.throwIO
283 withInterruptsSentTo :: IO ThreadId -> IO r -> IO r
284 withInterruptsSentTo io get_result = do
285 ts <- takeMVar interruptTargetThread
287 putMVar interruptTargetThread (child:ts)
288 get_result `finally` modifyMVar_ interruptTargetThread (return.tail)
290 -- This function sets up the interpreter for catching breakpoints, and
291 -- resets everything when the computation has stopped running. This
292 -- is a not-very-good way to ensure that only the interactive
293 -- evaluation should generate breakpoints.
294 withBreakAction step dflags breakMVar statusMVar io
295 = bracket setBreakAction resetBreakAction (\_ -> io)
298 stablePtr <- newStablePtr onBreak
299 poke breakPointIOAction stablePtr
300 when (dopt Opt_BreakOnException dflags) $ poke exceptionFlag 1
301 when step $ setStepFlag
303 -- Breaking on exceptions is not enabled by default, since it
304 -- might be a bit surprising. The exception flag is turned off
305 -- as soon as it is hit, or in resetBreakAction below.
307 onBreak is_exception info apStack = do
309 putMVar statusMVar (Break is_exception apStack info tid)
312 resetBreakAction stablePtr = do
313 poke breakPointIOAction noBreakStablePtr
316 freeStablePtr stablePtr
318 noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
320 noBreakAction False info apStack = putStrLn "*** Ignoring breakpoint"
321 noBreakAction True info apStack = return () -- exception: just continue
323 resume :: Session -> SingleStep -> IO RunResult
324 resume (Session ref) step
326 hsc_env <- readIORef ref
327 let ic = hsc_IC hsc_env
328 resume = ic_resume ic
331 [] -> throwDyn (ProgramError "not stopped at a breakpoint")
333 -- unbind the temporary locals by restoring the TypeEnv from
334 -- before the breakpoint, and drop this Resume from the
335 -- InteractiveContext.
336 let (resume_tmp_ids, resume_tyvars) = resumeBindings r
337 ic' = ic { ic_tmp_ids = resume_tmp_ids,
338 ic_tyvars = resume_tyvars,
340 writeIORef ref hsc_env{ hsc_IC = ic' }
342 -- remove any bindings created since the breakpoint from the
343 -- linker's environment
344 let new_names = map idName (filter (`notElem` resume_tmp_ids)
346 Linker.deleteFromLinkEnv new_names
348 when (isStep step) $ setStepFlag
350 Resume expr tid breakMVar statusMVar bindings
351 final_ids apStack info _ _ _ -> do
352 withBreakAction (isStep step) (hsc_dflags hsc_env)
353 breakMVar statusMVar $ do
354 status <- withInterruptsSentTo
355 (do putMVar breakMVar ()
356 -- this awakens the stopped thread...
358 (takeMVar statusMVar)
359 -- and wait for the result
362 traceRunStatus expr ref bindings final_ids
363 breakMVar statusMVar status emptyHistory
365 handleRunStatus expr ref bindings final_ids
366 breakMVar statusMVar status emptyHistory
369 back :: Session -> IO ([Name], Int, SrcSpan)
372 forward :: Session -> IO ([Name], Int, SrcSpan)
373 forward = moveHist (subtract 1)
375 moveHist fn (Session ref) = do
376 hsc_env <- readIORef ref
377 case ic_resume (hsc_IC hsc_env) of
378 [] -> throwDyn (ProgramError "not stopped at a breakpoint")
380 let ix = resumeHistoryIx r
381 history = resumeHistory r
384 when (new_ix > length history) $
385 throwDyn (ProgramError "no more logged breakpoints")
387 throwDyn (ProgramError "already at the beginning of the history")
390 update_ic apStack mb_info = do
391 (hsc_env1, names, span) <- bindLocalsAtBreakpoint hsc_env
393 let ic = hsc_IC hsc_env1
394 r' = r { resumeHistoryIx = new_ix }
395 ic' = ic { ic_resume = r':rs }
397 writeIORef ref hsc_env1{ hsc_IC = ic' }
399 return (names, new_ix, span)
401 -- careful: we want apStack to be the AP_STACK itself, not a thunk
402 -- around it, hence the cases are carefully constructed below to
403 -- make this the case. ToDo: this is v. fragile, do something better.
406 Resume { resumeApStack = apStack,
407 resumeBreakInfo = mb_info } ->
408 update_ic apStack mb_info
409 else case history !! (new_ix - 1) of
410 History apStack info ->
411 update_ic apStack (Just info)
413 -- -----------------------------------------------------------------------------
414 -- After stopping at a breakpoint, add free variables to the environment
416 bindLocalsAtBreakpoint
420 -> IO (HscEnv, [Name], SrcSpan)
422 -- Nothing case: we stopped when an exception was raised, not at a
423 -- breakpoint. We have no location information or local variables to
424 -- bind, all we can do is bind a local variable to the exception
426 bindLocalsAtBreakpoint hsc_env apStack Nothing = do
427 let exn_fs = FSLIT("_exception")
428 exn_name = mkInternalName (getUnique exn_fs) (mkVarOccFS exn_fs) span
430 e_name = mkInternalName (getUnique e_fs) (mkTyVarOcc e_fs) span
431 e_tyvar = mkTcTyVar e_name liftedTypeKind (SkolemTv RuntimeUnkSkol)
432 exn_id = Id.mkGlobalId VanillaGlobal exn_name (mkTyVarTy e_tyvar)
434 new_tyvars = unitVarSet e_tyvar
436 ictxt0 = hsc_IC hsc_env
437 ictxt1 = extendInteractiveContext ictxt0 [exn_id] new_tyvars
439 span = mkGeneralSrcSpan FSLIT("<exception thrown>")
441 Linker.extendLinkEnv [(exn_name, unsafeCoerce# apStack)]
442 return (hsc_env{ hsc_IC = ictxt1 }, [exn_name], span)
444 -- Just case: we stopped at a breakpoint, we have information about the location
445 -- of the breakpoint and the free variables of the expression.
446 bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
449 mod_name = moduleName (breakInfo_module info)
450 mod_details = fmap hm_details (lookupUFM (hsc_HPT hsc_env) mod_name)
451 breaks = md_modBreaks (expectJust "handlRunStatus" mod_details)
452 index = breakInfo_number info
453 vars = breakInfo_vars info
454 result_ty = breakInfo_resty info
455 occs = modBreaks_vars breaks ! index
456 span = modBreaks_locs breaks ! index
458 -- filter out any unboxed ids; we can't bind these at the prompt
459 let pointers = filter (\(id,_) -> isPointer id) vars
460 isPointer id | PtrRep <- idPrimRep id = True
463 let (ids, offsets) = unzip pointers
465 -- It might be that getIdValFromApStack fails, because the AP_STACK
466 -- has been accidentally evaluated, or something else has gone wrong.
467 -- So that we don't fall over in a heap when this happens, just don't
468 -- bind any free variables instead, and we emit a warning.
469 mb_hValues <- mapM (getIdValFromApStack apStack) offsets
470 let filtered_ids = [ id | (id, Just _) <- zip ids mb_hValues ]
471 when (any isNothing mb_hValues) $
472 debugTraceMsg (hsc_dflags hsc_env) 1 $
473 text "Warning: _result has been evaluated, some bindings have been lost"
475 new_ids <- zipWithM mkNewId occs filtered_ids
476 let names = map idName new_ids
478 -- make an Id for _result. We use the Unique of the FastString "_result";
479 -- we don't care about uniqueness here, because there will only be one
480 -- _result in scope at any time.
481 let result_fs = FSLIT("_result")
482 result_name = mkInternalName (getUnique result_fs)
483 (mkVarOccFS result_fs) span
484 result_id = Id.mkGlobalId VanillaGlobal result_name result_ty
487 -- for each Id we're about to bind in the local envt:
488 -- - skolemise the type variables in its type, so they can't
489 -- be randomly unified with other types. These type variables
490 -- can only be resolved by type reconstruction in RtClosureInspect
491 -- - tidy the type variables
492 -- - globalise the Id (Ids are supposed to be Global, apparently).
494 let all_ids | isPointer result_id = result_id : new_ids
495 | otherwise = new_ids
496 (id_tys, tyvarss) = mapAndUnzip (skolemiseTy.idType) all_ids
497 (_,tidy_tys) = tidyOpenTypes emptyTidyEnv id_tys
498 new_tyvars = unionVarSets tyvarss
499 final_ids = zipWith setIdType all_ids tidy_tys
501 let ictxt0 = hsc_IC hsc_env
502 ictxt1 = extendInteractiveContext ictxt0 final_ids new_tyvars
504 Linker.extendLinkEnv [ (name,hval) | (name, Just hval) <- zip names mb_hValues ]
505 Linker.extendLinkEnv [(result_name, unsafeCoerce# apStack)]
506 return (hsc_env{ hsc_IC = ictxt1 }, result_name:names, span)
508 mkNewId :: OccName -> Id -> IO Id
510 let uniq = idUnique id
511 loc = nameSrcSpan (idName id)
512 name = mkInternalName uniq occ loc
514 new_id = Id.mkGlobalId VanillaGlobal name ty (idInfo id)
517 skolemiseTy :: Type -> (Type, TyVarSet)
518 skolemiseTy ty = (substTy subst ty, mkVarSet new_tyvars)
519 where env = mkVarEnv (zip tyvars new_tyvar_tys)
520 subst = mkTvSubst emptyInScopeSet env
521 tyvars = varSetElems (tyVarsOfType ty)
522 new_tyvars = map skolemiseTyVar tyvars
523 new_tyvar_tys = map mkTyVarTy new_tyvars
525 skolemiseTyVar :: TyVar -> TyVar
526 skolemiseTyVar tyvar = mkTcTyVar (tyVarName tyvar) (tyVarKind tyvar)
527 (SkolemTv RuntimeUnkSkol)
529 getIdValFromApStack :: HValue -> Int -> IO (Maybe HValue)
530 getIdValFromApStack apStack (I# stackDepth) = do
531 case getApStackVal# apStack (stackDepth +# 1#) of
532 -- The +1 is magic! I don't know where it comes
533 -- from, but this makes things line up. --SDM
536 0# -> return Nothing -- AP_STACK not found
537 _ -> return (Just (unsafeCoerce# result))
539 pushResume :: HscEnv -> Resume -> HscEnv
540 pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }
542 ictxt0 = hsc_IC hsc_env
543 ictxt1 = ictxt0 { ic_resume = resume : ic_resume ictxt0 }
545 -- -----------------------------------------------------------------------------
546 -- Abandoning a resume context
548 abandon :: Session -> IO Bool
549 abandon (Session ref) = do
550 hsc_env <- readIORef ref
551 let ic = hsc_IC hsc_env
552 resume = ic_resume ic
556 writeIORef ref hsc_env{ hsc_IC = ic { ic_resume = rs } }
560 abandonAll :: Session -> IO Bool
561 abandonAll (Session ref) = do
562 hsc_env <- readIORef ref
563 let ic = hsc_IC hsc_env
564 resume = ic_resume ic
568 writeIORef ref hsc_env{ hsc_IC = ic { ic_resume = [] } }
572 -- when abandoning a computation we have to
573 -- (a) kill the thread with an async exception, so that the
574 -- computation itself is stopped, and
575 -- (b) fill in the MVar. This step is necessary because any
576 -- thunks that were under evaluation will now be updated
577 -- with the partial computation, which still ends in takeMVar,
578 -- so any attempt to evaluate one of these thunks will block
579 -- unless we fill in the MVar.
580 -- See test break010.
581 abandon_ :: Resume -> IO ()
583 killThread (resumeThreadId r)
584 putMVar (resumeBreakMVar r) ()
586 -- -----------------------------------------------------------------------------
587 -- Bounded list, optimised for repeated cons
589 data BoundedList a = BL
590 {-# UNPACK #-} !Int -- length
591 {-# UNPACK #-} !Int -- bound
593 [a] -- right, list is (left ++ reverse right)
595 nilBL :: Int -> BoundedList a
596 nilBL bound = BL 0 bound [] []
598 consBL a (BL len bound left right)
599 | len < bound = BL (len+1) bound (a:left) right
600 | null right = BL len bound [a] $! tail (reverse left)
601 | otherwise = BL len bound (a:left) $! tail right
603 toListBL (BL _ _ left right) = left ++ reverse right
605 -- lenBL (BL len _ _ _) = len
607 -- -----------------------------------------------------------------------------
608 -- | Set the interactive evaluation context.
610 -- Setting the context doesn't throw away any bindings; the bindings
611 -- we've built up in the InteractiveContext simply move to the new
612 -- module. They always shadow anything in scope in the current context.
613 setContext :: Session
614 -> [Module] -- entire top level scope of these modules
615 -> [Module] -- exports only of these modules
617 setContext sess@(Session ref) toplev_mods export_mods = do
618 hsc_env <- readIORef ref
619 let old_ic = hsc_IC hsc_env
620 hpt = hsc_HPT hsc_env
622 export_env <- mkExportEnv hsc_env export_mods
623 toplev_envs <- mapM (mkTopLevEnv hpt) toplev_mods
624 let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
625 writeIORef ref hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplev_mods,
626 ic_exports = export_mods,
627 ic_rn_gbl_env = all_env }}
629 -- Make a GlobalRdrEnv based on the exports of the modules only.
630 mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
631 mkExportEnv hsc_env mods = do
632 stuff <- mapM (getModuleExports hsc_env) mods
634 (_msgs, mb_name_sets) = unzip stuff
635 gres = [ nameSetToGlobalRdrEnv (availsToNameSet avails) (moduleName mod)
636 | (Just avails, mod) <- zip mb_name_sets mods ]
638 return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres
640 nameSetToGlobalRdrEnv :: NameSet -> ModuleName -> GlobalRdrEnv
641 nameSetToGlobalRdrEnv names mod =
642 mkGlobalRdrEnv [ GRE { gre_name = name, gre_par = NoParent, gre_prov = vanillaProv mod }
643 | name <- nameSetToList names ]
645 vanillaProv :: ModuleName -> Provenance
646 -- We're building a GlobalRdrEnv as if the user imported
647 -- all the specified modules into the global interactive module
648 vanillaProv mod_name = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}]
650 decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name,
652 is_dloc = srcLocSpan interactiveSrcLoc }
654 mkTopLevEnv :: HomePackageTable -> Module -> IO GlobalRdrEnv
656 = case lookupUFM hpt (moduleName modl) of
657 Nothing -> throwDyn (ProgramError ("mkTopLevEnv: not a home module " ++
658 showSDoc (ppr modl)))
660 case mi_globals (hm_iface details) of
662 throwDyn (ProgramError ("mkTopLevEnv: not interpreted "
663 ++ showSDoc (ppr modl)))
664 Just env -> return env
666 -- | Get the interactive evaluation context, consisting of a pair of the
667 -- set of modules from which we take the full top-level scope, and the set
668 -- of modules from which we take just the exports respectively.
669 getContext :: Session -> IO ([Module],[Module])
670 getContext s = withSession s (\HscEnv{ hsc_IC=ic } ->
671 return (ic_toplev_scope ic, ic_exports ic))
673 -- | Returns 'True' if the specified module is interpreted, and hence has
674 -- its full top-level scope available.
675 moduleIsInterpreted :: Session -> Module -> IO Bool
676 moduleIsInterpreted s modl = withSession s $ \h ->
677 if modulePackageId modl /= thisPackage (hsc_dflags h)
679 else case lookupUFM (hsc_HPT h) (moduleName modl) of
680 Just details -> return (isJust (mi_globals (hm_iface details)))
681 _not_a_home_module -> return False
683 -- | Looks up an identifier in the current interactive context (for :info)
684 getInfo :: Session -> Name -> IO (Maybe (TyThing,Fixity,[Instance]))
685 getInfo s name = withSession s $ \hsc_env -> tcRnGetInfo hsc_env name
687 -- | Returns all names in scope in the current interactive context
688 getNamesInScope :: Session -> IO [Name]
689 getNamesInScope s = withSession s $ \hsc_env -> do
690 return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
692 getRdrNamesInScope :: Session -> IO [RdrName]
693 getRdrNamesInScope s = withSession s $ \hsc_env -> do
696 gbl_rdrenv = ic_rn_gbl_env ic
698 gbl_names = concat (map greToRdrNames (globalRdrEnvElts gbl_rdrenv))
699 lcl_names = map (mkRdrUnqual.nameOccName.idName) ids
701 return (gbl_names ++ lcl_names)
704 -- ToDo: move to RdrName
705 greToRdrNames :: GlobalRdrElt -> [RdrName]
706 greToRdrNames GRE{ gre_name = name, gre_prov = prov }
709 Imported specs -> concat (map do_spec (map is_decl specs))
711 occ = nameOccName name
714 | is_qual decl_spec = [qual]
715 | otherwise = [unqual,qual]
716 where qual = Qual (is_as decl_spec) occ
718 -- | Parses a string as an identifier, and returns the list of 'Name's that
719 -- the identifier can refer to in the current interactive context.
720 parseName :: Session -> String -> IO [Name]
721 parseName s str = withSession s $ \hsc_env -> do
722 maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
723 case maybe_rdr_name of
725 Just (L _ rdr_name) -> do
726 mb_names <- tcRnLookupRdrName hsc_env rdr_name
730 -- ToDo: should return error messages
732 -- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
733 -- entity known to GHC, including 'Name's defined using 'runStmt'.
734 lookupName :: Session -> Name -> IO (Maybe TyThing)
735 lookupName s name = withSession s $ \hsc_env -> tcRnLookupName hsc_env name
737 -- -----------------------------------------------------------------------------
738 -- Getting the type of an expression
740 -- | Get the type of an expression
741 exprType :: Session -> String -> IO (Maybe Type)
742 exprType s expr = withSession s $ \hsc_env -> do
743 maybe_stuff <- hscTcExpr hsc_env expr
745 Nothing -> return Nothing
746 Just ty -> return (Just tidy_ty)
748 tidy_ty = tidyType emptyTidyEnv ty
750 -- -----------------------------------------------------------------------------
751 -- Getting the kind of a type
753 -- | Get the kind of a type
754 typeKind :: Session -> String -> IO (Maybe Kind)
755 typeKind s str = withSession s $ \hsc_env -> do
756 maybe_stuff <- hscKcType hsc_env str
758 Nothing -> return Nothing
759 Just kind -> return (Just kind)
761 -----------------------------------------------------------------------------
762 -- cmCompileExpr: compile an expression and deliver an HValue
764 compileExpr :: Session -> String -> IO (Maybe HValue)
765 compileExpr s expr = withSession s $ \hsc_env -> do
766 maybe_stuff <- hscStmt hsc_env ("let __cmCompileExpr = "++expr)
768 Nothing -> return Nothing
769 Just (ids, hval) -> do
771 hvals <- (unsafeCoerce# hval) :: IO [HValue]
774 ([n],[hv]) -> return (Just hv)
775 _ -> panic "compileExpr"
777 -- -----------------------------------------------------------------------------
778 -- Compile an expression into a dynamic
780 dynCompileExpr :: Session -> String -> IO (Maybe Dynamic)
781 dynCompileExpr ses expr = do
782 (full,exports) <- getContext ses
783 setContext ses full $
785 (stringToPackageId "base") (mkModuleName "Data.Dynamic")
787 let stmt = "let __dynCompileExpr = Data.Dynamic.toDyn (" ++ expr ++ ")"
788 res <- withSession ses (flip hscStmt stmt)
789 setContext ses full exports
791 Nothing -> return Nothing
792 Just (ids, hvals) -> do
793 vals <- (unsafeCoerce# hvals :: IO [Dynamic])
795 (_:[], v:[]) -> return (Just v)
796 _ -> panic "dynCompileExpr"
798 -----------------------------------------------------------------------------
799 -- show a module and it's source/object filenames
801 showModule :: Session -> ModSummary -> IO String
802 showModule s mod_summary = withSession s $ \hsc_env ->
803 isModuleInterpreted s mod_summary >>= \interpreted ->
804 return (showModMsg (hscTarget(hsc_dflags hsc_env)) interpreted mod_summary)
806 isModuleInterpreted :: Session -> ModSummary -> IO Bool
807 isModuleInterpreted s mod_summary = withSession s $ \hsc_env ->
808 case lookupUFM (hsc_HPT hsc_env) (ms_mod_name mod_summary) of
809 Nothing -> panic "missing linkable"
810 Just mod_info -> return (not obj_linkable)
812 obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
814 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
815 obtainTerm1 sess force mb_ty x = withSession sess $ \hsc_env -> cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x)
817 obtainTerm :: Session -> Bool -> Id -> IO Term
818 obtainTerm sess force id = withSession sess $ \hsc_env -> do
819 hv <- Linker.getHValue hsc_env (varName id)
820 cvObtainTerm hsc_env force (Just$ idType id) hv