OccName: Avoid re-encoding derived OccNames

Previously we would form derived OccNames by first decoding the name
being derived from, manipulating it in [Char] form, and then
re-encoding. This is all very wasteful as we essentially always just
want to concatenate. Instead we now take care to form the final name
with only one concatFS.

Test Plan: Validate, examing compiler allocations

Reviewers: simonpj, austin

Reviewed By: simonpj

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2387

GHC Trac Issues: #12357

1 files changed, 28 insertions, 14 deletions

diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs
index caaf90bae3..65195ab951 100644
--- a/compiler/basicTypes/OccName.hs
+++ b/compiler/basicTypes/OccName.hs
@@ -3,7 +3,9 @@
 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 -}
 
-{-# LANGUAGE DeriveDataTypeable, BangPatterns #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 -- |
 -- #name_types#
@@ -559,12 +561,19 @@ This knowledge is encoded in the following functions.
 NB: The string must already be encoded!
 -}
 
+-- | Build an 'OccName' derived from another 'OccName'.
+--
+-- Note that the pieces of the name are passed in as a @[FastString]@ so that
+-- the whole name can be constructed with a single 'concatFS', minimizing
+-- unnecessary intermediate allocations.
 mk_deriv :: NameSpace
-         -> String              -- Distinguishes one sort of derived name from another
-         -> String
+         -> FastString      -- ^ A prefix which distinguishes one sort of
+                            -- derived name from another
+         -> [FastString]    -- ^ The name we are deriving from in pieces which
+                            -- will be concatenated.
          -> OccName
-
-mk_deriv occ_sp sys_prefix str = mkOccName occ_sp (sys_prefix ++ str)
+mk_deriv occ_sp sys_prefix str =
+    mkOccNameFS occ_sp (concatFS $ sys_prefix : str)
 
 isDerivedOccName :: OccName -> Bool
 -- ^ Test for definitions internally generated by GHC.  This predicte
@@ -638,14 +647,19 @@ mkPDatasDataConOcc = mk_simple_deriv_with dataName "VPDs:"
 
 -- Overloaded record field selectors
 mkRecFldSelOcc :: String -> OccName
-mkRecFldSelOcc   = mk_deriv varName "$sel"
+mkRecFldSelOcc s = mk_deriv varName "$sel" [fsLit s]
 
-mk_simple_deriv :: NameSpace -> String -> OccName -> OccName
-mk_simple_deriv sp px occ = mk_deriv sp px (occNameString occ)
+mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName
+mk_simple_deriv sp px occ = mk_deriv sp px [occNameFS occ]
 
-mk_simple_deriv_with :: NameSpace -> String -> Maybe String -> OccName -> OccName
-mk_simple_deriv_with sp px Nothing     occ = mk_deriv sp px                  (occNameString occ)
-mk_simple_deriv_with sp px (Just with) occ = mk_deriv sp (px ++ with ++ "_") (occNameString occ)
+mk_simple_deriv_with :: NameSpace     -- ^ the namespace
+                     -> FastString    -- ^ an identifying prefix
+                     -> Maybe String  -- ^ another optional prefix
+                     -> OccName       -- ^ the 'OccName' to derive from
+                     -> OccName
+mk_simple_deriv_with sp px Nothing     occ = mk_deriv sp px [occNameFS occ]
+mk_simple_deriv_with sp px (Just with) occ =
+    mk_deriv sp px [fsLit with, fsLit "_", occNameFS occ]
 
 -- Data constructor workers are made by setting the name space
 -- of the data constructor OccName (which should be a DataName)
@@ -654,19 +668,19 @@ mkDataConWorkerOcc datacon_occ = setOccNameSpace varName datacon_occ
 
 mkSuperDictAuxOcc :: Int -> OccName -> OccName
 mkSuperDictAuxOcc index cls_tc_occ
-  = mk_deriv varName "$cp" (show index ++ occNameString cls_tc_occ)
+  = mk_deriv varName "$cp" [fsLit $ show index, occNameFS cls_tc_occ]
 
 mkSuperDictSelOcc :: Int        -- ^ Index of superclass, e.g. 3
                   -> OccName    -- ^ Class, e.g. @Ord@
                   -> OccName    -- ^ Derived 'Occname', e.g. @$p3Ord@
 mkSuperDictSelOcc index cls_tc_occ
-  = mk_deriv varName "$p" (show index ++ occNameString cls_tc_occ)
+  = mk_deriv varName "$p" [fsLit $ show index, occNameFS cls_tc_occ]
 
 mkLocalOcc :: Unique            -- ^ Unique to combine with the 'OccName'
            -> OccName           -- ^ Local name, e.g. @sat@
            -> OccName           -- ^ Nice unique version, e.g. @$L23sat@
 mkLocalOcc uniq occ
-   = mk_deriv varName ("$L" ++ show uniq) (occNameString occ)
+   = mk_deriv varName "$L" [fsLit $ show uniq, occNameFS occ]
         -- The Unique might print with characters
         -- that need encoding (e.g. 'z'!)