summaryrefslogtreecommitdiff
path: root/ghc
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2022-10-28 21:05:34 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-11-05 00:29:57 -0400
commit3c0e379322965aa87b14923f6d8e1ef5cd677925 (patch)
treec7db820ab9cd898e3539b4704d041bbaf0d6954f /ghc
parentbdc8cbb3a0808632fc6b33a7e3c10212f5d8a5e9 (diff)
downloadhaskell-3c0e379322965aa87b14923f6d8e1ef5cd677925.tar.gz
Minor refactor around FastStrings
Pass FastStrings to functions directly, to make sure the rule for fsLit "literal" fires. Remove SDoc indirection in GHCi.UI.Tags and GHC.Unit.Module.Graph.
Diffstat (limited to 'ghc')
-rw-r--r--ghc/GHCi/UI.hs10
-rw-r--r--ghc/GHCi/UI/Monad.hs6
-rw-r--r--ghc/GHCi/UI/Tags.hs22
3 files changed, 15 insertions, 23 deletions
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index f697073763..3e1bc227d1 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -2554,7 +2554,7 @@ isSafeModule m = do
(GHC.moduleNameString $ GHC.moduleName m))
(msafe, pkgs) <- GHC.moduleTrustReqs m
- let trust = showPpr dflags $ getSafeMode $ GHC.mi_trust $ fromJust iface
+ let trust = show $ getSafeMode $ GHC.mi_trust $ fromJust iface
pkg = if packageTrusted hsc_env m then "trusted" else "untrusted"
(good, bad) = tallyPkgs hsc_env pkgs
@@ -2998,7 +2998,7 @@ showOptions show_all
then text "none."
else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
))
- getDynFlags >>= liftIO . showDynFlags show_all
+ liftIO $ showDynFlags show_all dflags
showDynFlags :: Bool -> DynFlags -> IO ()
@@ -3215,9 +3215,9 @@ unsetOptions str
no_flag ('-':'X':rest) = return ("-XNo" ++ rest)
no_flag f = throwGhcException (ProgramError ("don't know how to reverse " ++ f))
- in if (not (null rest3))
- then liftIO (putStrLn ("unknown option: '" ++ head rest3 ++ "'"))
- else do
+ in case rest3 of
+ opt:_ -> liftIO (putStrLn ("unknown option: '" ++ opt ++ "'"))
+ [] -> do
mapM_ (fromJust.flip lookup defaulters) other_opts
mapM_ unsetOpt plus_opts
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index aae605efa8..3e6b834e11 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -502,8 +502,8 @@ initInterpBuffering = do
mkHelperExpr occ =
GHC.compileParsedExprRemote
$ GHC.nlHsVar $ RdrName.mkOrig gHC_GHCI_HELPERS occ
- nobuf <- mkHelperExpr $ mkVarOcc "disableBuffering"
- flush <- mkHelperExpr $ mkVarOcc "flushAll"
+ nobuf <- mkHelperExpr $ mkVarOccFS (fsLit "disableBuffering")
+ flush <- mkHelperExpr $ mkVarOccFS (fsLit "flushAll")
return (nobuf, flush)
-- | Invoke "hFlush stdout; hFlush stderr" in the interpreter
@@ -532,7 +532,7 @@ mkEvalWrapper progname' args' =
where
nlHsString = nlHsLit . mkHsString
evalWrapper' =
- GHC.nlHsVar $ RdrName.mkOrig gHC_GHCI_HELPERS (mkVarOcc "evalWrapper")
+ GHC.nlHsVar $ RdrName.mkOrig gHC_GHCI_HELPERS (mkVarOccFS (fsLit "evalWrapper"))
-- | Run a 'GhcMonad' action to compile an expression for internal usage.
runInternal :: GhcMonad m => m a -> m a
diff --git a/ghc/GHCi/UI/Tags.hs b/ghc/GHCi/UI/Tags.hs
index f1d55eab15..ebf2d5ebab 100644
--- a/ghc/GHCi/UI/Tags.hs
+++ b/ghc/GHCi/UI/Tags.hs
@@ -16,16 +16,14 @@ module GHCi.UI.Tags (
import GHC.Utils.Exception
import GHC
import GHCi.UI.Monad
-import GHC.Utils.Outputable
-- ToDo: figure out whether we need these, and put something appropriate
-- into the GHC API instead
import GHC.Types.Name (nameOccName)
-import GHC.Types.Name.Occurrence (pprOccName)
+import GHC.Types.Name.Occurrence (occNameString)
import GHC.Core.ConLike
import GHC.Utils.Monad
-import GHC.Unit.State
-import GHC.Driver.Env
+import GHC.Data.FastString
import Control.Monad
import Data.Function
@@ -34,7 +32,6 @@ import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Ord
import GHC.Driver.Phases
-import GHC.Driver.Ppr
import GHC.Utils.Panic
import Prelude
import System.Directory
@@ -97,14 +94,10 @@ listModuleTags m = do
case mbModInfo of
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 unit_state unqual exported kind name realLoc
+ return $! [ tagInfo exported kind name realLoc
| tyThing <- catMaybes mbTyThings
, let name = getName tyThing
, let exported = GHC.modInfoIsExportedName mInfo name
@@ -133,13 +126,12 @@ data TagInfo = TagInfo
-- get tag info, for later translation into Vim or Emacs style
-tagInfo :: DynFlags -> UnitState -> PrintUnqualified
- -> Bool -> Char -> Name -> RealSrcLoc
+tagInfo :: Bool -> Char -> Name -> RealSrcLoc
-> TagInfo
-tagInfo dflags unit_state unqual exported kind name loc
+tagInfo exported kind name loc
= TagInfo exported kind
- (showSDocForUser dflags unit_state unqual $ pprOccName (nameOccName name))
- (showSDocForUser dflags unit_state unqual $ ftext (srcLocFile loc))
+ (occNameString $ nameOccName name)
+ (unpackFS (srcLocFile loc))
(srcLocLine loc) (srcLocCol loc) Nothing
-- throw an exception when someone tries to overwrite existing source file (fix for #10989)