[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: JS: avoid head/tail and unpackFS
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Feb 8 14:30:40 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
c1670c6b by Sylvain Henry at 2023-02-07T21:25:18-05:00
JS: avoid head/tail and unpackFS
- - - - -
a9912de7 by Krzysztof Gogolewski at 2023-02-07T21:25:53-05:00
testsuite: Fix Python warnings (#22856)
- - - - -
0c3d1028 by sheaf at 2023-02-08T09:30:25-05:00
Fix tyvar scoping within class SPECIALISE pragmas
Type variables from class/instance headers scope over class/instance
method type signatures, but DO NOT scope over the type signatures in
SPECIALISE and SPECIALISE instance pragmas.
The logic in GHC.Rename.Bind.rnMethodBinds correctly accounted for
SPECIALISE inline pragmas, but forgot to apply the same treatment
to method SPECIALISE pragmas, which lead to a Core Lint failure with
an out-of-scope type variable. This patch makes sure we apply the same
logic for both cases.
Fixes #22913
- - - - -
22085bcd by Matthew Pickering at 2023-02-08T09:30:25-05:00
Revert "Don't keep exit join points so much"
This reverts commit caced75765472a1a94453f2e5a439dba0d04a265.
It seems the patch "Don't keep exit join points so much" is causing
wide-spread regressions in the bytestring library benchmarks. If I
revert it then the 9.6 numbers are better on average than 9.4.
See https://gitlab.haskell.org/ghc/ghc/-/issues/22893#note_479525
-------------------------
Metric Decrease:
MultiComponentModules
MultiComponentModulesRecomp
MultiLayerModules
MultiLayerModulesRecomp
MultiLayerModulesTH_Make
T12150
T13386
T13719
T21839c
T3294
parsing001
-------------------------
- - - - -
17 changed files:
- compiler/GHC/Core/Opt/Exitify.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/StgToJS/Printer.hs
- testsuite/driver/runtests.py
- testsuite/driver/testlib.py
- + testsuite/tests/rename/should_compile/T22913.hs
- testsuite/tests/rename/should_compile/all.T
- − testsuite/tests/simplCore/should_compile/T21148.hs
- − testsuite/tests/simplCore/should_compile/T21148.stderr
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/stranal/should_compile/T21128.hs
- testsuite/tests/stranal/should_compile/T21128.stderr
Changes:
=====================================
compiler/GHC/Core/Opt/Exitify.hs
=====================================
@@ -433,7 +433,6 @@ inlining.
Exit join points, recognizable using `isExitJoinId` are join points with an
occurrence in a recursive group, and can be recognized (after the occurrence
analyzer ran!) using `isExitJoinId`.
-
This function detects joinpoints with `occ_in_lam (idOccinfo id) == True`,
because the lambdas of a non-recursive join point are not considered for
`occ_in_lam`. For example, in the following code, `j1` is /not/ marked
@@ -447,29 +446,6 @@ To prevent inlining, we check for isExitJoinId
* In `simplLetUnfolding` we simply give exit join points no unfolding, which
prevents inlining in `postInlineUnconditionally` and call sites.
-But see Note [Be selective about not-inlining exit join points]
-
-Note [Be selective about not-inlining exit join points]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-If we follow "do not inline exit join points" mantra throughout,
-some bad things happen.
-
-* We can lose CPR information: see #21148
-
-* We get useless clutter (#22084) that
- - makes the program bigger (including duplicated code #20739), and
- - adds extra jumps (and maybe stack saves) at runtime
-
-So instead we follow "do not inline exit join points" for a /single run/
-of the simplifier, right after Exitification. That should give a
-sufficient chance for used-once things to inline, but subsequent runs
-will inline them back in. (Annoyingly, as things stand, only with -O2
-is there a subsequent run, but that might change, and it's not a huge
-deal anyway.)
-
-This is controlled by the Simplifier's sm_keep_exits flag; see
-GHC.Core.Opt.Pipeline.
-
Note [Placement of the exitification pass]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
I (Joachim) experimented with multiple positions for the Exitification pass in
=====================================
compiler/GHC/Core/Opt/Pipeline.hs
=====================================
@@ -15,7 +15,7 @@ import GHC.Driver.Plugins ( withPlugins, installCoreToDos )
import GHC.Driver.Env
import GHC.Driver.Config.Core.Lint ( endPass )
import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts )
-import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode )
+import GHC.Driver.Config.Core.Opt.Simplify ( initSimplifyOpts, initSimplMode, initGentleSimplMode )
import GHC.Driver.Config.Core.Opt.WorkWrap ( initWorkWrapOpts )
import GHC.Driver.Config.Core.Rules ( initRuleOpts )
import GHC.Platform.Ways ( hasWay, Way(WayProf) )
@@ -28,7 +28,6 @@ import GHC.Core.Utils ( dumpIdInfoOfProgram )
import GHC.Core.Lint ( lintAnnots )
import GHC.Core.Lint.Interactive ( interactiveInScope )
import GHC.Core.Opt.Simplify ( simplifyExpr, simplifyPgm )
-import GHC.Core.Opt.Simplify.Env( SimplMode(..) )
import GHC.Core.Opt.Simplify.Monad
import GHC.Core.Opt.Monad
import GHC.Core.Opt.Pipeline.Types
@@ -153,45 +152,32 @@ getCoreToDo dflags hpt_rule_base extra_vars
maybe_strictness_before _
= CoreDoNothing
- ----------------------------
- base_simpl_mode :: SimplMode
- base_simpl_mode = initSimplMode dflags
-
- -- gentle_mode: make specialiser happy: minimum effort please
- -- See Note [Inline in InitialPhase]
- -- See Note [RULEs enabled in InitialPhase]
- gentle_mode = base_simpl_mode { sm_names = ["Gentle"]
- , sm_phase = InitialPhase
- , sm_case_case = False }
-
- simpl_mode phase name
- = base_simpl_mode { sm_names = [name], sm_phase = phase }
-
- keep_exits :: SimplMode -> SimplMode
- -- See Note [Be selective about not-inlining exit join points]
- -- in GHC.Core.Opt.Exitify
- keep_exits mode = mode { sm_keep_exits = True }
-
- ----------------------------
- run_simplifier mode iter
- = CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter mode hpt_rule_base
-
- simpl_phase phase name iter = CoreDoPasses $
- [ maybe_strictness_before phase
- , run_simplifier (simpl_mode phase name) iter
- , maybe_rule_check phase ]
+ simpl_phase phase name iter
+ = CoreDoPasses
+ $ [ maybe_strictness_before phase
+ , CoreDoSimplify $ initSimplifyOpts dflags extra_vars iter
+ (initSimplMode dflags phase name) hpt_rule_base
+ , maybe_rule_check phase ]
-- Run GHC's internal simplification phase, after all rules have run.
-- See Note [Compiler phases] in GHC.Types.Basic
- simpl_gently = run_simplifier gentle_mode max_iter
- simplify_final name = run_simplifier ( simpl_mode FinalPhase name) max_iter
- simpl_keep_exits name = run_simplifier (keep_exits $ simpl_mode FinalPhase name) max_iter
+ simplify name = simpl_phase FinalPhase name max_iter
+
+ -- initial simplify: mk specialiser happy: minimum effort please
+ -- See Note [Inline in InitialPhase]
+ -- See Note [RULEs enabled in InitialPhase]
+ simpl_gently = CoreDoSimplify $ initSimplifyOpts dflags extra_vars max_iter
+ (initGentleSimplMode dflags) hpt_rule_base
- ----------------------------
dmd_cpr_ww = if ww_on then [CoreDoDemand True,CoreDoCpr,CoreDoWorkerWrapper]
else [CoreDoDemand False] -- NB: No CPR! See Note [Don't change boxity without worker/wrapper]
+ demand_analyser = (CoreDoPasses (
+ dmd_cpr_ww ++
+ [simplify "post-worker-wrapper"]
+ ))
+
-- Static forms are moved to the top level with the FloatOut pass.
-- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.
static_ptrs_float_outwards =
@@ -281,16 +267,14 @@ getCoreToDo dflags hpt_rule_base extra_vars
runWhen call_arity $ CoreDoPasses
[ CoreDoCallArity
- , simplify_final "post-call-arity"
+ , simplify "post-call-arity"
],
-- Strictness analysis
- runWhen strictness $ CoreDoPasses
- (dmd_cpr_ww ++ [simplify_final "post-worker-wrapper"]),
+ runWhen strictness demand_analyser,
runWhen exitification CoreDoExitify,
-- See Note [Placement of the exitification pass]
- -- in GHC.Core.Opt.Exitify
runWhen full_laziness $
CoreDoFloatOutwards FloatOutSwitches {
@@ -312,17 +296,7 @@ getCoreToDo dflags hpt_rule_base extra_vars
runWhen do_float_in CoreDoFloatInwards,
- -- Final tidy-up run of the simplifier
- simpl_keep_exits "final tidy up",
- -- Keep exit join point because this is the first
- -- Simplifier run after Exitify. Subsequent runs will
- -- re-inline those exit join points; their work is done.
- -- See Note [Be selective about not-inlining exit join points]
- -- in GHC.Core.Opt.Exitify
- --
- -- Annoyingly, we only /have/ a subsequent run with -O2. With
- -- plain -O we'll still have those exit join points hanging around.
- -- Oh well.
+ simplify "final", -- Final tidy-up
maybe_rule_check FinalPhase,
@@ -332,31 +306,31 @@ getCoreToDo dflags hpt_rule_base extra_vars
-- Case-liberation for -O2. This should be after
-- strictness analysis and the simplification which follows it.
runWhen liberate_case $ CoreDoPasses
- [ CoreLiberateCase, simplify_final "post-liberate-case" ],
+ [ CoreLiberateCase, simplify "post-liberate-case" ],
-- Run the simplifier after LiberateCase to vastly
-- reduce the possibility of shadowing
-- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr
runWhen spec_constr $ CoreDoPasses
- [ CoreDoSpecConstr, simplify_final "post-spec-constr"],
+ [ CoreDoSpecConstr, simplify "post-spec-constr"],
-- See Note [Simplify after SpecConstr]
maybe_rule_check FinalPhase,
runWhen late_specialise $ CoreDoPasses
- [ CoreDoSpecialising, simplify_final "post-late-spec"],
+ [ CoreDoSpecialising, simplify "post-late-spec"],
-- LiberateCase can yield new CSE opportunities because it peels
-- off one layer of a recursive function (concretely, I saw this
-- in wheel-sieve1), and I'm guessing that SpecConstr can too
-- And CSE is a very cheap pass. So it seems worth doing here.
runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses
- [ CoreCSE, simplify_final "post-final-cse" ],
+ [ CoreCSE, simplify "post-final-cse" ],
--------- End of -O2 passes --------------
runWhen late_dmd_anal $ CoreDoPasses (
- dmd_cpr_ww ++ [simplify_final "post-late-ww"]
+ dmd_cpr_ww ++ [simplify "post-late-ww"]
),
-- Final run of the demand_analyser, ensures that one-shot thunks are
=====================================
compiler/GHC/Core/Opt/Simplify/Env.hs
=====================================
@@ -248,16 +248,13 @@ data SimplMode = SimplMode -- See comments in GHC.Core.Opt.Simplify.Monad
, sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options
, sm_case_case :: !Bool -- ^ Whether case-of-case is enabled
, sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled
- , sm_keep_exits :: !Bool -- ^ True <=> keep ExitJoinIds
- -- See Note [Do not inline exit join points]
- -- in GHC.Core.Opt.Exitify
- , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out
+ , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out
, sm_do_eta_reduction :: !Bool
- , sm_arity_opts :: !ArityOpts
- , sm_rule_opts :: !RuleOpts
- , sm_case_folding :: !Bool
- , sm_case_merge :: !Bool
- , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options
+ , sm_arity_opts :: !ArityOpts
+ , sm_rule_opts :: !RuleOpts
+ , sm_case_folding :: !Bool
+ , sm_case_merge :: !Bool
+ , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options
}
instance Outputable SimplMode where
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -1395,11 +1395,11 @@ preInlineUnconditionally
-- Reason: we don't want to inline single uses, or discard dead bindings,
-- for unlifted, side-effect-ful bindings
preInlineUnconditionally env top_lvl bndr rhs rhs_env
- | not pre_inline = Nothing
+ | not pre_inline_unconditionally = Nothing
| not active = Nothing
| isTopLevel top_lvl && isDeadEndId bndr = Nothing -- Note [Top-level bottoming Ids]
| isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally]
- | keep_exits, isExitJoinId bndr = Nothing -- Note [Do not inline exit join points]
+ | isExitJoinId bndr = Nothing -- Note [Do not inline exit join points]
-- in module Exitify
| not (one_occ (idOccInfo bndr)) = Nothing
| not (isStableUnfolding unf) = Just $! (extend_subst_with rhs)
@@ -1409,36 +1409,19 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
, Just inl <- maybeUnfoldingTemplate unf = Just $! (extend_subst_with inl)
| otherwise = Nothing
where
- mode = seMode env
- phase = sm_phase mode
- keep_exits = sm_keep_exits mode
- pre_inline = sm_pre_inline mode
-
unf = idUnfolding bndr
extend_subst_with inl_rhs = extendIdSubst env bndr $! (mkContEx rhs_env inl_rhs)
one_occ IAmDead = True -- Happens in ((\x.1) v)
-
one_occ OneOcc{ occ_n_br = 1
, occ_in_lam = NotInsideLam } = isNotTopLevel top_lvl || early_phase
-
one_occ OneOcc{ occ_n_br = 1
, occ_in_lam = IsInsideLam
, occ_int_cxt = IsInteresting } = canInlineInLam rhs
+ one_occ _ = False
- one_occ OneOcc{ occ_n_br = 1 } -- Inline join point that are used once, even inside
- | isJoinId bndr = True -- lambdas (which are presumably other join points)
- -- E.g. join j x = rhs in
- -- joinrec k y = ....j x....
- -- Here j must be an exit for k, and we can safely inline it under the lambda
- -- This includes the case where j is nullary: a nullary join point is just the
- -- same as an arity-1 one. So we don't look at occ_int_cxt.
- -- All of this only applies if keep_exits is False, otherwise the
- -- earlier guard on preInlineUnconditionally would have fired
-
- one_occ _ = False
-
- active = isActive phase (inlinePragmaActivation inline_prag)
+ pre_inline_unconditionally = sePreInline env
+ active = isActive (sePhase env) (inlinePragmaActivation inline_prag)
-- See Note [pre/postInlineUnconditionally in gentle mode]
inline_prag = idInlinePragma bndr
@@ -1470,7 +1453,7 @@ preInlineUnconditionally env top_lvl bndr rhs rhs_env
-- not ticks. Counting ticks cannot be duplicated, and non-counting
-- ticks around a Lam will disappear anyway.
- early_phase = phase /= FinalPhase
+ early_phase = sePhase env /= FinalPhase
-- If we don't have this early_phase test, consider
-- x = length [1,2,3]
-- The full laziness pass carefully floats all the cons cells to
=====================================
compiler/GHC/Core/Opt/SpecConstr.hs
=====================================
@@ -1532,10 +1532,8 @@ scExpr' env (Case scrut b ty alts)
scrut_occ = case con of
DataAlt dc -- See Note [Do not specialise evals]
| not (single_alt && all deadArgOcc arg_occs)
- -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $
- ScrutOcc (unitUFM dc arg_occs)
- _ -> -- pprTrace "sc_alt1" (ppr b' $$ ppr con $$ ppr bs $$ ppr arg_occs) $
- UnkOcc
+ -> ScrutOcc (unitUFM dc arg_occs)
+ _ -> UnkOcc
; return (usg', b_occ `combineOcc` scrut_occ, Alt con bs2 rhs') }
=====================================
compiler/GHC/Driver/Config/Core/Opt/Simplify.hs
=====================================
@@ -2,6 +2,7 @@ module GHC.Driver.Config.Core.Opt.Simplify
( initSimplifyExprOpts
, initSimplifyOpts
, initSimplMode
+ , initGentleSimplMode
) where
import GHC.Prelude
@@ -26,13 +27,12 @@ import GHC.Types.Var ( Var )
initSimplifyExprOpts :: DynFlags -> InteractiveContext -> SimplifyExprOpts
initSimplifyExprOpts dflags ic = SimplifyExprOpts
{ se_fam_inst = snd $ ic_instances ic
-
- , se_mode = (initSimplMode dflags) { sm_names = ["GHCi"]
- , sm_inline = False }
- -- sm_inline: do not do any inlining, in case we expose
- -- some unboxed tuple stuff that confuses the bytecode
+ , se_mode = (initSimplMode dflags InitialPhase "GHCi")
+ { sm_inline = False
+ -- Do not do any inlining, in case we expose some
+ -- unboxed tuple stuff that confuses the bytecode
-- interpreter
-
+ }
, se_top_env_cfg = TopEnvConfig
{ te_history_size = historySize dflags
, te_tick_factor = simplTickFactor dflags
@@ -56,25 +56,31 @@ initSimplifyOpts dflags extra_vars iterations mode hpt_rule_base = let
}
in opts
-initSimplMode :: DynFlags -> SimplMode
-initSimplMode dflags = SimplMode
- { sm_names = ["Unknown simplifier run"] -- Always overriden
- , sm_phase = InitialPhase
- , sm_rules = gopt Opt_EnableRewriteRules dflags
- , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags
- , sm_pre_inline = gopt Opt_SimplPreInlining dflags
- , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags
- , sm_uf_opts = unfoldingOpts dflags
- , sm_float_enable = floatEnable dflags
- , sm_arity_opts = initArityOpts dflags
- , sm_rule_opts = initRuleOpts dflags
- , sm_case_folding = gopt Opt_CaseFolding dflags
- , sm_case_merge = gopt Opt_CaseMerge dflags
- , sm_co_opt_opts = initOptCoercionOpts dflags
+initSimplMode :: DynFlags -> CompilerPhase -> String -> SimplMode
+initSimplMode dflags phase name = SimplMode
+ { sm_names = [name]
+ , sm_phase = phase
+ , sm_rules = gopt Opt_EnableRewriteRules dflags
+ , sm_eta_expand = gopt Opt_DoLambdaEtaExpansion dflags
, sm_cast_swizzle = True
- , sm_inline = True
- , sm_case_case = True
- , sm_keep_exits = False
+ , sm_inline = True
+ , sm_uf_opts = unfoldingOpts dflags
+ , sm_case_case = True
+ , sm_pre_inline = gopt Opt_SimplPreInlining dflags
+ , sm_float_enable = floatEnable dflags
+ , sm_do_eta_reduction = gopt Opt_DoEtaReduction dflags
+ , sm_arity_opts = initArityOpts dflags
+ , sm_rule_opts = initRuleOpts dflags
+ , sm_case_folding = gopt Opt_CaseFolding dflags
+ , sm_case_merge = gopt Opt_CaseMerge dflags
+ , sm_co_opt_opts = initOptCoercionOpts dflags
+ }
+
+initGentleSimplMode :: DynFlags -> SimplMode
+initGentleSimplMode dflags = (initSimplMode dflags InitialPhase "Gentle")
+ { -- Don't do case-of-case transformations.
+ -- This makes full laziness work better
+ sm_case_case = False
}
floatEnable :: DynFlags -> FloatEnable
=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -893,17 +893,15 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs
-- Rename the pragmas and signatures
-- Annoyingly the type variables /are/ in scope for signatures, but
- -- /are not/ in scope in the SPECIALISE instance pramas; e.g.
- -- instance Eq a => Eq (T a) where
- -- (==) :: a -> a -> a
- -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
- ; let (spec_inst_prags, other_sigs) = partition isSpecInstLSig sigs
+ -- /are not/ in scope in SPECIALISE and SPECIALISE instance pragmas.
+ -- See Note [Type variable scoping in SPECIALISE pragmas].
+ ; let (spec_prags, other_sigs) = partition (isSpecLSig <||> isSpecInstLSig) sigs
bound_nms = mkNameSet (collectHsBindsBinders CollNoDictBinders binds')
sig_ctxt | is_cls_decl = ClsDeclCtxt cls
| otherwise = InstDeclCtxt bound_nms
- ; (spec_inst_prags', sip_fvs) <- renameSigs sig_ctxt spec_inst_prags
- ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $
- renameSigs sig_ctxt other_sigs
+ ; (spec_prags', spg_fvs) <- renameSigs sig_ctxt spec_prags
+ ; (other_sigs', sig_fvs) <- bindLocalNamesFV ktv_names $
+ renameSigs sig_ctxt other_sigs
-- Rename the bindings RHSs. Again there's an issue about whether the
-- type variables from the class/instance head are in scope.
@@ -914,8 +912,47 @@ rnMethodBinds is_cls_decl cls ktv_names binds sigs
emptyFVs binds_w_dus
; return (mapBag fstOf3 binds_w_dus, bind_fvs) }
- ; return ( binds'', spec_inst_prags' ++ other_sigs'
- , sig_fvs `plusFV` sip_fvs `plusFV` bind_fvs) }
+ ; return ( binds'', spec_prags' ++ other_sigs'
+ , sig_fvs `plusFV` spg_fvs `plusFV` bind_fvs) }
+
+{- Note [Type variable scoping in SPECIALISE pragmas]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When renaming the methods of a class or instance declaration, we must be careful
+with the scoping of the type variables that occur in SPECIALISE and SPECIALISE instance
+pragmas: the type variables from the class/instance header DO NOT scope over these,
+unlike class/instance method type signatures.
+
+Examples:
+
+ 1. SPECIALISE
+
+ class C a where
+ meth :: a
+ instance C (Maybe a) where
+ meth = Nothing
+ {-# SPECIALISE INLINE meth :: Maybe [a] #-}
+
+ 2. SPECIALISE instance
+
+ instance Eq a => Eq (T a) where
+ (==) :: a -> a -> a
+ {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
+
+ In both cases, the type variable `a` mentioned in the PRAGMA is NOT the same
+ as the type variable `a` from the instance header.
+ For example, the SPECIALISE instance pragma above is a shorthand for
+
+ {-# SPECIALISE instance forall a. Eq a => Eq (T [a]) #-}
+
+ which is alpha-equivalent to
+
+ {-# SPECIALISE instance forall b. Eq b => Eq (T [b]) #-}
+
+ This shows that the type variables are not bound in the header.
+
+ Getting this scoping wrong can lead to out-of-scope type variable errors from
+ Core Lint, see e.g. #22913.
+-}
rnMethodBindLHS :: Bool -> Name
-> LHsBindLR GhcPs GhcPs
=====================================
compiler/GHC/StgToJS/Printer.hs
=====================================
@@ -108,19 +108,17 @@ ghcjsRenderJsV r (JHash m)
where
quoteIfRequired :: FastString -> Doc
quoteIfRequired x
- | isUnquotedKey x' = text x'
- | otherwise = PP.squotes (text x')
- where x' = unpackFS x
-
- isUnquotedKey :: String -> Bool
- isUnquotedKey x | null x = False
- | all isDigit x = True
- | otherwise = validFirstIdent (head x)
- && all validOtherIdent (tail x)
+ | isUnquotedKey x = ftext x
+ | otherwise = PP.squotes (ftext x)
+ isUnquotedKey :: FastString -> Bool
+ isUnquotedKey fs = case unpackFS fs of
+ [] -> False
+ s@(c:cs) -> all isDigit s || (validFirstIdent c && all validOtherIdent cs)
validFirstIdent c = c == '_' || c == '$' || isAlpha c
validOtherIdent c = isAlpha c || isDigit c
+
ghcjsRenderJsV r v = renderJsV defaultRenderJs r v
prettyBlock :: RenderJs -> [JStat] -> Doc
=====================================
testsuite/driver/runtests.py
=====================================
@@ -601,6 +601,7 @@ else:
if args.junit:
junit(t).write(args.junit)
+ args.junit.close()
if config.only_report_hadrian_deps:
print("WARNING - skipping all tests and only reporting required hadrian dependencies:", config.hadrian_deps)
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1347,7 +1347,7 @@ def do_test(name: TestName,
# if found and instead have the testsuite decide on what to do
# with the output.
def override_options(pre_cmd):
- if config.verbose >= 5 and bool(re.match('\$make', pre_cmd, re.I)):
+ if config.verbose >= 5 and bool(re.match(r'\$make', pre_cmd, re.I)):
return pre_cmd.replace(' -s' , '') \
.replace('--silent', '') \
.replace('--quiet' , '')
@@ -1989,7 +1989,7 @@ def split_file(in_fn: Path, delimiter: str, out1_fn: Path, out2_fn: Path):
with out1_fn.open('w', encoding='utf8', newline='') as out1:
with out2_fn.open('w', encoding='utf8', newline='') as out2:
line = infile.readline()
- while re.sub('^\s*','',line) != delimiter and line != '':
+ while re.sub(r'^\s*','',line) != delimiter and line != '':
out1.write(line)
line = infile.readline()
@@ -2399,20 +2399,20 @@ def normalise_errmsg(s: str) -> str:
# warning message to get clean output.
if config.msys:
s = re.sub('Failed to remove file (.*); error= (.*)$', '', s)
- s = re.sub('DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s)
+ s = re.sub(r'DeleteFile "(.+)": permission denied \(Access is denied\.\)(.*)$', '', s)
# filter out unsupported GNU_PROPERTY_TYPE (5), which is emitted by LLVM10
# and not understood by older binutils (ar, ranlib, ...)
- s = modify_lines(s, lambda l: re.sub('^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l))
+ s = modify_lines(s, lambda l: re.sub(r'^(.+)warning: (.+): unsupported GNU_PROPERTY_TYPE \(5\) type: 0xc000000(.*)$', '', l))
- s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
+ s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s)
# ignore superfluous dylibs passed to the linker.
s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s)
# ignore LLVM Version mismatch garbage; this will just break tests.
s = re.sub('You are using an unsupported version of LLVM!.*\n','',s)
- s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s)
- s = re.sub('We will try though\.\.\..*\n','',s)
+ s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s)
+ s = re.sub('We will try though\\.\\.\\..*\n','',s)
# ignore warning about strip invalidating signatures
s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s)
# clang may warn about unused argument when used as assembler
@@ -2475,8 +2475,8 @@ def normalise_slashes_( s: str ) -> str:
return s
def normalise_exe_( s: str ) -> str:
- s = re.sub('\.exe', '', s)
- s = re.sub('\.jsexe', '', s)
+ s = re.sub(r'\.exe', '', s)
+ s = re.sub(r'\.jsexe', '', s)
return s
def normalise_output( s: str ) -> str:
@@ -2494,14 +2494,14 @@ def normalise_output( s: str ) -> str:
# ghci outputs are pretty unstable with -fexternal-dynamic-refs, which is
# requires for -fPIC
s = re.sub(' -fexternal-dynamic-refs\n','',s)
- s = re.sub('ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
+ s = re.sub(r'ld: warning: passed .* min versions \(.*\) for platform macOS. Using [\.0-9]+.','',s)
s = re.sub('ld: warning: -sdk_version and -platform_version are not compatible, ignoring -sdk_version','',s)
# ignore superfluous dylibs passed to the linker.
s = re.sub('ld: warning: .*, ignoring unexpected dylib file\n','',s)
# ignore LLVM Version mismatch garbage; this will just break tests.
s = re.sub('You are using an unsupported version of LLVM!.*\n','',s)
- s = re.sub('Currently only [\.0-9]+ is supported. System LLVM version: [\.0-9]+.*\n','',s)
- s = re.sub('We will try though\.\.\..*\n','',s)
+ s = re.sub('Currently only [\\.0-9]+ is supported. System LLVM version: [\\.0-9]+.*\n','',s)
+ s = re.sub('We will try though\\.\\.\\..*\n','',s)
# ignore warning about strip invalidating signatures
s = re.sub('.*strip: changes being made to the file will invalidate the code signature in.*\n','',s)
# clang may warn about unused argument when used as assembler
=====================================
testsuite/tests/rename/should_compile/T22913.hs
=====================================
@@ -0,0 +1,10 @@
+module T22913 where
+
+class FromSourceIO a where
+ fromSourceIO :: a
+instance FromSourceIO (Maybe o) where
+ fromSourceIO = undefined
+ {-# SPECIALISE INLINE fromSourceIO :: Maybe o #-}
+ -- This SPECIALISE pragma caused a Core Lint error
+ -- due to incorrectly scoping the type variable 'o' from the instance header
+ -- over the SPECIALISE pragma.
=====================================
testsuite/tests/rename/should_compile/all.T
=====================================
@@ -199,3 +199,4 @@ test('T22513f', normal, compile, ['-Wterm-variable-capture'])
test('T22513g', normal, compile, ['-Wterm-variable-capture'])
test('T22513h', normal, compile, ['-Wterm-variable-capture'])
test('T22513i', req_th, compile, ['-Wterm-variable-capture'])
+test('T22913', normal, compile, [''])
=====================================
testsuite/tests/simplCore/should_compile/T21148.hs deleted
=====================================
@@ -1,12 +0,0 @@
-module T211148 where
-
--- The point of this test is that f should get a (nested)
--- CPR property, with a worker of type
--- $wf :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
-
-{-# NOINLINE f #-}
--- The NOINLINE makes GHC do a worker/wrapper split
--- even though f is small
-f :: Int -> IO Int
-f x = return $! sum [0..x]
-
=====================================
testsuite/tests/simplCore/should_compile/T21148.stderr deleted
=====================================
@@ -1,126 +0,0 @@
-
-==================== Tidy Core ====================
-Result size of Tidy Core
- = {terms: 73, types: 80, coercions: 6, joins: 2/2}
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T211148.$trModule4 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
-T211148.$trModule4 = "main"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T211148.$trModule3 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-T211148.$trModule3 = GHC.Types.TrNameS T211148.$trModule4
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-T211148.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
-T211148.$trModule2 = "T211148"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-T211148.$trModule1 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-T211148.$trModule1 = GHC.Types.TrNameS T211148.$trModule2
-
--- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-T211148.$trModule :: GHC.Types.Module
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-T211148.$trModule
- = GHC.Types.Module T211148.$trModule3 T211148.$trModule1
-
--- RHS size: {terms: 41, types: 35, coercions: 0, joins: 2/2}
-T211148.$wf [InlPrag=NOINLINE]
- :: GHC.Prim.Int#
- -> GHC.Prim.State# GHC.Prim.RealWorld
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #)
-[GblId, Arity=2, Str=<L><L>, Unf=OtherCon []]
-T211148.$wf
- = \ (ww_s179 :: GHC.Prim.Int#)
- (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
- case GHC.Prim.># 0# ww_s179 of {
- __DEFAULT ->
- join {
- exit_X0 [Dmd=SC(S,C(1,!P(L,L)))]
- :: GHC.Prim.Int#
- -> GHC.Prim.Int#
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #)
- [LclId[JoinId(2)(Nothing)], Arity=2, Str=<L><L>]
- exit_X0 (x_s16Z [OS=OneShot] :: GHC.Prim.Int#)
- (ww1_s172 [OS=OneShot] :: GHC.Prim.Int#)
- = (# eta_s17b, GHC.Prim.+# ww1_s172 x_s16Z #) } in
- joinrec {
- $wgo3_s175 [InlPrag=[2], Occ=LoopBreaker, Dmd=SC(S,C(1,!P(L,L)))]
- :: GHC.Prim.Int#
- -> GHC.Prim.Int#
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #)
- [LclId[JoinId(2)(Nothing)], Arity=2, Str=<L><L>, Unf=OtherCon []]
- $wgo3_s175 (x_s16Z :: GHC.Prim.Int#) (ww1_s172 :: GHC.Prim.Int#)
- = case GHC.Prim.==# x_s16Z ww_s179 of {
- __DEFAULT ->
- jump $wgo3_s175
- (GHC.Prim.+# x_s16Z 1#) (GHC.Prim.+# ww1_s172 x_s16Z);
- 1# -> jump exit_X0 x_s16Z ww1_s172
- }; } in
- jump $wgo3_s175 0# 0#;
- 1# -> (# eta_s17b, 0# #)
- }
-
--- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0}
-T211148.f1 [InlPrag=NOINLINE[final]]
- :: Int
- -> GHC.Prim.State# GHC.Prim.RealWorld
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
-[GblId,
- Arity=2,
- Str=<1!P(L)><L>,
- Cpr=1(, 1),
- Unf=Unf{Src=StableSystem, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True,
- Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
- Tmpl= \ (x_s177 [Occ=Once1!] :: Int)
- (eta_s17b [Occ=Once1, OS=OneShot]
- :: GHC.Prim.State# GHC.Prim.RealWorld) ->
- case x_s177 of { GHC.Types.I# ww_s179 [Occ=Once1] ->
- case T211148.$wf ww_s179 eta_s17b of
- { (# ww1_s17e [Occ=Once1], ww2_s17j [Occ=Once1] #) ->
- (# ww1_s17e, GHC.Types.I# ww2_s17j #)
- }
- }}]
-T211148.f1
- = \ (x_s177 :: Int)
- (eta_s17b [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
- case x_s177 of { GHC.Types.I# ww_s179 ->
- case T211148.$wf ww_s179 eta_s17b of { (# ww1_s17e, ww2_s17j #) ->
- (# ww1_s17e, GHC.Types.I# ww2_s17j #)
- }
- }
-
--- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0}
-f [InlPrag=NOINLINE[final]] :: Int -> IO Int
-[GblId,
- Arity=2,
- Str=<1!P(L)><L>,
- Cpr=1(, 1),
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True,
- Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
-f = T211148.f1
- `cast` (<Int>_R %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] <Int>_R)
- :: (Int
- -> GHC.Prim.State# GHC.Prim.RealWorld
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #))
- ~R# (Int -> IO Int))
-
-
-
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -429,7 +429,6 @@ test('T21763a', only_ways(['optasm']), compile, ['-O2 -ddump-rules'])
test('T22028', normal, compile, ['-O -ddump-rule-firings'])
test('T22114', normal, compile, ['-O'])
test('T21286', normal, multimod_compile, ['T21286', '-O -ddump-rule-firings'])
-test('T21148', [grep_errmsg(r'Cpr=') ], compile, ['-O -ddump-simpl'])
# One module, T21851.hs, has OPTIONS_GHC -ddump-simpl
test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O -dno-typeable-binds -dsuppress-uniques'])
=====================================
testsuite/tests/stranal/should_compile/T21128.hs
=====================================
@@ -2,10 +2,6 @@ module T21128 where
import T21128a
-{- This test originally had some unnecessary reboxing of y
-in the hot path of $wtheresCrud. That reboxing should
-not happen. -}
-
theresCrud :: Int -> Int -> Int
theresCrud x y = go x
where
@@ -13,4 +9,3 @@ theresCrud x y = go x
go 1 = index x y 1
go n = go (n-1)
{-# NOINLINE theresCrud #-}
-
=====================================
testsuite/tests/stranal/should_compile/T21128.stderr
=====================================
@@ -1,7 +1,7 @@
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 125, types: 68, coercions: 4, joins: 0/0}
+ = {terms: 137, types: 92, coercions: 4, joins: 0/0}
lvl = "error"#
@@ -29,11 +29,17 @@ lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8
lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack
+$windexError
+ = \ @a @b ww eta eta1 eta2 ->
+ error
+ (lvl10 `cast` <Co:4> :: CallStack ~R# (?callStack::CallStack))
+ (++ (ww eta) (++ (ww eta1) (ww eta2)))
+
indexError
= \ @a @b $dShow eta eta1 eta2 ->
- error
- (lvl10 `cast` <Co:4> :: ...)
- (++ (show $dShow eta) (++ (show $dShow eta1) (show $dShow eta2)))
+ case $dShow of { C:Show ww ww1 ww2 ->
+ $windexError ww1 eta eta1 eta2
+ }
$trModule3 = TrNameS $trModule4
@@ -42,7 +48,8 @@ $trModule1 = TrNameS $trModule2
$trModule = Module $trModule3 $trModule1
$wlvl
- = \ ww ww1 ww2 -> indexError $fShowInt (I# ww2) (I# ww1) (I# ww)
+ = \ ww ww1 ww2 ->
+ $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww)
index
= \ l u i ->
@@ -66,7 +73,7 @@ index
==================== Tidy Core ====================
Result size of Tidy Core
- = {terms: 108, types: 46, coercions: 0, joins: 3/3}
+ = {terms: 108, types: 47, coercions: 0, joins: 3/4}
$trModule4 = "main"#
@@ -82,34 +89,35 @@ i = I# 1#
l = I# 0#
-lvl = \ x ww -> indexError $fShowInt x (I# ww) i
+lvl = \ y -> $windexError $fShowInt_$cshow l y l
-lvl1 = \ ww -> indexError $fShowInt l (I# ww) l
+lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i
$wtheresCrud
= \ ww ww1 ->
+ let { y = I# ww1 } in
join {
- exit
- = case <# 0# ww1 of {
- __DEFAULT -> case lvl1 ww1 of wild { };
- 1# -> 0#
- } } in
- join {
- exit1
+ lvl2
= case <=# ww 1# of {
- __DEFAULT -> case lvl (I# ww) ww1 of wild { };
+ __DEFAULT -> case lvl1 ww y of wild { };
1# ->
case <# 1# ww1 of {
- __DEFAULT -> case lvl (I# ww) ww1 of wild { };
+ __DEFAULT -> case lvl1 ww y of wild { };
1# -> -# 1# ww
}
} } in
+ join {
+ lvl3
+ = case <# 0# ww1 of {
+ __DEFAULT -> case lvl y of wild { };
+ 1# -> 0#
+ } } in
joinrec {
$wgo ww2
= case ww2 of wild {
__DEFAULT -> jump $wgo (-# wild 1#);
- 0# -> jump exit;
- 1# -> jump exit1
+ 0# -> jump lvl3;
+ 1# -> jump lvl2
}; } in
jump $wgo ww
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a933eab77971b711a652f9e681c9927173dff686...22085bcdf8b5ebf8e8a9b30fb74fbe400616c12c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/a933eab77971b711a652f9e681c9927173dff686...22085bcdf8b5ebf8e8a9b30fb74fbe400616c12c
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230208/342dc629/attachment-0001.html>
More information about the ghc-commits
mailing list