diff options
36 files changed, 102 insertions, 95 deletions
diff --git a/compiler/GHC/Cmm/BlockId.hs b/compiler/GHC/Cmm/BlockId.hs index e6396c8e83..ec52a3842a 100644 --- a/compiler/GHC/Cmm/BlockId.hs +++ b/compiler/GHC/Cmm/BlockId.hs @@ -11,6 +11,7 @@ module GHC.Cmm.BlockId import GHC.Prelude import GHC.Cmm.CLabel +import GHC.Data.FastString import GHC.Types.Id.Info import GHC.Types.Name import GHC.Types.Unique @@ -43,4 +44,4 @@ blockLbl label = mkLocalBlockLabel (getUnique label) infoTblLbl :: BlockId -> CLabel infoTblLbl label - = mkBlockInfoTableLabel (mkFCallName (getUnique label) "block") NoCafRefs + = mkBlockInfoTableLabel (mkFCallName (getUnique label) (fsLit "block")) NoCafRefs diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs index bf4214fed2..22c1c9ef05 100644 --- a/compiler/GHC/Cmm/CLabel.hs +++ b/compiler/GHC/Cmm/CLabel.hs @@ -300,19 +300,19 @@ instance Show CLabel where show = showPprUnsafe . pprDebugCLabel genericPlatform data ModuleLabelKind - = MLK_Initializer String + = MLK_Initializer LexicalFastString | MLK_InitializerArray - | MLK_Finalizer String + | MLK_Finalizer LexicalFastString | MLK_FinalizerArray | MLK_IPEBuffer deriving (Eq, Ord) instance Outputable ModuleLabelKind where - ppr MLK_InitializerArray = text "init_arr" - ppr (MLK_Initializer s) = text ("init__" ++ s) - ppr MLK_FinalizerArray = text "fini_arr" - ppr (MLK_Finalizer s) = text ("fini__" ++ s) - ppr MLK_IPEBuffer = text "ipe_buf" + ppr MLK_InitializerArray = text "init_arr" + ppr (MLK_Initializer (LexicalFastString s)) = text "init__" <> ftext s + ppr MLK_FinalizerArray = text "fini_arr" + ppr (MLK_Finalizer (LexicalFastString s)) = text "fini__" <> ftext s + ppr MLK_IPEBuffer = text "ipe_buf" isIdLabel :: CLabel -> Bool isIdLabel IdLabel{} = True @@ -885,15 +885,15 @@ mkDeadStripPreventer lbl = DeadStripPreventer lbl mkStringLitLabel :: Unique -> CLabel mkStringLitLabel = StringLitLabel -mkInitializerStubLabel :: Module -> String -> CLabel -mkInitializerStubLabel mod s = ModuleLabel mod (MLK_Initializer s) +mkInitializerStubLabel :: Module -> FastString -> CLabel +mkInitializerStubLabel mod s = ModuleLabel mod (MLK_Initializer (LexicalFastString s)) mkInitializerArrayLabel :: Module -> CLabel mkInitializerArrayLabel mod = ModuleLabel mod MLK_InitializerArray -mkFinalizerStubLabel :: Module -> String -> CLabel -mkFinalizerStubLabel mod s = ModuleLabel mod (MLK_Finalizer s) +mkFinalizerStubLabel :: Module -> FastString -> CLabel +mkFinalizerStubLabel mod s = ModuleLabel mod (MLK_Finalizer (LexicalFastString s)) mkFinalizerArrayLabel :: Module -> CLabel mkFinalizerArrayLabel mod = ModuleLabel mod MLK_FinalizerArray diff --git a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs index 5ca443f08e..54cf73d55e 100644 --- a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs +++ b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs @@ -232,7 +232,7 @@ pprImm _ (ImmInt i) = int i pprImm _ (ImmInteger i) = integer i pprImm p (ImmCLbl l) = pprAsmLabel p l pprImm p (ImmIndex l i) = pprAsmLabel p l <> char '+' <> int i -pprImm _ (ImmLit s) = text s +pprImm _ (ImmLit s) = ftext s -- TODO: See pprIm below for why this is a bad idea! pprImm _ (ImmFloat f) diff --git a/compiler/GHC/CmmToAsm/AArch64/Regs.hs b/compiler/GHC/CmmToAsm/AArch64/Regs.hs index d3650c96f0..4895d2b092 100644 --- a/compiler/GHC/CmmToAsm/AArch64/Regs.hs +++ b/compiler/GHC/CmmToAsm/AArch64/Regs.hs @@ -2,6 +2,7 @@ module GHC.CmmToAsm.AArch64.Regs where import GHC.Prelude +import GHC.Data.FastString import GHC.Platform.Reg import GHC.Platform.Reg.Class @@ -59,7 +60,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit String + | ImmLit FastString | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -67,7 +68,7 @@ data Imm | ImmConstantDiff Imm Imm deriving (Eq, Show) -strImmLit :: String -> Imm +strImmLit :: FastString -> Imm strImmLit s = ImmLit s diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs index f8563004b5..abad5d0427 100644 --- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs +++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs @@ -407,7 +407,7 @@ getRegister' :: NCGConfig -> Platform -> CmmExpr -> NatM Register getRegister' _ platform (CmmReg (CmmGlobal PicBaseReg)) | OSAIX <- platformOS platform = do let code dst = toOL [ LD II32 dst tocAddr ] - tocAddr = AddrRegImm toc (ImmLit "ghc_toc_table[TC]") + tocAddr = AddrRegImm toc (ImmLit (fsLit "ghc_toc_table[TC]")) return (Any II32 code) | target32Bit platform = do reg <- getPicBaseNat $ archWordFormat (target32Bit platform) diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs index 19de3cd1e2..78abfcb0a3 100644 --- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs +++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs @@ -240,7 +240,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pprAsmLabel platform l ImmIndex l i -> pprAsmLabel platform l <> char '+' <> int i - ImmLit s -> text s + ImmLit s -> ftext s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b diff --git a/compiler/GHC/CmmToAsm/PPC/Regs.hs b/compiler/GHC/CmmToAsm/PPC/Regs.hs index 901913f7d9..5b4e179f1a 100644 --- a/compiler/GHC/CmmToAsm/PPC/Regs.hs +++ b/compiler/GHC/CmmToAsm/PPC/Regs.hs @@ -47,6 +47,7 @@ module GHC.CmmToAsm.PPC.Regs ( where import GHC.Prelude +import GHC.Data.FastString import GHC.Platform.Reg import GHC.Platform.Reg.Class @@ -133,7 +134,7 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit String + | ImmLit FastString | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational @@ -146,7 +147,7 @@ data Imm | HIGHESTA Imm -strImmLit :: String -> Imm +strImmLit :: FastString -> Imm strImmLit s = ImmLit s diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs index 42b9543204..06fc3f6c7e 100644 --- a/compiler/GHC/CmmToAsm/X86/Instr.hs +++ b/compiler/GHC/CmmToAsm/X86/Instr.hs @@ -38,6 +38,7 @@ module GHC.CmmToAsm.X86.Instr where import GHC.Prelude +import GHC.Data.FastString import GHC.CmmToAsm.X86.Cond import GHC.CmmToAsm.X86.Regs @@ -868,7 +869,7 @@ mkStackAllocInstr platform amount case platformArch platform of ArchX86 | needs_probe_call platform amount -> [ MOV II32 (OpImm (ImmInt amount)) (OpReg eax) - , CALL (Left $ strImmLit "___chkstk_ms") [eax] + , CALL (Left $ strImmLit (fsLit "___chkstk_ms")) [eax] , SUB II32 (OpReg eax) (OpReg esp) ] | otherwise -> @@ -877,7 +878,7 @@ mkStackAllocInstr platform amount ] ArchX86_64 | needs_probe_call platform amount -> [ MOV II64 (OpImm (ImmInt amount)) (OpReg rax) - , CALL (Left $ strImmLit "___chkstk_ms") [rax] + , CALL (Left $ strImmLit (fsLit "___chkstk_ms")) [rax] , SUB II64 (OpReg rax) (OpReg rsp) ] | otherwise -> diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs index 6c16160ce8..32b163357d 100644 --- a/compiler/GHC/CmmToAsm/X86/Ppr.hs +++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs @@ -432,7 +432,7 @@ pprImm platform = \case ImmInteger i -> integer i ImmCLbl l -> pprAsmLabel platform l ImmIndex l i -> pprAsmLabel platform l <> char '+' <> int i - ImmLit s -> text s + ImmLit s -> ftext s ImmFloat f -> float $ fromRational f ImmDouble d -> double $ fromRational d ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b diff --git a/compiler/GHC/CmmToAsm/X86/Regs.hs b/compiler/GHC/CmmToAsm/X86/Regs.hs index ab5558d8e1..25746f9deb 100644 --- a/compiler/GHC/CmmToAsm/X86/Regs.hs +++ b/compiler/GHC/CmmToAsm/X86/Regs.hs @@ -48,6 +48,7 @@ module GHC.CmmToAsm.X86.Regs ( where import GHC.Prelude +import GHC.Data.FastString import GHC.Platform.Regs import GHC.Platform.Reg @@ -110,14 +111,14 @@ data Imm = ImmInt Int | ImmInteger Integer -- Sigh. | ImmCLbl CLabel -- AbstractC Label (with baggage) - | ImmLit String + | ImmLit FastString | ImmIndex CLabel Int | ImmFloat Rational | ImmDouble Rational | ImmConstantSum Imm Imm | ImmConstantDiff Imm Imm -strImmLit :: String -> Imm +strImmLit :: FastString -> Imm strImmLit s = ImmLit s diff --git a/compiler/GHC/CmmToLlvm.hs b/compiler/GHC/CmmToLlvm.hs index 5f585ef866..ea5884405e 100644 --- a/compiler/GHC/CmmToLlvm.hs +++ b/compiler/GHC/CmmToLlvm.hs @@ -110,8 +110,8 @@ llvmCodeGen' cfg cmm_stream header = let target = llvmCgLlvmTarget cfg llvmCfg = llvmCgLlvmConfig cfg - in text ("target datalayout = \"" ++ getDataLayout llvmCfg target ++ "\"") - $+$ text ("target triple = \"" ++ target ++ "\"") + in (text "target datalayout = \"" <> text (getDataLayout llvmCfg target) <> text "\"") + $+$ (text "target triple = \"" <> text target <> text "\"") getDataLayout :: LlvmConfig -> String -> String getDataLayout config target = diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs index 06bc235913..1449e2331d 100644 --- a/compiler/GHC/Core/Coercion.hs +++ b/compiler/GHC/Core/Coercion.hs @@ -146,6 +146,7 @@ import GHC.Types.Var.Set import GHC.Types.Name hiding ( varName ) import GHC.Types.Basic import GHC.Types.Unique +import GHC.Data.FastString import GHC.Data.Pair import GHC.Types.SrcLoc import GHC.Builtin.Names @@ -286,7 +287,7 @@ tidyCoAxBndrsForUser init_env tcvs (env', bndr') = tidyVarBndr env bndr env_wild = (occ_env, extendVarEnv subst bndr wild_bndr) wild_bndr = setVarName bndr $ - tidyNameOcc (varName bndr) (mkTyVarOcc "_") + tidyNameOcc (varName bndr) (mkTyVarOccFS (fsLit "_")) -- Tidy the binder to "_" is_wildcard :: Var -> Bool diff --git a/compiler/GHC/Core/FamInstEnv.hs b/compiler/GHC/Core/FamInstEnv.hs index 844f753957..e955e5befd 100644 --- a/compiler/GHC/Core/FamInstEnv.hs +++ b/compiler/GHC/Core/FamInstEnv.hs @@ -50,6 +50,7 @@ import GHC.Core.RoughMap import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Name +import GHC.Data.FastString import GHC.Data.Maybe import GHC.Types.Var import GHC.Types.SrcLoc @@ -686,7 +687,7 @@ mkCoAxBranch tvs eta_tvs cvs lhs rhs roles loc -- See Note [Tidy axioms when we build them] -- See also Note [CoAxBranch type variables] in GHC.Core.Coercion.Axiom - init_occ_env = initTidyOccEnv [mkTyVarOcc "_"] + init_occ_env = initTidyOccEnv [mkTyVarOccFS (fsLit "_")] init_tidy_env = mkEmptyTidyEnv init_occ_env -- See Note [Always number wildcard types in CoAxBranch] diff --git a/compiler/GHC/Core/TyCo/Tidy.hs b/compiler/GHC/Core/TyCo/Tidy.hs index 36f1bb015a..2cbebbd411 100644 --- a/compiler/GHC/Core/TyCo/Tidy.hs +++ b/compiler/GHC/Core/TyCo/Tidy.hs @@ -17,6 +17,7 @@ module GHC.Core.TyCo.Tidy ) where import GHC.Prelude +import GHC.Data.FastString import GHC.Core.TyCo.Rep import GHC.Core.TyCo.FVs (tyCoVarsOfTypesWellScoped, tyCoVarsOfTypeList) @@ -70,7 +71,7 @@ getHelpfulOccName :: TyCoVar -> OccName -- this way is a helpful clue for users getHelpfulOccName tv | isSystemName name, isTcTyVar tv - = mkTyVarOcc (occNameString occ ++ "0") + = mkTyVarOccFS (occNameFS occ `appendFS` fsLit "0") | otherwise = occ where diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs index 448c4c864e..2e56336cba 100644 --- a/compiler/GHC/Driver/CodeOutput.hs +++ b/compiler/GHC/Driver/CodeOutput.hs @@ -17,6 +17,7 @@ where import GHC.Prelude import GHC.Platform import GHC.ForeignSrcLang +import GHC.Data.FastString import GHC.CmmToAsm ( nativeCodeGen ) import GHC.CmmToLlvm ( llvmCodeGen ) @@ -331,7 +332,7 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs) initializerCStub platform fn_name decls body where pdocC = pprCLabel platform - fn_name = mkInitializerStubLabel this_mod "prof_init" + fn_name = mkInitializerStubLabel this_mod (fsLit "prof_init") decls = vcat $ map emit_cc_decl local_CCs ++ map emit_ccs_decl singleton_CCSs @@ -374,7 +375,7 @@ ipInitCode do_info_table platform this_mod | not do_info_table = mempty | otherwise = initializerCStub platform fn_nm ipe_buffer_decl body where - fn_nm = mkInitializerStubLabel this_mod "ip_init" + fn_nm = mkInitializerStubLabel this_mod (fsLit "ip_init") body = text "registerInfoProvList" <> parens (text "&" <> ipe_buffer_label) <> semi diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs index 9e2619db65..146a1a2125 100644 --- a/compiler/GHC/HsToCore/Coverage.hs +++ b/compiler/GHC/HsToCore/Coverage.hs @@ -116,7 +116,7 @@ hpcInitCode _ _ (NoHpcInfo {}) = mempty hpcInitCode platform this_mod (HpcInfo tickCount hashNo) = initializerCStub platform fn_name decls body where - fn_name = mkInitializerStubLabel this_mod "hpc" + fn_name = mkInitializerStubLabel this_mod (fsLit "hpc") decls = text "extern StgWord64 " <> tickboxes <> text "[]" <> semi body = text "hs_hpc_module" <> parens (hcat (punctuate comma [ diff --git a/compiler/GHC/HsToCore/Foreign/Decl.hs b/compiler/GHC/HsToCore/Foreign/Decl.hs index 60212b0d23..8257fea3bb 100644 --- a/compiler/GHC/HsToCore/Foreign/Decl.hs +++ b/compiler/GHC/HsToCore/Foreign/Decl.hs @@ -16,6 +16,7 @@ module GHC.HsToCore.Foreign.Decl where import GHC.Prelude +import GHC.Data.FastString import GHC.Tc.Utils.Monad -- temp @@ -184,7 +185,7 @@ foreignExportsInitialiser platform mod hs_fns = -- See Note [Tracking foreign exports] in rts/ForeignExports.c initializerCStub platform fn_nm list_decl fn_body where - fn_nm = mkInitializerStubLabel mod "fexports" + fn_nm = mkInitializerStubLabel mod (fsLit "fexports") mod_str = pprModuleName (moduleName mod) fn_body = text "registerForeignExports" <> parens (char '&' <> list_symbol) <> semi list_symbol = text "stg_exports_" <> mod_str diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs index 896f32df0a..db923a0982 100644 --- a/compiler/GHC/Iface/Recomp.hs +++ b/compiler/GHC/Iface/Recomp.hs @@ -19,6 +19,7 @@ module GHC.Iface.Recomp where import GHC.Prelude +import GHC.Data.FastString import GHC.Driver.Backend import GHC.Driver.Config.Finder @@ -168,7 +169,7 @@ instance Monoid RecompileRequired where data RecompReason = UnitDepRemoved UnitId - | ModulePackageChanged String + | ModulePackageChanged FastString | SourceFileChanged | ThisUnitIdChanged | ImpurePlugin @@ -200,7 +201,7 @@ data RecompReason instance Outputable RecompReason where ppr = \case UnitDepRemoved uid -> ppr uid <+> text "removed" - ModulePackageChanged s -> text s <+> text "package changed" + ModulePackageChanged s -> ftext s <+> text "package changed" SourceFileChanged -> text "Source file changed" ThisUnitIdChanged -> text "-this-unit-id changed" ImpurePlugin -> text "Impure plugin forced recompilation" @@ -596,7 +597,7 @@ checkDependencies hsc_env summary iface -> [(t, GenLocated l ModuleName)] -> IfG [Either - CompileReason (Either (UnitId, ModuleName) (String, UnitId))] + CompileReason (Either (UnitId, ModuleName) (FastString, UnitId))] classify_import find_import imports = liftIO $ traverse (\(mb_pkg, L _ mod) -> let reason = ModuleChanged mod @@ -612,9 +613,9 @@ checkDependencies hsc_env summary iface prev_dep_mods = map (second gwib_mod) $ Set.toAscList $ dep_direct_mods (mi_deps iface) prev_dep_pkgs = Set.toAscList (Set.union (dep_direct_pkgs (mi_deps iface)) (dep_plugin_pkgs (mi_deps iface))) - bkpk_units = map (("Signature",) . instUnitInstanceOf . moduleUnit) (requirementMerges units (moduleName (mi_module iface))) + bkpk_units = map ((fsLit "Signature",) . instUnitInstanceOf . moduleUnit) (requirementMerges units (moduleName (mi_module iface))) - implicit_deps = map ("Implicit",) (implicitPackageDeps dflags) + implicit_deps = map (fsLit "Implicit",) (implicitPackageDeps dflags) -- GHC.Prim is very special and doesn't appear in ms_textual_imps but -- ghc-prim will appear in the package dependencies still. In order to not confuse @@ -623,12 +624,12 @@ checkDependencies hsc_env summary iface Just home_unit | homeUnitId home_unit == primUnitId -> Left (primUnitId, mkModuleName "GHC.Prim") - _ -> Right ("GHC.Prim", primUnitId) + _ -> Right (fsLit "GHC.Prim", primUnitId) classify _ (Found _ mod) | (toUnitId $ moduleUnit mod) `elem` all_home_units = Right (Left ((toUnitId $ moduleUnit mod), moduleName mod)) - | otherwise = Right (Right (moduleNameString (moduleName mod), toUnitId $ moduleUnit mod)) + | otherwise = Right (Right (moduleNameFS (moduleName mod), toUnitId $ moduleUnit mod)) classify reason _ = Left (RecompBecause reason) check_mods :: [(UnitId, ModuleName)] -> [(UnitId, ModuleName)] -> IO RecompileRequired @@ -649,7 +650,7 @@ checkDependencies hsc_env summary iface text " not among previous dependencies" return $ needsRecompileBecause $ ModuleAdded new - check_packages :: [(String, UnitId)] -> [UnitId] -> IO RecompileRequired + check_packages :: [(FastString, UnitId)] -> [UnitId] -> IO RecompileRequired check_packages [] [] = return UpToDate check_packages [] (old:_) = do trace_hi_diffs logger $ @@ -661,7 +662,7 @@ checkDependencies hsc_env summary iface , new_unit == old = check_packages (dropWhile ((== new_unit) . snd) news) olds' | otherwise = do trace_hi_diffs logger $ - text "imported package" <+> text new_name <+> ppr new_unit <+> + text "imported package" <+> ftext new_name <+> ppr new_unit <+> text "not among previous dependencies" return $ needsRecompileBecause $ ModulePackageChanged new_name @@ -1243,7 +1244,7 @@ addFingerprints hsc_env iface0 iface_hash <- computeFingerprint putNameLiterally (mod_hash, mi_src_hash iface0, - ann_fn (mkVarOcc "module"), -- See mkIfaceAnnCache + ann_fn (mkVarOccFS (fsLit "module")), -- See mkIfaceAnnCache mi_usages iface0, sorted_deps, mi_hpc iface0) @@ -1638,7 +1639,7 @@ mkIfaceAnnCache anns pair (IfaceAnnotation target value) = (case target of NamedTarget occn -> occn - ModuleTarget _ -> mkVarOcc "module" + ModuleTarget _ -> mkVarOccFS (fsLit "module") , [value]) -- flipping (++), so the first argument is always short env = mkOccEnv_C (flip (++)) (map pair anns) diff --git a/compiler/GHC/Iface/Tidy/StaticPtrTable.hs b/compiler/GHC/Iface/Tidy/StaticPtrTable.hs index cf37095041..d53fddb943 100644 --- a/compiler/GHC/Iface/Tidy/StaticPtrTable.hs +++ b/compiler/GHC/Iface/Tidy/StaticPtrTable.hs @@ -144,6 +144,7 @@ import GHC.Linker.Types import GHC.Types.Id import GHC.Types.ForeignStubs import GHC.Data.Maybe +import GHC.Data.FastString import Control.Monad.Trans.State.Strict import Data.List (intercalate) @@ -244,7 +245,7 @@ sptModuleInitCode platform this_mod entries = initializerCStub platform init_fn_nm empty init_fn_body `mappend` finalizerCStub platform fini_fn_nm empty fini_fn_body where - init_fn_nm = mkInitializerStubLabel this_mod "spt" + init_fn_nm = mkInitializerStubLabel this_mod (fsLit "spt") init_fn_body = vcat [ text "static StgWord64 k" <> int i <> text "[2] = " <> pprFingerprint fp <> semi @@ -260,7 +261,7 @@ sptModuleInitCode platform this_mod entries = | (i, SptEntry n fp) <- zip [0..] entries ] - fini_fn_nm = mkFinalizerStubLabel this_mod "spt" + fini_fn_nm = mkFinalizerStubLabel this_mod (fsLit "spt") fini_fn_body = vcat [ text "StgWord64 k" <> int i <> text "[2] = " <> pprFingerprint fp <> semi diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 7b7ab4f4c8..cc2dcf2749 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, mkVarOccFS, occNameString) +import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS, mkVarOccFS) import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Error ( GhcHint(..) ) @@ -3885,8 +3885,7 @@ modid :: { LocatedA ModuleName } : CONID { sL1a $1 $ mkModuleNameFS (getCONID $1) } | QCONID { sL1a $1 $ let (mod,c) = getQCONID $1 in mkModuleNameFS - (mkFastString - (unpackFS mod ++ '.':unpackFS c)) + (concatFS [mod, fsLit ".", c]) } commas :: { ([SrcSpan],Int) } -- One or more commas diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 8e08a8c874..2dd8e06b3e 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -1816,7 +1816,7 @@ instance DisambECP (HsExpr GhcPs) where rejectPragmaPV _ = return () hsHoleExpr :: EpAnn EpAnnUnboundVar -> HsExpr GhcPs -hsHoleExpr anns = HsUnboundVar anns (mkVarOcc "_") +hsHoleExpr anns = HsUnboundVar anns (mkVarOccFS (fsLit "_")) type instance Anno (GRHS GhcPs (LocatedA (PatBuilder GhcPs))) = SrcAnn NoEpAnns type instance Anno [LocatedA (Match GhcPs (LocatedA (PatBuilder GhcPs)))] = SrcSpanAnnL diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs index 9e7decb2ff..4d22a994e9 100644 --- a/compiler/GHC/Rename/Expr.hs +++ b/compiler/GHC/Rename/Expr.hs @@ -28,6 +28,7 @@ module GHC.Rename.Expr ( ) where import GHC.Prelude +import GHC.Data.FastString import GHC.Rename.Bind ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS , rnMatchGroup, rnGRHS, makeMiniFixityEnv) @@ -2692,7 +2693,7 @@ getMonadFailOp ctxt | (isQualifiedDo || rebindableSyntax) && overloadedStrings = do (failExpr, failFvs) <- lookupQualifiedDoExpr ctxt failMName (fromStringExpr, fromStringFvs) <- lookupSyntaxExpr fromStringName - let arg_lit = mkVarOcc "arg" + let arg_lit = mkVarOccFS (fsLit "arg") arg_name <- newSysName arg_lit let arg_syn_expr = nlHsVar arg_name body :: LHsExpr GhcRn = diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs index 3acebb5894..75a6123891 100644 --- a/compiler/GHC/Runtime/Eval.hs +++ b/compiler/GHC/Runtime/Eval.hs @@ -1048,7 +1048,7 @@ parseInstanceHead str = withSession $ \hsc_env0 -> do -- Get all the constraints required of a dictionary binding getDictionaryBindings :: PredType -> TcM CtEvidence getDictionaryBindings theta = do - dictName <- newName (mkDictOcc (mkVarOcc "magic")) + dictName <- newName (mkDictOcc (mkVarOccFS (fsLit "magic"))) let dict_var = mkVanillaGlobal dictName theta loc <- getCtLocM (GivenOrigin (getSkolemInfo unkSkol)) Nothing diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs index 5189e5bec4..e578c25357 100644 --- a/compiler/GHC/Runtime/Loader.hs +++ b/compiler/GHC/Runtime/Loader.hs @@ -21,6 +21,7 @@ module GHC.Runtime.Loader ( ) where import GHC.Prelude +import GHC.Data.FastString import GHC.Driver.Session import GHC.Driver.Ppr @@ -46,7 +47,7 @@ import GHC.Types.SrcLoc ( noSrcSpan ) import GHC.Types.Name ( Name, nameModule_maybe ) import GHC.Types.Id ( idType ) import GHC.Types.TyThing -import GHC.Types.Name.Occurrence ( OccName, mkVarOcc ) +import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS ) import GHC.Types.Name.Reader ( RdrName, ImportSpec(..), ImpDeclSpec(..) , ImpItemSpec(..), mkGlobalRdrEnv, lookupGRE_RdrName , greMangledName, mkRdrQual ) @@ -136,14 +137,14 @@ loadPlugins hsc_env where options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags , opt_mod_nm == mod_nm ] - loadPlugin = loadPlugin' (mkVarOcc "plugin") pluginTyConName hsc_env + loadPlugin = loadPlugin' (mkVarOccFS (fsLit "plugin")) pluginTyConName hsc_env loadFrontendPlugin :: HscEnv -> ModuleName -> IO (FrontendPlugin, [Linkable], PkgsLoaded) loadFrontendPlugin hsc_env mod_name = do checkExternalInterpreter hsc_env (plugin, _iface, links, pkgs) - <- loadPlugin' (mkVarOcc "frontendPlugin") frontendPluginTyConName + <- loadPlugin' (mkVarOccFS (fsLit "frontendPlugin")) frontendPluginTyConName hsc_env mod_name return (plugin, links, pkgs) diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs index 8ec874da41..5590e29454 100644 --- a/compiler/GHC/Tc/Errors/Hole.hs +++ b/compiler/GHC/Tc/Errors/Hole.hs @@ -82,7 +82,7 @@ import GHC.Builtin.Utils (knownKeyNames) import GHC.Tc.Errors.Hole.FitTypes import qualified Data.Set as Set import GHC.Types.SrcLoc -import GHC.Data.FastString (unpackFS) +import GHC.Data.FastString (NonDetFastString(..)) import GHC.Types.Unique.Map @@ -482,15 +482,16 @@ addHoleFitDocs fits = Just m -> Right m Nothing -> Left $ case nameSrcLoc name of - RealSrcLoc r _ -> unpackFS $ srcLocFile r - UnhelpfulLoc s -> unpackFS $ s + -- Nondeterminism is fine, this is used only to display a warning + RealSrcLoc r _ -> NonDetFastString $ srcLocFile r + UnhelpfulLoc s -> NonDetFastString s report mods = do { let warning = text "WARNING: Couldn't find any documentation for the following modules:" $+$ nest 2 - (pprWithCommas (either text ppr) (Set.toList mods) $+$ + (pprWithCommas (either ppr ppr) (Set.toList mods) $+$ text "Make sure the modules are compiled with '-haddock'.") - ; warnPprTrace (not $ Set.null mods)"addHoleFitDocs" warning (pure ()) + ; warnPprTrace (not $ Set.null mods) "addHoleFitDocs" warning (pure ()) } -- For pretty printing hole fits, we display the name and type of the fit, diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs index cfc5454e54..6b141d9173 100644 --- a/compiler/GHC/Tc/Gen/Sig.hs +++ b/compiler/GHC/Tc/Gen/Sig.hs @@ -26,6 +26,7 @@ module GHC.Tc.Gen.Sig( ) where import GHC.Prelude +import GHC.Data.FastString import GHC.Driver.Session import GHC.Driver.Backend @@ -246,7 +247,7 @@ tcUserTypeSig loc hs_sig_ty mb_name where name = case mb_name of Just n -> n - Nothing -> mkUnboundName (mkVarOcc "<expression>") + Nothing -> mkUnboundName (mkVarOccFS (fsLit "<expression>")) ctxt_rrc = ctxt_fn (lhsSigWcTypeContextSpan hs_sig_ty) ctxt_no_rrc = ctxt_fn NoRRC diff --git a/compiler/GHC/Tc/Instance/Typeable.hs b/compiler/GHC/Tc/Instance/Typeable.hs index 3c5343722e..e0bcfa8428 100644 --- a/compiler/GHC/Tc/Instance/Typeable.hs +++ b/compiler/GHC/Tc/Instance/Typeable.hs @@ -190,7 +190,7 @@ mkModIdBindings :: TcM TcGblEnv mkModIdBindings = do { mod <- getModule ; loc <- getSrcSpanM - ; mod_nm <- newGlobalBinder mod (mkVarOcc "$trModule") loc + ; mod_nm <- newGlobalBinder mod (mkVarOccFS (fsLit "$trModule")) loc ; trModuleTyCon <- tcLookupTyCon trModuleTyConName ; let mod_id = mkExportedVanillaId mod_nm (mkTyConApp trModuleTyCon []) ; mod_bind <- mkVarBind mod_id <$> mkModIdRHS mod diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs index 2e9b3c1809..a448d550ac 100644 --- a/compiler/GHC/Tc/TyCl/PatSyn.hs +++ b/compiler/GHC/Tc/TyCl/PatSyn.hs @@ -787,8 +787,8 @@ tcPatSynMatcher (L loc ps_name) lpat prag_fn (ex_tvs, ex_tys, prov_theta, prov_dicts) (args, arg_tys) pat_ty = do { let loc' = locA loc - ; rr_name <- newNameAt (mkTyVarOcc "rep") loc' - ; tv_name <- newNameAt (mkTyVarOcc "r") loc' + ; rr_name <- newNameAt (mkTyVarOccFS (fsLit "rep")) loc' + ; tv_name <- newNameAt (mkTyVarOccFS (fsLit "r")) loc' ; let rr_tv = mkTyVar rr_name runtimeRepTy rr = mkTyVarTy rr_tv res_tv = mkTyVar tv_name (mkTYPEapp rr) diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs index 8319212147..2f61ff8777 100644 --- a/compiler/GHC/Tc/Utils/Monad.hs +++ b/compiler/GHC/Tc/Utils/Monad.hs @@ -1921,7 +1921,7 @@ emitAnonTypeHole extra_constraints tv , hole_loc = ct_loc } ; emitHole hole } where - occ = mkTyVarOcc "_" + occ = mkTyVarOccFS (fsLit "_") sort | YesExtraConstraint <- extra_constraints = ConstraintHole | otherwise = TypeHole diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs index 4dc4161664..97f9a8384f 100644 --- a/compiler/GHC/Tc/Validity.hs +++ b/compiler/GHC/Tc/Validity.hs @@ -21,6 +21,7 @@ module GHC.Tc.Validity ( ) where import GHC.Prelude +import GHC.Data.FastString import GHC.Data.Maybe @@ -2274,7 +2275,7 @@ checkConsistentFamInst (InClsInst { ai_class = clas tidyTypes tidy_env2 ax_arg_tys mk_wildcard at_tv = mkTyVarTy (mkTyVar tv_name (tyVarKind at_tv)) - tv_name = mkInternalName (mkAlphaTyVarUnique 1) (mkTyVarOcc "_") noSrcSpan + tv_name = mkInternalName (mkAlphaTyVarUnique 1) (mkTyVarOccFS (fsLit "_")) noSrcSpan -- For check_match, bind_me, see -- Note [Matching in the consistent-instantiation check] diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs index b38cde14a1..99ea5dddb0 100644 --- a/compiler/GHC/Types/Id/Make.hs +++ b/compiler/GHC/Types/Id/Make.hs @@ -1320,7 +1320,7 @@ mkFCallId uniq fcall ty -- The "occurrence name" of a ccall is the full info about the -- ccall; it is encoded, but may have embedded spaces etc! - name = mkFCallName uniq occ_str + name = mkFCallName uniq (mkFastString occ_str) info = noCafIdInfo `setArityInfo` arity diff --git a/compiler/GHC/Types/Name.hs b/compiler/GHC/Types/Name.hs index 9f82fd42a8..8176bec011 100644 --- a/compiler/GHC/Types/Name.hs +++ b/compiler/GHC/Types/Name.hs @@ -493,8 +493,8 @@ mkSysTvName :: Unique -> FastString -> Name mkSysTvName uniq fs = mkSystemName uniq (mkTyVarOccFS fs) -- | Make a name for a foreign call -mkFCallName :: Unique -> String -> Name -mkFCallName uniq str = mkInternalName uniq (mkVarOcc str) noSrcSpan +mkFCallName :: Unique -> FastString -> Name +mkFCallName uniq str = mkInternalName uniq (mkVarOccFS str) noSrcSpan -- The encoded string completely describes the ccall -- When we renumber/rename things, we need to be diff --git a/compiler/GHC/Unit/Module/Graph.hs b/compiler/GHC/Unit/Module/Graph.hs index fcd6a63a28..c2d36c5c0e 100644 --- a/compiler/GHC/Unit/Module/Graph.hs +++ b/compiler/GHC/Unit/Module/Graph.hs @@ -49,7 +49,6 @@ import GHC.Data.Maybe import GHC.Data.Graph.Directed import GHC.Driver.Backend -import GHC.Driver.Ppr import GHC.Driver.Session import GHC.Types.SourceFile ( hscSourceString ) @@ -278,8 +277,8 @@ showModMsg dflags recomp (ModuleNode _ mod_summary) = where op = normalise - mod = moduleName (ms_mod mod_summary) - mod_str = showPpr dflags mod ++ hscSourceString (ms_hsc_src mod_summary) + mod_str = moduleNameString (moduleName (ms_mod mod_summary)) ++ + hscSourceString (ms_hsc_src mod_summary) dyn_file = op $ msDynObjFilePath mod_summary obj_file = op $ msObjFilePath mod_summary files = [ obj_file ] 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) |