Modularize Tidy (#17957)

- Factorize Tidy options into TidyOpts datatype. Initialize it in
  GHC.Driver.Config.Tidy
- Same thing for StaticPtrOpts
- Perform lookups of unpackCString[Utf8]# once in initStaticPtrOpts
  instead of for every use of mkStringExprWithFS

1 files changed, 21 insertions, 9 deletions

diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index 200847134b..932bf8aa8d 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -19,6 +19,7 @@ module GHC.Core.Make (
         mkIntegerExpr, mkNaturalExpr,
         mkFloatExpr, mkDoubleExpr,
         mkCharExpr, mkStringExpr, mkStringExprFS, mkStringExprFSWith,
+        MkStringIds (..), getMkStringIds,
 
         -- * Floats
         FloatBind(..), wrapFloat, wrapFloats, floatBindings,
@@ -333,26 +334,37 @@ mkCharExpr c = mkCoreConApps charDataCon [mkCharLit c]
 
 -- | Create a 'CoreExpr' which will evaluate to the given @String@
 mkStringExpr   :: MonadThings m => String     -> m CoreExpr  -- Result :: String
+mkStringExpr str = mkStringExprFS (mkFastString str)
 
 -- | Create a 'CoreExpr' which will evaluate to a string morally equivalent to the given @FastString@
 mkStringExprFS :: MonadThings m => FastString -> m CoreExpr  -- Result :: String
+mkStringExprFS = mkStringExprFSLookup lookupId
 
-mkStringExpr str = mkStringExprFS (mkFastString str)
+mkStringExprFSLookup :: Monad m => (Name -> m Id) -> FastString -> m CoreExpr
+mkStringExprFSLookup lookupM str = do
+  mk <- getMkStringIds lookupM
+  pure (mkStringExprFSWith mk str)
+
+getMkStringIds :: Applicative m => (Name -> m Id) -> m MkStringIds
+getMkStringIds lookupM = MkStringIds <$> lookupM unpackCStringName <*> lookupM unpackCStringUtf8Name
 
-mkStringExprFS = mkStringExprFSWith lookupId
+data MkStringIds = MkStringIds
+  { unpackCStringId     :: !Id
+  , unpackCStringUtf8Id :: !Id
+  }
 
-mkStringExprFSWith :: Monad m => (Name -> m Id) -> FastString -> m CoreExpr
-mkStringExprFSWith lookupM str
+mkStringExprFSWith :: MkStringIds -> FastString -> CoreExpr
+mkStringExprFSWith ids str
   | nullFS str
-  = return (mkNilExpr charTy)
+  = mkNilExpr charTy
 
   | all safeChar chars
-  = do unpack_id <- lookupM unpackCStringName
-       return (App (Var unpack_id) lit)
+  = let !unpack_id = unpackCStringId ids
+    in App (Var unpack_id) lit
 
   | otherwise
-  = do unpack_utf8_id <- lookupM unpackCStringUtf8Name
-       return (App (Var unpack_utf8_id) lit)
+  = let !unpack_utf8_id = unpackCStringUtf8Id ids
+    in App (Var unpack_utf8_id) lit
 
   where
     chars = unpackFS str