compiler: Remove instance Binary Charwip/no-binary-char

It is generally not a good idea to serialise strings as [Char] into interface files,
as upon deserialisation each of these would be turned into a highly memory inefficient
structure mostly composed of cons cells and pointers.

If you really want to serialise a Char, use the SerialisableChar newtype.

23 files changed, 103 insertions, 80 deletions

diff --git a/compiler/GHC/Core/Opt/CallerCC.hs b/compiler/GHC/Core/Opt/CallerCC.hs
index dcf4df10bf..ebcc07a5ce 100644
--- a/compiler/GHC/Core/Opt/CallerCC.hs
+++ b/compiler/GHC/Core/Opt/CallerCC.hs
@@ -153,11 +153,11 @@ instance B.Binary NamePattern where
   get bh = do
     tag <- B.get bh
     case tag :: Word8 of
-      0 -> PChar <$> B.get bh <*> B.get bh
+      0 -> PChar <$> (B.getSerialisedChar <$> B.get bh) <*> B.get bh
       1 -> PWildcard <$> B.get bh
       2 -> pure PEnd
       _ -> panic "Binary(NamePattern): Invalid tag"
-  put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh x >> B.put_ bh y
+  put_ bh (PChar x y) = B.put_ bh (0 :: Word8) >> B.put_ bh (B.SerialisableChar x) >> B.put_ bh y
   put_ bh (PWildcard x) = B.put_ bh (1 :: Word8) >> B.put_ bh x
   put_ bh PEnd = B.put_ bh (2 :: Word8)
 
diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs
index 566900cdb4..81f4a17823 100644
--- a/compiler/GHC/CoreToIface.hs
+++ b/compiler/GHC/CoreToIface.hs
@@ -320,7 +320,7 @@ toIfaceCoercionX fr co
     go_prov :: UnivCoProvenance -> IfaceUnivCoProv
     go_prov (PhantomProv co)    = IfacePhantomProv (go co)
     go_prov (ProofIrrelProv co) = IfaceProofIrrelProv (go co)
-    go_prov (PluginProv str)    = IfacePluginProv str
+    go_prov (PluginProv str)    = IfacePluginProv (mkFastString str)
     go_prov (CorePrepProv b)    = IfaceCorePrepProv b
 
 toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs
diff --git a/compiler/GHC/Data/FastString.hs b/compiler/GHC/Data/FastString.hs
index dcb6901b2c..bec549156f 100644
--- a/compiler/GHC/Data/FastString.hs
+++ b/compiler/GHC/Data/FastString.hs
@@ -290,7 +290,7 @@ instance Ord NonDetFastString where
 -- representation). Hence it is deterministic from one run to the other.
 newtype LexicalFastString
    = LexicalFastString FastString
-   deriving newtype (Eq, Show)
+   deriving newtype (Eq, Show, NFData)
    deriving stock Data
 
 instance Ord LexicalFastString where
diff --git a/compiler/GHC/Hs/Doc.hs b/compiler/GHC/Hs/Doc.hs
index 70d0ee3638..e873720a75 100644
--- a/compiler/GHC/Hs/Doc.hs
+++ b/compiler/GHC/Hs/Doc.hs
@@ -28,6 +28,7 @@ module GHC.Hs.Doc
 
 import GHC.Prelude
 
+import GHC.Data.FastString
 import GHC.Utils.Binary
 import GHC.Types.Name
 import GHC.Utils.Outputable as Outputable hiding ((<>))
@@ -40,10 +41,9 @@ import GHC.Driver.Flags
 
 import Control.DeepSeq
 import Data.Data
+import Data.Function (on)
 import Data.IntMap (IntMap)
 import qualified Data.IntMap as IntMap
-import Data.Map (Map)
-import qualified Data.Map as Map
 import Data.List.NonEmpty (NonEmpty(..))
 import GHC.LanguageExtensions.Type
 import qualified GHC.Utils.Outputable as O
@@ -123,7 +123,7 @@ type LHsDoc pass = Located (HsDoc pass)
 data DocStructureItem
   = DsiSectionHeading !Int !(HsDoc GhcRn)
   | DsiDocChunk !(HsDoc GhcRn)
-  | DsiNamedChunkRef !(String)
+  | DsiNamedChunkRef !FastString
   | DsiExports !Avails
   | DsiModExport
       !(NonEmpty ModuleName) -- ^ We might re-export avails from multiple
@@ -176,7 +176,7 @@ instance Outputable DocStructureItem where
       , nest 2 (pprHsDocDebug doc)
       ]
     DsiNamedChunkRef name ->
-      text "reference to named chunk:" <+> text name
+      text "reference to named chunk:" <+> ftext name
     DsiExports avails ->
       text "avails:" $$ nest 2 (ppr avails)
     DsiModExport mod_names avails ->
