diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2022-10-24 19:52:40 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-10-25 18:10:19 -0400 |
commit | f5a486eb3233b0e577333f04d2087d0f6741af87 (patch) | |
tree | ecb7fd5de195ccfd58859d8644b95852ac8367c6 | |
parent | 1fd7f201a5afb9e8a26099da5ec86016bb487c92 (diff) | |
download | haskell-f5a486eb3233b0e577333f04d2087d0f6741af87.tar.gz |
Cleanup String/FastString conversions
Remove unused mkPtrString and isUnderscoreFS.
We no longer use mkPtrString since 1d03d8bef96.
Remove unnecessary conversions between FastString and String and back.
-rw-r--r-- | compiler/GHC/Core/Opt/Stats.hs | 38 | ||||
-rw-r--r-- | compiler/GHC/Data/FastString.hs | 34 | ||||
-rw-r--r-- | compiler/GHC/Hs/Dump.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Foreign/C.hs | 12 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Pmc/Solver/Types.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Quote.hs | 26 | ||||
-rw-r--r-- | compiler/GHC/Parser.y | 6 | ||||
-rw-r--r-- | compiler/GHC/Parser/HaddockLex.x | 6 | ||||
-rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 13 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Ppr.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Types/CostCentre.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Types/FieldLabel.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Types/Literal.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Types/Name/Occurrence.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/Types/Name/Occurrence.hs-boot | 5 | ||||
-rw-r--r-- | compiler/GHC/Unit/State.hs | 2 | ||||
-rw-r--r-- | ghc/GHCi/UI.hs | 2 |
17 files changed, 67 insertions, 99 deletions
diff --git a/compiler/GHC/Core/Opt/Stats.hs b/compiler/GHC/Core/Opt/Stats.hs index 79dfffbcfb..7f2043dfc7 100644 --- a/compiler/GHC/Core/Opt/Stats.hs +++ b/compiler/GHC/Core/Opt/Stats.hs @@ -213,7 +213,7 @@ pprTickCounts counts pprTickGroup :: NonEmpty (Tick, Int) -> SDoc pprTickGroup group@((tick1,_) :| _) - = hang (int (sum (fmap snd group)) <+> text (tickString tick1)) + = hang (int (sum (fmap snd group)) <+> pprTickType tick1) 2 (vcat [ int n <+> pprTickCts tick -- flip as we want largest first | (tick,n) <- sortOn (Down . snd) (NE.toList group)]) @@ -242,7 +242,7 @@ data Tick -- See Note [Which transformations are innocuous] | SimplifierDone -- Ticked at each iteration of the simplifier instance Outputable Tick where - ppr tick = text (tickString tick) <+> pprTickCts tick + ppr tick = pprTickType tick <+> pprTickCts tick instance Eq Tick where a == b = case a `cmpTick` b of @@ -270,23 +270,23 @@ tickToTag (FillInCaseDefault _) = 13 tickToTag SimplifierDone = 16 tickToTag (AltMerge _) = 17 -tickString :: Tick -> String -tickString (PreInlineUnconditionally _) = "PreInlineUnconditionally" -tickString (PostInlineUnconditionally _)= "PostInlineUnconditionally" -tickString (UnfoldingDone _) = "UnfoldingDone" -tickString (RuleFired _) = "RuleFired" -tickString LetFloatFromLet = "LetFloatFromLet" -tickString (EtaExpansion _) = "EtaExpansion" -tickString (EtaReduction _) = "EtaReduction" -tickString (BetaReduction _) = "BetaReduction" -tickString (CaseOfCase _) = "CaseOfCase" -tickString (KnownBranch _) = "KnownBranch" -tickString (CaseMerge _) = "CaseMerge" -tickString (AltMerge _) = "AltMerge" -tickString (CaseElim _) = "CaseElim" -tickString (CaseIdentity _) = "CaseIdentity" -tickString (FillInCaseDefault _) = "FillInCaseDefault" -tickString SimplifierDone = "SimplifierDone" +pprTickType :: Tick -> SDoc +pprTickType (PreInlineUnconditionally _) = text "PreInlineUnconditionally" +pprTickType (PostInlineUnconditionally _)= text "PostInlineUnconditionally" +pprTickType (UnfoldingDone _) = text "UnfoldingDone" +pprTickType (RuleFired _) = text "RuleFired" +pprTickType LetFloatFromLet = text "LetFloatFromLet" +pprTickType (EtaExpansion _) = text "EtaExpansion" +pprTickType (EtaReduction _) = text "EtaReduction" +pprTickType (BetaReduction _) = text "BetaReduction" +pprTickType (CaseOfCase _) = text "CaseOfCase" +pprTickType (KnownBranch _) = text "KnownBranch" +pprTickType (CaseMerge _) = text "CaseMerge" +pprTickType (AltMerge _) = text "AltMerge" +pprTickType (CaseElim _) = text "CaseElim" +pprTickType (CaseIdentity _) = text "CaseIdentity" +pprTickType (FillInCaseDefault _) = text "FillInCaseDefault" +pprTickType SimplifierDone = text "SimplifierDone" pprTickCts :: Tick -> SDoc pprTickCts (PreInlineUnconditionally v) = ppr v diff --git a/compiler/GHC/Data/FastString.hs b/compiler/GHC/Data/FastString.hs index 483d40cca1..98814fa6b3 100644 --- a/compiler/GHC/Data/FastString.hs +++ b/compiler/GHC/Data/FastString.hs @@ -30,8 +30,8 @@ -- * Pointer and size of a Latin-1 encoded string. -- * Practically no operations. -- * Outputting them is fast. --- * Generated by 'mkPtrString'. --- * Length of string literals (mkPtrString "abc") is computed statically +-- * Generated by 'mkPtrString#'. +-- * Length of string literals (mkPtrString# "abc"#) is computed statically -- * Turn into 'GHC.Utils.Outputable.SDoc' with 'GHC.Utils.Outputable.ptext' -- * Requires manual memory management. -- Improper use may lead to memory leaks or dangling pointers. @@ -85,7 +85,6 @@ module GHC.Data.FastString concatFS, consFS, nilFS, - isUnderscoreFS, lexicalCompareFS, uniqCompareFS, @@ -101,7 +100,6 @@ module GHC.Data.FastString -- ** Construction mkPtrString#, - mkPtrString, -- ** Deconstruction unpackPtrString, @@ -134,7 +132,6 @@ import Foreign.C import System.IO import Data.Data import Data.IORef -import Data.Char import Data.Semigroup as Semi import Foreign @@ -623,9 +620,6 @@ uniqueOfFS fs = uniq fs nilFS :: FastString nilFS = mkFastString "" -isUnderscoreFS :: FastString -> Bool -isUnderscoreFS fs = fs == fsLit "_" - -- ----------------------------------------------------------------------------- -- Stats @@ -667,30 +661,6 @@ mkPtrString# :: Addr# -> PtrString {-# INLINE mkPtrString# #-} mkPtrString# a# = PtrString (Ptr a#) (ptrStrLength (Ptr a#)) --- | Encode a 'String' into a newly allocated 'PtrString' using Latin-1 --- encoding. The original string must not contain non-Latin-1 characters --- (above codepoint @0xff@). -{-# NOINLINE[0] mkPtrString #-} -- see rules below -mkPtrString :: String -> PtrString -mkPtrString s = - -- we don't use `unsafeDupablePerformIO` here to avoid potential memory leaks - -- and because someone might be using `eqAddr#` to check for string equality. - unsafePerformIO (do - let len = length s - p <- mallocBytes len - let - loop :: Int -> String -> IO () - loop !_ [] = return () - loop n (c:cs) = do - pokeByteOff p n (fromIntegral (ord c) :: Word8) - loop (1+n) cs - loop 0 s - return (PtrString p len) - ) - -{-# RULES "mkPtrString" - forall x . mkPtrString (unpackCString# x) = mkPtrString# x #-} - -- | Decode a 'PtrString' back into a 'String' using Latin-1 encoding. -- This does not free the memory associated with 'PtrString'. unpackPtrString :: PtrString -> String diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs index 77d2036425..942ece7f37 100644 --- a/compiler/GHC/Hs/Dump.hs +++ b/compiler/GHC/Hs/Dump.hs @@ -158,7 +158,7 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 occName n = braces $ text "OccName:" - <+> text (occNameString n) + <+> ftext (occNameFS n) moduleName :: ModuleName -> SDoc moduleName m = braces $ text "ModuleName:" <+> ppr m diff --git a/compiler/GHC/HsToCore/Foreign/C.hs b/compiler/GHC/HsToCore/Foreign/C.hs index 13ba3123f4..ed9137f99d 100644 --- a/compiler/GHC/HsToCore/Foreign/C.hs +++ b/compiler/GHC/HsToCore/Foreign/C.hs @@ -423,7 +423,7 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc arg_cname n stg_ty | libffi = char '*' <> parens (stg_ty <> char '*') <> text "args" <> brackets (int (n-1)) - | otherwise = text ('a':show n) + | otherwise = char 'a' <> int n -- generate a libffi-style stub if this is a "wrapper" and libffi is enabled libffi = platformMisc_libFFI (platformMisc dflags) && isNothing maybe_target @@ -552,16 +552,16 @@ mkFExportCBits dflags c_nm maybe_target arg_htys res_hty is_IO_res_ty cc ] mkHObj :: Type -> SDoc -mkHObj t = text "rts_mk" <> text (showFFIType t) +mkHObj t = text "rts_mk" <> showFFIType t unpackHObj :: Type -> SDoc -unpackHObj t = text "rts_get" <> text (showFFIType t) +unpackHObj t = text "rts_get" <> showFFIType t showStgType :: Type -> SDoc -showStgType t = text "Hs" <> text (showFFIType t) +showStgType t = text "Hs" <> showFFIType t -showFFIType :: Type -> String -showFFIType t = getOccString (getName (typeTyCon t)) +showFFIType :: Type -> SDoc +showFFIType t = ftext (occNameFS (getOccName (typeTyCon t))) typeTyCon :: Type -> TyCon typeTyCon ty diff --git a/compiler/GHC/HsToCore/Pmc/Solver/Types.hs b/compiler/GHC/HsToCore/Pmc/Solver/Types.hs index fa22807358..e9c8c66033 100644 --- a/compiler/GHC/HsToCore/Pmc/Solver/Types.hs +++ b/compiler/GHC/HsToCore/Pmc/Solver/Types.hs @@ -766,7 +766,7 @@ it's already overloaded. instance Outputable PmLitValue where ppr (PmLitInt i) = ppr i - ppr (PmLitRat r) = ppr (double (fromRat r)) -- good enough + ppr (PmLitRat r) = double (fromRat r) -- good enough ppr (PmLitChar c) = pprHsChar c ppr (PmLitString s) = pprHsString s ppr (PmLitOverInt n i) = minuses n (ppr i) diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index c707a29368..18126d3a4f 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -744,7 +744,7 @@ repForD (L loc (ForeignImport { fd_name = name, fd_sig_ty = typ MkC cc' <- repCCallConv cc MkC s' <- repSafety s cis' <- conv_cimportspec cis - MkC str <- coreStringLit (static ++ chStr ++ cis') + MkC str <- coreStringLit (mkFastString (static ++ chStr ++ cis')) dec <- rep2 forImpDName [cc', s', str, name', typ'] return (locA loc, dec) where @@ -818,7 +818,7 @@ repRuleD (L loc (HsRule { rd_name = n ; tm_bndrs' <- repListM ruleBndrTyConName repRuleBndr tm_bndrs - ; n' <- coreStringLit $ unpackFS $ unLoc n + ; n' <- coreStringLit $ unLoc n ; act' <- repPhases act ; lhs' <- repLE lhs ; rhs' <- repLE rhs @@ -1861,7 +1861,7 @@ rep_implicit_param_bind (L loc (IPBind _ (L _ n) (L _ rhs))) ; return (locA loc, ipb) } rep_implicit_param_name :: HsIPName -> MetaM (Core String) -rep_implicit_param_name (HsIPName name) = coreStringLit (unpackFS name) +rep_implicit_param_name (HsIPName name) = coreStringLit name rep_val_binds :: HsValBinds GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))] -- Assumes: all the binders of the binding are already in the meta-env @@ -2195,8 +2195,8 @@ globalVar name ; rep2_nwDsM mkNameLName [occ,uni] } where mod = assert (isExternalName name) nameModule name - name_mod = moduleNameString (moduleName mod) - name_pkg = unitString (moduleUnit mod) + name_mod = moduleNameFS (moduleName mod) + name_pkg = unitFS (moduleUnit mod) name_occ = nameOccName name mk_varg | isDataOcc name_occ = mkNameG_dName | isVarOcc name_occ = mkNameG_vName @@ -2235,10 +2235,10 @@ wrapGenSyms binds body@(MkC b) gensym_app (MkC (Lam id body')) } nameLit :: Name -> DsM (Core String) -nameLit n = coreStringLit (occNameString (nameOccName n)) +nameLit n = coreStringLit (occNameFS (nameOccName n)) occNameLit :: OccName -> MetaM (Core String) -occNameLit name = coreStringLit (occNameString name) +occNameLit name = coreStringLit (occNameFS name) -- %********************************************************************* @@ -2416,7 +2416,7 @@ repDoBlock doName maybeModName (MkC ss) = do coreModNameM :: MetaM (Core (Maybe TH.ModName)) coreModNameM = case maybeModName of Just m -> do - MkC s <- coreStringLit (moduleNameString m) + MkC s <- coreStringLit (moduleNameFS m) mName <- rep2_nw mkModNameName [s] coreJust modNameTyConName mName _ -> coreNothing modNameTyConName @@ -2950,17 +2950,17 @@ repUnboundVar (MkC name) = rep2 unboundVarEName [name] repOverLabel :: FastString -> MetaM (Core (M TH.Exp)) repOverLabel fs = do - (MkC s) <- coreStringLit $ unpackFS fs + MkC s <- coreStringLit fs rep2 labelEName [s] repGetField :: Core (M TH.Exp) -> FastString -> MetaM (Core (M TH.Exp)) repGetField (MkC exp) fs = do - MkC s <- coreStringLit $ unpackFS fs + MkC s <- coreStringLit fs rep2 getFieldEName [exp,s] repProjection :: NonEmpty FastString -> MetaM (Core (M TH.Exp)) repProjection fs = do - MkC xs <- coreListNonEmpty stringTy <$> mapM (coreStringLit . unpackFS) fs + MkC xs <- coreListNonEmpty stringTy <$> mapM coreStringLit fs rep2 projectionEName [xs] ------------ Lists ------------------- @@ -3004,8 +3004,8 @@ nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs)) nonEmptyCoreList' :: NonEmpty (Core a) -> Core [a] nonEmptyCoreList' xs@(MkC x:|_) = MkC (mkListExpr (exprType x) (toList $ fmap unC xs)) -coreStringLit :: MonadThings m => String -> m (Core String) -coreStringLit s = do { z <- mkStringExpr s; return(MkC z) } +coreStringLit :: MonadThings m => FastString -> m (Core String) +coreStringLit s = do { z <- mkStringExprFS s; return (MkC z) } ------------------- Maybe ------------------ diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 2a4f66f057..7b7ab4f4c8 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -67,7 +67,7 @@ import GHC.Prelude import qualified GHC.Data.Strict as Strict import GHC.Types.Name.Reader -import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS, mkVarOcc, occNameString) +import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS, mkVarOccFS, occNameString) import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Error ( GhcHint(..) ) @@ -3447,7 +3447,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } final = last fields l = comb2 (reLoc $1) $3 isPun = True - var <- mkHsVarPV (L (noAnnSrcSpan $ getLocA final) (mkRdrUnqual . mkVarOcc . unpackFS . field_label . unLoc . dfoLabel . unLoc $ final)) + var <- mkHsVarPV (L (noAnnSrcSpan $ getLocA final) (mkRdrUnqual . mkVarOccFS . field_label . unLoc . dfoLabel . unLoc $ final)) fmap Right $ mkHsProjUpdatePV l (L l fields) var isPun [] } @@ -3830,7 +3830,7 @@ special_id special_sym :: { Located FastString } special_sym : '.' { sL1 $1 (fsLit ".") } - | '*' { sL1 $1 (fsLit (starSym (isUnicode $1))) } + | '*' { sL1 $1 (starSym (isUnicode $1)) } ----------------------------------------------------------------------------- -- Data constructors diff --git a/compiler/GHC/Parser/HaddockLex.x b/compiler/GHC/Parser/HaddockLex.x index e215769f9e..682ede39a4 100644 --- a/compiler/GHC/Parser/HaddockLex.x +++ b/compiler/GHC/Parser/HaddockLex.x @@ -148,7 +148,7 @@ lexStringLiteral identParser (L l sl@(StringLiteral _ fs _)) RealSrcSpan span _ -> [(RealSrcSpan span' Strict.Nothing, tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) bs] UnhelpfulSpan reason -> [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc bs] - fakeLoc = mkRealSrcLoc (mkFastString "") 0 0 + fakeLoc = mkRealSrcLoc nilFS 0 0 -- | Lex identifiers from a docstring. lexHsDoc :: P (LocatedN RdrName) -- ^ A precise identifier parser @@ -169,7 +169,7 @@ lexHsDoc identParser doc = plausibleIdents (L (UnhelpfulSpan reason) (HsDocStringChunk s)) = [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc s] -- preserve the original reason - fakeLoc = mkRealSrcLoc (mkFastString "") 0 0 + fakeLoc = mkRealSrcLoc nilFS 0 0 validateIdentWith :: P (LocatedN RdrName) -> SrcSpan -> ByteString -> Maybe (Located RdrName) validateIdentWith identParser mloc str0 = @@ -191,7 +191,7 @@ validateIdentWith identParser mloc str0 = buffer = stringBufferFromByteString str0 realSrcLc = case mloc of RealSrcSpan loc _ -> realSrcSpanStart loc - UnhelpfulSpan _ -> mkRealSrcLoc (mkFastString "") 0 0 + UnhelpfulSpan _ -> mkRealSrcLoc nilFS 0 0 pstate = initParserState pflags buffer realSrcLc in case unP identParser pstate of POk _ name -> Just $ case mloc of diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 02a4723f6f..8e08a8c874 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -965,8 +965,7 @@ mkRuleTyVarBndrs = fmap cvt_one checkRuleTyVarBndrNames :: [LHsTyVarBndr flag GhcPs] -> P () checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName) where check (L loc (Unqual occ)) = - -- TODO: don't use string here, OccName has a Unique/FastString - when ((occNameString occ ==) `any` ["forall","family","role"]) + when (occNameFS occ `elem` [fsLit "forall",fsLit "family",fsLit "role"]) (addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $ (PsErrParseErrorOnInput occ)) check _ = panic "checkRuleTyVarBndrNames" @@ -1009,7 +1008,7 @@ checkTyClHdr is_cls ty -- workaround to define '*' despite StarIsType go _ (HsParTy an (L l (HsStarTy _ isUni))) acc ops' cps' fix = do { addPsMessage (locA l) PsWarnStarBinder - ; let name = mkOccName tcClsName (starSym isUni) + ; let name = mkOccNameFS tcClsName (starSym isUni) ; let a' = newAnns l an ; return (L a' (Unqual name), acc, fix , (reverse ops') ++ cps') } @@ -2776,7 +2775,7 @@ mkExport (L lc cconv) (L le (StringLiteral esrc entity _), v, ty) -- want z-encoding (e.g. names with z's in them shouldn't be doubled) -- mkExtName :: RdrName -> CLabelString -mkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm)) +mkExtName rdrNm = occNameFS (rdrNameOcc rdrNm) -------------------------------------------------------------------------------- -- Help with module system imports/exports @@ -3142,9 +3141,9 @@ token_location_widenR (TokenLoc (EpaDelta _ _)) _ = ----------------------------------------------------------------------------- -- Token symbols -starSym :: Bool -> String -starSym True = "★" -starSym False = "*" +starSym :: Bool -> FastString +starSym True = fsLit "★" +starSym False = fsLit "*" ----------------------------------------- -- Bits and pieces for RecordDotSyntax. diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 84338000b9..bb4b0718cc 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -3781,13 +3781,13 @@ pprConversionFailReason = \case text "Illegal" <+> pprNameSpace ctxt_ns <+> text "name:" <+> quotes (text occ) SumAltArityExceeded alt arity -> - text "Sum alternative" <+> text (show alt) - <+> text "exceeds its arity," <+> text (show arity) + text "Sum alternative" <+> int alt + <+> text "exceeds its arity," <+> int arity IllegalSumAlt alt -> - vcat [ text "Illegal sum alternative:" <+> text (show alt) + vcat [ text "Illegal sum alternative:" <+> int alt , nest 2 $ text "Sum alternatives must start from 1" ] IllegalSumArity arity -> - vcat [ text "Illegal sum arity:" <+> text (show arity) + vcat [ text "Illegal sum arity:" <+> int arity , nest 2 $ text "Sums must have an arity of at least 2" ] MalformedType typeOrKind ty -> text "Malformed " <> text ty_str <+> text (show ty) diff --git a/compiler/GHC/Types/CostCentre.hs b/compiler/GHC/Types/CostCentre.hs index 092b727d8d..cbfe4637a3 100644 --- a/compiler/GHC/Types/CostCentre.hs +++ b/compiler/GHC/Types/CostCentre.hs @@ -259,7 +259,7 @@ instance Outputable CostCentre where ppr cc = getPprStyle $ \ sty -> if codeStyle sty then ppCostCentreLbl cc - else text (costCentreUserName cc) + else ftext (costCentreUserNameFS cc) -- Printing in Core pprCostCentreCore :: CostCentre -> SDoc diff --git a/compiler/GHC/Types/FieldLabel.hs b/compiler/GHC/Types/FieldLabel.hs index d1da25ca08..2c654926ae 100644 --- a/compiler/GHC/Types/FieldLabel.hs +++ b/compiler/GHC/Types/FieldLabel.hs @@ -188,7 +188,7 @@ fieldSelectorOccName lbl dc dup_fields_ok has_sel | otherwise = mkVarOccFS fl where fl = field_label lbl - str = ":" ++ unpackFS fl ++ ":" ++ occNameString dc + str = concatFS [fsLit ":", fl, fsLit ":", occNameFS dc] -- | Undo the name mangling described in Note [FieldLabel] to produce a Name -- that has the user-visible OccName (but the selector's unique). This should diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs index 9997859afc..4ece6800ec 100644 --- a/compiler/GHC/Types/Literal.hs +++ b/compiler/GHC/Types/Literal.hs @@ -904,7 +904,7 @@ pprLiteral add_par (LitLabel l mb fod) = add_par (text "__label" <+> b <+> ppr fod) where b = case mb of Nothing -> pprHsString l - Just x -> doubleQuotes (text (unpackFS l ++ '@':show x)) + Just x -> doubleQuotes (ftext l <> text ('@':show x)) pprLiteral _ (LitRubbish rep) = text "RUBBISH" <> parens (ppr rep) diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs index 947982b53d..38eefebc59 100644 --- a/compiler/GHC/Types/Name/Occurrence.hs +++ b/compiler/GHC/Types/Name/Occurrence.hs @@ -646,8 +646,8 @@ mkGenR = mk_simple_deriv tcName "Rep_" mkGen1R = mk_simple_deriv tcName "Rep1_" -- Overloaded record field selectors -mkRecFldSelOcc :: String -> OccName -mkRecFldSelOcc s = mk_deriv varName "$sel" [fsLit s] +mkRecFldSelOcc :: FastString -> OccName +mkRecFldSelOcc s = mk_deriv varName "$sel" [s] mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName mk_simple_deriv sp px occ = mk_deriv sp px [occNameFS occ] diff --git a/compiler/GHC/Types/Name/Occurrence.hs-boot b/compiler/GHC/Types/Name/Occurrence.hs-boot index 1c27d943a7..92661cb42b 100644 --- a/compiler/GHC/Types/Name/Occurrence.hs-boot +++ b/compiler/GHC/Types/Name/Occurrence.hs-boot @@ -1,6 +1,5 @@ module GHC.Types.Name.Occurrence where -import GHC.Prelude (String) import GHC.Data.FastString data OccName @@ -8,6 +7,6 @@ data OccName class HasOccName name where occName :: name -> OccName -occNameString :: OccName -> String -mkRecFldSelOcc :: String -> OccName +occNameFS :: OccName -> FastString +mkRecFldSelOcc :: FastString -> OccName mkVarOccFS :: FastString -> OccName diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs index 403216954f..ca361d69d2 100644 --- a/compiler/GHC/Unit/State.hs +++ b/compiler/GHC/Unit/State.hs @@ -2036,7 +2036,7 @@ mayThrowUnitErr = \case instance Outputable UnitErr where ppr = \case CloseUnitErr p mb_parent - -> (ftext (fsLit "unknown unit:") <+> ppr p) + -> (text "unknown unit:" <+> ppr p) <> case mb_parent of Nothing -> Outputable.empty Just parent -> space <> parens (text "dependency of" diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index 4efb35f35e..519049cad7 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -3423,7 +3423,7 @@ pprStopped res = text "Stopped in" <+> ((case mb_mod_name of Nothing -> empty - Just mod_name -> text (moduleNameString mod_name) <> char '.') + Just mod_name -> ftext (moduleNameFS mod_name) <> char '.') <> text (GHC.resumeDecl res)) <> char ',' <+> ppr (GHC.resumeSpan res) where |