summaryrefslogtreecommitdiff
path: root/ghc/GHCi
diff options
context:
space:
mode:
Diffstat (limited to 'ghc/GHCi')
-rw-r--r--ghc/GHCi/UI.hs63
-rw-r--r--ghc/GHCi/UI/Info.hs8
-rw-r--r--ghc/GHCi/UI/Tags.hs14
3 files changed, 49 insertions, 36 deletions
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index 81b0a84fca..152017de38 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -1495,7 +1495,8 @@ info allInfo s = handleSourceError GHC.printException $ do
unqual <- GHC.getPrintUnqual
dflags <- getDynFlags
sdocs <- mapM (infoThing allInfo) (words s)
- mapM_ (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs
+ unit_state <- hsc_units <$> GHC.getSession
+ mapM_ (liftIO . putStrLn . showSDocForUser dflags unit_state unqual) sdocs
infoThing :: GHC.GhcMonad m => Bool -> String -> m SDoc
infoThing allInfo str = do
@@ -1796,7 +1797,8 @@ docCmd s = do
let sdocs' = vcat (intersperse (text "") sdocs)
unqual <- GHC.getPrintUnqual
dflags <- getDynFlags
- (liftIO . putStrLn . showSDocForUser dflags unqual) sdocs'
+ unit_state <- hsc_units <$> GHC.getSession
+ (liftIO . putStrLn . showSDocForUser dflags unit_state unqual) sdocs'
pprDocs :: [(Maybe HsDocString, Map Int HsDocString)] -> [SDoc]
pprDocs docs
@@ -2085,6 +2087,7 @@ keepPackageImports = filterM is_pkg_import
modulesLoadedMsg :: GHC.GhcMonad m => SuccessFlag -> [GHC.ModSummary] -> m ()
modulesLoadedMsg ok mods = do
dflags <- getDynFlags
+ unit_state <- hsc_units <$> GHC.getSession
unqual <- GHC.getPrintUnqual
msg <- if gopt Opt_ShowLoadedModules dflags
@@ -2099,7 +2102,7 @@ modulesLoadedMsg ok mods = do
<+> speakNOf (length mods) (text "module") <+> "loaded."
when (verbosity dflags > 0) $
- liftIO $ putStrLn $ showSDocForUser dflags unqual msg
+ liftIO $ putStrLn $ showSDocForUser dflags unit_state unqual msg
where
status = case ok of
Failed -> text "Failed"
@@ -2122,7 +2125,8 @@ runExceptGhcMonad act = handleSourceError GHC.printException $
where
handleErr sdoc = do
dflags <- getDynFlags
- liftIO . hPutStrLn stderr . showSDocForUser dflags alwaysQualify $ sdoc
+ unit_state <- hsc_units <$> GHC.getSession
+ liftIO . hPutStrLn stderr . showSDocForUser dflags unit_state alwaysQualify $ sdoc
-- | Inverse of 'runExceptT' for \"pure\" computations
-- (c.f. 'except' for 'Except')
@@ -2186,9 +2190,11 @@ allTypesCmd _ = runExceptGhcMonad $ do
where
printSpan span'
| Just ty <- spaninfoType span' = do
- df <- getDynFlags
+ hsc_env <- GHC.getSession
let tyInfo = unwords . words $
- showSDocForUser df alwaysQualify (pprTypeForUser ty)
+ showSDocForUser (hsc_dflags hsc_env)
+ (hsc_units hsc_env)
+ alwaysQualify (pprTypeForUser ty)
liftIO . putStrLn $
showRealSrcSpan (spaninfoSrcSpan span') ++ ": " ++ tyInfo
| otherwise = return ()
@@ -2357,6 +2363,7 @@ isSafeModule m = do
(throwGhcException $ CmdLineError $ "unknown module: " ++ mname)
dflags <- getDynFlags
+ hsc_env <- GHC.getSession
let iface = GHC.modInfoIface $ fromJust mb_mod_info
when (isNothing iface)
(throwGhcException $ CmdLineError $ "can't load interface file for module: " ++
@@ -2364,8 +2371,8 @@ isSafeModule m = do
(msafe, pkgs) <- GHC.moduleTrustReqs m
let trust = showPpr dflags $ getSafeMode $ GHC.mi_trust $ fromJust iface
- pkg = if packageTrusted dflags m then "trusted" else "untrusted"
- (good, bad) = tallyPkgs dflags pkgs
+ pkg = if packageTrusted hsc_env m then "trusted" else "untrusted"
+ (good, bad) = tallyPkgs hsc_env pkgs
-- print info to user...
liftIO $ putStrLn $ "Trust type is (Module: " ++ trust ++ ", Package: " ++ pkg ++ ")"
@@ -2384,14 +2391,15 @@ isSafeModule m = do
where
mname = GHC.moduleNameString $ GHC.moduleName m
- packageTrusted dflags md
- | isHomeModule (mkHomeUnitFromFlags dflags) md = True
- | otherwise = unitIsTrusted $ unsafeLookupUnit (unitState dflags) (moduleUnit md)
+ packageTrusted hsc_env md
+ | isHomeModule (hsc_home_unit hsc_env) md = True
+ | otherwise = unitIsTrusted $ unsafeLookupUnit (hsc_units hsc_env) (moduleUnit md)
- tallyPkgs dflags deps | not (packageTrustOn dflags) = (S.empty, S.empty)
+ tallyPkgs hsc_env deps | not (packageTrustOn dflags) = (S.empty, S.empty)
| otherwise = S.partition part deps
where part pkg = unitIsTrusted $ unsafeLookupUnitId unit_state pkg
- unit_state = unitState dflags
+ unit_state = hsc_units hsc_env
+ dflags = hsc_dflags hsc_env
-----------------------------------------------------------------------------
-- :browse
@@ -2497,7 +2505,8 @@ browseModule bang modl exports_only = do
prettyThings = map pretty things
prettyThings' | bang = annotate $ zip modNames prettyThings
| otherwise = prettyThings
- liftIO $ putStrLn $ showSDocForUser dflags unqual (vcat prettyThings')
+ unit_state <- hsc_units <$> GHC.getSession
+ liftIO $ putStrLn $ showSDocForUser dflags unit_state unqual (vcat prettyThings')
-- ToDo: modInfoInstances currently throws an exception for
-- package modules. When it works, we can do this:
-- $$ vcat (map GHC.pprInstance (GHC.modInfoInstances mod_info))
@@ -2971,16 +2980,14 @@ newDynFlags interactive_only minus_opts = do
-- delete targets and all eventually defined breakpoints. (#1620)
clearAllTargets
when must_reload $ do
- let units = preloadUnits (unitState dflags2)
+ let units = preloadUnits (hsc_units hsc_env)
liftIO $ Loader.loadPackages hsc_env units
-- package flags changed, we can't re-use any of the old context
setContextAfterLoad False []
- -- and copy the package state to the interactive DynFlags
+ -- and copy the package flags to the interactive DynFlags
idflags <- GHC.getInteractiveDynFlags
GHC.setInteractiveDynFlags
- idflags{ unitState = unitState dflags2
- , unitDatabases = unitDatabases dflags2
- , packageFlags = packageFlags dflags2 }
+ idflags{ packageFlags = packageFlags dflags2 }
let ld0length = length $ ldInputs dflags0
fmrk0length = length $ cmdlineFrameworks dflags0
@@ -3475,23 +3482,23 @@ completeBreakpoint = wrapCompleter spaces $ \w -> do -- #3000
pure $ map (combineModIdent mod_str) bids
completeModule = wrapIdentCompleter $ \w -> do
- dflags <- GHC.getSessionDynFlags
- let pkg_mods = allVisibleModules dflags
+ hsc_env <- GHC.getSession
+ let pkg_mods = allVisibleModules (hsc_units hsc_env)
loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
return $ filter (w `isPrefixOf`)
- $ map (showPpr dflags) $ loaded_mods ++ pkg_mods
+ $ map (showPpr (hsc_dflags hsc_env)) $ loaded_mods ++ pkg_mods
completeSetModule = wrapIdentCompleterWithModifier "+-" $ \m w -> do
- dflags <- GHC.getSessionDynFlags
+ hsc_env <- GHC.getSession
modules <- case m of
Just '-' -> do
imports <- GHC.getContext
return $ map iiModuleName imports
_ -> do
- let pkg_mods = allVisibleModules dflags
+ let pkg_mods = allVisibleModules (hsc_units hsc_env)
loaded_mods <- liftM (map GHC.ms_mod_name) getLoadedModules
return $ loaded_mods ++ pkg_mods
- return $ filter (w `isPrefixOf`) $ map (showPpr dflags) modules
+ return $ filter (w `isPrefixOf`) $ map (showPpr (hsc_dflags hsc_env)) modules
completeHomeModule = wrapIdentCompleter listHomeModules
@@ -3549,8 +3556,8 @@ wrapIdentCompleterWithModifier modifChars fun = completeWordWithPrev Nothing wor
-- | Return a list of visible module names for autocompletion.
-- (NB: exposed != visible)
-allVisibleModules :: DynFlags -> [ModuleName]
-allVisibleModules dflags = listVisibleModuleNames (unitState dflags)
+allVisibleModules :: UnitState -> [ModuleName]
+allVisibleModules unit_state = listVisibleModuleNames unit_state
completeExpression = completeQuotedWord (Just '\\') "\"" listFiles
completeIdentifier
@@ -4335,7 +4342,7 @@ wantInterpretedModuleName :: GHC.GhcMonad m => ModuleName -> m Module
wantInterpretedModuleName modname = do
modl <- lookupModuleName modname
let str = moduleNameString modname
- home_unit <- mkHomeUnitFromFlags <$> getDynFlags
+ home_unit <- hsc_home_unit <$> GHC.getSession
unless (isHomeModule home_unit modl) $
throwGhcException (CmdLineError ("module '" ++ str ++ "' is from another package;\nthis command requires an interpreted module"))
is_interpreted <- GHC.moduleIsInterpreted modl
diff --git a/ghc/GHCi/UI/Info.hs b/ghc/GHCi/UI/Info.hs
index 64db8ea219..e6cf0838ca 100644
--- a/ghc/GHCi/UI/Info.hs
+++ b/ghc/GHCi/UI/Info.hs
@@ -40,6 +40,7 @@ import GHC.Driver.Session (HasDynFlags(..))
import GHC.Data.FastString
import GHC
import GHC.Driver.Monad
+import GHC.Driver.Env
import GHC.Driver.Ppr
import GHC.Types.Name
import GHC.Types.Name.Set
@@ -264,6 +265,7 @@ collectInfo :: (GhcMonad m) => Map ModuleName ModInfo -> [ModuleName]
-> m (Map ModuleName ModInfo)
collectInfo ms loaded = do
df <- getDynFlags
+ unit_state <- hsc_units <$> getSession
liftIO (filterM cacheInvalid loaded) >>= \case
[] -> return ms
invalidated -> do
@@ -271,13 +273,13 @@ collectInfo ms loaded = do
show (length invalidated) ++
" module(s) ... "))
- foldM (go df) ms invalidated
+ foldM (go df unit_state) ms invalidated
where
- go df m name = do { info <- getModInfo name; return (M.insert name info m) }
+ go df unit_state m name = do { info <- getModInfo name; return (M.insert name info m) }
`MC.catch`
(\(e :: SomeException) -> do
liftIO $ putStrLn
- $ showSDocForUser df alwaysQualify
+ $ showSDocForUser df unit_state alwaysQualify
$ "Error while getting type info from" <+>
ppr name <> ":" <+> text (show e)
return m)
diff --git a/ghc/GHCi/UI/Tags.hs b/ghc/GHCi/UI/Tags.hs
index 53c33ccbfe..7d8331198a 100644
--- a/ghc/GHCi/UI/Tags.hs
+++ b/ghc/GHCi/UI/Tags.hs
@@ -24,6 +24,8 @@ import GHC.Types.Name (nameOccName)
import GHC.Types.Name.Occurrence (pprOccName)
import GHC.Core.ConLike
import GHC.Utils.Monad
+import GHC.Unit.State
+import GHC.Driver.Env
import Control.Monad
import Data.Function
@@ -93,12 +95,13 @@ listModuleTags m = do
Nothing -> return []
Just mInfo -> do
dflags <- getDynFlags
+ unit_state <- hsc_units <$> getSession
mb_print_unqual <- GHC.mkPrintUnqualifiedForModule mInfo
let unqual = fromMaybe GHC.alwaysQualify mb_print_unqual
let names = fromMaybe [] $ GHC.modInfoTopLevelScope mInfo
let localNames = filter ((m==) . nameModule) names
mbTyThings <- mapM GHC.lookupName localNames
- return $! [ tagInfo dflags unqual exported kind name realLoc
+ return $! [ tagInfo dflags unit_state unqual exported kind name realLoc
| tyThing <- catMaybes mbTyThings
, let name = getName tyThing
, let exported = GHC.modInfoIsExportedName mInfo name
@@ -127,12 +130,13 @@ data TagInfo = TagInfo
-- get tag info, for later translation into Vim or Emacs style
-tagInfo :: DynFlags -> PrintUnqualified -> Bool -> Char -> Name -> RealSrcLoc
+tagInfo :: DynFlags -> UnitState -> PrintUnqualified
+ -> Bool -> Char -> Name -> RealSrcLoc
-> TagInfo
-tagInfo dflags unqual exported kind name loc
+tagInfo dflags unit_state unqual exported kind name loc
= TagInfo exported kind
- (showSDocForUser dflags unqual $ pprOccName (nameOccName name))
- (showSDocForUser dflags unqual $ ftext (srcLocFile loc))
+ (showSDocForUser dflags unit_state unqual $ pprOccName (nameOccName name))
+ (showSDocForUser dflags unit_state unqual $ ftext (srcLocFile loc))
(srcLocLine loc) (srcLocCol loc) Nothing
-- throw an exception when someone tries to overwrite existing source file (fix for #10989)
View Lorry Controller Status