@@ -202,12 +202,12 @@ data Docs = Docs
   , docs_args         :: UniqMap Name (IntMap (HsDoc GhcRn))
     -- ^ Docs for arguments. E.g. function arguments, method arguments.
   , docs_structure    :: DocStructure
-  , docs_named_chunks :: Map String (HsDoc GhcRn)
+  , docs_named_chunks :: UniqMap FastString (HsDoc GhcRn)
     -- ^ Map from chunk name to content.
     --
     -- This map will be empty unless we have an explicit export list from which
     -- we can reference the chunks.
-  , docs_haddock_opts :: Maybe String
+  , docs_haddock_opts :: Maybe FastString
     -- ^ Haddock options from @OPTIONS_HADDOCK@ or from @-haddock-opts@.
   , docs_language     :: Maybe Language
     -- ^ The 'Language' used in the module, for example 'Haskell2010'.
@@ -227,7 +227,7 @@ instance Binary Docs where
     put_ bh (sortBy (\a b -> (fst a) `stableNameCmp` fst b) $ nonDetUniqMapToList $ docs_decls docs)
     put_ bh (sortBy (\a b -> (fst a) `stableNameCmp` fst b) $ nonDetUniqMapToList $ docs_args docs)
     put_ bh (docs_structure docs)
-    put_ bh (Map.toList $ docs_named_chunks docs)
+    put_ bh (sortBy (lexicalCompareFS `on` fst) $ nonDetUniqMapToList $ docs_named_chunks docs)
     put_ bh (docs_haddock_opts docs)
     put_ bh (docs_language docs)
     put_ bh (docs_extensions docs)
@@ -236,7 +236,7 @@ instance Binary Docs where
     decls <- listToUniqMap <$> get bh
     args <- listToUniqMap <$> get bh
     structure <- get bh
-    named_chunks <- Map.fromList <$> get bh
+    named_chunks <- listToUniqMap <$> get bh
     haddock_opts <- get bh
     language <- get bh
     exts <- get bh
@@ -257,7 +257,7 @@ instance Outputable Docs where
         , pprField (ppr . fmap (ppr . map pprHsDocDebug)) "declaration docs" docs_decls
         , pprField (ppr . fmap (pprIntMap ppr pprHsDocDebug)) "arg docs" docs_args
         , pprField (vcat . map ppr) "documentation structure" docs_structure
-        , pprField (pprMap (doubleQuotes . text) pprHsDocDebug) "named chunks"
+        , pprField (ppr . fmap (ppr . pprHsDocDebug)) "named chunks"
                    docs_named_chunks
         , pprField pprMbString "haddock options" docs_haddock_opts
         , pprField ppr "language" docs_language
@@ -268,14 +268,11 @@ instance Outputable Docs where
       pprField :: (a -> SDoc) -> String -> (Docs -> a) -> SDoc
       pprField ppr' heading lbl =
         text heading O.<> colon $$ nest 2 (ppr' (lbl docs))
-      pprMap pprKey pprVal m =
-        vcat $ flip map (Map.toList m) $ \(k, v) ->
-          pprKey k O.<> colon $$ nest 2 (pprVal v)
       pprIntMap pprKey pprVal m =
         vcat $ flip map (IntMap.toList m) $ \(k, v) ->
           pprKey k O.<> colon $$ nest 2 (pprVal v)
       pprMbString Nothing = empty
-      pprMbString (Just s) = text s
+      pprMbString (Just s) = ftext s
       pprMaybe ppr' = \case
         Nothing -> text "Nothing"
         Just x -> text "Just" <+> ppr' x
@@ -286,7 +283,7 @@ emptyDocs = Docs
   , docs_decls = emptyUniqMap
   , docs_args = emptyUniqMap
   , docs_structure = []
-  , docs_named_chunks = Map.empty
+  , docs_named_chunks = emptyUniqMap
   , docs_haddock_opts = Nothing
   , docs_language = Nothing
   , docs_extensions = EnumSet.empty
diff --git a/compiler/GHC/Hs/DocString.hs b/compiler/GHC/Hs/DocString.hs
index 8e42c4a8d8..d765eda92d 100644
--- a/compiler/GHC/Hs/DocString.hs
+++ b/compiler/GHC/Hs/DocString.hs
@@ -25,6 +25,7 @@ module GHC.Hs.DocString
 
 import GHC.Prelude
 
+import GHC.Data.FastString
 import GHC.Utils.Binary
 import GHC.Utils.Encoding
 import GHC.Utils.Outputable as Outputable hiding ((<>))
@@ -102,7 +103,7 @@ instance Binary HsDocString where
 data HsDocStringDecorator
   = HsDocStringNext -- ^ '|' is the decorator
   | HsDocStringPrevious -- ^ '^' is the decorator
-  | HsDocStringNamed !String -- ^ '$<string>' is the decorator
+  | HsDocStringNamed !LexicalFastString -- ^ '$<string>' is the decorator
   | HsDocStringGroup !Int -- ^ The decorator is the given number of '*'s
   deriving (Eq, Ord, Show, Data)
 
@@ -118,7 +119,7 @@ instance NFData HsDocStringDecorator where
 printDecorator :: HsDocStringDecorator -> String
 printDecorator HsDocStringNext = "|"
 printDecorator HsDocStringPrevious = "^"
-printDecorator (HsDocStringNamed n) = '$':n
+printDecorator (HsDocStringNamed (LexicalFastString n)) = '$':unpackFS n
 printDecorator (HsDocStringGroup n) = replicate n '*'
 
 instance Binary HsDocStringDecorator where
diff --git a/compiler/GHC/HsToCore/Docs.hs b/compiler/GHC/HsToCore/Docs.hs
index f162dadaf5..ce9009d452 100644
--- a/compiler/GHC/HsToCore/Docs.hs
+++ b/compiler/GHC/HsToCore/Docs.hs
@@ -12,6 +12,7 @@ module GHC.HsToCore.Docs where
 
 import GHC.Prelude
 import GHC.Data.Bag
+import GHC.Data.FastString
 import GHC.Hs.Binds
 import GHC.Hs.Doc
 import GHC.Hs.Decls
@@ -86,7 +87,7 @@ extractDocs dflags
          , docs_args = th_arg_docs `unionArgMaps` arg_map
          , docs_structure = doc_structure
          , docs_named_chunks = named_chunks
-         , docs_haddock_opts = haddockOptions dflags
+         , docs_haddock_opts = fmap mkFastString $ haddockOptions dflags
          , docs_language = language_
          , docs_extensions = exts
          }
