summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-09-30 10:45:05 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-10-19 03:30:16 -0400
commit8144a92f5a73dd22c0d855d5b2bead930111511c (patch)
tree75a4c20d945da72a2e52fc802d030701b0cffbce
parent51281e81601fb0b288c921728ea3b3f568f77af7 (diff)
downloadhaskell-8144a92f5a73dd22c0d855d5b2bead930111511c.tar.gz
WW: Use module name rather than filename for absent error messages
WwOpts in WorkWrap.Utils initialised the wo_output_file field with the result of outputFile dflags. This is misguided because outputFile is only set when -o is specified, which is barely ever (and never in --make mode). It seems this is just used to add more context to an error message, a more appropriate thing to use I think would be a module name. Fixes #20438
-rw-r--r--compiler/GHC/Core/Opt/Pipeline.hs2
-rw-r--r--compiler/GHC/Core/Opt/WorkWrap.hs7
-rw-r--r--compiler/GHC/Core/Opt/WorkWrap/Utils.hs14
3 files changed, 12 insertions, 11 deletions
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index ad7905ee27..18ac910d15 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -514,7 +514,7 @@ doCorePass pass guts = do
updateBindsM (liftIO . cprAnalProgram logger fam_envs)
CoreDoWorkerWrapper -> {-# SCC "WorkWrap" #-}
- updateBinds (wwTopBinds dflags fam_envs us)
+ updateBinds (wwTopBinds (mg_module guts) dflags fam_envs us)
CoreDoSpecialising -> {-# SCC "Specialise" #-}
specProgram guts
diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs
index 2c204795c9..976dcd5fe5 100644
--- a/compiler/GHC/Core/Opt/WorkWrap.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap.hs
@@ -37,6 +37,7 @@ import GHC.Utils.Panic
import GHC.Utils.Panic.Plain
import GHC.Utils.Monad
import GHC.Utils.Trace
+import GHC.Unit.Types
{-
We take Core bindings whose binders have:
@@ -66,14 +67,14 @@ info for exported values).
\end{enumerate}
-}
-wwTopBinds :: DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram
+wwTopBinds :: Module -> DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram
-wwTopBinds dflags fam_envs us top_binds
+wwTopBinds this_mod dflags fam_envs us top_binds
= initUs_ us $ do
top_binds' <- mapM (wwBind ww_opts) top_binds
return (concat top_binds')
where
- ww_opts = initWwOpts dflags fam_envs
+ ww_opts = initWwOpts this_mod dflags fam_envs
{-
************************************************************************
diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
index 50200d18b0..df3608fe7d 100644
--- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
+++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs
@@ -64,6 +64,7 @@ import Control.Monad ( zipWithM )
import Data.List ( unzip4 )
import GHC.Types.RepType
+import GHC.Unit.Types
{-
************************************************************************
@@ -141,17 +142,18 @@ data WwOpts
, wo_cpr_anal :: !Bool
, wo_fun_to_thunk :: !Bool
, wo_max_worker_args :: !Int
- , wo_output_file :: Maybe String
+ -- Used for absent argument error message
+ , wo_module :: !Module
}
-initWwOpts :: DynFlags -> FamInstEnvs -> WwOpts
-initWwOpts dflags fam_envs = MkWwOpts
+initWwOpts :: Module -> DynFlags -> FamInstEnvs -> WwOpts
+initWwOpts this_mod dflags fam_envs = MkWwOpts
{ wo_fam_envs = fam_envs
, wo_simple_opts = initSimpleOpts dflags
, wo_cpr_anal = gopt Opt_CprAnal dflags
, wo_fun_to_thunk = gopt Opt_FunToThunk dflags
, wo_max_worker_args = maxWorkerArgs dflags
- , wo_output_file = outputFile dflags
+ , wo_module = this_mod
}
type WwResult
@@ -1003,9 +1005,7 @@ mkAbsentFiller opts arg
-- will have different lengths and hence different costs for
-- the inliner leading to different inlining.
-- See also Note [Unique Determinism] in GHC.Types.Unique
- file_msg = case wo_output_file opts of
- Nothing -> empty
- Just f -> text "In output file " <+> quotes (text f)
+ file_msg = text "In module" <+> quotes (ppr $ wo_module opts)
{- Note [Worker/wrapper for Strictness and Absence]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~