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
75 import GHC.Conc ( ThreadId(..) )
77 import Control.Exception as Exception
78 import Control.Concurrent
80 import Foreign.StablePtr
82 -- -----------------------------------------------------------------------------
83 -- running a statement interactively
86 = RunOk [Name] -- ^ names bound by this evaluation
87 | RunFailed -- ^ statement failed compilation
88 | RunException Exception -- ^ statement raised an exception
89 | RunBreak ThreadId [Name] (Maybe BreakInfo)
92 = Break Bool HValue BreakInfo ThreadId
93 -- ^ the computation hit a breakpoint (Bool <=> was an exception)
94 | Complete (Either Exception [HValue])
95 -- ^ the computation completed with either an exception or a value
99 resumeStmt :: String, -- the original statement
100 resumeThreadId :: ThreadId, -- thread running the computation
101 resumeBreakMVar :: MVar (),
102 resumeStatMVar :: MVar Status,
103 resumeBindings :: ([Id], TyVarSet),
104 resumeFinalIds :: [Id], -- [Id] to bind on completion
105 resumeApStack :: HValue, -- The object from which we can get
106 -- value of the free variables.
107 resumeBreakInfo :: Maybe BreakInfo,
108 -- the breakpoint we stopped at
109 -- (Nothing <=> exception)
110 resumeSpan :: SrcSpan, -- just a cache, otherwise it's a pain
111 -- to fetch the ModDetails & ModBreaks
113 resumeHistory :: [History],
114 resumeHistoryIx :: Int -- 0 <==> at the top of the history
117 getResumeContext :: Session -> IO [Resume]
118 getResumeContext s = withSession s (return . ic_resume . hsc_IC)
125 isStep RunToCompletion = False
130 historyApStack :: HValue,
131 historyBreakInfo :: BreakInfo
134 getHistorySpan :: Session -> History -> IO SrcSpan
135 getHistorySpan s hist = withSession s $ \hsc_env -> do
136 let inf = historyBreakInfo hist
137 num = breakInfo_number inf
138 case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
139 Just hmi -> return (modBreaks_locs (md_modBreaks (hm_details hmi)) ! num)
140 _ -> panic "getHistorySpan"
142 -- | Run a statement in the current interactive context. Statement
143 -- may bind multple values.
144 runStmt :: Session -> String -> SingleStep -> IO RunResult
145 runStmt (Session ref) expr step
147 hsc_env <- readIORef ref
149 breakMVar <- newEmptyMVar -- wait on this when we hit a breakpoint
150 statusMVar <- newEmptyMVar -- wait on this when a computation is running
152 -- Turn off -fwarn-unused-bindings when running a statement, to hide
153 -- warnings about the implicit bindings we introduce.
154 let dflags' = dopt_unset (hsc_dflags hsc_env) Opt_WarnUnusedBinds
155 hsc_env' = hsc_env{ hsc_dflags = dflags' }
157 maybe_stuff <- hscStmt hsc_env' expr
160 Nothing -> return RunFailed
161 Just (ids, hval) -> do
163 withBreakAction (isStep step) dflags' breakMVar statusMVar $ do
165 let thing_to_run = unsafeCoerce# hval :: IO [HValue]
166 status <- sandboxIO statusMVar thing_to_run
168 let ic = hsc_IC hsc_env
169 bindings = (ic_tmp_ids ic, ic_tyvars ic)
173 traceRunStatus expr ref bindings ids
174 breakMVar statusMVar status emptyHistory
176 handleRunStatus expr ref bindings ids
177 breakMVar statusMVar status emptyHistory
180 emptyHistory = nilBL 50 -- keep a log of length 50
182 handleRunStatus expr ref bindings final_ids breakMVar statusMVar status
185 -- did we hit a breakpoint or did we complete?
186 (Break is_exception apStack info tid) -> do
187 hsc_env <- readIORef ref
188 let mb_info | is_exception = Nothing
189 | otherwise = Just info
190 (hsc_env1, names, span) <- bindLocalsAtBreakpoint hsc_env
193 resume = Resume expr tid breakMVar statusMVar
194 bindings final_ids apStack mb_info span
196 hsc_env2 = pushResume hsc_env1 resume
198 writeIORef ref hsc_env2
199 return (RunBreak tid names mb_info)
200 (Complete either_hvals) ->
202 Left e -> return (RunException e)
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)
214 traceRunStatus expr ref bindings final_ids
215 breakMVar statusMVar status history = do
216 hsc_env <- readIORef ref
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 is_exception apStack info tid) | not is_exception -> do
221 b <- isBreakEnabled hsc_env info
225 let history' = consBL (History apStack info) history
226 -- probably better make history strict here, otherwise
227 -- our BoundedList will be pointless.
229 status <- withBreakAction True (hsc_dflags hsc_env)
230 breakMVar statusMVar $ do
232 (do putMVar breakMVar () -- awaken the stopped thread
234 (takeMVar statusMVar) -- and wait for the result
235 traceRunStatus expr ref bindings final_ids
236 breakMVar statusMVar status history'
240 handle_normally = handleRunStatus expr ref bindings final_ids
241 breakMVar statusMVar status history
244 isBreakEnabled :: HscEnv -> BreakInfo -> IO Bool
245 isBreakEnabled hsc_env inf =
246 case lookupUFM (hsc_HPT hsc_env) (moduleName (breakInfo_module inf)) of
248 w <- getBreak (modBreaks_flags (md_modBreaks (hm_details hmi)))
249 (breakInfo_number inf)
250 case w of Just n -> return (n /= 0); _other -> return False
255 foreign import ccall "&rts_stop_next_breakpoint" stepFlag :: Ptr CInt
256 foreign import ccall "&rts_stop_on_exception" exceptionFlag :: Ptr CInt
258 setStepFlag = poke stepFlag 1
259 resetStepFlag = poke stepFlag 0
261 -- this points to the IO action that is executed when a breakpoint is hit
262 foreign import ccall "&rts_breakpoint_io_action"
263 breakPointIOAction :: Ptr (StablePtr (Bool -> BreakInfo -> HValue -> IO ()))
265 -- When running a computation, we redirect ^C exceptions to the running
266 -- thread. ToDo: we might want a way to continue even if the target
267 -- thread doesn't die when it receives the exception... "this thread
268 -- is not responding".
269 sandboxIO :: MVar Status -> IO [HValue] -> IO Status
270 sandboxIO statusMVar thing =
272 (forkIO (do res <- Exception.try thing
273 putMVar statusMVar (Complete res)))
274 (takeMVar statusMVar)
276 withInterruptsSentTo :: IO ThreadId -> IO r -> IO r
277 withInterruptsSentTo io get_result = do
278 ts <- takeMVar interruptTargetThread
280 putMVar interruptTargetThread (child:ts)
281 get_result `finally` modifyMVar_ interruptTargetThread (return.tail)
283 -- This function sets up the interpreter for catching breakpoints, and
284 -- resets everything when the computation has stopped running. This
285 -- is a not-very-good way to ensure that only the interactive
286 -- evaluation should generate breakpoints.
287 withBreakAction step dflags breakMVar statusMVar io
288 = bracket setBreakAction resetBreakAction (\_ -> io)
291 stablePtr <- newStablePtr onBreak
292 poke breakPointIOAction stablePtr
293 when (dopt Opt_BreakOnException dflags) $ poke exceptionFlag 1
294 when step $ setStepFlag
296 -- Breaking on exceptions is not enabled by default, since it
297 -- might be a bit surprising. The exception flag is turned off
298 -- as soon as it is hit, or in resetBreakAction below.
300 onBreak is_exception info apStack = do
302 putMVar statusMVar (Break is_exception apStack info tid)
305 resetBreakAction stablePtr = do
306 poke breakPointIOAction noBreakStablePtr
309 freeStablePtr stablePtr
311 noBreakStablePtr = unsafePerformIO $ newStablePtr noBreakAction
313 noBreakAction False info apStack = putStrLn "*** Ignoring breakpoint"
314 noBreakAction True info apStack = return () -- exception: just continue
316 resume :: Session -> SingleStep -> IO RunResult
317 resume (Session ref) step
319 hsc_env <- readIORef ref
320 let ic = hsc_IC hsc_env
321 resume = ic_resume ic
324 [] -> throwDyn (ProgramError "not stopped at a breakpoint")
326 -- unbind the temporary locals by restoring the TypeEnv from
327 -- before the breakpoint, and drop this Resume from the
328 -- InteractiveContext.
329 let (resume_tmp_ids, resume_tyvars) = resumeBindings r
330 ic' = ic { ic_tmp_ids = resume_tmp_ids,
331 ic_tyvars = resume_tyvars,
333 writeIORef ref hsc_env{ hsc_IC = ic' }
335 -- remove any bindings created since the breakpoint from the
336 -- linker's environment
337 let new_names = map idName (filter (`notElem` resume_tmp_ids)
339 Linker.deleteFromLinkEnv new_names
341 when (isStep step) $ setStepFlag
343 Resume expr tid breakMVar statusMVar bindings
344 final_ids apStack info _ _ _ -> do
345 withBreakAction (isStep step) (hsc_dflags hsc_env)
346 breakMVar statusMVar $ do
347 status <- withInterruptsSentTo
348 (do putMVar breakMVar ()
349 -- this awakens the stopped thread...
351 (takeMVar statusMVar)
352 -- and wait for the result
355 traceRunStatus expr ref bindings final_ids
356 breakMVar statusMVar status emptyHistory
358 handleRunStatus expr ref bindings final_ids
359 breakMVar statusMVar status emptyHistory
362 back :: Session -> IO ([Name], Int, SrcSpan)
365 forward :: Session -> IO ([Name], Int, SrcSpan)
366 forward = moveHist (subtract 1)
368 moveHist fn (Session ref) = do
369 hsc_env <- readIORef ref
370 case ic_resume (hsc_IC hsc_env) of
371 [] -> throwDyn (ProgramError "not stopped at a breakpoint")
373 let ix = resumeHistoryIx r
374 history = resumeHistory r
377 when (new_ix > length history) $
378 throwDyn (ProgramError "no more logged breakpoints")
380 throwDyn (ProgramError "already at the beginning of the history")
383 update_ic apStack mb_info = do
384 (hsc_env1, names, span) <- bindLocalsAtBreakpoint hsc_env
386 let ic = hsc_IC hsc_env1
387 r' = r { resumeHistoryIx = new_ix }
388 ic' = ic { ic_resume = r':rs }
390 writeIORef ref hsc_env1{ hsc_IC = ic' }
392 return (names, new_ix, span)
394 -- careful: we want apStack to be the AP_STACK itself, not a thunk
395 -- around it, hence the cases are carefully constructed below to
396 -- make this the case. ToDo: this is v. fragile, do something better.
399 Resume { resumeApStack = apStack,
400 resumeBreakInfo = mb_info } ->
401 update_ic apStack mb_info
402 else case history !! (new_ix - 1) of
403 History apStack info ->
404 update_ic apStack (Just info)
406 -- -----------------------------------------------------------------------------
407 -- After stopping at a breakpoint, add free variables to the environment
409 bindLocalsAtBreakpoint
413 -> IO (HscEnv, [Name], SrcSpan)
415 -- Nothing case: we stopped when an exception was raised, not at a
416 -- breakpoint. We have no location information or local variables to
417 -- bind, all we can do is bind a local variable to the exception
419 bindLocalsAtBreakpoint hsc_env apStack Nothing = do
420 let exn_fs = FSLIT("_exception")
421 exn_name = mkInternalName (getUnique exn_fs) (mkVarOccFS exn_fs) span
423 e_name = mkInternalName (getUnique e_fs) (mkTyVarOcc e_fs) span
424 e_tyvar = mkTcTyVar e_name liftedTypeKind (SkolemTv RuntimeUnkSkol)
425 exn_id = Id.mkGlobalId VanillaGlobal exn_name (mkTyVarTy e_tyvar)
427 new_tyvars = unitVarSet e_tyvar
429 ictxt0 = hsc_IC hsc_env
430 ictxt1 = extendInteractiveContext ictxt0 [exn_id] new_tyvars
432 span = mkGeneralSrcSpan FSLIT("<exception thrown>")
434 Linker.extendLinkEnv [(exn_name, unsafeCoerce# apStack)]
435 return (hsc_env{ hsc_IC = ictxt1 }, [exn_name], span)
437 -- Just case: we stopped at a breakpoint, we have information about the location
438 -- of the breakpoint and the free variables of the expression.
439 bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
442 mod_name = moduleName (breakInfo_module info)
443 mod_details = fmap hm_details (lookupUFM (hsc_HPT hsc_env) mod_name)
444 breaks = md_modBreaks (expectJust "handlRunStatus" mod_details)
445 index = breakInfo_number info
446 vars = breakInfo_vars info
447 result_ty = breakInfo_resty info
448 occs = modBreaks_vars breaks ! index
449 span = modBreaks_locs breaks ! index
451 -- filter out any unboxed ids; we can't bind these at the prompt
452 let pointers = filter (\(id,_) -> isPointer id) vars
453 isPointer id | PtrRep <- idPrimRep id = True
456 let (ids, offsets) = unzip pointers
458 -- It might be that getIdValFromApStack fails, because the AP_STACK
459 -- has been accidentally evaluated, or something else has gone wrong.
460 -- So that we don't fall over in a heap when this happens, just don't
461 -- bind any free variables instead, and we emit a warning.
462 mb_hValues <- mapM (getIdValFromApStack apStack) offsets
463 let filtered_ids = [ id | (id, Just _) <- zip ids mb_hValues ]
464 when (any isNothing mb_hValues) $
465 debugTraceMsg (hsc_dflags hsc_env) 1 $
466 text "Warning: _result has been evaluated, some bindings have been lost"
468 new_ids <- zipWithM mkNewId occs filtered_ids
469 let names = map idName new_ids
471 -- make an Id for _result. We use the Unique of the FastString "_result";
472 -- we don't care about uniqueness here, because there will only be one
473 -- _result in scope at any time.
474 let result_fs = FSLIT("_result")
475 result_name = mkInternalName (getUnique result_fs)
476 (mkVarOccFS result_fs) span
477 result_id = Id.mkGlobalId VanillaGlobal result_name result_ty
480 -- for each Id we're about to bind in the local envt:
481 -- - skolemise the type variables in its type, so they can't
482 -- be randomly unified with other types. These type variables
483 -- can only be resolved by type reconstruction in RtClosureInspect
484 -- - tidy the type variables
485 -- - globalise the Id (Ids are supposed to be Global, apparently).
487 let all_ids | isPointer result_id = result_id : new_ids
488 | otherwise = new_ids
489 (id_tys, tyvarss) = mapAndUnzip (skolemiseTy.idType) all_ids
490 (_,tidy_tys) = tidyOpenTypes emptyTidyEnv id_tys
491 new_tyvars = unionVarSets tyvarss
492 final_ids = zipWith setIdType all_ids tidy_tys
494 let ictxt0 = hsc_IC hsc_env
495 ictxt1 = extendInteractiveContext ictxt0 final_ids new_tyvars
497 Linker.extendLinkEnv [ (name,hval) | (name, Just hval) <- zip names mb_hValues ]
498 Linker.extendLinkEnv [(result_name, unsafeCoerce# apStack)]
499 return (hsc_env{ hsc_IC = ictxt1 }, result_name:names, span)
501 mkNewId :: OccName -> Id -> IO Id
503 let uniq = idUnique id
504 loc = nameSrcSpan (idName id)
505 name = mkInternalName uniq occ loc
507 new_id = Id.mkGlobalId VanillaGlobal name ty (idInfo id)
510 skolemiseTy :: Type -> (Type, TyVarSet)
511 skolemiseTy ty = (substTy subst ty, mkVarSet new_tyvars)
512 where env = mkVarEnv (zip tyvars new_tyvar_tys)
513 subst = mkTvSubst emptyInScopeSet env
514 tyvars = varSetElems (tyVarsOfType ty)
515 new_tyvars = map skolemiseTyVar tyvars
516 new_tyvar_tys = map mkTyVarTy new_tyvars
518 skolemiseTyVar :: TyVar -> TyVar
519 skolemiseTyVar tyvar = mkTcTyVar (tyVarName tyvar) (tyVarKind tyvar)
520 (SkolemTv RuntimeUnkSkol)
522 getIdValFromApStack :: HValue -> Int -> IO (Maybe HValue)
523 getIdValFromApStack apStack (I# stackDepth) = do
524 case getApStackVal# apStack (stackDepth +# 1#) of
525 -- The +1 is magic! I don't know where it comes
526 -- from, but this makes things line up. --SDM
529 0# -> return Nothing -- AP_STACK not found
530 _ -> return (Just (unsafeCoerce# result))
532 pushResume :: HscEnv -> Resume -> HscEnv
533 pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }
535 ictxt0 = hsc_IC hsc_env
536 ictxt1 = ictxt0 { ic_resume = resume : ic_resume ictxt0 }
538 -- -----------------------------------------------------------------------------
539 -- Abandoning a resume context
541 abandon :: Session -> IO Bool
542 abandon (Session ref) = do
543 hsc_env <- readIORef ref
544 let ic = hsc_IC hsc_env
545 resume = ic_resume ic
549 writeIORef ref hsc_env{ hsc_IC = ic { ic_resume = rs } }
553 abandonAll :: Session -> IO Bool
554 abandonAll (Session ref) = do
555 hsc_env <- readIORef ref
556 let ic = hsc_IC hsc_env
557 resume = ic_resume ic
561 writeIORef ref hsc_env{ hsc_IC = ic { ic_resume = [] } }
565 -- when abandoning a computation we have to
566 -- (a) kill the thread with an async exception, so that the
567 -- computation itself is stopped, and
568 -- (b) fill in the MVar. This step is necessary because any
569 -- thunks that were under evaluation will now be updated
570 -- with the partial computation, which still ends in takeMVar,
571 -- so any attempt to evaluate one of these thunks will block
572 -- unless we fill in the MVar.
573 -- See test break010.
574 abandon_ :: Resume -> IO ()
576 killThread (resumeThreadId r)
577 putMVar (resumeBreakMVar r) ()
579 -- -----------------------------------------------------------------------------
580 -- Bounded list, optimised for repeated cons
582 data BoundedList a = BL
583 {-# UNPACK #-} !Int -- length
584 {-# UNPACK #-} !Int -- bound
586 [a] -- right, list is (left ++ reverse right)
588 nilBL :: Int -> BoundedList a
589 nilBL bound = BL 0 bound [] []
591 consBL a (BL len bound left right)
592 | len < bound = BL (len+1) bound (a:left) right
593 | null right = BL len bound [a] $! tail (reverse left)
594 | otherwise = BL len bound (a:left) $! tail right
596 toListBL (BL _ _ left right) = left ++ reverse right
598 -- lenBL (BL len _ _ _) = len
600 -- -----------------------------------------------------------------------------
601 -- | Set the interactive evaluation context.
603 -- Setting the context doesn't throw away any bindings; the bindings
604 -- we've built up in the InteractiveContext simply move to the new
605 -- module. They always shadow anything in scope in the current context.
606 setContext :: Session
607 -> [Module] -- entire top level scope of these modules
608 -> [Module] -- exports only of these modules
610 setContext sess@(Session ref) toplev_mods export_mods = do
611 hsc_env <- readIORef ref
612 let old_ic = hsc_IC hsc_env
613 hpt = hsc_HPT hsc_env
615 export_env <- mkExportEnv hsc_env export_mods
616 toplev_envs <- mapM (mkTopLevEnv hpt) toplev_mods
617 let all_env = foldr plusGlobalRdrEnv export_env toplev_envs
618 writeIORef ref hsc_env{ hsc_IC = old_ic { ic_toplev_scope = toplev_mods,
619 ic_exports = export_mods,
620 ic_rn_gbl_env = all_env }}
622 -- Make a GlobalRdrEnv based on the exports of the modules only.
623 mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv
624 mkExportEnv hsc_env mods = do
625 stuff <- mapM (getModuleExports hsc_env) mods
627 (_msgs, mb_name_sets) = unzip stuff
628 gres = [ nameSetToGlobalRdrEnv (availsToNameSet avails) (moduleName mod)
629 | (Just avails, mod) <- zip mb_name_sets mods ]
631 return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres
633 nameSetToGlobalRdrEnv :: NameSet -> ModuleName -> GlobalRdrEnv
634 nameSetToGlobalRdrEnv names mod =
635 mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = vanillaProv mod }
636 | name <- nameSetToList names ]
638 vanillaProv :: ModuleName -> Provenance
639 -- We're building a GlobalRdrEnv as if the user imported
640 -- all the specified modules into the global interactive module
641 vanillaProv mod_name = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}]
643 decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name,
645 is_dloc = srcLocSpan interactiveSrcLoc }
647 mkTopLevEnv :: HomePackageTable -> Module -> IO GlobalRdrEnv
649 = case lookupUFM hpt (moduleName modl) of
650 Nothing -> throwDyn (ProgramError ("mkTopLevEnv: not a home module " ++
651 showSDoc (ppr modl)))
653 case mi_globals (hm_iface details) of
655 throwDyn (ProgramError ("mkTopLevEnv: not interpreted "
656 ++ showSDoc (ppr modl)))
657 Just env -> return env
659 -- | Get the interactive evaluation context, consisting of a pair of the
660 -- set of modules from which we take the full top-level scope, and the set
661 -- of modules from which we take just the exports respectively.
662 getContext :: Session -> IO ([Module],[Module])
663 getContext s = withSession s (\HscEnv{ hsc_IC=ic } ->
664 return (ic_toplev_scope ic, ic_exports ic))
666 -- | Returns 'True' if the specified module is interpreted, and hence has
667 -- its full top-level scope available.
668 moduleIsInterpreted :: Session -> Module -> IO Bool
669 moduleIsInterpreted s modl = withSession s $ \h ->
670 if modulePackageId modl /= thisPackage (hsc_dflags h)
672 else case lookupUFM (hsc_HPT h) (moduleName modl) of
673 Just details -> return (isJust (mi_globals (hm_iface details)))
674 _not_a_home_module -> return False
676 -- | Looks up an identifier in the current interactive context (for :info)
677 getInfo :: Session -> Name -> IO (Maybe (TyThing,Fixity,[Instance]))
678 getInfo s name = withSession s $ \hsc_env -> tcRnGetInfo hsc_env name
680 -- | Returns all names in scope in the current interactive context
681 getNamesInScope :: Session -> IO [Name]
682 getNamesInScope s = withSession s $ \hsc_env -> do
683 return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
685 getRdrNamesInScope :: Session -> IO [RdrName]
686 getRdrNamesInScope s = withSession s $ \hsc_env -> do
689 gbl_rdrenv = ic_rn_gbl_env ic
691 gbl_names = concat (map greToRdrNames (globalRdrEnvElts gbl_rdrenv))
692 lcl_names = map (mkRdrUnqual.nameOccName.idName) ids
694 return (gbl_names ++ lcl_names)
697 -- ToDo: move to RdrName
698 greToRdrNames :: GlobalRdrElt -> [RdrName]
699 greToRdrNames GRE{ gre_name = name, gre_prov = prov }
702 Imported specs -> concat (map do_spec (map is_decl specs))
704 occ = nameOccName name
707 | is_qual decl_spec = [qual]
708 | otherwise = [unqual,qual]
709 where qual = Qual (is_as decl_spec) occ
711 -- | Parses a string as an identifier, and returns the list of 'Name's that
712 -- the identifier can refer to in the current interactive context.
713 parseName :: Session -> String -> IO [Name]
714 parseName s str = withSession s $ \hsc_env -> do
715 maybe_rdr_name <- hscParseIdentifier (hsc_dflags hsc_env) str
716 case maybe_rdr_name of
718 Just (L _ rdr_name) -> do
719 mb_names <- tcRnLookupRdrName hsc_env rdr_name
723 -- ToDo: should return error messages
725 -- | Returns the 'TyThing' for a 'Name'. The 'Name' may refer to any
726 -- entity known to GHC, including 'Name's defined using 'runStmt'.
727 lookupName :: Session -> Name -> IO (Maybe TyThing)
728 lookupName s name = withSession s $ \hsc_env -> tcRnLookupName hsc_env name
730 -- -----------------------------------------------------------------------------
731 -- Getting the type of an expression
733 -- | Get the type of an expression
734 exprType :: Session -> String -> IO (Maybe Type)
735 exprType s expr = withSession s $ \hsc_env -> do
736 maybe_stuff <- hscTcExpr hsc_env expr
738 Nothing -> return Nothing
739 Just ty -> return (Just tidy_ty)
741 tidy_ty = tidyType emptyTidyEnv ty
743 -- -----------------------------------------------------------------------------
744 -- Getting the kind of a type
746 -- | Get the kind of a type
747 typeKind :: Session -> String -> IO (Maybe Kind)
748 typeKind s str = withSession s $ \hsc_env -> do
749 maybe_stuff <- hscKcType hsc_env str
751 Nothing -> return Nothing
752 Just kind -> return (Just kind)
754 -----------------------------------------------------------------------------
755 -- cmCompileExpr: compile an expression and deliver an HValue
757 compileExpr :: Session -> String -> IO (Maybe HValue)
758 compileExpr s expr = withSession s $ \hsc_env -> do
759 maybe_stuff <- hscStmt hsc_env ("let __cmCompileExpr = "++expr)
761 Nothing -> return Nothing
762 Just (ids, hval) -> do
764 hvals <- (unsafeCoerce# hval) :: IO [HValue]
767 ([n],[hv]) -> return (Just hv)
768 _ -> panic "compileExpr"
770 -- -----------------------------------------------------------------------------
771 -- Compile an expression into a dynamic
773 dynCompileExpr :: Session -> String -> IO (Maybe Dynamic)
774 dynCompileExpr ses expr = do
775 (full,exports) <- getContext ses
776 setContext ses full $
778 (stringToPackageId "base") (mkModuleName "Data.Dynamic")
780 let stmt = "let __dynCompileExpr = Data.Dynamic.toDyn (" ++ expr ++ ")"
781 res <- withSession ses (flip hscStmt stmt)
782 setContext ses full exports
784 Nothing -> return Nothing
785 Just (ids, hvals) -> do
786 vals <- (unsafeCoerce# hvals :: IO [Dynamic])
788 (_:[], v:[]) -> return (Just v)
789 _ -> panic "dynCompileExpr"
791 -----------------------------------------------------------------------------
792 -- show a module and it's source/object filenames
794 showModule :: Session -> ModSummary -> IO String
795 showModule s mod_summary = withSession s $ \hsc_env ->
796 isModuleInterpreted s mod_summary >>= \interpreted ->
797 return (showModMsg (hscTarget(hsc_dflags hsc_env)) interpreted mod_summary)
799 isModuleInterpreted :: Session -> ModSummary -> IO Bool
800 isModuleInterpreted s mod_summary = withSession s $ \hsc_env ->
801 case lookupUFM (hsc_HPT hsc_env) (ms_mod_name mod_summary) of
802 Nothing -> panic "missing linkable"
803 Just mod_info -> return (not obj_linkable)
805 obj_linkable = isObjectLinkable (expectJust "showModule" (hm_linkable mod_info))
807 obtainTerm1 :: Session -> Bool -> Maybe Type -> a -> IO Term
808 obtainTerm1 sess force mb_ty x = withSession sess $ \hsc_env -> cvObtainTerm hsc_env force mb_ty (unsafeCoerce# x)
810 obtainTerm :: Session -> Bool -> Id -> IO Term
811 obtainTerm sess force id = withSession sess $ \hsc_env -> do
812 hv <- Linker.getHValue hsc_env (varName id)
813 cvObtainTerm hsc_env force (Just$ idType id) hv