@@ -146,7 +147,7 @@ mkDocStructureFromExportList mdl import_avails export_list =
       (IEModuleContents _ lmn, avails) -> moduleExport (unLoc lmn) avails
       (IEGroup _ level doc, _)         -> DsiSectionHeading level (unLoc doc)
       (IEDoc _ doc, _)                 -> DsiDocChunk (unLoc doc)
-      (IEDocNamed _ name, _)           -> DsiNamedChunkRef name
+      (IEDocNamed _ name, _)           -> DsiNamedChunkRef (mkFastString name)
       (_, avails)                      -> DsiExports (nubAvails avails)
 
     moduleExport :: ModuleName -- Alias
@@ -220,12 +221,12 @@ mkDocStructureFromDecls env all_exports decls =
 -- since there would be no way to link to a named chunk.
 getNamedChunks :: Bool -- ^ Do we have an explicit export list?
                -> HsGroup (GhcPass pass)
-               -> Map String (HsDoc (GhcPass pass))
+               -> UniqMap FastString (HsDoc (GhcPass pass))
 getNamedChunks True decls =
-  M.fromList $ flip mapMaybe (unLoc <$> hs_docs decls) $ \case
-    DocCommentNamed name doc -> Just (name, unLoc doc)
+  listToUniqMap $ flip mapMaybe (unLoc <$> hs_docs decls) $ \case
+    DocCommentNamed name doc -> Just (mkFastString name, unLoc doc)
     _                        -> Nothing
-getNamedChunks False _ = M.empty
+getNamedChunks False _ = emptyUniqMap
 
 -- | Create decl and arg doc-maps by looping through the declarations.
 -- For each declaration, find its names, its subordinates, and its doc strings.
diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs
index 59a8c01073..74a588e0de 100644
--- a/compiler/GHC/HsToCore/Usage.hs
+++ b/compiler/GHC/HsToCore/Usage.hs
@@ -173,7 +173,7 @@ mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do
   where
     linkableToUsage (LM _ m uls) = mapM (unlinkedToUsage m) uls
 
-    msg m = moduleNameString (moduleName m) ++ "[TH] changed"
+    msg m = moduleNameFS (moduleName m) `appendFS` fsLit "[TH] changed"
 
     fing mmsg fn = UsageFile (mkFastString fn) <$> lookupFileCache fc fn <*> pure mmsg
 
diff --git a/compiler/GHC/Iface/Binary.hs b/compiler/GHC/Iface/Binary.hs
index a1611fe263..815ee817e4 100644
--- a/compiler/GHC/Iface/Binary.hs
+++ b/compiler/GHC/Iface/Binary.hs
@@ -106,12 +106,12 @@ readBinIfaceHeader profile _name_cache checkHiWay traceBinIFace hi_path = do
         (unFixedLength $ binaryInterfaceMagic platform) (unFixedLength magic)
 
     -- Check the interface file version and profile tag.
