X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FInteractiveEval.hs;h=7e4406e61bceea28cf70cf6a3fd0024072b19aac;hb=24a3fee9f3ff6cef6fe471ab6f0a7ba9ac001faf;hp=33227a8cd80187b8133a470d05ba2029286adf30;hpb=d436c70d43fb905c63220040168295e473f4b90a;p=ghc-hetmet.git diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 33227a8..7e4406e 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -18,7 +18,7 @@ module InteractiveEval ( getHistoryModule, back, forward, setContext, getContext, - nameSetToGlobalRdrEnv, + availsToGlobalRdrEnv, getNamesInScope, getRdrNamesInScope, moduleIsInterpreted, @@ -42,9 +42,10 @@ module InteractiveEval ( import HscMain hiding (compileExpr) import HscTypes import TcRnDriver -import Type hiding (typeKind) -import TcType hiding (typeKind) +import RnNames ( gresFromAvails ) import InstEnv +import Type +import TcType hiding( typeKind ) import Var import Id import Name hiding ( varName ) @@ -59,7 +60,7 @@ import Unique import UniqSupply import Module import Panic -import LazyUniqFM +import UniqFM import Maybes import ErrUtils import Util @@ -380,9 +381,9 @@ rethrow dflags io = Exception.catch io $ \se -> do not (dopt Opt_BreakOnException dflags) then poke exceptionFlag 1 else case fromException se of - -- If it is an "Interrupted" exception, we allow + -- If it is a "UserInterrupt" exception, we allow -- a possible break by way of -fbreak-on-exception - Just Interrupted -> return () + Just UserInterrupt -> return () -- In any other case, we don't want to break _ -> poke exceptionFlag 0 @@ -586,7 +587,7 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do -- has been accidentally evaluated, or something else has gone wrong. -- So that we don't fall over in a heap when this happens, just don't -- bind any free variables instead, and we emit a warning. - mb_hValues <- mapM (getIdValFromApStack apStack) offsets + mb_hValues <- mapM (getIdValFromApStack apStack) (map fromIntegral offsets) let filtered_ids = [ id | (id, Just _hv) <- zip ids mb_hValues ] when (any isNothing mb_hValues) $ debugTraceMsg (hsc_dflags hsc_env) 1 $ @@ -807,25 +808,20 @@ setContext toplev_mods export_mods = do -- Make a GlobalRdrEnv based on the exports of the modules only. mkExportEnv :: HscEnv -> [Module] -> IO GlobalRdrEnv -mkExportEnv hsc_env mods = do - stuff <- mapM (getModuleExports hsc_env) mods - let - (_msgs, mb_name_sets) = unzip stuff - gres = [ nameSetToGlobalRdrEnv (availsToNameSet avails) (moduleName mod) - | (Just avails, mod) <- zip mb_name_sets mods ] - -- - return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv gres - -nameSetToGlobalRdrEnv :: NameSet -> ModuleName -> GlobalRdrEnv -nameSetToGlobalRdrEnv names mod = - mkGlobalRdrEnv [ GRE { gre_name = name, gre_par = NoParent, gre_prov = vanillaProv mod } - | name <- nameSetToList names ] - -vanillaProv :: ModuleName -> Provenance --- We're building a GlobalRdrEnv as if the user imported --- all the specified modules into the global interactive module -vanillaProv mod_name = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}] +mkExportEnv hsc_env mods + = do { stuff <- mapM (getModuleExports hsc_env) mods + ; let (_msgs, mb_name_sets) = unzip stuff + envs = [ availsToGlobalRdrEnv (moduleName mod) avails + | (Just avails, mod) <- zip mb_name_sets mods ] + ; return $! foldr plusGlobalRdrEnv emptyGlobalRdrEnv envs } + +availsToGlobalRdrEnv :: ModuleName -> [AvailInfo] -> GlobalRdrEnv +availsToGlobalRdrEnv mod_name avails + = mkGlobalRdrEnv (gresFromAvails imp_prov avails) where + -- We're building a GlobalRdrEnv as if the user imported + -- all the specified modules into the global interactive module + imp_prov = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}] decl = ImpDeclSpec { is_mod = mod_name, is_as = mod_name, is_qual = False, is_dloc = srcLocSpan interactiveSrcLoc }