-    check_ver  <- get bh
+    check_ver  <- map getSerialisedChar <$> get bh
     let our_ver = show hiVersion
     wantedGot "Version" our_ver check_ver text
     errorOnMismatch "mismatched interface file versions" our_ver check_ver
 
-    check_tag <- get bh
+    check_tag <- map getSerialisedChar <$> get bh
     let tag = profileBuildTag profile
     wantedGot "Way" tag check_tag text
     when (checkHiWay == CheckHiWay) $
@@ -179,8 +179,8 @@ writeBinIface profile traceBinIface hi_path mod_iface = do
     put_ bh (binaryInterfaceMagic platform)
 
     -- The version, profile tag, and source hash go next
-    put_ bh (show hiVersion)
-    let tag = profileBuildTag profile
+    put_ bh (map SerialisableChar $ show hiVersion)
+    let tag = map SerialisableChar $ profileBuildTag profile
     put_  bh tag
     put_  bh (mi_src_hash mod_iface)
 
diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs
index 24a68e63c4..5af938cbe7 100644
--- a/compiler/GHC/Iface/Ext/Ast.hs
+++ b/compiler/GHC/Iface/Ext/Ast.hs
@@ -303,7 +303,7 @@ mkHieFileWithSource src_file src ms ts rs =
       tcs = tcg_tcs ts
       (asts',arr) = getCompressedAsts tc_binds rs top_ev_binds insts tcs in
   HieFile
-      { hie_hs_file = src_file
+      { hie_hs_file = mkFastString src_file
       , hie_module = ms_mod ms
       , hie_types = arr
       , hie_asts = asts'
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index 6474fbeb8e..e537d2ecd8 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -32,6 +32,7 @@ import GHC.Types.SrcLoc as SrcLoc
 import GHC.Types.Unique
 import GHC.Types.Unique.FM
 
+import Data.Bifunctor             (first)
 import qualified Data.Array        as A
 import qualified Data.Array.IO     as A
 import qualified Data.Array.Unsafe as A
@@ -344,7 +345,7 @@ putHieName bh (LocalName occName span) = do
   put_ bh (occName, BinSrcSpan span)
 putHieName bh (KnownKeyName uniq) = do
   putByte bh 2
-  put_ bh $ unpkUnique uniq
+  put_ bh $ (first SerialisableChar $ unpkUnique uniq)
 
 getHieName :: BinHandle -> IO HieName
 getHieName bh = do
@@ -358,5 +359,5 @@ getHieName bh = do
       return $ LocalName occ $ unBinSrcSpan span
     2 -> do
       (c,i) <- get bh
-      return $ KnownKeyName $ mkUnique c i
+      return $ KnownKeyName $ mkUnique (getSerialisedChar c) i
     _ -> panic "GHC.Iface.Ext.Binary.getHieName: invalid tag"
diff --git a/compiler/GHC/Iface/Ext/Fields.hs b/compiler/GHC/Iface/Ext/Fields.hs
index 37322303d8..76cd936bdc 100644
--- a/compiler/GHC/Iface/Ext/Fields.hs
+++ b/compiler/GHC/Iface/Ext/Fields.hs
@@ -15,23 +15,25 @@ where
 
 import GHC.Prelude
 import GHC.Utils.Binary
+import GHC.Data.FastString
+import GHC.Types.Unique.Map
 
+import Data.Function (on)
+import Data.List (sortBy)
 import Control.Monad
-import Data.Map         ( Map )
-import qualified Data.Map as Map
 import Control.DeepSeq
 
-type FieldName = String
+type FieldName = FastString
 
-newtype ExtensibleFields = ExtensibleFields { getExtensibleFields :: (Map FieldName BinData) }
+newtype ExtensibleFields = ExtensibleFields { getExtensibleFields :: (UniqMap FastString BinData) }
 
 instance Binary ExtensibleFields where
   put_ bh (ExtensibleFields fs) = do
-    put_ bh (Map.size fs :: Int)
+    put_ bh (sizeUniqMap fs :: Int)
 
     -- Put the names of each field, and reserve a space
     -- for a payload pointer after each name:
-    header_entries <- forM (Map.toList fs) $ \(name, dat) -> do
+    header_entries <- forM (sortBy (lexicalCompareFS `on` fst) $ nonDetUniqMapToList fs) $ \(name, dat) -> do
       put_ bh name
       field_p_p <- tellBin bh
       put_ bh field_p_p
@@ -58,13 +60,13 @@ instance Binary ExtensibleFields where
       dat <- get bh
       return (name, dat)
 
-    return . ExtensibleFields . Map.fromList $ fields
+    return . ExtensibleFields . listToUniqMap $ fields
 
 instance NFData ExtensibleFields where
   rnf (ExtensibleFields fs) = rnf fs
 
 emptyExtensibleFields :: ExtensibleFields
-emptyExtensibleFields = ExtensibleFields Map.empty
+emptyExtensibleFields = ExtensibleFields emptyUniqMap
 
 --------------------------------------------------------------------------------
 -- | Reading
@@ -74,7 +76,7 @@ readField name = readFieldWith name get
 
 readFieldWith :: FieldName -> (BinHandle -> IO a) -> ExtensibleFields -> IO (Maybe a)
 readFieldWith name read fields = sequence $ ((read =<<) . dataHandle) <$>
-  Map.lookup name (getExtensibleFields fields)
+  lookupUniqMap (getExtensibleFields fields) name
 
 --------------------------------------------------------------------------------
 -- | Writing
@@ -88,7 +90,7 @@ writeFieldWith name write fields = do
   write bh
   --
   bd <- handleData bh
-  return $ ExtensibleFields (Map.insert name bd $ getExtensibleFields fields)
+  return $ ExtensibleFields (addToUniqMap (getExtensibleFields fields) name bd)
 
 deleteField :: FieldName -> ExtensibleFields -> ExtensibleFields
-deleteField name (ExtensibleFields fs) = ExtensibleFields $ Map.delete name fs
+deleteField name (ExtensibleFields fs) = ExtensibleFields $ delFromUniqMap fs name
diff --git a/compiler/GHC/Iface/Ext/Types.hs b/compiler/GHC/Iface/Ext/Types.hs
index b8a398465c..6fe5a9f7af 100644
--- a/compiler/GHC/Iface/Ext/Types.hs
+++ b/compiler/GHC/Iface/Ext/Types.hs
@@ -65,7 +65,7 @@ Besides saving compilation cycles, @.hie@ files also offer a more stable
 interface than the GHC API.
 -}
 data HieFile = HieFile
-    { hie_hs_file :: FilePath
+    { hie_hs_file :: FastString
     -- ^ Initial Haskell source file path
 
     , hie_module :: Module
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index f5628e8fb6..819b943d9a 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -94,6 +94,7 @@ import GHC.Types.SourceFile
 import GHC.Types.SafeHaskell
 import GHC.Types.TypeEnv
 import GHC.Types.Unique.DSet
+import GHC.Types.Unique.Map
 import GHC.Types.SrcLoc
 import GHC.Types.TyThing
 import GHC.Types.PkgQual
@@ -109,10 +110,12 @@ import GHC.Unit.Home.ModInfo
 import GHC.Unit.Finder
 import GHC.Unit.Env
 
-import GHC.Data.Maybe
+import GHC.Data.FastString
 
 import Control.Monad
-import Data.Map ( toList )
+import Data.List (sortBy)
+import Data.Function (on)
+import GHC.Data.Maybe
 import System.FilePath
 import System.Directory
 import GHC.Driver.Env.KnotVars
@@ -1219,6 +1222,6 @@ pprIfaceAnnotation (IfaceAnnotation { ifAnnotatedTarget = target, ifAnnotatedVal
   = ppr target <+> text "annotated by" <+> ppr serialized
 
 pprExtensibleFields :: ExtensibleFields -> SDoc
-pprExtensibleFields (ExtensibleFields fs) = vcat . map pprField $ toList fs
+pprExtensibleFields (ExtensibleFields fs) = vcat . map pprField $ sortBy (lexicalCompareFS `on` fst) $ nonDetUniqMapToList fs
   where
-    pprField (name, (BinData size _data)) = text name <+> text "-" <+> ppr size <+> text "bytes"
+    pprField (name, (BinData size _data)) = ftext name <+> text "-" <+> ppr size <+> text "bytes"
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index 298e876595..afb1ef922c 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -777,7 +777,7 @@ checkModUsage fc UsageFile{ usg_file_path = file,
          else return UpToDate
  where
    reason = FileChanged $ unpackFS file
-   recomp  = needsRecompileBecause $ fromMaybe reason $ fmap CustomReason mlabel
+   recomp  = needsRecompileBecause $ fromMaybe reason $ fmap (CustomReason . unpackFS) mlabel
    handler = if debugIsOn
       then \e -> pprTrace "UsageFile" (text (show e)) $ return recomp
       else \_ -> return recomp -- if we can't find the file, just recompile, don't fail
diff --git a/compiler/GHC/Iface/Recomp/Flags.hs b/compiler/GHC/Iface/Recomp/Flags.hs
index e8d13bfa0d..024320f679 100644
--- a/compiler/GHC/Iface/Recomp/Flags.hs
+++ b/compiler/GHC/Iface/Recomp/Flags.hs
@@ -8,6 +8,7 @@ module GHC.Iface.Recomp.Flags (
       , fingerprintHpcFlags
     ) where
 
+import Data.Bifunctor (first)
 import GHC.Prelude
 
 import GHC.Driver.Session
@@ -36,7 +37,8 @@ fingerprintDynFlags :: HscEnv -> Module
 
 fingerprintDynFlags hsc_env this_mod nameio =
     let dflags@DynFlags{..} = hsc_dflags hsc_env
-        mainis   = if mainModIs (hsc_HUE hsc_env) == this_mod then Just mainFunIs else Nothing
+        serialisableString = map SerialisableChar
+        mainis   = if mainModIs (hsc_HUE hsc_env) == this_mod then Just (fmap serialisableString mainFunIs) else Nothing
                       -- see #5878
         -- pkgopts  = (homeUnit home_unit, sort $ packageFlags dflags)
         safeHs   = setSafeMode safeHaskell
@@ -51,14 +53,14 @@ fingerprintDynFlags hsc_env this_mod nameio =
         includePathsMinusImplicit = includePaths { includePathsQuoteImplicit = [] }
 
         -- -I, -D and -U flags affect CPP
-        cpp = ( map normalise $ flattenIncludes includePathsMinusImplicit
+        cpp = ( map (serialisableString . normalise) $ flattenIncludes includePathsMinusImplicit
             -- normalise: eliminate spurious differences due to "./foo" vs "foo"
-              , picPOpts dflags
-              , opt_P_signature dflags)
+              , map serialisableString $ picPOpts dflags
+              , first (map serialisableString) $ opt_P_signature dflags)
             -- See Note [Repeated -optP hashing]
 
         -- Note [path flags and recompilation]
-        paths = [ hcSuf ]
+        paths = map serialisableString [ hcSuf ]
 
         -- -fprof-auto etc.
         prof = if sccProfilingEnabled dflags then fromEnum profAuto else 0
@@ -102,7 +104,7 @@ fingerprintHpcFlags dflags@DynFlags{..} nameio =
       let
         -- -fhpc, see https://gitlab.haskell.org/ghc/ghc/issues/11798
         -- hpcDir is output-only, so we should recompile if it changes
-        hpc = if gopt Opt_Hpc dflags then Just hpcDir else Nothing
+        hpc = if gopt Opt_Hpc dflags then Just (map SerialisableChar hpcDir) else Nothing
 
       in computeFingerprint nameio hpc
 
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 1796539cd5..669e998e38 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -402,7 +402,7 @@ data IfaceCoercion
 data IfaceUnivCoProv
   = IfacePhantomProv IfaceCoercion
   | IfaceProofIrrelProv IfaceCoercion
-  | IfacePluginProv String
+  | IfacePluginProv FastString
   | IfaceCorePrepProv Bool  -- See defn of CorePrepProv
 
 {- Note [Holes in IfaceCoercion]
@@ -1886,7 +1886,7 @@ pprIfaceUnivCoProv (IfacePhantomProv co)
 pprIfaceUnivCoProv (IfaceProofIrrelProv co)
   = text "irrel" <+> pprParendIfaceCoercion co
 pprIfaceUnivCoProv (IfacePluginProv s)
-  = text "plugin" <+> doubleQuotes (text s)
+  = text "plugin" <+> doubleQuotes (ftext s)
 pprIfaceUnivCoProv (IfaceCorePrepProv _)
   = text "CorePrep"
 
@@ -1952,7 +1952,7 @@ instance Outputable IfaceTyLit where
 instance Binary IfaceTyLit where
   put_ bh (IfaceNumTyLit n)   = putByte bh 1 >> put_ bh n
   put_ bh (IfaceStrTyLit n)   = putByte bh 2 >> put_ bh n
-  put_ bh (IfaceCharTyLit n)  = putByte bh 3 >> put_ bh n
+  put_ bh (IfaceCharTyLit n)  = putByte bh 3 >> put_ bh (SerialisableChar n)
 
   get bh =
     do tag <- getByte bh
@@ -1962,7 +1962,7 @@ instance Binary IfaceTyLit where
          2 -> do { n <- get bh
                  ; return (IfaceStrTyLit n) }
          3 -> do { n <- get bh
-                 ; return (IfaceCharTyLit n) }
+                 ; return (IfaceCharTyLit $ getSerialisedChar n) }
          _ -> panic ("get IfaceTyLit " ++ show tag)
 
 instance Binary IfaceAppArgs where
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index 03506e531c..261ff883f1 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -1514,7 +1514,7 @@ tcIfaceCo = go
 tcIfaceUnivCoProv :: IfaceUnivCoProv -> IfL UnivCoProvenance
 tcIfaceUnivCoProv (IfacePhantomProv kco)    = PhantomProv <$> tcIfaceCo kco
 tcIfaceUnivCoProv (IfaceProofIrrelProv kco) = ProofIrrelProv <$> tcIfaceCo kco
-tcIfaceUnivCoProv (IfacePluginProv str)     = return $ PluginProv str
+tcIfaceUnivCoProv (IfacePluginProv str)     = return $ PluginProv (unpackFS str)
 tcIfaceUnivCoProv (IfaceCorePrepProv b)     = return $ CorePrepProv b
 
 {-
diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x
index 61235f5942..496fcd681b 100644
--- a/compiler/GHC/Parser/Lexer.x
+++ b/compiler/GHC/Parser/Lexer.x
@@ -1614,7 +1614,7 @@ mkHdkCommentPrev loc mkDS =  (HdkCommentPrev ds,ITdocComment ds loc)
 
 mkHdkCommentNamed :: PsSpan -> String -> (HsDocStringDecorator -> HsDocString) -> (HdkComment, Token)
 mkHdkCommentNamed loc name mkDS = (HdkCommentNamed name ds, ITdocComment ds loc)
-  where ds = mkDS (HsDocStringNamed name)
+  where ds = mkDS (HsDocStringNamed $ LexicalFastString $ mkFastString name)
 
 mkHdkCommentSection :: PsSpan -> Int -> (HsDocStringDecorator -> HsDocString) -> (HdkComment, Token)
 mkHdkCommentSection loc n mkDS = (HdkCommentSection n ds, ITdocComment ds loc)
diff --git a/compiler/GHC/StgToJS/Object.hs b/compiler/GHC/StgToJS/Object.hs
index be87945f3f..adbc8d8fdd 100644
--- a/compiler/GHC/StgToJS/Object.hs
+++ b/compiler/GHC/StgToJS/Object.hs
@@ -227,12 +227,12 @@ putObject
   -> IO ()
 putObject bh mod_name deps os = do
   forM_ magic (putByte bh . fromIntegral . ord)
-  put_ bh (show hiVersion)
+  put_ bh (map SerialisableChar $ show hiVersion)
 
   -- we store the module name as a String because we don't want to have to
   -- decode the FastString table just to decode it when we're looking for an
   -- object in an archive.
-  put_ bh (moduleNameString mod_name)
+  put_ bh (moduleNameFS mod_name)
 
   (bh_fs, _bin_dict, put_dict) <- initFSTable bh
 
@@ -281,12 +281,12 @@ getObjectHeader bh = do
   case is_magic of
     False -> pure (Left "invalid magic header")
     True  -> do
-      is_correct_version <- ((== hiVersion) . read) <$> get bh
+      is_correct_version <- ((== hiVersion) . read . map getSerialisedChar) <$> get bh
       case is_correct_version of
         False -> pure (Left "invalid header version")
         True  -> do
           mod_name <- get bh
-          pure (Right (mkModuleName (mod_name)))
+          pure (Right (mkModuleNameFS mod_name))
 
 
 -- | Parse object body. Must be called after a sucessful getObjectHeader
diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs
index 1bb9ddb31b..d076a7a35a 100644
--- a/compiler/GHC/Types/Literal.hs
+++ b/compiler/GHC/Types/Literal.hs
@@ -254,7 +254,7 @@ for more details.
 -}
 
 instance Binary Literal where
-    put_ bh (LitChar aa)     = do putByte bh 0; put_ bh aa
+    put_ bh (LitChar aa)     = do putByte bh 0; put_ bh $ SerialisableChar aa
     put_ bh (LitString ab)   = do putByte bh 1; put_ bh ab
     put_ bh (LitNullAddr)    = putByte bh 2
     put_ bh (LitFloat ah)    = do putByte bh 3; put_ bh ah
@@ -276,7 +276,7 @@ instance Binary Literal where
             case h of
               0 -> do
                     aa <- get bh
-                    return (LitChar aa)
+                    return (LitChar $ getSerialisedChar aa)
               1 -> do
                     ab <- get bh
                     return (LitString ab)
diff --git a/compiler/GHC/Unit/Module/Deps.hs b/compiler/GHC/Unit/Module/Deps.hs
index 75063e901f..894fa7a4aa 100644
--- a/compiler/GHC/Unit/Module/Deps.hs
+++ b/compiler/GHC/Unit/Module/Deps.hs
@@ -283,7 +283,7 @@ data Usage
         usg_file_hash  :: Fingerprint,
         -- ^ 'Fingerprint' of the file contents.
 
-        usg_file_label :: Maybe String
+        usg_file_label :: Maybe FastString
         -- ^ An optional string which is used in recompilation messages if
         -- file in question has changed.
 
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs
index 7534d65918..6ee06274d3 100644
--- a/compiler/GHC/Utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -1,5 +1,7 @@
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -81,7 +83,7 @@ module GHC.Utils.Binary
    FSTable, initFSTable, getDictFastString, putDictFastString,
 
    -- * Newtype wrappers
-   BinSpan(..), BinSrcSpan(..), BinLocated(..)
+   BinSpan(..), BinSrcSpan(..), BinLocated(..), SerialisableChar(..)
   ) where
 
 import GHC.Prelude
@@ -125,6 +127,8 @@ import qualified Data.IntMap as IntMap
 import GHC.ForeignPtr           ( unsafeWithForeignPtr )
 #endif
 
+import GHC.TypeError
+
 type BinArray = ForeignPtr Word8
 
 #if !MIN_VERSION_base(4,15,0)
@@ -675,9 +679,20 @@ instance Binary Bool where
     put_ bh b = putByte bh (fromIntegral (fromEnum b))
     get  bh   = do x <- getWord8 bh; return $! (toEnum (fromIntegral x))
 
-instance Binary Char where
-    put_  bh c = put_ bh (fromIntegral (ord c) :: Word32)
-    get  bh   = do x <- get bh; return $! (chr (fromIntegral (x :: Word32)))
+instance (TypeError (Text "No instance for Binary Char"
+                :$$: Text "We don't want to serialise Strings into interface files"
+                :$$: Text "Use a compact representation like " :<>: ShowType FastString :<>: Text " instead"
+                :$$: Text "If you really want to serialise you can use " :<>: ShowType SerialisableChar)
+                )
+               => Binary Char where
+    put_ = undefined
+    get = undefined
+
+newtype SerialisableChar = SerialisableChar { getSerialisedChar :: Char }
+
+instance Binary SerialisableChar where
+    put_  bh (SerialisableChar c) = put_ bh (fromIntegral (ord c) :: Word32)
+    get  bh   = do x <- get bh; return $! (SerialisableChar $ chr (fromIntegral (x :: Word32)))
 
 instance Binary Int where
     put_ bh i = put_ bh (fromIntegral i :: Int64)
diff --git a/compiler/GHC/Utils/Binary/Typeable.hs b/compiler/GHC/Utils/Binary/Typeable.hs
index 5734905ebd..bc2dd7da48 100644
--- a/compiler/GHC/Utils/Binary/Typeable.hs
+++ b/compiler/GHC/Utils/Binary/Typeable.hs
@@ -17,6 +17,7 @@ where
 import GHC.Prelude
 
 import GHC.Utils.Binary
+import GHC.Data.FastString
 
 import GHC.Exts (RuntimeRep(..), VecCount(..), VecElem(..))
 #if __GLASGOW_HASKELL__ >= 901
@@ -32,13 +33,13 @@ import Data.Kind (Type)
 
 instance Binary TyCon where
     put_ bh tc = do
-        put_ bh (tyConPackage tc)
-        put_ bh (tyConModule tc)
-        put_ bh (tyConName tc)
+        put_ bh (mkFastString $ tyConPackage tc)
+        put_ bh (mkFastString $ tyConModule tc)
+        put_ bh (mkFastString $ tyConName tc)
         put_ bh (tyConKindArgs tc)
         put_ bh (tyConKindRep tc)
     get bh =
-        mkTyCon <$> get bh <*> get bh <*> get bh <*> get bh <*> get bh
+        mkTyCon <$> (unpackFS <$> get bh) <*> (unpackFS <$> get bh) <*> (unpackFS <$> get bh) <*> get bh <*> get bh
 
 getSomeTypeRep :: BinHandle -> IO SomeTypeRep
 getSomeTypeRep bh = do
@@ -157,7 +158,7 @@ instance Binary KindRep where
     put_ bh (KindRepApp a b) = putByte bh 2 >> put_ bh a >> put_ bh b
     put_ bh (KindRepFun a b) = putByte bh 3 >> put_ bh a >> put_ bh b
     put_ bh (KindRepTYPE r) = putByte bh 4 >> put_ bh r
-    put_ bh (KindRepTypeLit sort r) = putByte bh 5 >> put_ bh sort >> put_ bh r
+    put_ bh (KindRepTypeLit sort r) = putByte bh 5 >> put_ bh sort >> put_ bh (mkFastString r)
 
     get bh = do
         tag <- getByte bh
@@ -167,7 +168,7 @@ instance Binary KindRep where
           2 -> KindRepApp <$> get bh <*> get bh
           3 -> KindRepFun <$> get bh <*> get bh
           4 -> KindRepTYPE <$> get bh
-          5 -> KindRepTypeLit <$> get bh <*> get bh
+          5 -> KindRepTypeLit <$> get bh <*> (unpackFS <$> get bh)
           _ -> fail "Binary.putKindRep: invalid tag"
 
 instance Binary TypeLitSort where