01 Mar '26
Apoorv Ingle pushed to branch wip/ani/kill-SrcCodeOrigin at Glasgow Haskell Compiler / GHC
Commits:
e9109729 by Apoorv Ingle at 2026-03-01T14:10:35-06:00
ErrCtxtMsg to CtOrigin
- - - - -
10 changed files:
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/Monad.hs
Changes:
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -640,11 +640,12 @@ deriving instance Eq (IE GhcRn)
deriving instance Eq (IE GhcTc)
-- ---------------------------------------------------------------------
-
+-- TODO: I think we still need instances for StmtCtxt, ExprCtxt and PatCtxt ctors of ErrCtxtMsg
instance Data ErrCtxtMsg where
gunfold _ _ _ = error "no gunfold for ErrCtxtMsg"
gfoldl _ _ _ = error "no goldl for ErrCtxtMsg"
-
+ toConstr = error "no toConstr for ErrCtxtMsg"
+ dataTypeOf = err "no dataTypeOf for ErrCtxtMsg"
deriving instance Data XXExprGhcRn
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -20,6 +20,7 @@ import GHC.Hs
import GHC.Tc.Gen.Head
import GHC.Tc.Errors.Types
+import GHC.Tc.Errors.Ppr
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.Unify
import GHC.Tc.Utils.Instantiate
@@ -275,7 +276,7 @@ tcApp works like this:
2. Use tcInferAppHead to infer the type of the function,
as an (uninstantiated) TcSigmaType
There are special cases for
- HsVar, HsRecSel, and ExprWithTySig
+ HsVar, HsRecSel, and ExprWithTySig and XExpr
Otherwise, delegate back to tcExpr, which
infers an (instantiated) TcRhoType
@@ -2050,6 +2051,7 @@ mk_origin fun_lspan_arg rn_fun_arg rn_fun
= return $ exprCtOrigin rn_fun_arg
| otherwise
= do { code_orig <- getSrcCodeOrigin
+ ; traceTc "mk_origin" (case (pprErrCtxtMsg <$> code_orig) of { Just e -> e; _ -> text "Nothing"})
; return $ srcCodeOriginCtOrigin rn_fun code_orig
}
=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -213,7 +213,7 @@ mk_fail_block doFlav pat stmt e (Just (SyntaxExprRn fail_op)) =
fail_op_expr :: DynFlags -> LPat GhcRn -> HsExpr GhcRn -> LHsExpr GhcRn
fail_op_expr dflags pat@(L pat_lspan _) fail_op
- = L pat_lspan $ mkExpandedPatRn doFlav (unLoc pat) stmt $ genHsApp fail_op (mk_fail_msg_expr dflags pat)
+ = L pat_lspan $ mkExpandedPatRn doFlav pat stmt $ genHsApp fail_op (mk_fail_msg_expr dflags pat)
mk_fail_msg_expr :: DynFlags -> LPat GhcRn -> LHsExpr GhcRn
mk_fail_msg_expr dflags pat
@@ -481,7 +481,7 @@ It stores the original statement (with location) and the expanded expression
-}
-mkExpandedPatRn :: HsDoFlavour -> Pat GhcRn -> ExprLStmt GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
+mkExpandedPatRn :: HsDoFlavour -> LPat GhcRn -> ExprLStmt GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
mkExpandedPatRn flav pat stmt e = XExpr $ ExpandedThingRn
{ xrn_orig = StmtErrCtxtPat (HsDoStmt flav) stmt pat
, xrn_expanded = e}
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -430,6 +430,7 @@ tcInferAppHead :: (HsExpr GhcRn, SrcSpan)
-- * A bare identifier (just look it up)
-- This case also covers a record selector HsRecSel
-- * An expression with a type signature (e :: ty)
+-- * An XExpr where 'f' is actually an expanded out expression
-- See Note [Application chains and heads] in GHC.Tc.Gen.App
--
-- Note that [] and (,,) are both HsVar:
@@ -452,6 +453,8 @@ tcInferAppHead_maybe :: HsExpr GhcRn
-> TcM (Maybe (HsExpr GhcTc, DeepSubsumptionFlag, TcSigmaType))
-- See Note [Application chains and heads] in GHC.Tc.Gen.App
-- Returns Nothing for a complicated head
+-- XExpr's although complicated needs to be looked through, useful for QL things when
+-- the argument is an XExpr
tcInferAppHead_maybe fun = case fun of
HsVar _ nm -> Just <$> with_get_ds (tcInferId nm)
ExprWithTySig _ e hs_ty -> Just <$> with_get_ds (tcExprWithSig e hs_ty)
=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -1,5 +1,4 @@
{-# LANGUAGE PatternSynonyms #-}
-
{-
(c) The University of Glasgow 2006-2012
(c) The GRASP Project, Glasgow University, 1992-2002
=====================================
compiler/GHC/Tc/Types/ErrCtxt.hs
=====================================
@@ -340,7 +340,7 @@ data ErrCtxtMsg
| DoStmtErrCtxt !HsStmtContextRn !(ExprLStmt GhcRn)
-- | In patten of the do statement. (c.f. MonadFailErrors)
- | StmtErrCtxtPat !HsStmtContextRn !(ExprLStmt GhcRn) (Pat GhcRn)
+ | StmtErrCtxtPat !HsStmtContextRn !(ExprLStmt GhcRn) (LPat GhcRn)
-- | In an rebindable syntax expression.
| SyntaxNameCtxt !(HsExpr GhcRn) !CtOrigin !TcType !SrcSpan
=====================================
compiler/GHC/Tc/Types/LclEnv.hs
=====================================
@@ -211,11 +211,12 @@ setLclEnvSrcCodeOrigin ec = modifyLclCtxt (setLclCtxtSrcCodeOrigin ec)
-- See Note [ErrCtxtStack Manipulation]
setLclCtxtSrcCodeOrigin :: ErrCtxt -> TcLclCtxt -> TcLclCtxt
setLclCtxtSrcCodeOrigin ec lclCtxt
- | ecs@(MkErrCtxt ExpansionCodeCtxt _ : _) <- tcl_err_ctxt lclCtxt
- , MkErrCtxt ExpansionCodeCtxt ExprCtxt{} <- ec
- = lclCtxt { tcl_err_ctxt = ec : ecs }
- | MkErrCtxt ExpansionCodeCtxt _ : ecs <- tcl_err_ctxt lclCtxt
- , MkErrCtxt ExpansionCodeCtxt _ <- ec
+ -- | ecs@(MkErrCtxt ExpansionCodeCtxt _ : _) <- tcl_err_ctxt lclCtxt
+ -- , MkErrCtxt ExpansionCodeCtxt ExprCtxt{} <- ec
+ -- = lclCtxt { tcl_err_ctxt = ec : ecs }
+ -- never stack 2 statement error contexts on top of each other
+ | MkErrCtxt _ DoStmtErrCtxt{} : ecs <- tcl_err_ctxt lclCtxt
+ , MkErrCtxt _ DoStmtErrCtxt{} <- ec
= lclCtxt { tcl_err_ctxt = ec : ecs }
| otherwise
= lclCtxt { tcl_err_ctxt = ec : tcl_err_ctxt lclCtxt }
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -455,7 +455,7 @@ data CtOrigin
-- `ty1` to `ty2`.
| DefaultOrigin -- Typechecking a default decl
- | DoStmtOrigin -- Arising from a do expression
+ | DoStmtOrigin -- Arising from a do statement
| DoPatOrigin (LPat GhcRn) -- Arising from a failable pattern in
-- a do expression
| MCompOrigin -- Arising from a monad comprehension
@@ -690,12 +690,22 @@ exprCtOrigin e@(HsIf {}) = ExpansionOrigin (ExprCtxt e)
exprCtOrigin e@(HsProjection _ _) = ExpansionOrigin (ExprCtxt e)
exprCtOrigin e@(RecordUpd{}) = ExpansionOrigin (ExprCtxt e)
exprCtOrigin e@(HsGetField{}) = ExpansionOrigin (ExprCtxt e)
-exprCtOrigin (XExpr (ExpandedThingRn o _)) = ExpansionOrigin o
+exprCtOrigin (XExpr (ExpandedThingRn o _)) = errCtxtCtOrigin o
exprCtOrigin (XExpr (HsRecSelRn f)) = OccurrenceOfRecSel $ L (getLoc $ foLabel f) (foExt f)
srcCodeOriginCtOrigin :: HsExpr GhcRn -> Maybe ErrCtxtMsg -> CtOrigin
srcCodeOriginCtOrigin e Nothing = exprCtOrigin e
-srcCodeOriginCtOrigin _ (Just o) = ExpansionOrigin o
+srcCodeOriginCtOrigin _ (Just o) = errCtxtCtOrigin o
+
+
+errCtxtCtOrigin :: ErrCtxtMsg -> CtOrigin
+errCtxtCtOrigin (ExprCtxt e) = exprCtOrigin e
+errCtxtCtOrigin (FunAppCtxt (FunAppCtxtExpr _ e) _) = exprCtOrigin e
+errCtxtCtOrigin (StmtErrCtxt{}) = DoStmtOrigin
+errCtxtCtOrigin (DoStmtErrCtxt{}) = DoStmtOrigin
+errCtxtCtOrigin (StmtErrCtxtPat _ _ p) = DoPatOrigin p
+errCtxtCtOrigin _ = Shouldn'tHappenOrigin "errCtxtCtOrigin"
+
-- | Extract a suitable CtOrigin from a MatchGroup
matchesCtOrigin :: MatchGroup GhcRn (LHsExpr GhcRn) -> CtOrigin
@@ -731,6 +741,8 @@ pprCtOrigin (ExpansionOrigin o)
what = case o of
StmtErrCtxt{} ->
text "a do statement"
+ DoStmtErrCtxt{} ->
+ text "a do statement"
StmtErrCtxtPat _ _ p ->
text "a do statement" $$
text "with the failable pattern" <+> quotes (ppr p)
@@ -744,6 +756,7 @@ pprCtOrigin (ExpansionOrigin o)
ExprCtxt (HsProjection _ p) -> text "the record selector" <+>
quotes (ppr ((FieldLabelStrings $ fmap noLocA p)))
ExprCtxt e -> text "the expression" <+> (ppr e)
+ RecordUpdCtxt{} -> text "a record update"
_ -> text "shouldn't happen ExpansionOrigin pprCtOrigin"
pprCtOrigin (GivenSCOrigin sk d blk)
=====================================
compiler/GHC/Tc/Utils/Instantiate.hs
=====================================
@@ -52,7 +52,6 @@ import GHC.Core.FamInstEnv
import GHC.Core ( isOrphan ) -- For the Coercion constructor
import GHC.Core.Type
import GHC.Core.TyCo.Ppr ( debugPprType )
-import GHC.Core.TyCo.Tidy ( tidyType )
import GHC.Core.Class( Class )
import GHC.Core.Coercion.Axiom
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1330,27 +1330,28 @@ addLExprCtxt lspan e thing_inside
= setSrcSpan lspan $ add_expr_ctxt e thing_inside
| otherwise -- no op in generated code
= thing_inside
+ where
+ add_expr_ctxt :: HsExpr GhcRn -> TcRn a -> TcRn a
+ add_expr_ctxt e thing_inside
+ = case e of
+ -- The HsHole special case addresses situations like
+ -- f x = _
+ -- when we don't want to say "In the expression: _",
+ -- because it is mentioned in the error message itself
+ HsHole{} -> thing_inside
+
+ -- There is a special case for expressions with signatures to avoid having too verbose
+ -- error context. So here we flip the ErrCtxt state to expanded if the expression is expanded.
+ -- c.f. RecordDotSyntaxFail9
+ ExprWithTySig _ (L _ e') _
+ | XExpr (ExpandedThingRn o _) <- e' -> addExpansionErrCtxt o thing_inside
+
+ -- Flip error ctxt into expansion mode
+ XExpr (ExpandedThingRn o _) -> addExpansionErrCtxt o thing_inside
+
+ _ -> addErrCtxt (ExprCtxt e) thing_inside
+
--- | !Caution!: Users should not call add_expr_ctxt, they ought to use addLExprCtxt
-add_expr_ctxt :: HsExpr GhcRn -> TcRn a -> TcRn a
-add_expr_ctxt e thing_inside
- = case e of
- HsHole{} -> thing_inside
- -- The HsHole special case addresses situations like
- -- f x = _
- -- when we don't want to say "In the expression: _",
- -- because it is mentioned in the error message itself
-
- ExprWithTySig _ (L _ e') _
- | XExpr (ExpandedThingRn o _) <- e' -> addExpansionErrCtxt o thing_inside
- -- There is a special case for expressions with signatures to avoid having too verbose
- -- error context. So here we flip the ErrCtxt state to expanded if the expression is expanded.
- -- c.f. RecordDotSyntaxFail9
-
- XExpr (ExpandedThingRn o _) -> addExpansionErrCtxt o thing_inside
- -- Flip error ctxt into expansion mode
-
- _ -> addErrCtxt (ExprCtxt e) thing_inside
getErrCtxt :: TcM [ErrCtxt]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9109729aa290b2334f34282abb0b9b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e9109729aa290b2334f34282abb0b9b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/int-index/ppr-hstype-quote
by Vladislav Zavialov (＠int-index) 01 Mar '26
by Vladislav Zavialov (＠int-index) 01 Mar '26
01 Mar '26
Vladislav Zavialov pushed new branch wip/int-index/ppr-hstype-quote at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/ppr-hstype-quote
You're receiving this email because of your account on gitlab.haskell.org.
1
0
01 Mar '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
08bc245b by sheaf at 2026-03-01T11:11:54-05:00
Clean up join points, casts & ticks
This commit shores up the logic dealing with casts and ticks occurring
in between a join point binding and a jump.
Fixes #26642 #26929 #26693
Makes progress on #14610 #26157 #26422
Changes:
- Remove 'GHC.Types.Tickish.TickishScoping' in favour of simpler
predicates 'tickishHasNoScope'/'tickishHasSoftScope', as things were
before commit 993975d3. This makes the code easier to read and
document (fewer indirections).
- Introduce 'canCollectArgsThroughTick' for consistent handling of
ticks around PrimOps and other 'Id's that cannot be eta-reduced.
See overhauled Note [Ticks and mandatory eta expansion].
- New Note [JoinId vs TailCallInfo] in GHC.Core.SimpleOpt that explains
robustness of JoinId vs fragility of TailCallInfo.
- Allow casts/non-soft-scoped ticks to occur in between a join point
binder and a jump, but only in Core Prep.
See Note [Join points, casts, and ticks] and
Note [Join points, casts, and ticks... in Core Prep]
in GHC.Core.Opt.Simplify.Iteration.
Also update Core Lint to account for this.
See Note [Linting join points with casts or ticks] in GHC.Core.Lint.
- Update 'GHC.Core.Utils.mergeCaseAlts' to avoid pushing a cast in
between a join point binding and its jumps. This fixes #26642.
See the new (MC5) and (MC6) in Note [Merge Nested Cases].
- Update float out to properly handle source note ticks. They are now
properly floated out instead of being discarded.
This increases the number of ticks in certain tests with -g.
Test cases: T26642 and TrickyJoins.
Metric increase due to more source note ticks with -g:
-------------------------
Metric Increase:
libdir
size_hello_artifact
size_hello_unicode
-------------------------
- - - - -
21 changed files:
- compiler/GHC/Cmm/Node.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/FloatIn.hs
- compiler/GHC/Core/Opt/FloatOut.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/Tickish.hs
- testsuite/tests/codeGen/should_compile/debug.stdout
- + testsuite/tests/simplCore/should_compile/T26642.hs
- + testsuite/tests/simplCore/should_compile/TrickyJoins.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Cmm/Node.hs
=====================================
@@ -819,8 +819,8 @@ data CmmTickScope
| SubScope !U.Unique CmmTickScope
-- ^ Constructs a new sub-scope to an existing scope. This allows
- -- us to translate Core-style scoping rules (see @tickishScoped@)
- -- into the Cmm world. Suppose the following code:
+ -- us to translate Core-style scoping rules (see Note [Scoping ticks and counting ticks]
+ -- in GHC.Types.Tickish) into the Cmm world. Suppose the following code:
--
-- tick<1> case ... of
-- A -> tick<2> ...
=====================================
compiler/GHC/Core.hs
=====================================
@@ -1035,6 +1035,143 @@ tail position: A cast changes the type, but the type must be the same. But
operationally, casts are vacuous, so this is a bit unfortunate! See #14610 for
ideas how to fix this.
+Note [Join points, casts, and ticks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Point (1) of Note [Invariants on join points] says that a join point
+must always be tail called. But what precisely does "tail called" mean
+in the presence of (a) casts and (b) ticks?
+
+Example (CAST)
+ let j x = rhs in
+ case y of { True -> j 1 |> co; False -> j 2 }
+
+Example (TICK)
+ let j x = rhs in
+ case y of { True -> <tick t> (j 1); False -> j 2 }
+
+Answer: in Core:
+
+ (JCT1) A tail call cannot be under a cast.
+
+ Thus, in (CAST), `j` is not a join point.
+
+ (JCT2) A tail call cannot be under a cost-centre-scoped tick.
+
+ Thus, in (TICK), `j` is a join point only if tick `t` has soft scope
+ (as per Note [Scoping ticks and counting ticks] in GHC.Tickish).
+
+The Big Reason for these choices is that the Simplifier moves the continuation
+into the RHS of a join point, as explained in Note [Join points and case-of-case]
+in GHC.Core.Opt.Simplify.Iteration:
+
+ K[ join j x = rhs in body ] --> join j x = K[rhs] in K[body]
+
+and K then evaporates when it encounters the tail call:
+
+ K[jump j v] --> jump j v
+
+These transformations:
+ * Are ill-typed if the tail is under a cast, hence (JCT1)
+ * Change cost semantics if the tick has cost-centre scope, hence (JCT2)
+
+The occurrence analyser is careful not to treat an occurrence as a tail call if
+it falls under (JCT1) or (JCT2), by using 'markAllNonTail'.
+
+However, during /code generation/ the key thing about a join point is that
+ * The binding does no allocation
+ * A tail call can be implemented by "adjust stack pointer and jump".
+
+This code-gen strategy works fine even if the "tail call" occurs under
+/arbitrary/ ticks and casts. Hence:
+
+(JCT3) In CorePrep, the occurrence analyser is called with a special flag that
+ /does/ treat `j` as tail-called in Example (CAST) and Example (TICK).
+ Core Prep then uses 'joinPointBinding_maybe', which turns always-tail-called
+ let bindings into join points, thus recovering join-point-hood.
+
+See also Note [Linting join points with casts or ticks] in GHC.Core.Lint.
+
+Examples
+========
+
+ Join point jumps under ticks (#14242, #26157, #26642, #26693)
+ ============================
+ In #26693 we had:
+
+ join { j :: Bool -> Int -> IO (); j _ = guts }
+ in case b of
+ False -> scc<foo> jump j True
+ True -> jump j False
+
+ If we try to push the application to an argument 'arg :: Int' into this
+ expression, we first get:
+
+ join { j :: Bool -> IO (); j _ = guts arg ] }
+ in case b of
+ False -> (scc<foo> jump j True) arg
+ True -> jump j False arg
+
+ We then rely on 'trimJoinCont' to remove the argument. In this case, this fails
+ for the first branch, because 'trimJoinCont' doesn't look through profiling
+ ticks. Were we to address this, it's still not clear what code we would want to
+ end up with, as we don't want to misattribute profiling costs.
+ We could plausibly transform to the following:
+
+ join { j :: Bool -> IO (); j scc_or_null _ = (setSCC# scc_or_null guts) arg ] }
+ in case b of
+ False -> jump j <foo> True
+ True -> jump j null False
+
+ where `setSCC#` is a new primop that would set the current cost centre pointer
+ (or no-op if the given pointer is null). However:
+ - this primop doesn't exist today,
+ - it requires adding an argument to the join point (hence changing its arity)
+
+ Note that soft scope ticks are floated out by the simplifier (see the
+ 'tickishHasSoftScope' guard in 'GHC.Core.Opt.Simplify.Iteration.simplTick'),
+ so don't suffer from the same problem.
+
+ Join point jumps under casts (#14610, #21716, #26422)
+ ============================
+ Consider:
+
+ newtype Age = MkAge Int -- axAge :: Age ~ Int
+ f :: Int -> ...
+
+ f (join j :: Bool -> Age
+ j x = (rhs1 :: Age)
+ in case v of
+ Just x -> ((j x) |> axAge) :: Int
+ Nothing -> rhs2)
+
+ If we try to use the case of case transformation to push 'f' inwards, we would
+ get:
+
+ join j' x = f (rhs1 :: Age)
+ in case v of
+ Just x -> (j' x |> axAge)
+ Nothing -> f rhs2
+
+ which is utterly bogus, as we are now passing an argument of type 'Age' to
+ 'f', which expects an 'Int'.
+
+ The alternative would be to implement a transformation of the form
+
+ join { j x = blah }
+ in case e of
+ False -> j True |> co1
+ True -> j False |> co2
+
+ ====>
+
+ join { j x co = blah |> co }
+ in case e of
+ False -> j True co1
+ True -> j False co2
+
+ by adding a coercion argument to the join point. We don't do this currently.
+
+
Note [Strict fields in Core]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In Core, evaluating a data constructor worker evaluates its strict fields.
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -106,6 +106,7 @@ import Data.List.NonEmpty ( NonEmpty(..), groupWith, nonEmpty )
import Data.Maybe
import Data.IntMap.Strict ( IntMap )
import qualified Data.IntMap.Strict as IntMap ( lookup, keys, empty, fromList )
+import GHC.Types.Unique.Map
{-
Note [Core Lint guarantee]
@@ -914,8 +915,8 @@ lintCoreExpr (Lit lit)
; return (literalType lit, zeroUE) }
lintCoreExpr (Cast expr co)
- = do { (expr_ty, ue) <- markAllJoinsBad (lintCoreExpr expr)
- -- markAllJoinsBad: see Note [Join points and casts]
+ = do { (expr_ty, ue) <- markAllJoinsUnderCast (lintCoreExpr expr)
+ -- markAllJoinsUnderCast: see Note [Linting join points with casts or ticks]
; lintCoercion co
; lintRole co Representational (coercionRole co)
@@ -929,14 +930,7 @@ lintCoreExpr (Tick tickish expr)
= do { case tickish of
Breakpoint _ _ ids -> forM_ ids $ \id -> lintIdOcc id 0
_ -> return ()
- ; markAllJoinsBadIf block_joins $ lintCoreExpr expr }
- where
- block_joins = not (tickish `tickishScopesLike` SoftScope)
- -- TODO Consider whether this is the correct rule. It is consistent with
- -- the simplifier's behaviour - cost-centre-scoped ticks become part of
- -- the continuation, and thus they behave like part of an evaluation
- -- context, but soft-scoped and non-scoped ticks simply wrap the result
- -- (see Simplify.simplTick).
+ ; markAllJoinsUnderTick tickish $ lintCoreExpr expr }
lintCoreExpr (Let (NonRec tv (Type ty)) body)
| isTyVar tv
@@ -1017,22 +1011,16 @@ lintCoreExpr e@(App _ _)
; return app_pair}
where
- skipTick t = case collectFunSimple e of
- (Var v) -> etaExpansionTick v t
- _ -> tickishFloatable t
- (fun, args, _source_ticks) = collectArgsTicks skipTick e
- -- We must look through source ticks to avoid #21152, for example:
- --
- -- reallyUnsafePtrEquality
- -- = \ @a ->
- -- (src<loc> reallyUnsafePtrEquality#)
- -- @Lifted @a @Lifted @a
+ skipTick t =
+ case collectFunSimple e of
+ Var v -> canCollectArgsThroughTick v t
+ _ -> tickishFloatable t
+ (fun, args, _ticks) = collectArgsTicks skipTick e
+ -- We must look through ticks, otherwise we may fail to spot a
+ -- saturated application. We use 'canCollectArgsThroughTicks', which is
+ -- the same predicate that Core Prep uses.
--
- -- To do this, we use `collectArgsTicks tickishFloatable` to match
- -- the eta expansion behaviour, as per Note [Eta expansion and source notes]
- -- in GHC.Core.Opt.Arity.
- -- Sadly this was not quite enough. So we now also accept things that CorePrep will allow.
- -- See Note [Ticks and mandatory eta expansion]
+ -- See Note [Ticks and mandatory eta expansion] in GHC.CoreToStg.Prep.
lintCoreExpr (Lam var expr)
= markAllJoinsBad $
@@ -1131,7 +1119,7 @@ checkDeadIdOcc id
------------------
lintJoinBndrType :: OutType -- Type of the body
-> OutId -- Possibly a join Id
- -> LintM ()
+ -> LintM ()
-- Checks that the return type of a join Id matches the body
-- E.g. join j x = rhs in body
-- The type of 'rhs' must be the same as the type of 'body'
@@ -1139,13 +1127,29 @@ lintJoinBndrType body_ty bndr
| JoinPoint arity <- idJoinPointHood bndr
, let bndr_ty = idType bndr
, (bndrs, res) <- splitPiTys bndr_ty
- = do let msg =
- hang (text "Join point returns different type than body")
- 2 (vcat [ text "Join bndr:" <+> ppr bndr <+> dcolon <+> ppr (idType bndr)
- , text "Join arity:" <+> ppr arity
- , text "Body type:" <+> ppr body_ty ])
- checkL (length bndrs >= arity) msg
- ensureEqTys body_ty (mkPiTys (drop arity bndrs) res) msg
+ = do let
+ ty_msg =
+ hang (text "Join point returns different type than body")
+ 2 (vcat [ text "Join bndr:" <+> ppr bndr <+> dcolon <+> ppr (idType bndr)
+ , text "Join arity:" <+> ppr arity
+ , text "Body type:" <+> ppr body_ty ])
+ arity_msg =
+ hang (text "Join point is not saturated")
+ 2 (vcat [ text "Join bndr:" <+> ppr bndr <+> dcolon <+> ppr (idType bndr)
+ , text "Join arity:" <+> ppr arity
+ , text "Arguments:" <+> ppr bndrs ])
+
+ mb_join_info <- lookupJoinId bndr
+ case mb_join_info of
+ Nothing ->
+ pprPanic "lintJoinBndrType: valid join marked bad" (ppr bndr)
+ Just (_, occ_info) -> do
+ checkL (length bndrs >= arity) arity_msg
+
+ -- See Note [Linting join points with casts or ticks] for why
+ -- we skip this check if there is an intervening cast.
+ unless (occ_info == JoinOccUnderCast) $
+ ensureEqTys body_ty (mkPiTys (drop arity bndrs) res) ty_msg
| otherwise
= return ()
@@ -1156,11 +1160,11 @@ checkJoinOcc var n_args
| JoinPoint join_arity_occ <- idJoinPointHood var
= do { mb_join_arity_bndr <- lookupJoinId var
; case mb_join_arity_bndr of {
- NotJoinPoint -> do { join_set <- getValidJoins
- ; addErrL (text "join set " <+> ppr join_set $$
- invalidJoinOcc var) } ;
+ Nothing -> do { valid_joins <- getValidJoins
+ ; addErrL (text "valid joins:" <+> ppr valid_joins $$
+ invalidJoinOcc var) } ;
- JoinPoint join_arity_bndr ->
+ Just (join_arity_bndr, _join_occ) ->
do { checkL (join_arity_bndr == join_arity_occ) $
-- Arity differs at binding site and occurrence
@@ -1333,39 +1337,34 @@ checkLinearity body_ue lam_var =
return body_ue'
Nothing -> return body_ue -- A type variable
-{- Note [Join points and casts]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-You might think that this should be OK:
- join j x = rhs
- in (case e of
- A -> alt1
- B x -> (jump j x) |> co)
+{- Note [Linting join points with casts or ticks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+As per Note [Join points, casts, and ticks] in GHC.Core, we have to be careful
+when a cast or tick occurs in between a join point binding and a corresponding
+join point occurrence.
-You might think that, since the cast is ultimately erased, the jump to
-`j` should still be OK as a join point. But no! See #21716. Suppose
+Generally speaking:
- newtype Age = MkAge Int -- axAge :: Age ~ Int
- f :: Int -> ... -- f strict in it's first argument
+ - The simplifier cannot handle intervening casts or non-soft-scope ticks, so
+ we must check for that to avoid producing invalid Core.
+ - However, as per (JCT3), Core Prep **can** produce join points with
+ intervening casts or non-soft-scope ticks, which means we must expect them.
-and consider the expression
+Casts present an additional challenge. Consider for example:
- f (join j :: Bool -> Age
- j x = (rhs1 :: Age)
- in case v of
- Just x -> (j x |> axAge :: Int)
- Nothing -> rhs2)
+ join { j :: Bool -> Age; j x = (blah :: Age) }
+ in case e of
+ False -> j True |> (co1 :: Age ~ Int)
+ True -> other :: Int
-Then, if the Simplifier pushes the strict call into the join points
-and alternatives we'll get
+It is **not** the case that the type of 'blah' is the same as the type of
+the body of the join point binding! Indeed:
- join j' x = f (rhs1 :: Age)
- in case v of
- Just x -> j' x |> axAge
- Nothing -> f rhs2
+ - RHS of the join-point binding: blah :: Age
+ - The body of the join point has type Int.
-Utterly bogus. `f` expects an `Int` and we are giving it an `Age`.
-No no no. Casts destroy the tail-call property. Henc markAllJoinsBad
-in the (Cast expr co) case of lintCoreExpr.
+So we skip the 'exprType(join_rhs) == exprType(join_body)' check when casts
+occur in between.
Note [No alternatives lint check]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2977,9 +2976,10 @@ data LintEnv
-- type variables, and coercion variables)
-- Used at an occurrence of the InVar
- , le_joins :: IdSet -- Join points in scope that are valid
- -- A subset of the InScopeSet in le_subst
- -- See Note [Join points]
+ , le_joins :: UniqMap Id JoinOcc
+ -- ^ Join points in scope that are valid
+ -- A subset of the InScopeSet in le_subst
+ -- See Note [Join points]
, le_ue_aliases :: NameEnv UsageEnv
-- See Note [Linting linearity]
@@ -2999,6 +2999,7 @@ data LintFlags
, lf_check_linearity :: Bool -- ^ See Note [Linting linearity]
, lf_check_fixed_rep :: Bool -- ^ See Note [Checking for representation polymorphism]
, lf_check_rubbish_lits :: Bool -- ^ See Note [Checking for rubbish literals]
+ , lf_allow_weak_joins :: Bool -- ^ See Note [Linting join points with casts or ticks]
}
-- See Note [Checking StaticPtrs]
@@ -3307,6 +3308,20 @@ data LintLocInfo
| InCo Coercion -- Inside a coercion
| InAxiom (CoAxiom Branched) -- Inside a CoAxiom
+-- | Does this join point 'Id' occur inside a cast?
+--
+-- See Note [Linting join points with casts or ticks].
+data JoinOcc
+ -- | A normal occurrence of a 'JoinId'.
+ = NormalJoinOcc
+ -- | An occurrence of a 'JoinId' with an intervening cast between the
+ -- join point binder definition and the jump.
+ | JoinOccUnderCast
+ deriving stock Eq
+instance Outputable JoinOcc where
+ ppr NormalJoinOcc = text "Normal"
+ ppr JoinOccUnderCast = text "UnderCast"
+
data LintConfig = LintConfig
{ l_diagOpts :: !DiagOpts -- ^ Diagnostics opts
, l_platform :: !Platform -- ^ Target platform
@@ -3328,7 +3343,7 @@ initL cfg m
env = LE { le_flags = l_flags cfg
, le_subst = mkEmptySubst (mkInScopeSetList vars)
, le_in_vars = mkVarEnv [ (v,(v, varType v)) | v <- vars ]
- , le_joins = emptyVarSet
+ , le_joins = emptyUniqMap
, le_loc = []
, le_ue_aliases = emptyNameEnv
, le_platform = l_platform cfg
@@ -3428,11 +3443,11 @@ addInScopeId in_id out_ty thing_inside
in unLintM (thing_inside out_id) env' errs
where
- add env@(LE { le_in_vars = id_vars, le_joins = join_set
+ add env@(LE { le_in_vars = id_vars, le_joins = valid_joins
, le_ue_aliases = aliases, le_subst = subst })
= (out_id, env1)
where
- env1 = env { le_in_vars = in_vars', le_joins = join_set', le_ue_aliases = aliases' }
+ env1 = env { le_in_vars = in_vars', le_joins = valid_joins', le_ue_aliases = aliases' }
in_vars' = extendVarEnv id_vars in_id (in_id, out_ty)
aliases' = delFromNameEnv aliases (idName in_id)
@@ -3446,9 +3461,9 @@ addInScopeId in_id out_ty thing_inside
out_id | isEmptyTCvSubst subst = in_id
| otherwise = setIdType in_id out_ty
- join_set'
- | isJoinId out_id = extendVarSet join_set in_id -- Overwrite with new arity
- | otherwise = delVarSet join_set in_id -- Remove any existing binding
+ valid_joins'
+ | isJoinId out_id = addToUniqMap valid_joins in_id NormalJoinOcc -- Overwrite with new arity
+ | otherwise = delFromUniqMap valid_joins in_id -- Remove any existing binding
addInScopeTyCoVar :: InTyCoVar -> OutType -> (OutTyCoVar -> LintM a) -> LintM a
-- This function clones to avoid shadowing of TyCoVars
@@ -3485,13 +3500,35 @@ extendTvSubstL tv ty m
markAllJoinsBad :: LintM a -> LintM a
markAllJoinsBad m
- = LintM $ \ env errs -> unLintM m (env { le_joins = emptyVarSet }) errs
+ = LintM $ \ env errs -> unLintM m (env { le_joins = emptyUniqMap }) errs
+
+-- | Mark all join points as occurring under a tick.
+--
+-- See Note [Linting join points with casts or ticks].
+markAllJoinsUnderTick :: CoreTickish -> LintM a -> LintM a
+markAllJoinsUnderTick tick m
+ = LintM $ \ env errs ->
+ let env' = if tickishHasSoftScope tick || lf_allow_weak_joins (le_flags env)
+ then env
+ else env { le_joins = emptyUniqMap }
+ in unLintM m env' errs
+
+-- | Mark all join points as occurring under a cast.
+--
+-- See Note [Linting join points with casts or ticks].
+markAllJoinsUnderCast :: LintM a -> LintM a
+markAllJoinsUnderCast m
+ = LintM $ \ env errs ->
+ let !env' = if lf_allow_weak_joins (le_flags env)
+ then env { le_joins = fmap (const JoinOccUnderCast) (le_joins env) }
+ else env { le_joins = emptyUniqMap }
+ in unLintM m env' errs
markAllJoinsBadIf :: Bool -> LintM a -> LintM a
markAllJoinsBadIf True m = markAllJoinsBad m
markAllJoinsBadIf False m = m
-getValidJoins :: LintM IdSet
+getValidJoins :: LintM (UniqMap Id JoinOcc)
getValidJoins = LintM (\ env errs -> fromBoxedLResult (Just (le_joins env), errs))
getSubst :: LintM Subst
@@ -3552,14 +3589,14 @@ lintVarOcc v_occ
| otherwise
= return ()
-lookupJoinId :: Id -> LintM JoinPointHood
+lookupJoinId :: Id -> LintM (Maybe (JoinArity, JoinOcc))
-- Look up an Id which should be a join point, valid here
-- If so, return its arity, if not return Nothing
lookupJoinId id
- = do { join_set <- getValidJoins
- ; case lookupVarSet join_set id of
- Just id' -> return (idJoinPointHood id')
- Nothing -> return NotJoinPoint }
+ = do { valid_joins <- getValidJoins
+ ; case lookupUniqMap valid_joins id of
+ Just join_occ -> return $ Just (idJoinArity id, join_occ)
+ Nothing -> return Nothing }
addAliasUE :: OutId -> UsageEnv -> LintM a -> LintM a
addAliasUE id ue thing_inside = LintM $ \ env errs ->
=====================================
compiler/GHC/Core/Opt/Arity.hs
=====================================
@@ -90,7 +90,6 @@ import GHC.Utils.Misc
import Data.List.NonEmpty ( nonEmpty )
import qualified Data.List.NonEmpty as NE
-import Data.Maybe( isJust )
{-
************************************************************************
@@ -2835,21 +2834,6 @@ tryEtaReduce rec_ids bndrs body eval_sd
ok_arg _ _ _ _ = Nothing
--- | Can we eta-reduce the given function
--- See Note [Eta reduction soundness], criteria (B), (J), and (W).
-cantEtaReduceFun :: Id -> Bool
-cantEtaReduceFun fun
- = hasNoBinding fun -- (B)
- -- Don't undersaturate functions with no binding.
-
- || isJoinId fun -- (J)
- -- Don't undersaturate join points.
- -- See Note [Invariants on join points] in GHC.Core, and #20599
-
- || (isJust (idCbvMarks_maybe fun)) -- (W)
- -- Don't undersaturate StrictWorkerIds.
- -- See Note [CBV Function Ids: overview] in GHC.Types.Id.Info.
-
{- *********************************************************************
* *
=====================================
compiler/GHC/Core/Opt/FloatIn.hs
=====================================
@@ -375,7 +375,7 @@ We don't float lets inwards past an SCC.
-}
fiExpr platform to_drop (_, AnnTick tickish expr)
- | tickish `tickishScopesLike` SoftScope
+ | tickishHasSoftScope tickish
= Tick tickish (fiExpr platform to_drop expr)
| otherwise -- Wimp out for now - we could push values in
=====================================
compiler/GHC/Core/Opt/FloatOut.hs
=====================================
@@ -365,25 +365,28 @@ floatExpr lam@(Lam (TB _ lam_spec) _)
(add_to_stats fs floats, floats, mkLams bndrs body') }
floatExpr (Tick tickish expr)
- | tickish `tickishScopesLike` SoftScope -- not scoped, can just float
+ -- If possible, float out past the tick
+ | let float_out_of_tick
+ -- See Note [Floating past breakpoints]
+ | Breakpoint{} <- tickish
+ = True
+ | otherwise
+ -- We can float code out of non-scoped ticks
+ = tickishHasNoScope tickish
+ , float_out_of_tick
= case (floatExpr expr) of { (fs, floating_defns, expr') ->
(fs, floating_defns, Tick tickish expr') }
- | not (tickishCounts tickish) || tickishCanSplit tickish
- = case (floatExpr expr) of { (fs, floating_defns, expr') ->
- let -- Annotate bindings floated outwards past an scc expression
- -- with the cc. We mark that cc as "duplicated", though.
- annotated_defns = wrapTick (mkNoCount tickish) floating_defns
+ -- We can't move code out of the tick
+ | otherwise
+ = assert (not (tickishCounts tickish) || tickishCanSplit tickish) $
+ case (floatExpr expr) of { (fs, floating_defns, expr') ->
+ -- Wrap floated code with the correct tick scope, but using 'mkNoCount'
+ -- to ensure we don't duplicate counters.
+ let annotated_defns = wrapTick (mkNoCount tickish) floating_defns
in
(fs, annotated_defns, Tick tickish expr') }
- -- See Note [Floating past breakpoints]
- | Breakpoint{} <- tickish
- = case (floatExpr expr) of { (fs, floating_defns, expr') ->
- (fs, floating_defns, Tick tickish expr') }
-
- | otherwise
- = pprPanic "floatExpr tick" (ppr tickish)
floatExpr (Cast expr co)
= case (floatExpr expr) of { (fs, floating_defns, expr') ->
@@ -661,7 +664,8 @@ partitionByLevel (Level major minor) (FB tops defns)
wrapTick :: CoreTickish -> FloatBinds -> FloatBinds
wrapTick t (FB tops defns)
- = FB (mapBag wrap_bind tops)
+ = assert (not $ tickishCounts t) $
+ FB (mapBag wrap_bind tops)
(M.map (M.map wrap_defns) defns)
where
wrap_defns = mapBag wrap_one
@@ -672,10 +676,13 @@ wrapTick t (FB tops defns)
wrap_one (FloatLet bind) = FloatLet (wrap_bind bind)
wrap_one (FloatCase e b c bs) = FloatCase (maybe_tick e) b c bs
- maybe_tick e | exprIsHNF e = tickHNFArgs t e
- | otherwise = mkTick t e
- -- we don't need to wrap a tick around an HNF when we float it
- -- outside a tick: that is an invariant of the tick semantics
+ maybe_tick
+ -- We don't need to wrap an SCC tick around HNFs that we floated out of
+ -- the SCC, as that is an invariant of the semantics for SCCs.
-- Conversely, inlining of HNFs inside an SCC is allowed, and
-- indeed the HNF we're floating here might well be inlined back
-- again, and we don't want to end up with duplicate ticks.
+ | tickishPlace t == PlaceCostCentre
+ = mkTickNoHNF t
+ | otherwise
+ = mkTick t
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -27,7 +27,7 @@ core expression with (hopefully) improved usage information.
module GHC.Core.Opt.OccurAnal (
occurAnalysePgm,
- occurAnalyseExpr,
+ occurAnalyseExpr, occurAnalyseExpr_Prep,
zapLambdaBndrs
) where
@@ -85,6 +85,15 @@ occurAnalyseExpr expr = expr'
where
WUD _ expr' = occAnal initOccEnv expr
+-- | A version of 'occurAnalyseExpr' suitable for CorePrep.
+--
+-- Different from 'occurAnalyseExpr' due to (JCT3)
+-- in Note [Join points, casts, and ticks] in GHC.Core.
+occurAnalyseExpr_Prep :: CoreExpr -> CoreExpr
+occurAnalyseExpr_Prep expr = expr'
+ where
+ WUD _ expr' = occAnal (initOccEnv { occ_allow_weak_joins = True }) expr
+
occurAnalysePgm :: Module -- Used only in debug output
-> (Id -> Bool) -- Active unfoldings
-> (ActivationGhc -> Bool) -- Active rules
@@ -2300,12 +2309,8 @@ occ_anal_lam_tail env (Cast expr co)
Var {} | isRhsEnv env -> markAllMany usage1
_ -> usage1
- -- usage3: you might think this was not necessary, because of
- -- the markAllNonTail in adjustTailUsage; but not so! For a
- -- join point, adjustTailUsage doesn't do this; yet if there is
- -- a cast, we must! Also: why markAllNonTail? See
- -- GHC.Core.Lint: Note Note [Join points and casts]
- usage3 = markAllNonTail usage2
+ -- usage3: see (JCT1) in Note [Join points, casts, and ticks] in GHC.Core.
+ usage3 = markAllNonTail_CastOrTick env usage2
in WUD usage3 (Cast expr' co)
@@ -2587,42 +2592,39 @@ But it is not necessary to gather CoVars from the types of other binders.
-}
occAnal env (Tick tickish body)
- = WUD usage' (Tick tickish body')
+ = WUD usage2 (Tick tickish body')
where
WUD usage body' = occAnal env body
- usage'
- | tickish `tickishScopesLike` SoftScope
- = usage -- For soft-scoped ticks (including SourceNotes) we don't want
- -- to lose join-point-hood, so we don't mess with `usage` (#24078)
+ usage1
+ -- We don't want to lose join-point-hood. We can move soft-scoped ticks
+ -- out of the way, so don't mess with `usage` (#24078).
+ | tickishHasSoftScope tickish
+ = usage
- -- For a non-soft tick scope, we can inline lambdas only, so we
- -- abandon tail calls, and do markAllInsideLam too: usage_lam
+ -- Otherwise, we can inline lambdas only, so use 'markAllInsideLam'.
+ | otherwise
+ = markAllNonTail_CastOrTick env $ markAllInsideLam usage
+ -- markAllNonTail_CastOrTick: abandon tail calls.
+ -- See (JCT2) in Note [Join points, casts, and ticks] in GHC.Core.
+ usage2
| Breakpoint _ _ ids <- tickish
= -- Never substitute for any of the Ids in a Breakpoint
- addManyOccs usage_lam (mkVarSet ids)
+ addManyOccs usage1 (mkVarSet ids)
| otherwise
- = usage_lam
-
- usage_lam = markAllNonTail (markAllInsideLam usage)
-
- -- TODO There may be ways to make ticks and join points play
- -- nicer together, but right now there are problems:
- -- let j x = ... in tick<t> (j 1)
- -- Making j a join point may cause the simplifier to drop t
- -- (if the tick is put into the continuation). So we don't
- -- count j 1 as a tail call.
- -- See #14242.
+ = usage1
occAnal env (Cast expr co)
- = let (WUD usage expr') = occAnal env expr
- usage1 = addManyOccs usage (coVarsOfCo co)
- -- usage2: see Note [Gather occurrences of coercion variables]
- usage2 = markAllNonTail usage1
- -- usage3: calls inside expr aren't tail calls any more
- in WUD usage2 (Cast expr' co)
+ = let
+ WUD usage expr' = occAnal env expr
+ -- usage1: see Note [Gather occurrences of coercion variables]
+ usage1 = addManyOccs usage (coVarsOfCo co)
+ -- usage2: see (JCT1) in Note [Join points, casts, and ticks] in GHC.Core.
+ usage2 = markAllNonTail_CastOrTick env usage1
+ in
+ WUD usage2 (Cast expr' co)
occAnal env app@(App _ _)
= occAnalApp env (collectArgsTicks tickishFloatable app)
@@ -2936,6 +2938,11 @@ data OccEnv
, occ_rule_act :: ActivationGhc -> Bool -- Which rules are active
-- See Note [Finding rule RHS free vars]
+ , occ_allow_weak_joins :: !Bool
+ -- ^ Allow a join point jump to occur inside casts or profiling ticks?
+ --
+ -- See (JCT3) in Note [Join points, casts, and ticks] in GHC.Core.Opt.
+
-- See Note [The binder-swap substitution]
-- If x :-> (y, co) is in the env,
-- then please replace x by (y |> mco)
@@ -3003,6 +3010,8 @@ initOccEnv
, occ_unf_act = \_ -> True
, occ_rule_act = \_ -> True
+ , occ_allow_weak_joins = False
+
, occ_join_points = emptyVarEnv
, occ_bs_env = emptyVarEnv
, occ_bs_rng = emptyVarSet
@@ -3026,6 +3035,15 @@ setScrutCtxt !env alts
-- non-default alternative. That in turn influences
-- pre/postInlineUnconditionally. Grep for "occ_int_cxt"!
+-- | Mark occurrences under a cast/non-soft-scope tick as non-tail-called,
+-- except if 'occ_allow_weak_joins = True'.
+--
+-- See Note [Join points, casts, and ticks] in GHC.Core.
+markAllNonTail_CastOrTick :: OccEnv -> UsageDetails -> UsageDetails
+markAllNonTail_CastOrTick env =
+ markAllNonTailIf
+ (not $ occ_allow_weak_joins env)
+
{- Note [The OccEnv for a right hand side]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
How do we create the OccEnv for a RHS (in mkRhsOccEnv)?
@@ -4075,7 +4093,10 @@ okForJoinPoint :: TopLevelFlag -> Id -> TailCallInfo -> Bool
-- See Note [Invariants on join points]; invariants cited by number below.
-- Invariant 2 is always satisfiable by the simplifier by eta expansion.
okForJoinPoint lvl bndr tail_call_info
- | isJoinId bndr -- A current join point should still be one!
+ -- A current join point should still be one!
+ --
+ -- See Note [JoinId vs TailCallInfo] in GHC.Core.SimpleOpt.
+ | isJoinId bndr
= warnPprTrace lost_join "Lost join point" lost_join_doc $
True
| valid_join
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -814,9 +814,9 @@ prepareRhs env top_lvl occ rhs0
= return (emptyLetFloats, Var fun)
anfise (Tick t rhs)
- -- We want to be able to float bindings past this
- -- tick. Non-scoping ticks don't care.
- | tickishScoped t == NoScope
+ -- We want to be able to float bindings past this tick.
+ -- Non-scoping ticks don't care.
+ | tickishHasNoScope t
= do { (floats, rhs') <- anfise rhs
; return (floats, Tick t rhs') }
@@ -1413,7 +1413,7 @@ simplTick env tickish expr cont
-- bottom, then rebuildCall will discard the continuation.
--------------------------
--- | tickishScoped tickish && not (tickishCounts tickish)
+-- | not (tickishHasNoScope tickish) && not (tickishCounts tickish)
-- = simplExprF env expr (TickIt tickish cont)
-- XXX: we cannot do this, because the simplifier assumes that
-- the context can be pushed into a case with a single branch. e.g.
@@ -1425,12 +1425,11 @@ simplTick env tickish expr cont
-- simplifier iterations that necessary in some cases.
--------------------------
- -- For unscoped or soft-scoped ticks, we are allowed to float in new
- -- cost, so we simply push the continuation inside the tick. This
- -- has the effect of moving the tick to the outside of a case or
- -- application context, allowing the normal case and application
- -- optimisations to fire.
- | tickish `tickishScopesLike` SoftScope
+ -- For soft-scoped ticks, we are allowed to float in new cost, so we simply
+ -- push the continuation inside the tick. This has the effect of moving the
+ -- tick to the outside of a case or application context, allowing the normal
+ -- 'case' and 'application' optimisations to fire.
+ | tickishHasSoftScope tickish
= do { (floats, expr') <- simplExprF env expr cont
; return (floats, mkTick tickish expr')
}
@@ -1459,14 +1458,14 @@ simplTick env tickish expr cont
_other -> Nothing
where (ticks, expr0) = stripTicksTop movable (Tick tickish expr)
movable t = not (tickishCounts t) ||
- t `tickishScopesLike` NoScope ||
+ tickishHasNoScope t ||
tickishCanSplit t
tickScrut e = foldr mkTick e ticks
-- Alternatives get annotated with all ticks that scope in some way,
-- but we don't want to count entries.
tickAlt (Alt c bs e) = Alt c bs (foldr mkTick e ts_scope)
ts_scope = map mkNoCount $
- filter (not . (`tickishScopesLike` NoScope)) ticks
+ filter (not . tickishHasNoScope) ticks
no_floating_past_tick =
do { let (inc,outc) = splitCont cont
@@ -2180,16 +2179,15 @@ evaluation context E):
As is evident from the example, there are two components to this behavior:
- 1. When entering the RHS of a join point, copy the context inside.
- 2. When a join point is invoked, discard the outer context.
+ (wrapJoinCont) When entering the RHS of a join point, copy the context inside.
+ (trimJoinCont) When a join point is invoked, discard the outer context.
We need to be very careful here to remain consistent---neither part is
optional!
-We need do make the continuation E duplicable (since we are duplicating it)
+We need to make the continuation E duplicable (since we are duplicating it)
with mkDupableCont.
-
Note [Join points with -fno-case-of-case]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Supose case-of-case is switched off, and we are simplifying
@@ -2213,7 +2211,8 @@ case-of-case we may then end up with this totally bogus result
This would be OK in the language of the paper, but not in GHC: j is no longer
a join point. We can only do the "push continuation into the RHS of the
join point j" if we also push the continuation right down to the /jumps/ to
-j, so that it can evaporate there. If we are doing case-of-case, we'll get to
+j, so that it can evaporate there (trimJoinCont). Then, if we are doing
+case-of-case, we'll get to:
join x = case <j-rhs> of <outer-alts> in
case y of
@@ -3656,9 +3655,11 @@ addBinderUnfolding env bndr unf
= modifyInScope env (bndr `setIdUnfolding` unf)
zapBndrOccInfo :: Bool -> Id -> Id
--- Consider case e of b { (a,b) -> ... }
--- Then if we bind b to (a,b) in "...", and b is not dead,
--- then we must zap the deadness info on a,b
+-- ^ Consider:
+-- > case e of e' { (a,b) -> rhs }
+--
+-- We bind @e'@ to @(a,b)@ in @rhs@. If @e'@ is not dead,
+-- then we must zap the deadness info on @a@ and @b@.
zapBndrOccInfo keep_occ_info pat_id
| keep_occ_info = pat_id
| otherwise = zapIdOccInfo pat_id
=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -437,7 +437,7 @@ simple_app env e@(Lam {}) []
simple_app env (Tick t e) as
-- Okay to do "(Tick t e) x ==> Tick t (e x)"?
- | t `tickishScopesLike` SoftScope
+ | tickishHasSoftScope t
= mkTick t $ simple_app env e as
-- (let x = e in b) a1 .. an => let x = e in (b a1 .. an)
@@ -1059,23 +1059,33 @@ and again its arity increases (#15517)
-}
--- | Returns Just (bndr,rhs) if the binding is a join point:
--- If it's a JoinId, just return it
--- If it's not yet a JoinId but is always tail-called,
--- make it into a JoinId and return it.
+-- | Returns @Just (bndr, rhs)@ if the binding is a join point, or can be made
+-- into a join poin. Returns @Nothing@ otherwise.
+--
+-- - If the input binder is a 'JoinId', just return it;
+-- - if it's not yet a 'JoinId' but is always tail-called,
+-- make it into a 'JoinId' and return that.
+--
-- In the latter case, eta-expand the RHS if necessary, to make the
--- lambdas explicit, as is required for join points
+-- lambdas explicit, as is required for join points.
+--
+-- Precondition: the 'TailCallInfo' of the 'InBndr' is conservative:
--
--- Precondition: the InBndr has been occurrence-analysed,
--- so its OccInfo is valid
+-- - if it says 'AlwaysTailCalled', it is definitely always tail called,
+-- - if it says 'NoTailCallInfo', then we're not sure.
+--
+-- See Note [JoinId vs TailCallInfo].
joinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr)
joinPointBinding_maybe bndr rhs
| not (isId bndr)
= Nothing
+ -- Being a JoinId is robust: preserve that. See Note [JoinId vs TailCallInfo].
| isJoinId bndr
= Just (bndr, rhs)
+ -- If the 'TailCallInfo' of 'bndr' says 'AlwaysTailCalled', then we know for
+ -- sure that it can be made into a join point.
| AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr)
, (bndrs, body) <- etaExpandToJoinPoint join_arity rhs
, let str_sig = idDmdSig bndr
@@ -1091,6 +1101,48 @@ joinPointBindings_maybe :: [(InBndr, InExpr)] -> Maybe [(InBndr, InExpr)]
joinPointBindings_maybe bndrs
= mapM (uncurry joinPointBinding_maybe) bndrs
+{- Note [JoinId vs TailCallInfo]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+* Occurrence information is /fundamentally fragile/; that is, it may
+ be invalidated by the Simplifier.
+ Example 1:
+ \y -> let x = y in ...x..x...
+ Here `y` is marked "occurs exactly once" but, after inlining `x`,
+ `y` now occurs many times.
+ Example 2:
+ f (let h x = ... in case y of { True -> h 1; False -> h 2 })
+ Here `h` is tail-called; but if `f` is strict we could transform to
+ let h x = ... in
+ case y of { True -> f (h 1); False -> f (h 2) }
+ Now `h` is not tail called any more.
+
+ Exception: Dead things (with no occurrences) usually stay dead.
+ There are exceptions e.g.
+ case x of y { (a,b) -> case y of (p,q) -> p }
+ Here `a` and `b` look dead, but we may well transform to
+ case x of y { (a,b) -> a }
+
+ Because occurrence info is fragile, we recompute occurrence info
+ (including tail call info) before each run of the Simplifier.
+
+ Whenever the simplifier performs a transformation that **might** invalidate
+ occurrence information, it calls 'zapFragileIdInfo'. This sets the
+ 'TailCallInfo' to 'NoTailCallInfo' (among other things).
+
+* Being a JoinId is /robust/, and is rigorously maintained by the
+ Simplifier. In Example 2 above, if `h` was marked as a JoinId,
+ that transformation would not have happened. Instead we'd have
+ transformed to
+ let h x = f (...) in
+ case y of { True -> h 1; False -> h 2 }
+
+ The Simplifier takes an Id whose occurrences are marked as
+ `AlwaysTailCalled` and turns it into robust `JoinId`. This is
+ done by `joinPointBinding_maybe`.
+
+ There is one exception: float-out, the only caller of 'zapJoinId'.
+ See Note [Zapping JoinId when floating].
+-}
{- *********************************************************************
* *
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -34,7 +34,8 @@ module GHC.Core.Utils (
exprIsTickedString, exprIsTickedString_maybe,
exprIsTopLevelBindable,
exprIsUnaryClassFun, isUnaryClassId,
- altsAreExhaustive, etaExpansionTick,
+ altsAreExhaustive,
+ canCollectArgsThroughTick, cantEtaReduceFun,
-- * Equality
cheapEqExpr, cheapEqExpr', diffBinds,
@@ -680,7 +681,7 @@ mergeCaseAlts :: CoreExpr -> Id -> [CoreAlt] -> Maybe ([CoreBind], [CoreAlt])
mergeCaseAlts scrut outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
| Just (joins, inner_alts) <- go deflt_rhs
, Just aux_binds <- mk_aux_binds joins
- = Just ( aux_binds ++ joins, mergeAlts outer_alts inner_alts )
+ = Just (aux_binds ++ joins, mergeAlts outer_alts inner_alts )
-- NB: mergeAlts gives priority to the left
-- case x of
-- A -> e1
@@ -727,7 +728,7 @@ mergeCaseAlts scrut outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
, Just tc <- tyConAppTyCon_maybe type_arg
, Just (dc1:dcs) <- tyConDataCons_maybe tc -- At least one data constructor
, dcs `lengthAtMost` 3 -- Arbitrary
- = return ( [], mk_alts dc1 dcs)
+ = return ([], mk_alts dc1 dcs)
where
mk_lit dc = mkLitIntUnchecked $ toInteger $ dataConTagZ dc
mk_rhs dc = Var (dataConWorkId dc)
@@ -748,11 +749,16 @@ mergeCaseAlts scrut outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
| otherwise
= Nothing
- -- We don't want ticks to get in the way; just push them inwards.
- -- (This happens when you add SourceTicks e.g. GHC.Num.Integer.integerLt#)
+ -- Push ticks **inwards** (when possible).
+ -- See (MC5) in Note [Merge Nested Cases].
go (Tick t body)
- = do { (joins, alts) <- go body
- ; return (joins, [Alt con bs (Tick t rhs) | Alt con bs rhs <- alts]) }
+ = do { (joins, alts) <- go body -- (MC4): any join points inside are floated out of the tick.
+
+ -- Abort if this would put a non-soft-scope tick in between
+ -- a join point binding and its jumps. See (MC6).
+ ; guard $ null joins || tickishHasSoftScope t
+ ; return (joins, [Alt con bs (mkTick t rhs) | Alt con bs rhs <- alts])
+ }
go _ = Nothing
@@ -974,12 +980,74 @@ Wrinkles
So `mergeCaseAlts` floats out any join points. It doesn't float out
non-join-points unless the /outer/ case has just one alternative; doing
- so would risk more allocation
+ so would risk more allocation.
+
+ Note also that `mergeCaseAlts` floats join points out of ticks, for which
+ we need to be extra careful; see (MC6).
Floating out join points isn't entirely straightforward.
See Note [Floating join points out of DEFAULT alternatives]
-(MC5) See Note [Cascading case merge]
+(MC5) We want to move ticks out of the way if possible, to prevent them from
+ inhibiting optimisation. For example, say we have:
+
+ case expensive of r {
+ C1 -> rhs1; -- happy path
+ _ -> scctick<doEdgeCase> (case r of { C2 -> rhs2; C3 -> rhs3 })
+ }
+
+ In this situation, we push the "doEdgeCase" tick **inwards** and proceed
+ to merge cases, like so:
+
+ case expensive of
+ C1 -> rhs1
+ C2 -> scctick<doEdgeCase> rhs2
+ C3 -> scctick<doEdgeCase> rhs3
+
+ This preserves the tick semantics (see Note [Scoping ticks and counting ticks]
+ in GHC.Types.Tickish), because this transformation:
+
+ 1. preserves counts,
+ 2. does not move cost in or out of the tick scope.
+
+ (1) is clear: we will tick 'doEdgeCase' exactly in the C2/C3 alternatives,
+ and we won't otherwise.
+ For (2), recall that case is strict in Core. We already evaluated 'expensive',
+ so re-scrutinising 'r' is free.
+
+ This means that, perhaps surprisingly, this transformation is valid for
+ **all** ticks, including non-floatable ones.
+
+ In contrast, we would not want to move the tick outwards, because this:
+
+ - will lead to additional counting of 'doEdgeCase' in the 'C1' (happy path) case,
+ - risks attributing the cost of evaluating 'expensive' to 'doEdgeCase'.
+
+(MC6) There is a dangerous interaction between (MC4) and (MC5), which can lead
+ to invalid Core (as reported in #26642, #26929). Suppose we have:
+
+ case f x of r ->
+ scctick<foo>
+ join j y = rhs in
+ case r of { C1 -> j 1; C2 -> bar }
+
+ If we naively carried out (MC4) and (MC5) together, this would result in:
+
+ join j y = rhs in
+ case f x of
+ C1 -> scctick<foo> (j 1)
+ C2 -> scctick<foo> bar
+
+ This has moved the tick in between the join point binding 'j' and the
+ join point jump, which is invalid as per Note [Join points, casts, and ticks]
+ in GHC.Core. The simplifier cannot deal with such Core, resulting in #26642.
+
+ The solution: abort whenever we would position a non-soft-scope tick
+ inside a join point in this manner.
+ An alternative would be to float the tick outwards, but as we saw in (MC5)
+ this risks a grave misattribution of profiling costs, so we don't do that.
+
+(MC7) See Note [Cascading case merge]
See also Note [Example of case-merging and caseRules] in GHC.Core.Opt.Simplify.Utils
@@ -2076,14 +2144,31 @@ altsAreExhaustive (Alt con1 _ _ : alts)
-- we behave conservatively here -- I don't think it's important
-- enough to deserve special treatment
--- | Should we look past this tick when eta-expanding the given function?
+-- | Should we look past this tick when collecting arguments
+-- for the given function?
--
-- See Note [Ticks and mandatory eta expansion]
--- Takes the function we are applying as argument.
-etaExpansionTick :: Id -> GenTickish pass -> Bool
-etaExpansionTick id t
- = hasNoBinding id &&
- ( tickishFloatable t || isProfTick t )
+canCollectArgsThroughTick
+ :: Id -- ^ function at the head of the application
+ -> GenTickish pass -- ^ tick we want to collect arguments past
+ -> Bool
+canCollectArgsThroughTick id t
+ = tickishFloatable t || cantEtaReduceFun id
+
+-- | Can we eta-reduce the given function?
+-- See Note [Eta reduction soundness], criteria (B), (J), and (W).
+cantEtaReduceFun :: Id -> Bool
+cantEtaReduceFun fun
+ = hasNoBinding fun -- (B)
+ -- Don't undersaturate functions with no binding.
+
+ || isJoinId fun -- (J)
+ -- Don't undersaturate join points.
+ -- See Note [Invariants on join points] in GHC.Core, and #20599
+
+ || isJust (idCbvMarks_maybe fun) -- (W)
+ -- Don't undersaturate StrictWorkerIds.
+ -- See Note [CBV Function Ids: overview] in GHC.Types.Id.Info.
{- Note [exprOkForSpeculation and type classes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -39,7 +39,8 @@ import GHC.Core.Type
import GHC.Core.Coercion
import GHC.Core.TyCon
import GHC.Core.DataCon
-import GHC.Core.Opt.OccurAnal
+import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr_Prep )
+import GHC.Core.SimpleOpt ( joinPointBinding_maybe, joinPointBindings_maybe )
import GHC.Data.Maybe
import GHC.Data.OrdList
@@ -575,7 +576,18 @@ cpeBind :: TopLevelFlag -> CorePrepEnv -> CoreBind
Maybe CoreBind) -- Just bind' <=> returned new bind; no float
-- Nothing <=> added bind' to floats instead
cpeBind top_lvl env (NonRec bndr rhs)
- | not (isJoinId bndr)
+ -- A join point.
+ -- NB: use 'joinPointBinding_maybe' instead of 'isJoinId' as per the plan
+ -- described in (JCT3) in Note [Join points, casts, and ticks].
+ | Just (bndr, rhs) <- joinPointBinding_maybe bndr rhs
+ = assert (not (isTopLevel top_lvl)) $ -- can't have top-level join point; see Note [Join points and floating]
+ do { (_, bndr1) <- cpCloneBndr env bndr
+ ; (bndr2, rhs1) <- cpeJoinPair env bndr1 rhs
+ ; return (extendCorePrepEnv env bndr bndr2,
+ emptyFloats,
+ Just (NonRec bndr2 rhs1)) }
+
+ | otherwise
= do { (env1, bndr1) <- cpCloneBndr env bndr
; let dmd = idDemandInfo bndr
lev = typeLevity (idType bndr)
@@ -594,16 +606,23 @@ cpeBind top_lvl env (NonRec bndr rhs)
; return (env2, floats1, Nothing) }
- | otherwise -- A join point; see Note [Join points and floating]
- = assert (not (isTopLevel top_lvl)) $ -- can't have top-level join point
- do { (_, bndr1) <- cpCloneBndr env bndr
- ; (bndr2, rhs1) <- cpeJoinPair env bndr1 rhs
- ; return (extendCorePrepEnv env bndr bndr2,
- emptyFloats,
- Just (NonRec bndr2 rhs1)) }
-
cpeBind top_lvl env (Rec pairs)
- | not (isJoinId (head bndrs))
+ -- A recursive join point.
+ -- NB: use 'joinPointBindings_maybe' instead of 'isJoinId' as per the plan
+ -- described in (JCT3) in Note [Join points, casts, and ticks].
+ | Just pairs <- joinPointBindings_maybe pairs
+ , let (bndrs, rhss) = unzip pairs
+ = do { (env, bndrs1) <- cpCloneBndrs env bndrs
+ ; let env' = enterRecGroupRHSs env bndrs1
+ ; pairs1 <- zipWithM (cpeJoinPair env') bndrs1 rhss
+
+ ; let bndrs2 = map fst pairs1
+ -- use env below, so that we reset cpe_rec_ids
+ ; return (extendCorePrepEnvList env (bndrs `zip` bndrs2),
+ emptyFloats,
+ Just (Rec pairs1)) }
+ | otherwise
+ , let (bndrs, rhss) = unzip pairs
= do { (env, bndrs1) <- cpCloneBndrs env bndrs
; let env' = enterRecGroupRHSs env bndrs1
; stuff <- zipWithM (cpePair top_lvl Recursive topDmd Lifted env')
@@ -626,19 +645,9 @@ cpeBind top_lvl env (Rec pairs)
(Float (Rec all_pairs) LetBound TopLvlFloatable),
Nothing) }
- | otherwise -- See Note [Join points and floating]
- = do { (env, bndrs1) <- cpCloneBndrs env bndrs
- ; let env' = enterRecGroupRHSs env bndrs1
- ; pairs1 <- zipWithM (cpeJoinPair env') bndrs1 rhss
-
- ; let bndrs2 = map fst pairs1
- -- use env below, so that we reset cpe_rec_ids
- ; return (extendCorePrepEnvList env (bndrs `zip` bndrs2),
- emptyFloats,
- Just (Rec pairs1)) }
where
- (bndrs, rhss) = unzip pairs
-
+ -- See Note [Join points and floating]
+ --
-- Flatten all the floats, and the current
-- group into a single giant Rec
add_float (Float bind bound _) prs2
@@ -653,7 +662,6 @@ cpeBind top_lvl env (Rec pairs)
Rec prs1 -> prs1 ++ prs2
add_float f _ = pprPanic "cpeBind" (ppr f)
-
---------------
cpePair :: TopLevelFlag -> RecFlag -> Demand -> Levity
-> CorePrepEnv -> OutId -> CoreExpr
@@ -661,7 +669,7 @@ cpePair :: TopLevelFlag -> RecFlag -> Demand -> Levity
-- Used for all bindings
-- The binder is already cloned, hence an OutId
cpePair top_lvl is_rec dmd lev env0 bndr rhs
- = assert (not (isJoinId bndr)) $ -- those should use cpeJoinPair
+ = assert (isNothing $ joinPointBinding_maybe bndr rhs) $ -- those should use cpeJoinPair
do { (floats1, rhs1) <- cpeRhsE env rhs
-- See if we are allowed to float this stuff out of the RHS
@@ -926,7 +934,7 @@ rhsToBody :: CorePrepEnv -> CpeRhs -> UniqSM (Floats, CpeBody)
-- Remove top level lambdas by let-binding
rhsToBody env (Tick t expr)
- | tickishScoped t == NoScope -- only float out of non-scoped annotations
+ | tickishHasNoScope t -- only float out of non-scoped annotations
= do { (floats, expr') <- rhsToBody env expr
; return (floats, mkTick t expr') }
@@ -984,43 +992,74 @@ instance Outputable ArgInfo where
{- Note [Ticks and mandatory eta expansion]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Something like
- `foo x = ({-# SCC foo #-} tagToEnum#) x :: Bool`
-caused a compiler panic in #20938. Why did this happen?
-The simplifier will eta-reduce the rhs giving us a partial
-application of tagToEnum#. The tick is then pushed inside the
-type argument. That is we get
- `(Tick<foo> tagToEnum#) @Bool`
+We must look through ticks when they get in the way of seeing the arguments to
+'Id's that cannot be eta-reduced.
+
+For example, we may have
+
+ myReallyUnsafePtrEquality
+ = \ @a x y ->
+ (src<loc> reallyUnsafePtrEquality#)
+ @Lifted @a @Lifted @a x y
+
+If we don't move the SourceNote out of the way, this looks like an unsaturated
+occurrence of the PrimOp "reallyUnsafePtrEquality#", which we cannot generate
+code for.
+
+Moreover, we must also move out non-floatable ticks. Case in point: #20938,
+of the form:
+
+ foo x = ({-# SCC foo #-} tagToEnum#) x :: Bool
+
+If we don't look past the tick "foo", the simplifier will eta-reduce the RHS,
+giving us a partial application of 'tagToEnum#'. The tick is then pushed inside
+the type argument, resulting in:
+
+ (Tick<foo> tagToEnum#) @Bool
+
CorePrep would go on to see a undersaturated tagToEnum# application
-and eta expand the expression under the tick. Giving us:
+and eta-expand the expression under the tick. Giving us:
+
(Tick<scc> (\forall a. x -> tagToEnum# @a x) @Bool
-Suddenly tagToEnum# is applied to a polymorphic type and the code generator
+
+Suddenly, 'tagToEnum#' is applied to a polymorphic type and the code generator
panics as it needs a concrete type to determine the representation.
-The problem in my eyes was that the tick covers a partial application
-of a primop. There is no clear semantic for such a construct as we can't
-partially apply a primop since they do not have bindings.
-We fix this by expanding the scope of such ticks slightly to cover the body
-of the eta-expanded expression.
-
-We do this by:
-* Checking if an application is headed by a primOpish thing.
-* If so we collect floatable ticks and usually but also profiling ticks
- along with regular arguments.
-* When rebuilding the application we check if any profiling ticks appear
- before the primop is fully saturated.
-* If the primop isn't fully satured we eta expand the primop application
- and scope the tick to scope over the body of the saturated expression.
-
-Going back to #20938 this means starting with
- `(Tick<foo> tagToEnum#) @Bool`
-we check if the function head is a primop (yes). This means we collect the
-profiling tick like if it was floatable. Giving us
- (tagToEnum#, [CpeTick foo, CpeApp @Bool]).
+The problem was that the tick covered a partial application of a primop.
+There is no clear semantic for such a construct: we can't partially apply a
+primop, since primops do not have bindings.
+
+To fix this, we expand the scope of ticks slightly to cover the body
+of the eta-expanded expression, even when the tick isn't normally floatable.
+
+This is achieved by using 'GHC.Core.Utils.canCollectArgsThroughTick', which
+responds 'True' in the following two situations:
+
+ - The tick is floatable (i.e. satisfies 'tickishFloatable'), meaning that it
+ is OK to float it out slightly, moving in more code under it.
+ See also Note [Eta expansion and source notes] in GHC.Core.Opt.Arity.
+ - The tick is around an application that is headed by an 'Id' that cannot be
+ undersaturated, such as a PrimOp (see 'GHC.Core.Utils.cantEtaReduceFun').
+
+This solves #20938. Indeed, starting with
+
+ (scctick<foo> tagToEnum#) @Bool
+
+we see that the head of the application is 'tagToEnum#', which is a PrimOp and
+thus satisfies 'hasNoBinding = True'. As a result, we collect the profiling tick
+as if it was floatable, resulting in
+
+ (tagToEnum#, [CpeTick foo, CpeApp @Bool])
+
cpe_app filters out the tick as a underscoped tick on the expression
-`tagToEnum# @Bool`. During eta expansion we then put that tick back onto the
-body of the eta-expansion lambdas. Giving us `\x -> Tick<foo> (tagToEnum# @Bool x)`.
+`tagToEnum# @Bool`. During eta-expansion, we put that tick back onto the
+body of the eta-expansion lambda, resulting in
+
+ \x -> scctick<foo> (tagToEnum# @Bool x)
+
+which is unproblematic.
-}
+
cpeApp :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)
-- May return a CpeRhs (instead of CpeApp) because of saturating primops
cpeApp top_env expr
@@ -1045,15 +1084,14 @@ cpeApp top_env expr
go (Cast fun co) as
= go fun (AICast co : as)
go (Tick tickish fun) as
- -- Profiling ticks are slightly less strict so we expand their scope
- -- if they cover partial applications of things like primOps.
- -- See Note [Ticks and mandatory eta expansion]
- -- Here we look inside `fun` before we make the final decision about
- -- floating the tick which isn't optimal for perf. But this only makes
- -- a difference if we have a non-floatable tick which is somewhat rare.
+ -- Try to move a tick out of the way, if:
+ -- - the tick can be floated out of the way ('tickishFloatable'), or
+ -- - the tick must be moved out of the way because it stands in between
+ -- an 'Id' that must be saturated and some of its arguments;
+ -- see Note [Ticks and mandatory eta expansion].
| Var vh <- head
- , Var head' <- lookupCorePrepEnv top_env vh
- , etaExpansionTick head' tickish
+ , Just head' <- getIdFromTrivialExpr_maybe (lookupCorePrepEnv top_env vh)
+ , canCollectArgsThroughTick head' tickish
= (head,as')
where
(head,as') = go fun (AITick tickish : as)
@@ -1130,7 +1168,10 @@ cpeApp top_env expr
hd = getIdFromTrivialExpr_maybe e2
-- Determine number of required arguments. See Note [Ticks and mandatory eta expansion]
min_arity = case hd of
- Just v_hd -> if hasNoBinding v_hd then Just $! (idArity v_hd) else Nothing
+ Just v_hd ->
+ if cantEtaReduceFun v_hd
+ then Just $! idArity v_hd
+ else Nothing
Nothing -> Nothing
-- ; pprTraceM "cpe_app:stricts:" (ppr v <+> ppr args $$ ppr stricts $$ ppr (idCbvMarks_maybe v))
; (app, floats, unsat_ticks) <- rebuild_app env args e2 emptyFloats stricts min_arity
@@ -2293,8 +2334,8 @@ deFloatTop floats
get b _ = pprPanic "deFloatTop" (ppr b)
-- See Note [Dead code in CorePrep]
- get_bind (NonRec x e) = NonRec x (occurAnalyseExpr e)
- get_bind (Rec xes) = Rec [(x, occurAnalyseExpr e) | (x, e) <- xes]
+ get_bind (NonRec x e) = NonRec x (occurAnalyseExpr_Prep e)
+ get_bind (Rec xes) = Rec [(x, occurAnalyseExpr_Prep e) | (x, e) <- xes]
---------------------------------------------------------------------------
=====================================
compiler/GHC/Driver/Config/Core/Lint.hs
=====================================
@@ -115,7 +115,8 @@ perPassFlags dflags pass
, lf_check_inline_loop_breakers = check_lbs
, lf_check_static_ptrs = check_static_ptrs
, lf_check_linearity = check_linearity
- , lf_check_rubbish_lits = check_rubbish }
+ , lf_check_rubbish_lits = check_rubbish
+ , lf_allow_weak_joins = allow_weak_joins }
where
-- See Note [Checking for global Ids]
check_globals = case pass of
@@ -152,6 +153,11 @@ perPassFlags dflags pass
CorePrep -> True
_ -> False
+ -- See Note [Linting join points with casts or ticks] in GHC.Core.Lint
+ allow_weak_joins = case pass of
+ CorePrep -> True
+ _ -> False
+
initLintConfig :: DynFlags -> [Var] -> LintConfig
initLintConfig dflags vars =LintConfig
{ l_diagOpts = initDiagOpts dflags
@@ -168,4 +174,5 @@ defaultLintFlags dflags = LF { lf_check_global_ids = False
, lf_report_unsat_syns = True
, lf_check_fixed_rep = True
, lf_check_rubbish_lits = True
+ , lf_allow_weak_joins = False
}
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -1272,7 +1272,7 @@ tidyTopIdInfo rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold
is_external = isExternalName name
--------- OccInfo ------------
- robust_occ_info = zapFragileOcc (occInfo idinfo)
+ robust_occ_info = zapFragileOccInfo (occInfo idinfo)
-- It's important to keep loop-breaker information
-- when we are doing -fexpose-all-unfoldings
=====================================
compiler/GHC/StgToCmm/Expr.hs
=====================================
@@ -1273,5 +1273,5 @@ cgTick tick
ProfNote cc t p -> emitSetCCC cc t p
HpcTick m n -> emit (mkTickBox platform m n)
SourceNote s n -> emitTick $ SourceNote s n
- _other -> return () -- ignore
+ Breakpoint {} -> return () -- ignore
}
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -66,7 +66,7 @@ module GHC.Types.Basic (
noOneShotInfo, hasNoOneShotInfo, isOneShotInfo,
bestOneShot, worstOneShot,
- OccInfo(..), noOccInfo, seqOccInfo, zapFragileOcc, isOneOcc,
+ OccInfo(..), noOccInfo, seqOccInfo, zapFragileOccInfo, isOneOcc,
isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs,
isNoOccInfo, strongLoopBreaker, weakLoopBreaker,
@@ -980,10 +980,13 @@ isOneOcc :: OccInfo -> Bool
isOneOcc (OneOcc {}) = True
isOneOcc _ = False
-zapFragileOcc :: OccInfo -> OccInfo
--- Keep only the most robust data: deadness, loop-breaker-hood
-zapFragileOcc (OneOcc {}) = noOccInfo
-zapFragileOcc occ = zapOccTailCallInfo occ
+-- | Keep only the most robust occurrence info: deadness, loop-breaker-hood.
+--
+-- In particular, it zaps 'TailCallInfo': see Note [JoinId vs TailCallInfo]
+-- in 'GHC.Core.Opt.Simplify.Env'.
+zapFragileOccInfo :: OccInfo -> OccInfo
+zapFragileOccInfo (OneOcc {}) = noOccInfo
+zapFragileOccInfo occ = zapOccTailCallInfo occ
instance Outputable OccInfo where
-- only used for debugging; never parsed. KSW 1999-07
=====================================
compiler/GHC/Types/Id/Info.hs
=====================================
@@ -914,14 +914,15 @@ zapUsedOnceInfo info
, demandInfo = zapUsedOnceDemand (demandInfo info) }
zapFragileInfo :: IdInfo -> Maybe IdInfo
--- ^ Zap info that depends on free variables
+-- ^ Zap fragile 'IdInfo', such as info that depends on free variables
+-- or fragile occurrence info (see 'zapFragileOccInfo').
zapFragileInfo info@(IdInfo { occInfo = occ, realUnfoldingInfo = unf })
= new_unf `seq` -- The unfolding field is not (currently) strict, so we
-- force it here to avoid a (zapFragileUnfolding unf) thunk
-- which might leak space
Just (info `setRuleInfo` emptyRuleInfo
`setUnfoldingInfo` new_unf
- `setOccInfo` zapFragileOcc occ)
+ `setOccInfo` zapFragileOccInfo occ)
where
new_unf = zapFragileUnfolding unf
=====================================
compiler/GHC/Types/Tickish.hs
=====================================
@@ -6,9 +6,8 @@ module GHC.Types.Tickish (
CoreTickish, StgTickish, CmmTickish,
XTickishId,
tickishCounts,
- TickishScoping(..),
- tickishScoped,
- tickishScopesLike,
+ tickishHasNoScope,
+ tickishHasSoftScope,
tickishFloatable,
tickishCanSplit,
mkNoCount,
@@ -206,103 +205,177 @@ instance Binary BreakpointId where
--------------------------------------------------------------------------------
--- | A "counting tick" (where tickishCounts is True) is one that
+-- | A "counting tick" (for which 'tickishCounts' is True) is one that
-- counts evaluations in some way. We cannot discard a counting tick,
--- and the compiler should preserve the number of counting ticks as
--- far as possible.
+-- and the compiler should preserve the number of counting ticks (as
+-- far as possible).
--
--- However, we still allow the simplifier to increase or decrease
--- sharing, so in practice the actual number of ticks may vary, except
--- that we never change the value from zero to non-zero or vice versa.
+-- See Note [Counting ticks]
tickishCounts :: GenTickish pass -> Bool
-tickishCounts n@ProfNote{} = profNoteCount n
-tickishCounts HpcTick{} = True
-tickishCounts Breakpoint{} = True
-tickishCounts _ = False
-
-
--- | Specifies the scoping behaviour of ticks. This governs the
--- behaviour of ticks that care about the covered code and the cost
--- associated with it. Important for ticks relating to profiling.
-data TickishScoping =
- -- | No scoping: The tick does not care about what code it
- -- covers. Transformations can freely move code inside as well as
- -- outside without any additional annotation obligations
- NoScope
-
- -- | Soft scoping: We want all code that is covered to stay
- -- covered. Note that this scope type does not forbid
- -- transformations from happening, as long as all results of
- -- the transformations are still covered by this tick or a copy of
- -- it. For example
- --
- -- let x = tick<...> (let y = foo in bar) in baz
- -- ===>
- -- let x = tick<...> bar; y = tick<...> foo in baz
- --
- -- Is a valid transformation as far as "bar" and "foo" is
- -- concerned, because both still are scoped over by the tick.
- --
- -- Note though that one might object to the "let" not being
- -- covered by the tick any more. However, we are generally lax
- -- with this - constant costs don't matter too much, and given
- -- that the "let" was effectively merged we can view it as having
- -- lost its identity anyway.
- --
- -- Also note that this scoping behaviour allows floating a tick
- -- "upwards" in pretty much any situation. For example:
- --
- -- case foo of x -> tick<...> bar
- -- ==>
- -- tick<...> case foo of x -> bar
- --
- -- While this is always legal, we want to make a best effort to
- -- only make us of this where it exposes transformation
- -- opportunities.
- | SoftScope
-
- -- | Cost centre scoping: We don't want any costs to move to other
- -- cost-centre stacks. This means we not only want no code or cost
- -- to get moved out of their cost centres, but we also object to
- -- code getting associated with new cost-centre ticks - or
- -- changing the order in which they get applied.
- --
- -- A rule of thumb is that we don't want any code to gain new
- -- annotations. However, there are notable exceptions, for
- -- example:
- --
- -- let f = \y -> foo in tick<...> ... (f x) ...
- -- ==>
- -- tick<...> ... foo[x/y] ...
- --
- -- In-lining lambdas like this is always legal, because inlining a
- -- function does not change the cost-centre stack when the
- -- function is called.
- | CostCentreScope
-
- deriving (Eq)
-
--- | Returns the intended scoping rule for a Tickish
-tickishScoped :: GenTickish pass -> TickishScoping
-tickishScoped n@ProfNote{}
- | profNoteScope n = CostCentreScope
- | otherwise = NoScope
-tickishScoped HpcTick{} = NoScope
-tickishScoped Breakpoint{} = CostCentreScope
- -- Breakpoints are scoped: eventually we're going to do call
- -- stacks, but also this helps prevent the simplifier from moving
- -- breakpoints around and changing their result type (see #1531).
-tickishScoped SourceNote{} = SoftScope
-
--- | Returns whether the tick scoping rule is at least as permissive
--- as the given scoping rule.
-tickishScopesLike :: GenTickish pass -> TickishScoping -> Bool
-tickishScopesLike t scope = tickishScoped t `like` scope
- where NoScope `like` _ = True
- _ `like` NoScope = False
- SoftScope `like` _ = True
- _ `like` SoftScope = False
- CostCentreScope `like` _ = True
+tickishCounts = \case
+ ProfNote { profNoteCount = counts } -> counts
+ HpcTick {} -> True
+ Breakpoint {} -> True
+ SourceNote {} -> False
+
+-- | Is this a non-scoping tick, for which we don't care about precisely
+-- the extent of code that the tick encompasses?
+--
+-- See Note [Scoped ticks]
+tickishHasNoScope :: GenTickish pass -> Bool
+tickishHasNoScope = \case
+ ProfNote { profNoteScope = scopes } -> not scopes
+ HpcTick {} -> True
+ Breakpoint {} -> False
+ SourceNote {} -> False
+
+-- | A "tick with soft scoping" (for which 'tickishHasSoftScope' is True) is
+-- one that either does not scope at all (for which 'tickishHasNoScope' is True),
+-- or that has a "soft" scope: we allow new code to be floated into to the scope,
+-- as long as all code that was covered remains covered.
+--
+-- See Note [Scoped ticks]
+tickishHasSoftScope :: GenTickish pass -> Bool
+tickishHasSoftScope = \case
+ ProfNote { profNoteScope = scopes } -> not scopes
+ HpcTick {} -> True
+ Breakpoint {} -> False
+ SourceNote {} -> True
+
+{- Note [Scoping ticks and counting ticks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Ticks have two independent attributes:
+
+ * Whether the tick /counts/.
+ Counting ticks are used when we want a counter to be bumped, e.g. counting
+ how many times a function is called.
+
+ See Note [Counting ticks]
+
+ * What kind of /scope/ the tick has:
+ * Cost-centre scope: you cannot move a redex into the scope of the tick,
+ nor can you float a redex out.
+ * Soft scope: you can move a redex /into/ the scope of a tick,
+ but you cannot float a redex /out/
+ * No scope: there are no restrictions on floating in or out.
+
+ See Note [Scoped ticks]
+
+Note [Counting ticks]
+~~~~~~~~~~~~~~~~~~~~
+The following ticks count:
+ - ProfNote ticks with profNoteCounts = True
+ - HPC ticks
+ - Breakpoints
+
+Going past a counting tick implies bumping a counter.
+Generally, the simplifier attempts to preserve counts when transforming
+programs and moving ticks, for example by transforming:
+
+ case <tick> e of
+ alt1 -> rhs1
+ alt2 -> rhs2
+
+to
+
+ case e of
+ alt1 -> <tick> rhs1
+ alt2 -> <tick> rhs2
+
+which preserves the total count (as exactly one branch of the case
+will be taken).
+
+However, we still allow the simplifier to increase or decrease
+sharing, so in practice the actual number of ticks may vary, except
+that we never change the value from zero to non-zero or vice-versa.
+
+Note [Scoped ticks]
+~~~~~~~~~~~~~~~~~~~~
+The following ticks are scoped:
+ - ProfNote ticks with profNoteScope = True
+ - Breakpoints
+ - Source notes
+
+A scoped tick is one that scopes over a portion of code. For example,
+an SCC anotation sets the cost centre for the code within; any allocations
+within that piece of code should get attributed to that cost centre.
+
+When the simplifier deals with a scoping tick, it ensures that all code that
+was covered remains covered. For example
+
+ let x = tick<...> (let y = foo in bar) in baz
+ ===>
+ let x = tick<...> bar; y = tick<...> foo in baz
+
+is a valid transformation as far as "bar" and "foo" are concerned, because
+both still are scoped over by the tick. One might object to the "let" not
+being covered by the tick any more. However, we are generally lax with this;
+constant costs don't matter too much, and given that the "let" was effectively
+merged we can view it as having lost its identity anyway.
+
+Perhaps surprisingly, breakpoints are considered to be scoped, because we
+don't want the simplifier to move them around, changing their result type (see #1531).
+
+We specifically forbid floating code outside of a scoping tick, as cost
+associated with the floated-out code would no longer be attributed to the
+appropriate scope.
+
+Whether we are allowed to float in additional cost depends on the tick:
+
+ Cost-centre scope ticks
+ - ProfNote with profNoteScope = True
+ - Breakpoints
+
+ A tick with cost-centre scope is one for which we can neither move
+ redexes into or move redexes outside of the tick. For example, we don't
+ want profiling costs to move to other cost-centre stacks.
+ Morever, we also object to changing the order in which such ticks
+ are applied.
+
+ A rule of thumb is that we don't want any code to gain new
+ lexically-enclosing ticks. For example, we should not transform:
+
+ f (scctick<foo> a) ==> scctick<foo> (f a)
+
+ as this would attribute the cost of evaluating the application 'f a'
+ to the cost centre 'foo'.
+
+ However, there are notable exceptions, for example:
+
+ let f = \y -> foo in tick<...> ... (f x) ...
+ ==>
+ tick<...> ... foo[x/y] ...
+
+ Inlining lambdas like this is always legal, because inlining a function
+ does not change the cost-centre stack when the function is called.
+
+ Soft scope ticks
+ - Source notes
+
+ A tick with soft scope is one for which we can move redexes inside the
+ tick, but cannot float redexes outside the tick. This is a slightly more
+ lenient notion of scoping than cost-centres, and is used only for source
+ note ticks (they are used to provide DWARF debug symbols, and for those
+ it matters less if code from outside gets moved under the tick).
+
+ Examples:
+
+ - FloatIn (GHC.Core.Opt.FloatIn.fiExpr)
+
+ let x = rhs in <tick> body
+ ==>
+ <tick> (let x = rhs in body)
+
+ - Moving a tick outside of a case or of an application
+ (GHC.Core.Opt.Simplify.Iteration.simplTick)
+
+ case <tick> e of alts ==> <tick> case e of alts
+
+ (<tick> e1) e2 ==> <tick> (e1 e2)
+
+ While these transformations are legal, we want to make a best effort to
+ only make use of them where it exposes transformation opportunities.
+-}
-- | Returns @True@ for ticks that can be floated upwards easily even
-- where it might change execution counts, such as:
@@ -311,12 +384,11 @@ tickishScopesLike t scope = tickishScoped t `like` scope
-- ==>
-- tick<...> (Just foo)
--
--- This is a combination of @tickishSoftScope@ and
--- @tickishCounts@. Note that in principle splittable ticks can become
--- floatable using @mkNoTick@ -- even though there's currently no
--- tickish for which that is the case.
+-- This is a combination of @tickishHasSoftScope@ and @tickishCounts@.
+-- Note that in principle splittable ticks can become floatable using @mkNoTick@,
+-- even though there's currently no tickish for which that is the case.
tickishFloatable :: GenTickish pass -> Bool
-tickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t)
+tickishFloatable t = tickishHasSoftScope t && not (tickishCounts t)
-- | Returns @True@ for a tick that is both counting /and/ scoping and
-- can be split into its (tick, scope) parts using 'mkNoScope' and
@@ -334,7 +406,7 @@ mkNoCount n@ProfNote{} = let n' = n {profNoteCount = False}
mkNoCount _ = panic "mkNoCount: Undefined split!"
mkNoScope :: GenTickish pass -> GenTickish pass
-mkNoScope n | tickishScoped n == NoScope = n
+mkNoScope n | tickishHasNoScope n = n
| not (tickishCanSplit n) = panic "mkNoScope: Cannot split!"
mkNoScope n@ProfNote{} = let n' = n {profNoteScope = False}
in assert (profNoteCount n) n'
@@ -357,7 +429,9 @@ mkNoScope _ = panic "mkNoScope: Undefined split!"
-- translate the code as if it found the latter.
tickishIsCode :: GenTickish pass -> Bool
tickishIsCode SourceNote{} = False
-tickishIsCode _tickish = True -- all the rest for now
+tickishIsCode ProfNote{} = True
+tickishIsCode Breakpoint{} = True
+tickishIsCode HpcTick{} = True
isProfTick :: GenTickish pass -> Bool
isProfTick ProfNote{} = True
=====================================
testsuite/tests/codeGen/should_compile/debug.stdout
=====================================
@@ -18,7 +18,6 @@ src<debug.hs:4:9>
src<debug.hs:5:21-29>
src<debug.hs:5:9-29>
src<debug.hs:6:1-21>
-src<debug.hs:6:16-21>
== CBE ==
src<debug.hs:4:9>
89
=====================================
testsuite/tests/simplCore/should_compile/T26642.hs
=====================================
@@ -0,0 +1,46 @@
+module T26642 ( saveClobberedTemps ) where
+
+import Prelude ( IO, Bool(..), Int, (>>=), (==), return )
+import Data.Word ( Word64 )
+
+-------------------------------------------------------------------------------
+
+data Word64Map a
+ = Bin (Word64Map a) (Word64Map a)
+ | Tip a
+ | Nil
+
+{-# NOINLINE myFoldr #-}
+myFoldr :: (a -> b -> b) -> b -> Word64Map a -> b
+myFoldr f = go
+ where
+ {-# NOINLINE go #-}
+ go z' Nil = z'
+ go z' (Tip x) = f x z'
+ go z' (Bin l r) = go (go z' r) l
+
+{-# NOINLINE nonDetFold #-}
+nonDetFold :: (b -> elt -> IO b) -> b -> Word64Map elt -> IO b
+nonDetFold f z0 xs = myFoldr c return xs z0
+ where
+ {-# NOINLINE c #-}
+ c x k z = f z x >>= k
+
+{-# NOINLINE myFalse #-}
+myFalse :: Bool
+myFalse = False
+
+type RealReg = Int
+data Loc = InReg RealReg | InMem
+
+saveClobberedTemps :: forall instr. [RealReg] -> IO [instr]
+saveClobberedTemps clobbered = nonDetFold maybe_spill [] Nil
+ where
+ {-# NOINLINE maybe_spill #-}
+ maybe_spill :: [instr] -> Loc -> IO [instr]
+ maybe_spill instrs !loc =
+ case loc of
+ InReg reg
+ | myFalse
+ -> return []
+ _ -> return instrs
=====================================
testsuite/tests/simplCore/should_compile/TrickyJoins.hs
=====================================
@@ -0,0 +1,154 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module TrickyJoinPoints where
+
+import Data.Coerce
+ ( coerce )
+import Data.Kind
+ ( Type )
+
+
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+
+-----------------------------------
+-- Join points and profiling ticks
+
+data ModGuts2 = MkModGuts2
+
+runCorePasses3 :: Bool -> ModGuts2 -> IO ModGuts2
+runCorePasses3 pass guts = doCorePass3 pass guts
+
+doCorePass3 :: Bool -> ModGuts2 -> IO ModGuts2
+doCorePass3 pass guts = do
+ _ <- putStrLn "hi"
+
+ let
+ updateBinds _ = return guts
+
+ case pass of
+ True -> {-# SCC "XXX3" #-} updateBinds False
+ _ -> {-# SCC "YYY3" #-} updateBinds True
+
+--------------------------
+-- Join points & casts
+
+newtype AdjacencyMap a = AM {
+ adjacencyMap :: Map a (Set.Set a) }
+
+overlays :: Ord a => [AdjacencyMap a] -> AdjacencyMap a
+overlays = AM . Map.unionsWith Set.union . map adjacencyMap
+
+
+type SBool :: Bool -> Type
+data SBool b where
+ SFalse :: SBool False
+ STrue :: SBool True
+
+type N :: Bool -> Type
+data family N b
+newtype instance N False = NF ( Int -> Int )
+newtype instance N True = NT ( Int -> Int )
+
+testCast :: forall b. SBool b -> Int -> Int
+testCast b n =
+ case
+ ( let
+ {-# NOINLINE juliet #-}
+ juliet :: Int -> Int -> Int
+ juliet x = \ y -> x + y + n
+ in
+ case b of
+ SFalse -> NF (juliet 1)
+ STrue -> NT (juliet 2)
+ ) :: N b of
+ n | SFalse <- b
+ , NF f <- n
+ -> f 100
+ | STrue <- b
+ , NT g <- n
+ -> g 200
+
+
+------------------------------------------
+-- Join points, profiling ticks and casts
+
+newtype M = M ( Int -> Int -> Int )
+
+testCastTick :: forall b. SBool b -> Int -> Int
+testCastTick b n =
+ case
+ ( let
+ {-# NOINLINE j #-}
+ j :: Int -> Int -> Int
+ j x = \ y -> x + y + n
+ {-# NOINLINE k #-}
+ k :: M
+ k = coerce j
+ in
+ case b of
+ SFalse -> {-# SCC "ticked" #-} NF ( coerce @M @( Int -> Int -> Int ) k 1 )
+ STrue -> NT ( coerce @M @( Int -> Int -> Int ) k 2 )
+ ) :: N b of
+ n | SFalse <- b
+ , NF f <- n
+ -> f 100
+ | STrue <- b
+ , NT g <- n
+ -> g 200
+
+------------------------------------------
+
+{-# NOINLINE testJoinTransitivity #-}
+testJoinTransitivity :: Bool -> Int -> Int
+testJoinTransitivity b n =
+ let
+ f x = x ^ ( 99 :: Int ) + 7 * ( x - 19 )
+ {-# NOINLINE f #-}
+ in
+ f (
+ let
+ j1 :: Int -> Int
+ j1 x = x + n
+ {-# NOINLINE j1 #-}
+
+ j2 :: Int -> Int
+ j2 y = j1 (y * 2)
+ {-# NOINLINE j2 #-}
+
+ j3 :: Int -> Int
+ j3 z = j2 (z * 3)
+ {-# NOINLINE j3 #-}
+
+ in case b of
+ True -> {-# SCC "ticked" #-} j3 10
+ False -> j3 20
+ )
+
+--------------------------------------------------------------------------------
+-- Test relating to Note [JoinId vs TailCallInfo]
+
+expt :: Int -> Int
+expt _ = 3
+{-# NOINLINE expt #-}
+
+repro :: (Int, Int) -> (Int, Int)
+repro (f0,e0) =
+ let
+ (f,e) =
+ let n = e0
+ in
+ case n > 0 of
+ True -> (f0, e0 + n)
+ False -> (f0, e0)
+ r = let be = expt e in f * be
+ in
+ (r, 7)
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -470,6 +470,9 @@ test('T22272', normal, multimod_compile, ['T22272', '-O -fexpose-all-unfoldings
# go should become a join point
test('T22428', [grep_errmsg(r'jump go') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds -dsuppress-unfoldings'])
+test('TrickyJoins', normal, compile, [''])
+test('T26642', [unless(have_profiling(), skip)], compile, ['-O -prof -fprof-auto-calls'])
+
test('T22459', normal, compile, [''])
test('T22623', normal, multimod_compile, ['T22623', '-O -v0'])
test('T22662', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/08bc245be70d95801bc1138804ed1de…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/08bc245be70d95801bc1138804ed1de…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
01 Mar '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
ea4c2cbd by Brandon Chinn at 2026-02-27T16:22:38-08:00
Implement QualifiedStrings (#26503)
See Note [Implementation of QualifiedStrings]
- - - - -
67 changed files:
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/Lexer.x
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/String.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Expr.hs
- + compiler/GHC/Rename/Lit.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- compiler/Language/Haskell/Syntax/Pat.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.16.1-notes.rst
- + docs/users_guide/exts/qualified_strings.rst
- libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs
- testsuite/tests/driver/T4437.hs
- testsuite/tests/ghc-api/annotations-literals/literals.stdout
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- + testsuite/tests/qualified-strings/Makefile
- + testsuite/tests/qualified-strings/should_compile/Example/Length.hs
- + testsuite/tests/qualified-strings/should_compile/all.T
- + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.hs
- + testsuite/tests/qualified-strings/should_compile/qstrings_redundant_pattern.stderr
- + testsuite/tests/qualified-strings/should_fail/Example/Length.hs
- + testsuite/tests/qualified-strings/should_fail/Makefile
- + testsuite/tests/qualified-strings/should_fail/all.T
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_expr.stderr
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_bad_pat.stderr
- + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.hs
- + testsuite/tests/qualified-strings/should_fail/qstrings_multiline_no_ext.stderr
- + testsuite/tests/qualified-strings/should_run/Example/ByteStringAscii.hs
- + testsuite/tests/qualified-strings/should_run/Example/ByteStringUtf8.hs
- + testsuite/tests/qualified-strings/should_run/Example/Text.hs
- + testsuite/tests/qualified-strings/should_run/Makefile
- + testsuite/tests/qualified-strings/should_run/all.T
- + testsuite/tests/qualified-strings/should_run/qstrings_expr.hs
- + testsuite/tests/qualified-strings/should_run/qstrings_expr.stdout
- + testsuite/tests/qualified-strings/should_run/qstrings_pat.hs
- + testsuite/tests/qualified-strings/should_run/qstrings_pat.stdout
- + testsuite/tests/qualified-strings/should_run/qstrings_th.hs
- + testsuite/tests/qualified-strings/should_run/qstrings_th.stdout
- utils/check-exact/ExactPrint.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea4c2cbde13ad7b8944ac9d16146ead…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ea4c2cbde13ad7b8944ac9d16146ead…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] Clean up join points, casts & ticks
by Marge Bot (＠marge-bot) 01 Mar '26
by Marge Bot (＠marge-bot) 01 Mar '26
01 Mar '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
77b48b37 by sheaf at 2026-03-01T06:30:28-05:00
Clean up join points, casts & ticks
This commit shores up the logic dealing with casts and ticks occurring
in between a join point binding and a jump.
Fixes #26642 #26929 #26693
Makes progress on #14610 #26157 #26422
Changes:
- Remove 'GHC.Types.Tickish.TickishScoping' in favour of simpler
predicates 'tickishHasNoScope'/'tickishHasSoftScope', as things were
before commit 993975d3. This makes the code easier to read and
document (fewer indirections).
- Introduce 'canCollectArgsThroughTick' for consistent handling of
ticks around PrimOps and other 'Id's that cannot be eta-reduced.
See overhauled Note [Ticks and mandatory eta expansion].
- New Note [JoinId vs TailCallInfo] in GHC.Core.SimpleOpt that explains
robustness of JoinId vs fragility of TailCallInfo.
- Allow casts/non-soft-scoped ticks to occur in between a join point
binder and a jump, but only in Core Prep.
See Note [Join points, casts, and ticks] and
Note [Join points, casts, and ticks... in Core Prep]
in GHC.Core.Opt.Simplify.Iteration.
Also update Core Lint to account for this.
See Note [Linting join points with casts or ticks] in GHC.Core.Lint.
- Update 'GHC.Core.Utils.mergeCaseAlts' to avoid pushing a cast in
between a join point binding and its jumps. This fixes #26642.
See the new (MC5) and (MC6) in Note [Merge Nested Cases].
- Update float out to properly handle source note ticks. They are now
properly floated out instead of being discarded.
This increases the number of ticks in certain tests with -g.
Test cases: T26642 and TrickyJoins.
Metric increase due to more source note ticks with -g:
-------------------------
Metric Increase:
libdir
size_hello_artifact
size_hello_unicode
-------------------------
- - - - -
21 changed files:
- compiler/GHC/Cmm/Node.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/FloatIn.hs
- compiler/GHC/Core/Opt/FloatOut.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/Tickish.hs
- testsuite/tests/codeGen/should_compile/debug.stdout
- + testsuite/tests/simplCore/should_compile/T26642.hs
- + testsuite/tests/simplCore/should_compile/TrickyJoins.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Cmm/Node.hs
=====================================
@@ -819,8 +819,8 @@ data CmmTickScope
| SubScope !U.Unique CmmTickScope
-- ^ Constructs a new sub-scope to an existing scope. This allows
- -- us to translate Core-style scoping rules (see @tickishScoped@)
- -- into the Cmm world. Suppose the following code:
+ -- us to translate Core-style scoping rules (see Note [Scoping ticks and counting ticks]
+ -- in GHC.Types.Tickish) into the Cmm world. Suppose the following code:
--
-- tick<1> case ... of
-- A -> tick<2> ...
=====================================
compiler/GHC/Core.hs
=====================================
@@ -1035,6 +1035,143 @@ tail position: A cast changes the type, but the type must be the same. But
operationally, casts are vacuous, so this is a bit unfortunate! See #14610 for
ideas how to fix this.
+Note [Join points, casts, and ticks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Point (1) of Note [Invariants on join points] says that a join point
+must always be tail called. But what precisely does "tail called" mean
+in the presence of (a) casts and (b) ticks?
+
+Example (CAST)
+ let j x = rhs in
+ case y of { True -> j 1 |> co; False -> j 2 }
+
+Example (TICK)
+ let j x = rhs in
+ case y of { True -> <tick t> (j 1); False -> j 2 }
+
+Answer: in Core:
+
+ (JCT1) A tail call cannot be under a cast.
+
+ Thus, in (CAST), `j` is not a join point.
+
+ (JCT2) A tail call cannot be under a cost-centre-scoped tick.
+
+ Thus, in (TICK), `j` is a join point only if tick `t` has soft scope
+ (as per Note [Scoping ticks and counting ticks] in GHC.Tickish).
+
+The Big Reason for these choices is that the Simplifier moves the continuation
+into the RHS of a join point, as explained in Note [Join points and case-of-case]
+in GHC.Core.Opt.Simplify.Iteration:
+
+ K[ join j x = rhs in body ] --> join j x = K[rhs] in K[body]
+
+and K then evaporates when it encounters the tail call:
+
+ K[jump j v] --> jump j v
+
+These transformations:
+ * Are ill-typed if the tail is under a cast, hence (JCT1)
+ * Change cost semantics if the tick has cost-centre scope, hence (JCT2)
+
+The occurrence analyser is careful not to treat an occurrence as a tail call if
+it falls under (JCT1) or (JCT2), by using 'markAllNonTail'.
+
+However, during /code generation/ the key thing about a join point is that
+ * The binding does no allocation
+ * A tail call can be implemented by "adjust stack pointer and jump".
+
+This code-gen strategy works fine even if the "tail call" occurs under
+/arbitrary/ ticks and casts. Hence:
+
+(JCT3) In CorePrep, the occurrence analyser is called with a special flag that
+ /does/ treat `j` as tail-called in Example (CAST) and Example (TICK).
+ Core Prep then uses 'joinPointBinding_maybe', which turns always-tail-called
+ let bindings into join points, thus recovering join-point-hood.
+
+See also Note [Linting join points with casts or ticks] in GHC.Core.Lint.
+
+Examples
+========
+
+ Join point jumps under ticks (#14242, #26157, #26642, #26693)
+ ============================
+ In #26693 we had:
+
+ join { j :: Bool -> Int -> IO (); j _ = guts }
+ in case b of
+ False -> scc<foo> jump j True
+ True -> jump j False
+
+ If we try to push the application to an argument 'arg :: Int' into this
+ expression, we first get:
+
+ join { j :: Bool -> IO (); j _ = guts arg ] }
+ in case b of
+ False -> (scc<foo> jump j True) arg
+ True -> jump j False arg
+
+ We then rely on 'trimJoinCont' to remove the argument. In this case, this fails
+ for the first branch, because 'trimJoinCont' doesn't look through profiling
+ ticks. Were we to address this, it's still not clear what code we would want to
+ end up with, as we don't want to misattribute profiling costs.
+ We could plausibly transform to the following:
+
+ join { j :: Bool -> IO (); j scc_or_null _ = (setSCC# scc_or_null guts) arg ] }
+ in case b of
+ False -> jump j <foo> True
+ True -> jump j null False
+
+ where `setSCC#` is a new primop that would set the current cost centre pointer
+ (or no-op if the given pointer is null). However:
+ - this primop doesn't exist today,
+ - it requires adding an argument to the join point (hence changing its arity)
+
+ Note that soft scope ticks are floated out by the simplifier (see the
+ 'tickishHasSoftScope' guard in 'GHC.Core.Opt.Simplify.Iteration.simplTick'),
+ so don't suffer from the same problem.
+
+ Join point jumps under casts (#14610, #21716, #26422)
+ ============================
+ Consider:
+
+ newtype Age = MkAge Int -- axAge :: Age ~ Int
+ f :: Int -> ...
+
+ f (join j :: Bool -> Age
+ j x = (rhs1 :: Age)
+ in case v of
+ Just x -> ((j x) |> axAge) :: Int
+ Nothing -> rhs2)
+
+ If we try to use the case of case transformation to push 'f' inwards, we would
+ get:
+
+ join j' x = f (rhs1 :: Age)
+ in case v of
+ Just x -> (j' x |> axAge)
+ Nothing -> f rhs2
+
+ which is utterly bogus, as we are now passing an argument of type 'Age' to
+ 'f', which expects an 'Int'.
+
+ The alternative would be to implement a transformation of the form
+
+ join { j x = blah }
+ in case e of
+ False -> j True |> co1
+ True -> j False |> co2
+
+ ====>
+
+ join { j x co = blah |> co }
+ in case e of
+ False -> j True co1
+ True -> j False co2
+
+ by adding a coercion argument to the join point. We don't do this currently.
+
+
Note [Strict fields in Core]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In Core, evaluating a data constructor worker evaluates its strict fields.
=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -106,6 +106,7 @@ import Data.List.NonEmpty ( NonEmpty(..), groupWith, nonEmpty )
import Data.Maybe
import Data.IntMap.Strict ( IntMap )
import qualified Data.IntMap.Strict as IntMap ( lookup, keys, empty, fromList )
+import GHC.Types.Unique.Map
{-
Note [Core Lint guarantee]
@@ -914,8 +915,8 @@ lintCoreExpr (Lit lit)
; return (literalType lit, zeroUE) }
lintCoreExpr (Cast expr co)
- = do { (expr_ty, ue) <- markAllJoinsBad (lintCoreExpr expr)
- -- markAllJoinsBad: see Note [Join points and casts]
+ = do { (expr_ty, ue) <- markAllJoinsUnderCast (lintCoreExpr expr)
+ -- markAllJoinsUnderCast: see Note [Linting join points with casts or ticks]
; lintCoercion co
; lintRole co Representational (coercionRole co)
@@ -929,14 +930,7 @@ lintCoreExpr (Tick tickish expr)
= do { case tickish of
Breakpoint _ _ ids -> forM_ ids $ \id -> lintIdOcc id 0
_ -> return ()
- ; markAllJoinsBadIf block_joins $ lintCoreExpr expr }
- where
- block_joins = not (tickish `tickishScopesLike` SoftScope)
- -- TODO Consider whether this is the correct rule. It is consistent with
- -- the simplifier's behaviour - cost-centre-scoped ticks become part of
- -- the continuation, and thus they behave like part of an evaluation
- -- context, but soft-scoped and non-scoped ticks simply wrap the result
- -- (see Simplify.simplTick).
+ ; markAllJoinsUnderTick tickish $ lintCoreExpr expr }
lintCoreExpr (Let (NonRec tv (Type ty)) body)
| isTyVar tv
@@ -1017,22 +1011,16 @@ lintCoreExpr e@(App _ _)
; return app_pair}
where
- skipTick t = case collectFunSimple e of
- (Var v) -> etaExpansionTick v t
- _ -> tickishFloatable t
- (fun, args, _source_ticks) = collectArgsTicks skipTick e
- -- We must look through source ticks to avoid #21152, for example:
- --
- -- reallyUnsafePtrEquality
- -- = \ @a ->
- -- (src<loc> reallyUnsafePtrEquality#)
- -- @Lifted @a @Lifted @a
+ skipTick t =
+ case collectFunSimple e of
+ Var v -> canCollectArgsThroughTick v t
+ _ -> tickishFloatable t
+ (fun, args, _ticks) = collectArgsTicks skipTick e
+ -- We must look through ticks, otherwise we may fail to spot a
+ -- saturated application. We use 'canCollectArgsThroughTicks', which is
+ -- the same predicate that Core Prep uses.
--
- -- To do this, we use `collectArgsTicks tickishFloatable` to match
- -- the eta expansion behaviour, as per Note [Eta expansion and source notes]
- -- in GHC.Core.Opt.Arity.
- -- Sadly this was not quite enough. So we now also accept things that CorePrep will allow.
- -- See Note [Ticks and mandatory eta expansion]
+ -- See Note [Ticks and mandatory eta expansion] in GHC.CoreToStg.Prep.
lintCoreExpr (Lam var expr)
= markAllJoinsBad $
@@ -1131,7 +1119,7 @@ checkDeadIdOcc id
------------------
lintJoinBndrType :: OutType -- Type of the body
-> OutId -- Possibly a join Id
- -> LintM ()
+ -> LintM ()
-- Checks that the return type of a join Id matches the body
-- E.g. join j x = rhs in body
-- The type of 'rhs' must be the same as the type of 'body'
@@ -1139,13 +1127,29 @@ lintJoinBndrType body_ty bndr
| JoinPoint arity <- idJoinPointHood bndr
, let bndr_ty = idType bndr
, (bndrs, res) <- splitPiTys bndr_ty
- = do let msg =
- hang (text "Join point returns different type than body")
- 2 (vcat [ text "Join bndr:" <+> ppr bndr <+> dcolon <+> ppr (idType bndr)
- , text "Join arity:" <+> ppr arity
- , text "Body type:" <+> ppr body_ty ])
- checkL (length bndrs >= arity) msg
- ensureEqTys body_ty (mkPiTys (drop arity bndrs) res) msg
+ = do let
+ ty_msg =
+ hang (text "Join point returns different type than body")
+ 2 (vcat [ text "Join bndr:" <+> ppr bndr <+> dcolon <+> ppr (idType bndr)
+ , text "Join arity:" <+> ppr arity
+ , text "Body type:" <+> ppr body_ty ])
+ arity_msg =
+ hang (text "Join point is not saturated")
+ 2 (vcat [ text "Join bndr:" <+> ppr bndr <+> dcolon <+> ppr (idType bndr)
+ , text "Join arity:" <+> ppr arity
+ , text "Arguments:" <+> ppr bndrs ])
+
+ mb_join_info <- lookupJoinId bndr
+ case mb_join_info of
+ Nothing ->
+ pprPanic "lintJoinBndrType: valid join marked bad" (ppr bndr)
+ Just (_, occ_info) -> do
+ checkL (length bndrs >= arity) arity_msg
+
+ -- See Note [Linting join points with casts or ticks] for why
+ -- we skip this check if there is an intervening cast.
+ unless (occ_info == JoinOccUnderCast) $
+ ensureEqTys body_ty (mkPiTys (drop arity bndrs) res) ty_msg
| otherwise
= return ()
@@ -1156,11 +1160,11 @@ checkJoinOcc var n_args
| JoinPoint join_arity_occ <- idJoinPointHood var
= do { mb_join_arity_bndr <- lookupJoinId var
; case mb_join_arity_bndr of {
- NotJoinPoint -> do { join_set <- getValidJoins
- ; addErrL (text "join set " <+> ppr join_set $$
- invalidJoinOcc var) } ;
+ Nothing -> do { valid_joins <- getValidJoins
+ ; addErrL (text "valid joins:" <+> ppr valid_joins $$
+ invalidJoinOcc var) } ;
- JoinPoint join_arity_bndr ->
+ Just (join_arity_bndr, _join_occ) ->
do { checkL (join_arity_bndr == join_arity_occ) $
-- Arity differs at binding site and occurrence
@@ -1333,39 +1337,34 @@ checkLinearity body_ue lam_var =
return body_ue'
Nothing -> return body_ue -- A type variable
-{- Note [Join points and casts]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-You might think that this should be OK:
- join j x = rhs
- in (case e of
- A -> alt1
- B x -> (jump j x) |> co)
+{- Note [Linting join points with casts or ticks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+As per Note [Join points, casts, and ticks] in GHC.Core, we have to be careful
+when a cast or tick occurs in between a join point binding and a corresponding
+join point occurrence.
-You might think that, since the cast is ultimately erased, the jump to
-`j` should still be OK as a join point. But no! See #21716. Suppose
+Generally speaking:
- newtype Age = MkAge Int -- axAge :: Age ~ Int
- f :: Int -> ... -- f strict in it's first argument
+ - The simplifier cannot handle intervening casts or non-soft-scope ticks, so
+ we must check for that to avoid producing invalid Core.
+ - However, as per (JCT3), Core Prep **can** produce join points with
+ intervening casts or non-soft-scope ticks, which means we must expect them.
-and consider the expression
+Casts present an additional challenge. Consider for example:
- f (join j :: Bool -> Age
- j x = (rhs1 :: Age)
- in case v of
- Just x -> (j x |> axAge :: Int)
- Nothing -> rhs2)
+ join { j :: Bool -> Age; j x = (blah :: Age) }
+ in case e of
+ False -> j True |> (co1 :: Age ~ Int)
+ True -> other :: Int
-Then, if the Simplifier pushes the strict call into the join points
-and alternatives we'll get
+It is **not** the case that the type of 'blah' is the same as the type of
+the body of the join point binding! Indeed:
- join j' x = f (rhs1 :: Age)
- in case v of
- Just x -> j' x |> axAge
- Nothing -> f rhs2
+ - RHS of the join-point binding: blah :: Age
+ - The body of the join point has type Int.
-Utterly bogus. `f` expects an `Int` and we are giving it an `Age`.
-No no no. Casts destroy the tail-call property. Henc markAllJoinsBad
-in the (Cast expr co) case of lintCoreExpr.
+So we skip the 'exprType(join_rhs) == exprType(join_body)' check when casts
+occur in between.
Note [No alternatives lint check]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2977,9 +2976,10 @@ data LintEnv
-- type variables, and coercion variables)
-- Used at an occurrence of the InVar
- , le_joins :: IdSet -- Join points in scope that are valid
- -- A subset of the InScopeSet in le_subst
- -- See Note [Join points]
+ , le_joins :: UniqMap Id JoinOcc
+ -- ^ Join points in scope that are valid
+ -- A subset of the InScopeSet in le_subst
+ -- See Note [Join points]
, le_ue_aliases :: NameEnv UsageEnv
-- See Note [Linting linearity]
@@ -2999,6 +2999,7 @@ data LintFlags
, lf_check_linearity :: Bool -- ^ See Note [Linting linearity]
, lf_check_fixed_rep :: Bool -- ^ See Note [Checking for representation polymorphism]
, lf_check_rubbish_lits :: Bool -- ^ See Note [Checking for rubbish literals]
+ , lf_allow_weak_joins :: Bool -- ^ See Note [Linting join points with casts or ticks]
}
-- See Note [Checking StaticPtrs]
@@ -3307,6 +3308,20 @@ data LintLocInfo
| InCo Coercion -- Inside a coercion
| InAxiom (CoAxiom Branched) -- Inside a CoAxiom
+-- | Does this join point 'Id' occur inside a cast?
+--
+-- See Note [Linting join points with casts or ticks].
+data JoinOcc
+ -- | A normal occurrence of a 'JoinId'.
+ = NormalJoinOcc
+ -- | An occurrence of a 'JoinId' with an intervening cast between the
+ -- join point binder definition and the jump.
+ | JoinOccUnderCast
+ deriving stock Eq
+instance Outputable JoinOcc where
+ ppr NormalJoinOcc = text "Normal"
+ ppr JoinOccUnderCast = text "UnderCast"
+
data LintConfig = LintConfig
{ l_diagOpts :: !DiagOpts -- ^ Diagnostics opts
, l_platform :: !Platform -- ^ Target platform
@@ -3328,7 +3343,7 @@ initL cfg m
env = LE { le_flags = l_flags cfg
, le_subst = mkEmptySubst (mkInScopeSetList vars)
, le_in_vars = mkVarEnv [ (v,(v, varType v)) | v <- vars ]
- , le_joins = emptyVarSet
+ , le_joins = emptyUniqMap
, le_loc = []
, le_ue_aliases = emptyNameEnv
, le_platform = l_platform cfg
@@ -3428,11 +3443,11 @@ addInScopeId in_id out_ty thing_inside
in unLintM (thing_inside out_id) env' errs
where
- add env@(LE { le_in_vars = id_vars, le_joins = join_set
+ add env@(LE { le_in_vars = id_vars, le_joins = valid_joins
, le_ue_aliases = aliases, le_subst = subst })
= (out_id, env1)
where
- env1 = env { le_in_vars = in_vars', le_joins = join_set', le_ue_aliases = aliases' }
+ env1 = env { le_in_vars = in_vars', le_joins = valid_joins', le_ue_aliases = aliases' }
in_vars' = extendVarEnv id_vars in_id (in_id, out_ty)
aliases' = delFromNameEnv aliases (idName in_id)
@@ -3446,9 +3461,9 @@ addInScopeId in_id out_ty thing_inside
out_id | isEmptyTCvSubst subst = in_id
| otherwise = setIdType in_id out_ty
- join_set'
- | isJoinId out_id = extendVarSet join_set in_id -- Overwrite with new arity
- | otherwise = delVarSet join_set in_id -- Remove any existing binding
+ valid_joins'
+ | isJoinId out_id = addToUniqMap valid_joins in_id NormalJoinOcc -- Overwrite with new arity
+ | otherwise = delFromUniqMap valid_joins in_id -- Remove any existing binding
addInScopeTyCoVar :: InTyCoVar -> OutType -> (OutTyCoVar -> LintM a) -> LintM a
-- This function clones to avoid shadowing of TyCoVars
@@ -3485,13 +3500,35 @@ extendTvSubstL tv ty m
markAllJoinsBad :: LintM a -> LintM a
markAllJoinsBad m
- = LintM $ \ env errs -> unLintM m (env { le_joins = emptyVarSet }) errs
+ = LintM $ \ env errs -> unLintM m (env { le_joins = emptyUniqMap }) errs
+
+-- | Mark all join points as occurring under a tick.
+--
+-- See Note [Linting join points with casts or ticks].
+markAllJoinsUnderTick :: CoreTickish -> LintM a -> LintM a
+markAllJoinsUnderTick tick m
+ = LintM $ \ env errs ->
+ let env' = if tickishHasSoftScope tick || lf_allow_weak_joins (le_flags env)
+ then env
+ else env { le_joins = emptyUniqMap }
+ in unLintM m env' errs
+
+-- | Mark all join points as occurring under a cast.
+--
+-- See Note [Linting join points with casts or ticks].
+markAllJoinsUnderCast :: LintM a -> LintM a
+markAllJoinsUnderCast m
+ = LintM $ \ env errs ->
+ let !env' = if lf_allow_weak_joins (le_flags env)
+ then env { le_joins = fmap (const JoinOccUnderCast) (le_joins env) }
+ else env { le_joins = emptyUniqMap }
+ in unLintM m env' errs
markAllJoinsBadIf :: Bool -> LintM a -> LintM a
markAllJoinsBadIf True m = markAllJoinsBad m
markAllJoinsBadIf False m = m
-getValidJoins :: LintM IdSet
+getValidJoins :: LintM (UniqMap Id JoinOcc)
getValidJoins = LintM (\ env errs -> fromBoxedLResult (Just (le_joins env), errs))
getSubst :: LintM Subst
@@ -3552,14 +3589,14 @@ lintVarOcc v_occ
| otherwise
= return ()
-lookupJoinId :: Id -> LintM JoinPointHood
+lookupJoinId :: Id -> LintM (Maybe (JoinArity, JoinOcc))
-- Look up an Id which should be a join point, valid here
-- If so, return its arity, if not return Nothing
lookupJoinId id
- = do { join_set <- getValidJoins
- ; case lookupVarSet join_set id of
- Just id' -> return (idJoinPointHood id')
- Nothing -> return NotJoinPoint }
+ = do { valid_joins <- getValidJoins
+ ; case lookupUniqMap valid_joins id of
+ Just join_occ -> return $ Just (idJoinArity id, join_occ)
+ Nothing -> return Nothing }
addAliasUE :: OutId -> UsageEnv -> LintM a -> LintM a
addAliasUE id ue thing_inside = LintM $ \ env errs ->
=====================================
compiler/GHC/Core/Opt/Arity.hs
=====================================
@@ -90,7 +90,6 @@ import GHC.Utils.Misc
import Data.List.NonEmpty ( nonEmpty )
import qualified Data.List.NonEmpty as NE
-import Data.Maybe( isJust )
{-
************************************************************************
@@ -2835,21 +2834,6 @@ tryEtaReduce rec_ids bndrs body eval_sd
ok_arg _ _ _ _ = Nothing
--- | Can we eta-reduce the given function
--- See Note [Eta reduction soundness], criteria (B), (J), and (W).
-cantEtaReduceFun :: Id -> Bool
-cantEtaReduceFun fun
- = hasNoBinding fun -- (B)
- -- Don't undersaturate functions with no binding.
-
- || isJoinId fun -- (J)
- -- Don't undersaturate join points.
- -- See Note [Invariants on join points] in GHC.Core, and #20599
-
- || (isJust (idCbvMarks_maybe fun)) -- (W)
- -- Don't undersaturate StrictWorkerIds.
- -- See Note [CBV Function Ids: overview] in GHC.Types.Id.Info.
-
{- *********************************************************************
* *
=====================================
compiler/GHC/Core/Opt/FloatIn.hs
=====================================
@@ -375,7 +375,7 @@ We don't float lets inwards past an SCC.
-}
fiExpr platform to_drop (_, AnnTick tickish expr)
- | tickish `tickishScopesLike` SoftScope
+ | tickishHasSoftScope tickish
= Tick tickish (fiExpr platform to_drop expr)
| otherwise -- Wimp out for now - we could push values in
=====================================
compiler/GHC/Core/Opt/FloatOut.hs
=====================================
@@ -365,25 +365,28 @@ floatExpr lam@(Lam (TB _ lam_spec) _)
(add_to_stats fs floats, floats, mkLams bndrs body') }
floatExpr (Tick tickish expr)
- | tickish `tickishScopesLike` SoftScope -- not scoped, can just float
+ -- If possible, float out past the tick
+ | let float_out_of_tick
+ -- See Note [Floating past breakpoints]
+ | Breakpoint{} <- tickish
+ = True
+ | otherwise
+ -- We can float code out of non-scoped ticks
+ = tickishHasNoScope tickish
+ , float_out_of_tick
= case (floatExpr expr) of { (fs, floating_defns, expr') ->
(fs, floating_defns, Tick tickish expr') }
- | not (tickishCounts tickish) || tickishCanSplit tickish
- = case (floatExpr expr) of { (fs, floating_defns, expr') ->
- let -- Annotate bindings floated outwards past an scc expression
- -- with the cc. We mark that cc as "duplicated", though.
- annotated_defns = wrapTick (mkNoCount tickish) floating_defns
+ -- We can't move code out of the tick
+ | otherwise
+ = assert (not (tickishCounts tickish) || tickishCanSplit tickish) $
+ case (floatExpr expr) of { (fs, floating_defns, expr') ->
+ -- Wrap floated code with the correct tick scope, but using 'mkNoCount'
+ -- to ensure we don't duplicate counters.
+ let annotated_defns = wrapTick (mkNoCount tickish) floating_defns
in
(fs, annotated_defns, Tick tickish expr') }
- -- See Note [Floating past breakpoints]
- | Breakpoint{} <- tickish
- = case (floatExpr expr) of { (fs, floating_defns, expr') ->
- (fs, floating_defns, Tick tickish expr') }
-
- | otherwise
- = pprPanic "floatExpr tick" (ppr tickish)
floatExpr (Cast expr co)
= case (floatExpr expr) of { (fs, floating_defns, expr') ->
@@ -661,7 +664,8 @@ partitionByLevel (Level major minor) (FB tops defns)
wrapTick :: CoreTickish -> FloatBinds -> FloatBinds
wrapTick t (FB tops defns)
- = FB (mapBag wrap_bind tops)
+ = assert (not $ tickishCounts t) $
+ FB (mapBag wrap_bind tops)
(M.map (M.map wrap_defns) defns)
where
wrap_defns = mapBag wrap_one
@@ -672,10 +676,13 @@ wrapTick t (FB tops defns)
wrap_one (FloatLet bind) = FloatLet (wrap_bind bind)
wrap_one (FloatCase e b c bs) = FloatCase (maybe_tick e) b c bs
- maybe_tick e | exprIsHNF e = tickHNFArgs t e
- | otherwise = mkTick t e
- -- we don't need to wrap a tick around an HNF when we float it
- -- outside a tick: that is an invariant of the tick semantics
+ maybe_tick
+ -- We don't need to wrap an SCC tick around HNFs that we floated out of
+ -- the SCC, as that is an invariant of the semantics for SCCs.
-- Conversely, inlining of HNFs inside an SCC is allowed, and
-- indeed the HNF we're floating here might well be inlined back
-- again, and we don't want to end up with duplicate ticks.
+ | tickishPlace t == PlaceCostCentre
+ = mkTickNoHNF t
+ | otherwise
+ = mkTick t
=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -27,7 +27,7 @@ core expression with (hopefully) improved usage information.
module GHC.Core.Opt.OccurAnal (
occurAnalysePgm,
- occurAnalyseExpr,
+ occurAnalyseExpr, occurAnalyseExpr_Prep,
zapLambdaBndrs
) where
@@ -85,6 +85,15 @@ occurAnalyseExpr expr = expr'
where
WUD _ expr' = occAnal initOccEnv expr
+-- | A version of 'occurAnalyseExpr' suitable for CorePrep.
+--
+-- Different from 'occurAnalyseExpr' due to (JCT3)
+-- in Note [Join points, casts, and ticks] in GHC.Core.
+occurAnalyseExpr_Prep :: CoreExpr -> CoreExpr
+occurAnalyseExpr_Prep expr = expr'
+ where
+ WUD _ expr' = occAnal (initOccEnv { occ_allow_weak_joins = True }) expr
+
occurAnalysePgm :: Module -- Used only in debug output
-> (Id -> Bool) -- Active unfoldings
-> (ActivationGhc -> Bool) -- Active rules
@@ -2300,12 +2309,8 @@ occ_anal_lam_tail env (Cast expr co)
Var {} | isRhsEnv env -> markAllMany usage1
_ -> usage1
- -- usage3: you might think this was not necessary, because of
- -- the markAllNonTail in adjustTailUsage; but not so! For a
- -- join point, adjustTailUsage doesn't do this; yet if there is
- -- a cast, we must! Also: why markAllNonTail? See
- -- GHC.Core.Lint: Note Note [Join points and casts]
- usage3 = markAllNonTail usage2
+ -- usage3: see (JCT1) in Note [Join points, casts, and ticks] in GHC.Core.
+ usage3 = markAllNonTail_CastOrTick env usage2
in WUD usage3 (Cast expr' co)
@@ -2587,42 +2592,39 @@ But it is not necessary to gather CoVars from the types of other binders.
-}
occAnal env (Tick tickish body)
- = WUD usage' (Tick tickish body')
+ = WUD usage2 (Tick tickish body')
where
WUD usage body' = occAnal env body
- usage'
- | tickish `tickishScopesLike` SoftScope
- = usage -- For soft-scoped ticks (including SourceNotes) we don't want
- -- to lose join-point-hood, so we don't mess with `usage` (#24078)
+ usage1
+ -- We don't want to lose join-point-hood. We can move soft-scoped ticks
+ -- out of the way, so don't mess with `usage` (#24078).
+ | tickishHasSoftScope tickish
+ = usage
- -- For a non-soft tick scope, we can inline lambdas only, so we
- -- abandon tail calls, and do markAllInsideLam too: usage_lam
+ -- Otherwise, we can inline lambdas only, so use 'markAllInsideLam'.
+ | otherwise
+ = markAllNonTail_CastOrTick env $ markAllInsideLam usage
+ -- markAllNonTail_CastOrTick: abandon tail calls.
+ -- See (JCT2) in Note [Join points, casts, and ticks] in GHC.Core.
+ usage2
| Breakpoint _ _ ids <- tickish
= -- Never substitute for any of the Ids in a Breakpoint
- addManyOccs usage_lam (mkVarSet ids)
+ addManyOccs usage1 (mkVarSet ids)
| otherwise
- = usage_lam
-
- usage_lam = markAllNonTail (markAllInsideLam usage)
-
- -- TODO There may be ways to make ticks and join points play
- -- nicer together, but right now there are problems:
- -- let j x = ... in tick<t> (j 1)
- -- Making j a join point may cause the simplifier to drop t
- -- (if the tick is put into the continuation). So we don't
- -- count j 1 as a tail call.
- -- See #14242.
+ = usage1
occAnal env (Cast expr co)
- = let (WUD usage expr') = occAnal env expr
- usage1 = addManyOccs usage (coVarsOfCo co)
- -- usage2: see Note [Gather occurrences of coercion variables]
- usage2 = markAllNonTail usage1
- -- usage3: calls inside expr aren't tail calls any more
- in WUD usage2 (Cast expr' co)
+ = let
+ WUD usage expr' = occAnal env expr
+ -- usage1: see Note [Gather occurrences of coercion variables]
+ usage1 = addManyOccs usage (coVarsOfCo co)
+ -- usage2: see (JCT1) in Note [Join points, casts, and ticks] in GHC.Core.
+ usage2 = markAllNonTail_CastOrTick env usage1
+ in
+ WUD usage2 (Cast expr' co)
occAnal env app@(App _ _)
= occAnalApp env (collectArgsTicks tickishFloatable app)
@@ -2936,6 +2938,11 @@ data OccEnv
, occ_rule_act :: ActivationGhc -> Bool -- Which rules are active
-- See Note [Finding rule RHS free vars]
+ , occ_allow_weak_joins :: !Bool
+ -- ^ Allow a join point jump to occur inside casts or profiling ticks?
+ --
+ -- See (JCT3) in Note [Join points, casts, and ticks] in GHC.Core.Opt.
+
-- See Note [The binder-swap substitution]
-- If x :-> (y, co) is in the env,
-- then please replace x by (y |> mco)
@@ -3003,6 +3010,8 @@ initOccEnv
, occ_unf_act = \_ -> True
, occ_rule_act = \_ -> True
+ , occ_allow_weak_joins = False
+
, occ_join_points = emptyVarEnv
, occ_bs_env = emptyVarEnv
, occ_bs_rng = emptyVarSet
@@ -3026,6 +3035,15 @@ setScrutCtxt !env alts
-- non-default alternative. That in turn influences
-- pre/postInlineUnconditionally. Grep for "occ_int_cxt"!
+-- | Mark occurrences under a cast/non-soft-scope tick as non-tail-called,
+-- except if 'occ_allow_weak_joins = True'.
+--
+-- See Note [Join points, casts, and ticks] in GHC.Core.
+markAllNonTail_CastOrTick :: OccEnv -> UsageDetails -> UsageDetails
+markAllNonTail_CastOrTick env =
+ markAllNonTailIf
+ (not $ occ_allow_weak_joins env)
+
{- Note [The OccEnv for a right hand side]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
How do we create the OccEnv for a RHS (in mkRhsOccEnv)?
@@ -4075,7 +4093,10 @@ okForJoinPoint :: TopLevelFlag -> Id -> TailCallInfo -> Bool
-- See Note [Invariants on join points]; invariants cited by number below.
-- Invariant 2 is always satisfiable by the simplifier by eta expansion.
okForJoinPoint lvl bndr tail_call_info
- | isJoinId bndr -- A current join point should still be one!
+ -- A current join point should still be one!
+ --
+ -- See Note [JoinId vs TailCallInfo] in GHC.Core.SimpleOpt.
+ | isJoinId bndr
= warnPprTrace lost_join "Lost join point" lost_join_doc $
True
| valid_join
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -814,9 +814,9 @@ prepareRhs env top_lvl occ rhs0
= return (emptyLetFloats, Var fun)
anfise (Tick t rhs)
- -- We want to be able to float bindings past this
- -- tick. Non-scoping ticks don't care.
- | tickishScoped t == NoScope
+ -- We want to be able to float bindings past this tick.
+ -- Non-scoping ticks don't care.
+ | tickishHasNoScope t
= do { (floats, rhs') <- anfise rhs
; return (floats, Tick t rhs') }
@@ -1413,7 +1413,7 @@ simplTick env tickish expr cont
-- bottom, then rebuildCall will discard the continuation.
--------------------------
--- | tickishScoped tickish && not (tickishCounts tickish)
+-- | not (tickishHasNoScope tickish) && not (tickishCounts tickish)
-- = simplExprF env expr (TickIt tickish cont)
-- XXX: we cannot do this, because the simplifier assumes that
-- the context can be pushed into a case with a single branch. e.g.
@@ -1425,12 +1425,11 @@ simplTick env tickish expr cont
-- simplifier iterations that necessary in some cases.
--------------------------
- -- For unscoped or soft-scoped ticks, we are allowed to float in new
- -- cost, so we simply push the continuation inside the tick. This
- -- has the effect of moving the tick to the outside of a case or
- -- application context, allowing the normal case and application
- -- optimisations to fire.
- | tickish `tickishScopesLike` SoftScope
+ -- For soft-scoped ticks, we are allowed to float in new cost, so we simply
+ -- push the continuation inside the tick. This has the effect of moving the
+ -- tick to the outside of a case or application context, allowing the normal
+ -- 'case' and 'application' optimisations to fire.
+ | tickishHasSoftScope tickish
= do { (floats, expr') <- simplExprF env expr cont
; return (floats, mkTick tickish expr')
}
@@ -1459,14 +1458,14 @@ simplTick env tickish expr cont
_other -> Nothing
where (ticks, expr0) = stripTicksTop movable (Tick tickish expr)
movable t = not (tickishCounts t) ||
- t `tickishScopesLike` NoScope ||
+ tickishHasNoScope t ||
tickishCanSplit t
tickScrut e = foldr mkTick e ticks
-- Alternatives get annotated with all ticks that scope in some way,
-- but we don't want to count entries.
tickAlt (Alt c bs e) = Alt c bs (foldr mkTick e ts_scope)
ts_scope = map mkNoCount $
- filter (not . (`tickishScopesLike` NoScope)) ticks
+ filter (not . tickishHasNoScope) ticks
no_floating_past_tick =
do { let (inc,outc) = splitCont cont
@@ -2180,16 +2179,15 @@ evaluation context E):
As is evident from the example, there are two components to this behavior:
- 1. When entering the RHS of a join point, copy the context inside.
- 2. When a join point is invoked, discard the outer context.
+ (wrapJoinCont) When entering the RHS of a join point, copy the context inside.
+ (trimJoinCont) When a join point is invoked, discard the outer context.
We need to be very careful here to remain consistent---neither part is
optional!
-We need do make the continuation E duplicable (since we are duplicating it)
+We need to make the continuation E duplicable (since we are duplicating it)
with mkDupableCont.
-
Note [Join points with -fno-case-of-case]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Supose case-of-case is switched off, and we are simplifying
@@ -2213,7 +2211,8 @@ case-of-case we may then end up with this totally bogus result
This would be OK in the language of the paper, but not in GHC: j is no longer
a join point. We can only do the "push continuation into the RHS of the
join point j" if we also push the continuation right down to the /jumps/ to
-j, so that it can evaporate there. If we are doing case-of-case, we'll get to
+j, so that it can evaporate there (trimJoinCont). Then, if we are doing
+case-of-case, we'll get to:
join x = case <j-rhs> of <outer-alts> in
case y of
@@ -3656,9 +3655,11 @@ addBinderUnfolding env bndr unf
= modifyInScope env (bndr `setIdUnfolding` unf)
zapBndrOccInfo :: Bool -> Id -> Id
--- Consider case e of b { (a,b) -> ... }
--- Then if we bind b to (a,b) in "...", and b is not dead,
--- then we must zap the deadness info on a,b
+-- ^ Consider:
+-- > case e of e' { (a,b) -> rhs }
+--
+-- We bind @e'@ to @(a,b)@ in @rhs@. If @e'@ is not dead,
+-- then we must zap the deadness info on @a@ and @b@.
zapBndrOccInfo keep_occ_info pat_id
| keep_occ_info = pat_id
| otherwise = zapIdOccInfo pat_id
=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -437,7 +437,7 @@ simple_app env e@(Lam {}) []
simple_app env (Tick t e) as
-- Okay to do "(Tick t e) x ==> Tick t (e x)"?
- | t `tickishScopesLike` SoftScope
+ | tickishHasSoftScope t
= mkTick t $ simple_app env e as
-- (let x = e in b) a1 .. an => let x = e in (b a1 .. an)
@@ -1059,23 +1059,33 @@ and again its arity increases (#15517)
-}
--- | Returns Just (bndr,rhs) if the binding is a join point:
--- If it's a JoinId, just return it
--- If it's not yet a JoinId but is always tail-called,
--- make it into a JoinId and return it.
+-- | Returns @Just (bndr, rhs)@ if the binding is a join point, or can be made
+-- into a join poin. Returns @Nothing@ otherwise.
+--
+-- - If the input binder is a 'JoinId', just return it;
+-- - if it's not yet a 'JoinId' but is always tail-called,
+-- make it into a 'JoinId' and return that.
+--
-- In the latter case, eta-expand the RHS if necessary, to make the
--- lambdas explicit, as is required for join points
+-- lambdas explicit, as is required for join points.
+--
+-- Precondition: the 'TailCallInfo' of the 'InBndr' is conservative:
--
--- Precondition: the InBndr has been occurrence-analysed,
--- so its OccInfo is valid
+-- - if it says 'AlwaysTailCalled', it is definitely always tail called,
+-- - if it says 'NoTailCallInfo', then we're not sure.
+--
+-- See Note [JoinId vs TailCallInfo].
joinPointBinding_maybe :: InBndr -> InExpr -> Maybe (InBndr, InExpr)
joinPointBinding_maybe bndr rhs
| not (isId bndr)
= Nothing
+ -- Being a JoinId is robust: preserve that. See Note [JoinId vs TailCallInfo].
| isJoinId bndr
= Just (bndr, rhs)
+ -- If the 'TailCallInfo' of 'bndr' says 'AlwaysTailCalled', then we know for
+ -- sure that it can be made into a join point.
| AlwaysTailCalled join_arity <- tailCallInfo (idOccInfo bndr)
, (bndrs, body) <- etaExpandToJoinPoint join_arity rhs
, let str_sig = idDmdSig bndr
@@ -1091,6 +1101,48 @@ joinPointBindings_maybe :: [(InBndr, InExpr)] -> Maybe [(InBndr, InExpr)]
joinPointBindings_maybe bndrs
= mapM (uncurry joinPointBinding_maybe) bndrs
+{- Note [JoinId vs TailCallInfo]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+* Occurrence information is /fundamentally fragile/; that is, it may
+ be invalidated by the Simplifier.
+ Example 1:
+ \y -> let x = y in ...x..x...
+ Here `y` is marked "occurs exactly once" but, after inlining `x`,
+ `y` now occurs many times.
+ Example 2:
+ f (let h x = ... in case y of { True -> h 1; False -> h 2 })
+ Here `h` is tail-called; but if `f` is strict we could transform to
+ let h x = ... in
+ case y of { True -> f (h 1); False -> f (h 2) }
+ Now `h` is not tail called any more.
+
+ Exception: Dead things (with no occurrences) usually stay dead.
+ There are exceptions e.g.
+ case x of y { (a,b) -> case y of (p,q) -> p }
+ Here `a` and `b` look dead, but we may well transform to
+ case x of y { (a,b) -> a }
+
+ Because occurrence info is fragile, we recompute occurrence info
+ (including tail call info) before each run of the Simplifier.
+
+ Whenever the simplifier performs a transformation that **might** invalidate
+ occurrence information, it calls 'zapFragileIdInfo'. This sets the
+ 'TailCallInfo' to 'NoTailCallInfo' (among other things).
+
+* Being a JoinId is /robust/, and is rigorously maintained by the
+ Simplifier. In Example 2 above, if `h` was marked as a JoinId,
+ that transformation would not have happened. Instead we'd have
+ transformed to
+ let h x = f (...) in
+ case y of { True -> h 1; False -> h 2 }
+
+ The Simplifier takes an Id whose occurrences are marked as
+ `AlwaysTailCalled` and turns it into robust `JoinId`. This is
+ done by `joinPointBinding_maybe`.
+
+ There is one exception: float-out, the only caller of 'zapJoinId'.
+ See Note [Zapping JoinId when floating].
+-}
{- *********************************************************************
* *
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -34,7 +34,8 @@ module GHC.Core.Utils (
exprIsTickedString, exprIsTickedString_maybe,
exprIsTopLevelBindable,
exprIsUnaryClassFun, isUnaryClassId,
- altsAreExhaustive, etaExpansionTick,
+ altsAreExhaustive,
+ canCollectArgsThroughTick, cantEtaReduceFun,
-- * Equality
cheapEqExpr, cheapEqExpr', diffBinds,
@@ -680,7 +681,7 @@ mergeCaseAlts :: CoreExpr -> Id -> [CoreAlt] -> Maybe ([CoreBind], [CoreAlt])
mergeCaseAlts scrut outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
| Just (joins, inner_alts) <- go deflt_rhs
, Just aux_binds <- mk_aux_binds joins
- = Just ( aux_binds ++ joins, mergeAlts outer_alts inner_alts )
+ = Just (aux_binds ++ joins, mergeAlts outer_alts inner_alts )
-- NB: mergeAlts gives priority to the left
-- case x of
-- A -> e1
@@ -727,7 +728,7 @@ mergeCaseAlts scrut outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
, Just tc <- tyConAppTyCon_maybe type_arg
, Just (dc1:dcs) <- tyConDataCons_maybe tc -- At least one data constructor
, dcs `lengthAtMost` 3 -- Arbitrary
- = return ( [], mk_alts dc1 dcs)
+ = return ([], mk_alts dc1 dcs)
where
mk_lit dc = mkLitIntUnchecked $ toInteger $ dataConTagZ dc
mk_rhs dc = Var (dataConWorkId dc)
@@ -748,11 +749,16 @@ mergeCaseAlts scrut outer_bndr (Alt DEFAULT _ deflt_rhs : outer_alts)
| otherwise
= Nothing
- -- We don't want ticks to get in the way; just push them inwards.
- -- (This happens when you add SourceTicks e.g. GHC.Num.Integer.integerLt#)
+ -- Push ticks **inwards** (when possible).
+ -- See (MC5) in Note [Merge Nested Cases].
go (Tick t body)
- = do { (joins, alts) <- go body
- ; return (joins, [Alt con bs (Tick t rhs) | Alt con bs rhs <- alts]) }
+ = do { (joins, alts) <- go body -- (MC4): any join points inside are floated out of the tick.
+
+ -- Abort if this would put a non-soft-scope tick in between
+ -- a join point binding and its jumps. See (MC6).
+ ; guard $ null joins || tickishHasSoftScope t
+ ; return (joins, [Alt con bs (mkTick t rhs) | Alt con bs rhs <- alts])
+ }
go _ = Nothing
@@ -974,12 +980,74 @@ Wrinkles
So `mergeCaseAlts` floats out any join points. It doesn't float out
non-join-points unless the /outer/ case has just one alternative; doing
- so would risk more allocation
+ so would risk more allocation.
+
+ Note also that `mergeCaseAlts` floats join points out of ticks, for which
+ we need to be extra careful; see (MC6).
Floating out join points isn't entirely straightforward.
See Note [Floating join points out of DEFAULT alternatives]
-(MC5) See Note [Cascading case merge]
+(MC5) We want to move ticks out of the way if possible, to prevent them from
+ inhibiting optimisation. For example, say we have:
+
+ case expensive of r {
+ C1 -> rhs1; -- happy path
+ _ -> scctick<doEdgeCase> (case r of { C2 -> rhs2; C3 -> rhs3 })
+ }
+
+ In this situation, we push the "doEdgeCase" tick **inwards** and proceed
+ to merge cases, like so:
+
+ case expensive of
+ C1 -> rhs1
+ C2 -> scctick<doEdgeCase> rhs2
+ C3 -> scctick<doEdgeCase> rhs3
+
+ This preserves the tick semantics (see Note [Scoping ticks and counting ticks]
+ in GHC.Types.Tickish), because this transformation:
+
+ 1. preserves counts,
+ 2. does not move cost in or out of the tick scope.
+
+ (1) is clear: we will tick 'doEdgeCase' exactly in the C2/C3 alternatives,
+ and we won't otherwise.
+ For (2), recall that case is strict in Core. We already evaluated 'expensive',
+ so re-scrutinising 'r' is free.
+
+ This means that, perhaps surprisingly, this transformation is valid for
+ **all** ticks, including non-floatable ones.
+
+ In contrast, we would not want to move the tick outwards, because this:
+
+ - will lead to additional counting of 'doEdgeCase' in the 'C1' (happy path) case,
+ - risks attributing the cost of evaluating 'expensive' to 'doEdgeCase'.
+
+(MC6) There is a dangerous interaction between (MC4) and (MC5), which can lead
+ to invalid Core (as reported in #26642, #26929). Suppose we have:
+
+ case f x of r ->
+ scctick<foo>
+ join j y = rhs in
+ case r of { C1 -> j 1; C2 -> bar }
+
+ If we naively carried out (MC4) and (MC5) together, this would result in:
+
+ join j y = rhs in
+ case f x of
+ C1 -> scctick<foo> (j 1)
+ C2 -> scctick<foo> bar
+
+ This has moved the tick in between the join point binding 'j' and the
+ join point jump, which is invalid as per Note [Join points, casts, and ticks]
+ in GHC.Core. The simplifier cannot deal with such Core, resulting in #26642.
+
+ The solution: abort whenever we would position a non-soft-scope tick
+ inside a join point in this manner.
+ An alternative would be to float the tick outwards, but as we saw in (MC5)
+ this risks a grave misattribution of profiling costs, so we don't do that.
+
+(MC7) See Note [Cascading case merge]
See also Note [Example of case-merging and caseRules] in GHC.Core.Opt.Simplify.Utils
@@ -2076,14 +2144,31 @@ altsAreExhaustive (Alt con1 _ _ : alts)
-- we behave conservatively here -- I don't think it's important
-- enough to deserve special treatment
--- | Should we look past this tick when eta-expanding the given function?
+-- | Should we look past this tick when collecting arguments
+-- for the given function?
--
-- See Note [Ticks and mandatory eta expansion]
--- Takes the function we are applying as argument.
-etaExpansionTick :: Id -> GenTickish pass -> Bool
-etaExpansionTick id t
- = hasNoBinding id &&
- ( tickishFloatable t || isProfTick t )
+canCollectArgsThroughTick
+ :: Id -- ^ function at the head of the application
+ -> GenTickish pass -- ^ tick we want to collect arguments past
+ -> Bool
+canCollectArgsThroughTick id t
+ = tickishFloatable t || cantEtaReduceFun id
+
+-- | Can we eta-reduce the given function?
+-- See Note [Eta reduction soundness], criteria (B), (J), and (W).
+cantEtaReduceFun :: Id -> Bool
+cantEtaReduceFun fun
+ = hasNoBinding fun -- (B)
+ -- Don't undersaturate functions with no binding.
+
+ || isJoinId fun -- (J)
+ -- Don't undersaturate join points.
+ -- See Note [Invariants on join points] in GHC.Core, and #20599
+
+ || isJust (idCbvMarks_maybe fun) -- (W)
+ -- Don't undersaturate StrictWorkerIds.
+ -- See Note [CBV Function Ids: overview] in GHC.Types.Id.Info.
{- Note [exprOkForSpeculation and type classes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -39,7 +39,8 @@ import GHC.Core.Type
import GHC.Core.Coercion
import GHC.Core.TyCon
import GHC.Core.DataCon
-import GHC.Core.Opt.OccurAnal
+import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr_Prep )
+import GHC.Core.SimpleOpt ( joinPointBinding_maybe, joinPointBindings_maybe )
import GHC.Data.Maybe
import GHC.Data.OrdList
@@ -575,7 +576,18 @@ cpeBind :: TopLevelFlag -> CorePrepEnv -> CoreBind
Maybe CoreBind) -- Just bind' <=> returned new bind; no float
-- Nothing <=> added bind' to floats instead
cpeBind top_lvl env (NonRec bndr rhs)
- | not (isJoinId bndr)
+ -- A join point.
+ -- NB: use 'joinPointBinding_maybe' instead of 'isJoinId' as per the plan
+ -- described in (JCT3) in Note [Join points, casts, and ticks].
+ | Just (bndr, rhs) <- joinPointBinding_maybe bndr rhs
+ = assert (not (isTopLevel top_lvl)) $ -- can't have top-level join point; see Note [Join points and floating]
+ do { (_, bndr1) <- cpCloneBndr env bndr
+ ; (bndr2, rhs1) <- cpeJoinPair env bndr1 rhs
+ ; return (extendCorePrepEnv env bndr bndr2,
+ emptyFloats,
+ Just (NonRec bndr2 rhs1)) }
+
+ | otherwise
= do { (env1, bndr1) <- cpCloneBndr env bndr
; let dmd = idDemandInfo bndr
lev = typeLevity (idType bndr)
@@ -594,16 +606,23 @@ cpeBind top_lvl env (NonRec bndr rhs)
; return (env2, floats1, Nothing) }
- | otherwise -- A join point; see Note [Join points and floating]
- = assert (not (isTopLevel top_lvl)) $ -- can't have top-level join point
- do { (_, bndr1) <- cpCloneBndr env bndr
- ; (bndr2, rhs1) <- cpeJoinPair env bndr1 rhs
- ; return (extendCorePrepEnv env bndr bndr2,
- emptyFloats,
- Just (NonRec bndr2 rhs1)) }
-
cpeBind top_lvl env (Rec pairs)
- | not (isJoinId (head bndrs))
+ -- A recursive join point.
+ -- NB: use 'joinPointBindings_maybe' instead of 'isJoinId' as per the plan
+ -- described in (JCT3) in Note [Join points, casts, and ticks].
+ | Just pairs <- joinPointBindings_maybe pairs
+ , let (bndrs, rhss) = unzip pairs
+ = do { (env, bndrs1) <- cpCloneBndrs env bndrs
+ ; let env' = enterRecGroupRHSs env bndrs1
+ ; pairs1 <- zipWithM (cpeJoinPair env') bndrs1 rhss
+
+ ; let bndrs2 = map fst pairs1
+ -- use env below, so that we reset cpe_rec_ids
+ ; return (extendCorePrepEnvList env (bndrs `zip` bndrs2),
+ emptyFloats,
+ Just (Rec pairs1)) }
+ | otherwise
+ , let (bndrs, rhss) = unzip pairs
= do { (env, bndrs1) <- cpCloneBndrs env bndrs
; let env' = enterRecGroupRHSs env bndrs1
; stuff <- zipWithM (cpePair top_lvl Recursive topDmd Lifted env')
@@ -626,19 +645,9 @@ cpeBind top_lvl env (Rec pairs)
(Float (Rec all_pairs) LetBound TopLvlFloatable),
Nothing) }
- | otherwise -- See Note [Join points and floating]
- = do { (env, bndrs1) <- cpCloneBndrs env bndrs
- ; let env' = enterRecGroupRHSs env bndrs1
- ; pairs1 <- zipWithM (cpeJoinPair env') bndrs1 rhss
-
- ; let bndrs2 = map fst pairs1
- -- use env below, so that we reset cpe_rec_ids
- ; return (extendCorePrepEnvList env (bndrs `zip` bndrs2),
- emptyFloats,
- Just (Rec pairs1)) }
where
- (bndrs, rhss) = unzip pairs
-
+ -- See Note [Join points and floating]
+ --
-- Flatten all the floats, and the current
-- group into a single giant Rec
add_float (Float bind bound _) prs2
@@ -653,7 +662,6 @@ cpeBind top_lvl env (Rec pairs)
Rec prs1 -> prs1 ++ prs2
add_float f _ = pprPanic "cpeBind" (ppr f)
-
---------------
cpePair :: TopLevelFlag -> RecFlag -> Demand -> Levity
-> CorePrepEnv -> OutId -> CoreExpr
@@ -661,7 +669,7 @@ cpePair :: TopLevelFlag -> RecFlag -> Demand -> Levity
-- Used for all bindings
-- The binder is already cloned, hence an OutId
cpePair top_lvl is_rec dmd lev env0 bndr rhs
- = assert (not (isJoinId bndr)) $ -- those should use cpeJoinPair
+ = assert (isNothing $ joinPointBinding_maybe bndr rhs) $ -- those should use cpeJoinPair
do { (floats1, rhs1) <- cpeRhsE env rhs
-- See if we are allowed to float this stuff out of the RHS
@@ -926,7 +934,7 @@ rhsToBody :: CorePrepEnv -> CpeRhs -> UniqSM (Floats, CpeBody)
-- Remove top level lambdas by let-binding
rhsToBody env (Tick t expr)
- | tickishScoped t == NoScope -- only float out of non-scoped annotations
+ | tickishHasNoScope t -- only float out of non-scoped annotations
= do { (floats, expr') <- rhsToBody env expr
; return (floats, mkTick t expr') }
@@ -984,43 +992,74 @@ instance Outputable ArgInfo where
{- Note [Ticks and mandatory eta expansion]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Something like
- `foo x = ({-# SCC foo #-} tagToEnum#) x :: Bool`
-caused a compiler panic in #20938. Why did this happen?
-The simplifier will eta-reduce the rhs giving us a partial
-application of tagToEnum#. The tick is then pushed inside the
-type argument. That is we get
- `(Tick<foo> tagToEnum#) @Bool`
+We must look through ticks when they get in the way of seeing the arguments to
+'Id's that cannot be eta-reduced.
+
+For example, we may have
+
+ myReallyUnsafePtrEquality
+ = \ @a x y ->
+ (src<loc> reallyUnsafePtrEquality#)
+ @Lifted @a @Lifted @a x y
+
+If we don't move the SourceNote out of the way, this looks like an unsaturated
+occurrence of the PrimOp "reallyUnsafePtrEquality#", which we cannot generate
+code for.
+
+Moreover, we must also move out non-floatable ticks. Case in point: #20938,
+of the form:
+
+ foo x = ({-# SCC foo #-} tagToEnum#) x :: Bool
+
+If we don't look past the tick "foo", the simplifier will eta-reduce the RHS,
+giving us a partial application of 'tagToEnum#'. The tick is then pushed inside
+the type argument, resulting in:
+
+ (Tick<foo> tagToEnum#) @Bool
+
CorePrep would go on to see a undersaturated tagToEnum# application
-and eta expand the expression under the tick. Giving us:
+and eta-expand the expression under the tick. Giving us:
+
(Tick<scc> (\forall a. x -> tagToEnum# @a x) @Bool
-Suddenly tagToEnum# is applied to a polymorphic type and the code generator
+
+Suddenly, 'tagToEnum#' is applied to a polymorphic type and the code generator
panics as it needs a concrete type to determine the representation.
-The problem in my eyes was that the tick covers a partial application
-of a primop. There is no clear semantic for such a construct as we can't
-partially apply a primop since they do not have bindings.
-We fix this by expanding the scope of such ticks slightly to cover the body
-of the eta-expanded expression.
-
-We do this by:
-* Checking if an application is headed by a primOpish thing.
-* If so we collect floatable ticks and usually but also profiling ticks
- along with regular arguments.
-* When rebuilding the application we check if any profiling ticks appear
- before the primop is fully saturated.
-* If the primop isn't fully satured we eta expand the primop application
- and scope the tick to scope over the body of the saturated expression.
-
-Going back to #20938 this means starting with
- `(Tick<foo> tagToEnum#) @Bool`
-we check if the function head is a primop (yes). This means we collect the
-profiling tick like if it was floatable. Giving us
- (tagToEnum#, [CpeTick foo, CpeApp @Bool]).
+The problem was that the tick covered a partial application of a primop.
+There is no clear semantic for such a construct: we can't partially apply a
+primop, since primops do not have bindings.
+
+To fix this, we expand the scope of ticks slightly to cover the body
+of the eta-expanded expression, even when the tick isn't normally floatable.
+
+This is achieved by using 'GHC.Core.Utils.canCollectArgsThroughTick', which
+responds 'True' in the following two situations:
+
+ - The tick is floatable (i.e. satisfies 'tickishFloatable'), meaning that it
+ is OK to float it out slightly, moving in more code under it.
+ See also Note [Eta expansion and source notes] in GHC.Core.Opt.Arity.
+ - The tick is around an application that is headed by an 'Id' that cannot be
+ undersaturated, such as a PrimOp (see 'GHC.Core.Utils.cantEtaReduceFun').
+
+This solves #20938. Indeed, starting with
+
+ (scctick<foo> tagToEnum#) @Bool
+
+we see that the head of the application is 'tagToEnum#', which is a PrimOp and
+thus satisfies 'hasNoBinding = True'. As a result, we collect the profiling tick
+as if it was floatable, resulting in
+
+ (tagToEnum#, [CpeTick foo, CpeApp @Bool])
+
cpe_app filters out the tick as a underscoped tick on the expression
-`tagToEnum# @Bool`. During eta expansion we then put that tick back onto the
-body of the eta-expansion lambdas. Giving us `\x -> Tick<foo> (tagToEnum# @Bool x)`.
+`tagToEnum# @Bool`. During eta-expansion, we put that tick back onto the
+body of the eta-expansion lambda, resulting in
+
+ \x -> scctick<foo> (tagToEnum# @Bool x)
+
+which is unproblematic.
-}
+
cpeApp :: CorePrepEnv -> CoreExpr -> UniqSM (Floats, CpeRhs)
-- May return a CpeRhs (instead of CpeApp) because of saturating primops
cpeApp top_env expr
@@ -1045,15 +1084,14 @@ cpeApp top_env expr
go (Cast fun co) as
= go fun (AICast co : as)
go (Tick tickish fun) as
- -- Profiling ticks are slightly less strict so we expand their scope
- -- if they cover partial applications of things like primOps.
- -- See Note [Ticks and mandatory eta expansion]
- -- Here we look inside `fun` before we make the final decision about
- -- floating the tick which isn't optimal for perf. But this only makes
- -- a difference if we have a non-floatable tick which is somewhat rare.
+ -- Try to move a tick out of the way, if:
+ -- - the tick can be floated out of the way ('tickishFloatable'), or
+ -- - the tick must be moved out of the way because it stands in between
+ -- an 'Id' that must be saturated and some of its arguments;
+ -- see Note [Ticks and mandatory eta expansion].
| Var vh <- head
- , Var head' <- lookupCorePrepEnv top_env vh
- , etaExpansionTick head' tickish
+ , Just head' <- getIdFromTrivialExpr_maybe (lookupCorePrepEnv top_env vh)
+ , canCollectArgsThroughTick head' tickish
= (head,as')
where
(head,as') = go fun (AITick tickish : as)
@@ -1130,7 +1168,10 @@ cpeApp top_env expr
hd = getIdFromTrivialExpr_maybe e2
-- Determine number of required arguments. See Note [Ticks and mandatory eta expansion]
min_arity = case hd of
- Just v_hd -> if hasNoBinding v_hd then Just $! (idArity v_hd) else Nothing
+ Just v_hd ->
+ if cantEtaReduceFun v_hd
+ then Just $! idArity v_hd
+ else Nothing
Nothing -> Nothing
-- ; pprTraceM "cpe_app:stricts:" (ppr v <+> ppr args $$ ppr stricts $$ ppr (idCbvMarks_maybe v))
; (app, floats, unsat_ticks) <- rebuild_app env args e2 emptyFloats stricts min_arity
@@ -2293,8 +2334,8 @@ deFloatTop floats
get b _ = pprPanic "deFloatTop" (ppr b)
-- See Note [Dead code in CorePrep]
- get_bind (NonRec x e) = NonRec x (occurAnalyseExpr e)
- get_bind (Rec xes) = Rec [(x, occurAnalyseExpr e) | (x, e) <- xes]
+ get_bind (NonRec x e) = NonRec x (occurAnalyseExpr_Prep e)
+ get_bind (Rec xes) = Rec [(x, occurAnalyseExpr_Prep e) | (x, e) <- xes]
---------------------------------------------------------------------------
=====================================
compiler/GHC/Driver/Config/Core/Lint.hs
=====================================
@@ -115,7 +115,8 @@ perPassFlags dflags pass
, lf_check_inline_loop_breakers = check_lbs
, lf_check_static_ptrs = check_static_ptrs
, lf_check_linearity = check_linearity
- , lf_check_rubbish_lits = check_rubbish }
+ , lf_check_rubbish_lits = check_rubbish
+ , lf_allow_weak_joins = allow_weak_joins }
where
-- See Note [Checking for global Ids]
check_globals = case pass of
@@ -152,6 +153,11 @@ perPassFlags dflags pass
CorePrep -> True
_ -> False
+ -- See Note [Linting join points with casts or ticks] in GHC.Core.Lint
+ allow_weak_joins = case pass of
+ CorePrep -> True
+ _ -> False
+
initLintConfig :: DynFlags -> [Var] -> LintConfig
initLintConfig dflags vars =LintConfig
{ l_diagOpts = initDiagOpts dflags
@@ -168,4 +174,5 @@ defaultLintFlags dflags = LF { lf_check_global_ids = False
, lf_report_unsat_syns = True
, lf_check_fixed_rep = True
, lf_check_rubbish_lits = True
+ , lf_allow_weak_joins = False
}
=====================================
compiler/GHC/Iface/Tidy.hs
=====================================
@@ -1272,7 +1272,7 @@ tidyTopIdInfo rhs_tidy_env name rhs_ty orig_rhs tidy_rhs idinfo show_unfold
is_external = isExternalName name
--------- OccInfo ------------
- robust_occ_info = zapFragileOcc (occInfo idinfo)
+ robust_occ_info = zapFragileOccInfo (occInfo idinfo)
-- It's important to keep loop-breaker information
-- when we are doing -fexpose-all-unfoldings
=====================================
compiler/GHC/StgToCmm/Expr.hs
=====================================
@@ -1273,5 +1273,5 @@ cgTick tick
ProfNote cc t p -> emitSetCCC cc t p
HpcTick m n -> emit (mkTickBox platform m n)
SourceNote s n -> emitTick $ SourceNote s n
- _other -> return () -- ignore
+ Breakpoint {} -> return () -- ignore
}
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -66,7 +66,7 @@ module GHC.Types.Basic (
noOneShotInfo, hasNoOneShotInfo, isOneShotInfo,
bestOneShot, worstOneShot,
- OccInfo(..), noOccInfo, seqOccInfo, zapFragileOcc, isOneOcc,
+ OccInfo(..), noOccInfo, seqOccInfo, zapFragileOccInfo, isOneOcc,
isDeadOcc, isStrongLoopBreaker, isWeakLoopBreaker, isManyOccs,
isNoOccInfo, strongLoopBreaker, weakLoopBreaker,
@@ -980,10 +980,13 @@ isOneOcc :: OccInfo -> Bool
isOneOcc (OneOcc {}) = True
isOneOcc _ = False
-zapFragileOcc :: OccInfo -> OccInfo
--- Keep only the most robust data: deadness, loop-breaker-hood
-zapFragileOcc (OneOcc {}) = noOccInfo
-zapFragileOcc occ = zapOccTailCallInfo occ
+-- | Keep only the most robust occurrence info: deadness, loop-breaker-hood.
+--
+-- In particular, it zaps 'TailCallInfo': see Note [JoinId vs TailCallInfo]
+-- in 'GHC.Core.Opt.Simplify.Env'.
+zapFragileOccInfo :: OccInfo -> OccInfo
+zapFragileOccInfo (OneOcc {}) = noOccInfo
+zapFragileOccInfo occ = zapOccTailCallInfo occ
instance Outputable OccInfo where
-- only used for debugging; never parsed. KSW 1999-07
=====================================
compiler/GHC/Types/Id/Info.hs
=====================================
@@ -914,14 +914,15 @@ zapUsedOnceInfo info
, demandInfo = zapUsedOnceDemand (demandInfo info) }
zapFragileInfo :: IdInfo -> Maybe IdInfo
--- ^ Zap info that depends on free variables
+-- ^ Zap fragile 'IdInfo', such as info that depends on free variables
+-- or fragile occurrence info (see 'zapFragileOccInfo').
zapFragileInfo info@(IdInfo { occInfo = occ, realUnfoldingInfo = unf })
= new_unf `seq` -- The unfolding field is not (currently) strict, so we
-- force it here to avoid a (zapFragileUnfolding unf) thunk
-- which might leak space
Just (info `setRuleInfo` emptyRuleInfo
`setUnfoldingInfo` new_unf
- `setOccInfo` zapFragileOcc occ)
+ `setOccInfo` zapFragileOccInfo occ)
where
new_unf = zapFragileUnfolding unf
=====================================
compiler/GHC/Types/Tickish.hs
=====================================
@@ -6,9 +6,8 @@ module GHC.Types.Tickish (
CoreTickish, StgTickish, CmmTickish,
XTickishId,
tickishCounts,
- TickishScoping(..),
- tickishScoped,
- tickishScopesLike,
+ tickishHasNoScope,
+ tickishHasSoftScope,
tickishFloatable,
tickishCanSplit,
mkNoCount,
@@ -206,103 +205,177 @@ instance Binary BreakpointId where
--------------------------------------------------------------------------------
--- | A "counting tick" (where tickishCounts is True) is one that
+-- | A "counting tick" (for which 'tickishCounts' is True) is one that
-- counts evaluations in some way. We cannot discard a counting tick,
--- and the compiler should preserve the number of counting ticks as
--- far as possible.
+-- and the compiler should preserve the number of counting ticks (as
+-- far as possible).
--
--- However, we still allow the simplifier to increase or decrease
--- sharing, so in practice the actual number of ticks may vary, except
--- that we never change the value from zero to non-zero or vice versa.
+-- See Note [Counting ticks]
tickishCounts :: GenTickish pass -> Bool
-tickishCounts n@ProfNote{} = profNoteCount n
-tickishCounts HpcTick{} = True
-tickishCounts Breakpoint{} = True
-tickishCounts _ = False
-
-
--- | Specifies the scoping behaviour of ticks. This governs the
--- behaviour of ticks that care about the covered code and the cost
--- associated with it. Important for ticks relating to profiling.
-data TickishScoping =
- -- | No scoping: The tick does not care about what code it
- -- covers. Transformations can freely move code inside as well as
- -- outside without any additional annotation obligations
- NoScope
-
- -- | Soft scoping: We want all code that is covered to stay
- -- covered. Note that this scope type does not forbid
- -- transformations from happening, as long as all results of
- -- the transformations are still covered by this tick or a copy of
- -- it. For example
- --
- -- let x = tick<...> (let y = foo in bar) in baz
- -- ===>
- -- let x = tick<...> bar; y = tick<...> foo in baz
- --
- -- Is a valid transformation as far as "bar" and "foo" is
- -- concerned, because both still are scoped over by the tick.
- --
- -- Note though that one might object to the "let" not being
- -- covered by the tick any more. However, we are generally lax
- -- with this - constant costs don't matter too much, and given
- -- that the "let" was effectively merged we can view it as having
- -- lost its identity anyway.
- --
- -- Also note that this scoping behaviour allows floating a tick
- -- "upwards" in pretty much any situation. For example:
- --
- -- case foo of x -> tick<...> bar
- -- ==>
- -- tick<...> case foo of x -> bar
- --
- -- While this is always legal, we want to make a best effort to
- -- only make us of this where it exposes transformation
- -- opportunities.
- | SoftScope
-
- -- | Cost centre scoping: We don't want any costs to move to other
- -- cost-centre stacks. This means we not only want no code or cost
- -- to get moved out of their cost centres, but we also object to
- -- code getting associated with new cost-centre ticks - or
- -- changing the order in which they get applied.
- --
- -- A rule of thumb is that we don't want any code to gain new
- -- annotations. However, there are notable exceptions, for
- -- example:
- --
- -- let f = \y -> foo in tick<...> ... (f x) ...
- -- ==>
- -- tick<...> ... foo[x/y] ...
- --
- -- In-lining lambdas like this is always legal, because inlining a
- -- function does not change the cost-centre stack when the
- -- function is called.
- | CostCentreScope
-
- deriving (Eq)
-
--- | Returns the intended scoping rule for a Tickish
-tickishScoped :: GenTickish pass -> TickishScoping
-tickishScoped n@ProfNote{}
- | profNoteScope n = CostCentreScope
- | otherwise = NoScope
-tickishScoped HpcTick{} = NoScope
-tickishScoped Breakpoint{} = CostCentreScope
- -- Breakpoints are scoped: eventually we're going to do call
- -- stacks, but also this helps prevent the simplifier from moving
- -- breakpoints around and changing their result type (see #1531).
-tickishScoped SourceNote{} = SoftScope
-
--- | Returns whether the tick scoping rule is at least as permissive
--- as the given scoping rule.
-tickishScopesLike :: GenTickish pass -> TickishScoping -> Bool
-tickishScopesLike t scope = tickishScoped t `like` scope
- where NoScope `like` _ = True
- _ `like` NoScope = False
- SoftScope `like` _ = True
- _ `like` SoftScope = False
- CostCentreScope `like` _ = True
+tickishCounts = \case
+ ProfNote { profNoteCount = counts } -> counts
+ HpcTick {} -> True
+ Breakpoint {} -> True
+ SourceNote {} -> False
+
+-- | Is this a non-scoping tick, for which we don't care about precisely
+-- the extent of code that the tick encompasses?
+--
+-- See Note [Scoped ticks]
+tickishHasNoScope :: GenTickish pass -> Bool
+tickishHasNoScope = \case
+ ProfNote { profNoteScope = scopes } -> not scopes
+ HpcTick {} -> True
+ Breakpoint {} -> False
+ SourceNote {} -> False
+
+-- | A "tick with soft scoping" (for which 'tickishHasSoftScope' is True) is
+-- one that either does not scope at all (for which 'tickishHasNoScope' is True),
+-- or that has a "soft" scope: we allow new code to be floated into to the scope,
+-- as long as all code that was covered remains covered.
+--
+-- See Note [Scoped ticks]
+tickishHasSoftScope :: GenTickish pass -> Bool
+tickishHasSoftScope = \case
+ ProfNote { profNoteScope = scopes } -> not scopes
+ HpcTick {} -> True
+ Breakpoint {} -> False
+ SourceNote {} -> True
+
+{- Note [Scoping ticks and counting ticks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Ticks have two independent attributes:
+
+ * Whether the tick /counts/.
+ Counting ticks are used when we want a counter to be bumped, e.g. counting
+ how many times a function is called.
+
+ See Note [Counting ticks]
+
+ * What kind of /scope/ the tick has:
+ * Cost-centre scope: you cannot move a redex into the scope of the tick,
+ nor can you float a redex out.
+ * Soft scope: you can move a redex /into/ the scope of a tick,
+ but you cannot float a redex /out/
+ * No scope: there are no restrictions on floating in or out.
+
+ See Note [Scoped ticks]
+
+Note [Counting ticks]
+~~~~~~~~~~~~~~~~~~~~
+The following ticks count:
+ - ProfNote ticks with profNoteCounts = True
+ - HPC ticks
+ - Breakpoints
+
+Going past a counting tick implies bumping a counter.
+Generally, the simplifier attempts to preserve counts when transforming
+programs and moving ticks, for example by transforming:
+
+ case <tick> e of
+ alt1 -> rhs1
+ alt2 -> rhs2
+
+to
+
+ case e of
+ alt1 -> <tick> rhs1
+ alt2 -> <tick> rhs2
+
+which preserves the total count (as exactly one branch of the case
+will be taken).
+
+However, we still allow the simplifier to increase or decrease
+sharing, so in practice the actual number of ticks may vary, except
+that we never change the value from zero to non-zero or vice-versa.
+
+Note [Scoped ticks]
+~~~~~~~~~~~~~~~~~~~~
+The following ticks are scoped:
+ - ProfNote ticks with profNoteScope = True
+ - Breakpoints
+ - Source notes
+
+A scoped tick is one that scopes over a portion of code. For example,
+an SCC anotation sets the cost centre for the code within; any allocations
+within that piece of code should get attributed to that cost centre.
+
+When the simplifier deals with a scoping tick, it ensures that all code that
+was covered remains covered. For example
+
+ let x = tick<...> (let y = foo in bar) in baz
+ ===>
+ let x = tick<...> bar; y = tick<...> foo in baz
+
+is a valid transformation as far as "bar" and "foo" are concerned, because
+both still are scoped over by the tick. One might object to the "let" not
+being covered by the tick any more. However, we are generally lax with this;
+constant costs don't matter too much, and given that the "let" was effectively
+merged we can view it as having lost its identity anyway.
+
+Perhaps surprisingly, breakpoints are considered to be scoped, because we
+don't want the simplifier to move them around, changing their result type (see #1531).
+
+We specifically forbid floating code outside of a scoping tick, as cost
+associated with the floated-out code would no longer be attributed to the
+appropriate scope.
+
+Whether we are allowed to float in additional cost depends on the tick:
+
+ Cost-centre scope ticks
+ - ProfNote with profNoteScope = True
+ - Breakpoints
+
+ A tick with cost-centre scope is one for which we can neither move
+ redexes into or move redexes outside of the tick. For example, we don't
+ want profiling costs to move to other cost-centre stacks.
+ Morever, we also object to changing the order in which such ticks
+ are applied.
+
+ A rule of thumb is that we don't want any code to gain new
+ lexically-enclosing ticks. For example, we should not transform:
+
+ f (scctick<foo> a) ==> scctick<foo> (f a)
+
+ as this would attribute the cost of evaluating the application 'f a'
+ to the cost centre 'foo'.
+
+ However, there are notable exceptions, for example:
+
+ let f = \y -> foo in tick<...> ... (f x) ...
+ ==>
+ tick<...> ... foo[x/y] ...
+
+ Inlining lambdas like this is always legal, because inlining a function
+ does not change the cost-centre stack when the function is called.
+
+ Soft scope ticks
+ - Source notes
+
+ A tick with soft scope is one for which we can move redexes inside the
+ tick, but cannot float redexes outside the tick. This is a slightly more
+ lenient notion of scoping than cost-centres, and is used only for source
+ note ticks (they are used to provide DWARF debug symbols, and for those
+ it matters less if code from outside gets moved under the tick).
+
+ Examples:
+
+ - FloatIn (GHC.Core.Opt.FloatIn.fiExpr)
+
+ let x = rhs in <tick> body
+ ==>
+ <tick> (let x = rhs in body)
+
+ - Moving a tick outside of a case or of an application
+ (GHC.Core.Opt.Simplify.Iteration.simplTick)
+
+ case <tick> e of alts ==> <tick> case e of alts
+
+ (<tick> e1) e2 ==> <tick> (e1 e2)
+
+ While these transformations are legal, we want to make a best effort to
+ only make use of them where it exposes transformation opportunities.
+-}
-- | Returns @True@ for ticks that can be floated upwards easily even
-- where it might change execution counts, such as:
@@ -311,12 +384,11 @@ tickishScopesLike t scope = tickishScoped t `like` scope
-- ==>
-- tick<...> (Just foo)
--
--- This is a combination of @tickishSoftScope@ and
--- @tickishCounts@. Note that in principle splittable ticks can become
--- floatable using @mkNoTick@ -- even though there's currently no
--- tickish for which that is the case.
+-- This is a combination of @tickishHasSoftScope@ and @tickishCounts@.
+-- Note that in principle splittable ticks can become floatable using @mkNoTick@,
+-- even though there's currently no tickish for which that is the case.
tickishFloatable :: GenTickish pass -> Bool
-tickishFloatable t = t `tickishScopesLike` SoftScope && not (tickishCounts t)
+tickishFloatable t = tickishHasSoftScope t && not (tickishCounts t)
-- | Returns @True@ for a tick that is both counting /and/ scoping and
-- can be split into its (tick, scope) parts using 'mkNoScope' and
@@ -334,7 +406,7 @@ mkNoCount n@ProfNote{} = let n' = n {profNoteCount = False}
mkNoCount _ = panic "mkNoCount: Undefined split!"
mkNoScope :: GenTickish pass -> GenTickish pass
-mkNoScope n | tickishScoped n == NoScope = n
+mkNoScope n | tickishHasNoScope n = n
| not (tickishCanSplit n) = panic "mkNoScope: Cannot split!"
mkNoScope n@ProfNote{} = let n' = n {profNoteScope = False}
in assert (profNoteCount n) n'
@@ -357,7 +429,9 @@ mkNoScope _ = panic "mkNoScope: Undefined split!"
-- translate the code as if it found the latter.
tickishIsCode :: GenTickish pass -> Bool
tickishIsCode SourceNote{} = False
-tickishIsCode _tickish = True -- all the rest for now
+tickishIsCode ProfNote{} = True
+tickishIsCode Breakpoint{} = True
+tickishIsCode HpcTick{} = True
isProfTick :: GenTickish pass -> Bool
isProfTick ProfNote{} = True
=====================================
testsuite/tests/codeGen/should_compile/debug.stdout
=====================================
@@ -18,7 +18,6 @@ src<debug.hs:4:9>
src<debug.hs:5:21-29>
src<debug.hs:5:9-29>
src<debug.hs:6:1-21>
-src<debug.hs:6:16-21>
== CBE ==
src<debug.hs:4:9>
89
=====================================
testsuite/tests/simplCore/should_compile/T26642.hs
=====================================
@@ -0,0 +1,46 @@
+module T26642 ( saveClobberedTemps ) where
+
+import Prelude ( IO, Bool(..), Int, (>>=), (==), return )
+import Data.Word ( Word64 )
+
+-------------------------------------------------------------------------------
+
+data Word64Map a
+ = Bin (Word64Map a) (Word64Map a)
+ | Tip a
+ | Nil
+
+{-# NOINLINE myFoldr #-}
+myFoldr :: (a -> b -> b) -> b -> Word64Map a -> b
+myFoldr f = go
+ where
+ {-# NOINLINE go #-}
+ go z' Nil = z'
+ go z' (Tip x) = f x z'
+ go z' (Bin l r) = go (go z' r) l
+
+{-# NOINLINE nonDetFold #-}
+nonDetFold :: (b -> elt -> IO b) -> b -> Word64Map elt -> IO b
+nonDetFold f z0 xs = myFoldr c return xs z0
+ where
+ {-# NOINLINE c #-}
+ c x k z = f z x >>= k
+
+{-# NOINLINE myFalse #-}
+myFalse :: Bool
+myFalse = False
+
+type RealReg = Int
+data Loc = InReg RealReg | InMem
+
+saveClobberedTemps :: forall instr. [RealReg] -> IO [instr]
+saveClobberedTemps clobbered = nonDetFold maybe_spill [] Nil
+ where
+ {-# NOINLINE maybe_spill #-}
+ maybe_spill :: [instr] -> Loc -> IO [instr]
+ maybe_spill instrs !loc =
+ case loc of
+ InReg reg
+ | myFalse
+ -> return []
+ _ -> return instrs
=====================================
testsuite/tests/simplCore/should_compile/TrickyJoins.hs
=====================================
@@ -0,0 +1,154 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
+module TrickyJoinPoints where
+
+import Data.Coerce
+ ( coerce )
+import Data.Kind
+ ( Type )
+
+
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+
+-----------------------------------
+-- Join points and profiling ticks
+
+data ModGuts2 = MkModGuts2
+
+runCorePasses3 :: Bool -> ModGuts2 -> IO ModGuts2
+runCorePasses3 pass guts = doCorePass3 pass guts
+
+doCorePass3 :: Bool -> ModGuts2 -> IO ModGuts2
+doCorePass3 pass guts = do
+ _ <- putStrLn "hi"
+
+ let
+ updateBinds _ = return guts
+
+ case pass of
+ True -> {-# SCC "XXX3" #-} updateBinds False
+ _ -> {-# SCC "YYY3" #-} updateBinds True
+
+--------------------------
+-- Join points & casts
+
+newtype AdjacencyMap a = AM {
+ adjacencyMap :: Map a (Set.Set a) }
+
+overlays :: Ord a => [AdjacencyMap a] -> AdjacencyMap a
+overlays = AM . Map.unionsWith Set.union . map adjacencyMap
+
+
+type SBool :: Bool -> Type
+data SBool b where
+ SFalse :: SBool False
+ STrue :: SBool True
+
+type N :: Bool -> Type
+data family N b
+newtype instance N False = NF ( Int -> Int )
+newtype instance N True = NT ( Int -> Int )
+
+testCast :: forall b. SBool b -> Int -> Int
+testCast b n =
+ case
+ ( let
+ {-# NOINLINE juliet #-}
+ juliet :: Int -> Int -> Int
+ juliet x = \ y -> x + y + n
+ in
+ case b of
+ SFalse -> NF (juliet 1)
+ STrue -> NT (juliet 2)
+ ) :: N b of
+ n | SFalse <- b
+ , NF f <- n
+ -> f 100
+ | STrue <- b
+ , NT g <- n
+ -> g 200
+
+
+------------------------------------------
+-- Join points, profiling ticks and casts
+
+newtype M = M ( Int -> Int -> Int )
+
+testCastTick :: forall b. SBool b -> Int -> Int
+testCastTick b n =
+ case
+ ( let
+ {-# NOINLINE j #-}
+ j :: Int -> Int -> Int
+ j x = \ y -> x + y + n
+ {-# NOINLINE k #-}
+ k :: M
+ k = coerce j
+ in
+ case b of
+ SFalse -> {-# SCC "ticked" #-} NF ( coerce @M @( Int -> Int -> Int ) k 1 )
+ STrue -> NT ( coerce @M @( Int -> Int -> Int ) k 2 )
+ ) :: N b of
+ n | SFalse <- b
+ , NF f <- n
+ -> f 100
+ | STrue <- b
+ , NT g <- n
+ -> g 200
+
+------------------------------------------
+
+{-# NOINLINE testJoinTransitivity #-}
+testJoinTransitivity :: Bool -> Int -> Int
+testJoinTransitivity b n =
+ let
+ f x = x ^ ( 99 :: Int ) + 7 * ( x - 19 )
+ {-# NOINLINE f #-}
+ in
+ f (
+ let
+ j1 :: Int -> Int
+ j1 x = x + n
+ {-# NOINLINE j1 #-}
+
+ j2 :: Int -> Int
+ j2 y = j1 (y * 2)
+ {-# NOINLINE j2 #-}
+
+ j3 :: Int -> Int
+ j3 z = j2 (z * 3)
+ {-# NOINLINE j3 #-}
+
+ in case b of
+ True -> {-# SCC "ticked" #-} j3 10
+ False -> j3 20
+ )
+
+--------------------------------------------------------------------------------
+-- Test relating to Note [JoinId vs TailCallInfo]
+
+expt :: Int -> Int
+expt _ = 3
+{-# NOINLINE expt #-}
+
+repro :: (Int, Int) -> (Int, Int)
+repro (f0,e0) =
+ let
+ (f,e) =
+ let n = e0
+ in
+ case n > 0 of
+ True -> (f0, e0 + n)
+ False -> (f0, e0)
+ r = let be = expt e in f * be
+ in
+ (r, 7)
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -470,6 +470,9 @@ test('T22272', normal, multimod_compile, ['T22272', '-O -fexpose-all-unfoldings
# go should become a join point
test('T22428', [grep_errmsg(r'jump go') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dno-typeable-binds -dsuppress-unfoldings'])
+test('TrickyJoins', normal, compile, [''])
+test('T26642', [unless(have_profiling(), skip)], compile, ['-O -prof -fprof-auto-calls'])
+
test('T22459', normal, compile, [''])
test('T22623', normal, multimod_compile, ['T22623', '-O -v0'])
test('T22662', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77b48b37fa767a00d747419c0483afa…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/77b48b37fa767a00d747419c0483afa…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
28 Feb '26
Simon Peyton Jones pushed to branch wip/T26868 at Glasgow Haskell Compiler / GHC
Commits:
7c714caf by Simon Peyton Jones at 2026-02-28T23:47:11+00:00
Wibble error messages
- - - - -
15 changed files:
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Tc/Errors.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/cpranal/should_compile/T18401.stderr
- testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr
- testsuite/tests/indexed-types/should_fail/T2693.stderr
- testsuite/tests/partial-sigs/should_compile/T10403.stderr
- testsuite/tests/partial-sigs/should_compile/T12844.stderr
- testsuite/tests/partial-sigs/should_compile/T15039a.stderr
- testsuite/tests/partial-sigs/should_compile/T15039b.stderr
- testsuite/tests/partial-sigs/should_compile/T15039c.stderr
- testsuite/tests/partial-sigs/should_compile/T15039d.stderr
- testsuite/tests/partial-sigs/should_fail/T10999.stderr
- testsuite/tests/partial-sigs/should_fail/T12634.stderr
Changes:
=====================================
compiler/GHC/Core/Predicate.hs
=====================================
@@ -749,7 +749,12 @@ tyCoVarsOfTypeWellScoped = scopedSort . tyCoVarsOfTypeList
-- | Get the free vars of types in scoped order
tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar]
-tyCoVarsOfTypesWellScoped = scopedSort . tyCoVarsOfTypesList
+tyCoVarsOfTypesWellScoped tys
+-- = pprTrace "tyCoVarsOfTypesWellScoped"
+-- (vcat [ ppr tys
+-- , ppr (tyCoVarsOfTypesList tys)
+-- , ppr (scopedSort (tyCoVarsOfTypesList tys)) ]) $
+ = scopedSort (tyCoVarsOfTypesList tys)
{- *********************************************************************
=====================================
compiler/GHC/Tc/Errors.hs
=====================================
@@ -2024,6 +2024,12 @@ mkTyVarEqErr' ctxt item tv1 ty2
{ mismatchMsg = headline_msg
, cannotUnifyReason = occurs_err }
+-- pprTrace "mkTyVarEqErr" (vcat
+-- [ text "interesting" <+> pprTyVars interesting_tyvars
+-- , text "tv1" <+> ppr tv1
+-- , text "free tvs1" <+> pprTyVars (tyCoVarsOfTypeList ty1)
+-- , text "ty2" <+> ppr ty2
+-- , text "free tvs2" <+> pprTyVars (tyCoVarsOfTypeList ty2) ]) $
return main_msg
-- If the immediately-enclosing implication has 'tv' a skolem, and
=====================================
testsuite/tests/count-deps/CountDepsAst.stdout
=====================================
@@ -192,6 +192,7 @@ GHC.Types.Unique.Set
GHC.Types.Unique.Supply
GHC.Types.Var
GHC.Types.Var.Env
+GHC.Types.Var.FV
GHC.Types.Var.Set
GHC.Unit
GHC.Unit.Home
@@ -218,7 +219,6 @@ GHC.Utils.Containers.Internal.StrictPair
GHC.Utils.EndoOS
GHC.Utils.Error
GHC.Utils.Exception
-GHC.Utils.FV
GHC.Utils.Fingerprint
GHC.Utils.GlobalVars
GHC.Utils.IO.Unsafe
=====================================
testsuite/tests/count-deps/CountDepsParser.stdout
=====================================
@@ -217,6 +217,7 @@ GHC.Types.Unique.Set
GHC.Types.Unique.Supply
GHC.Types.Var
GHC.Types.Var.Env
+GHC.Types.Var.FV
GHC.Types.Var.Set
GHC.Unit
GHC.Unit.Home
@@ -247,7 +248,6 @@ GHC.Utils.Containers.Internal.StrictPair
GHC.Utils.EndoOS
GHC.Utils.Error
GHC.Utils.Exception
-GHC.Utils.FV
GHC.Utils.Fingerprint
GHC.Utils.GlobalVars
GHC.Utils.IO.Unsafe
=====================================
testsuite/tests/cpranal/should_compile/T18401.stderr
=====================================
@@ -1,37 +1,34 @@
==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 58, types: 93, coercions: 0, joins: 1/1}
+Result size of Tidy Core = {terms: 52, types: 86, coercions: 0, joins: 0/0}
Rec {
-- RHS size: {terms: 18, types: 24, coercions: 0, joins: 0/0}
-T18401.$w$spoly_$wgo1 :: forall a. a -> [a] -> (# [a] #)
+T18401.$w$spoly_$wgo1 :: forall a. [a] -> a -> (# [a] #)
T18401.$w$spoly_$wgo1
- = \ (@a_s1eu) (sc_s1ev :: a_s1eu) (sc1_s1ew :: [a_s1eu]) ->
- case sc1_s1ew of {
- [] -> (# GHC.Types.[] @a_s1eu #);
- : y_a1dy ys_a1dz -> (# GHC.Types.: @a_s1eu sc_s1ev (case T18401.$w$spoly_$wgo1 @a_s1eu y_a1dy ys_a1dz of { (# ww_s1eA #) -> ww_s1eA }) #)
+ = \ (@a_s1fk) (sc_s1fl :: [a_s1fk]) (sc1_s1fm :: a_s1fk) ->
+ case sc_s1fl of {
+ [] -> (# GHC.Internal.Types.[] @a_s1fk #);
+ : y_a1eg ys_a1eh -> (# GHC.Internal.Types.: @a_s1fk sc1_s1fm (case T18401.$w$spoly_$wgo1 @a_s1fk ys_a1eh y_a1eg of { (# ww_s1fr #) -> ww_s1fr }) #)
}
end Rec }
--- RHS size: {terms: 23, types: 29, coercions: 0, joins: 1/1}
+-- RHS size: {terms: 17, types: 22, coercions: 0, joins: 0/0}
si :: forall a. [a] -> (Bool, [a])
si
- = \ (@a_s1dI) (xs0_s1dJ :: [a_s1dI]) ->
- join {
- $j_s1eq :: Bool %1 -> [a_s1dI] %1 -> (Bool, [a_s1dI])
- $j_s1eq (ww_s1dX :: Bool) (ww1_s1dY :: [a_s1dI]) = (ww_s1dX, ww1_s1dY) } in
- case xs0_s1dJ of {
- [] -> jump $j_s1eq GHC.Types.False (GHC.Types.[] @a_s1dI);
- : y_a1dy ys_a1dz -> jump $j_s1eq GHC.Types.True (case T18401.$w$spoly_$wgo1 @a_s1dI y_a1dy ys_a1dz of { (# ww_s1eA #) -> ww_s1eA })
+ = \ (@a_s1er) (xs0_s1es :: [a_s1er]) ->
+ case xs0_s1es of {
+ [] -> (GHC.Internal.Types.False, GHC.Internal.Types.[] @a_s1er);
+ : y_a1eg ys_a1eh -> (GHC.Internal.Types.True, case T18401.$w$spoly_$wgo1 @a_s1er ys_a1eh y_a1eg of { (# ww_s1fr #) -> ww_s1fr })
}
-- RHS size: {terms: 14, types: 19, coercions: 0, joins: 0/0}
safeInit :: forall a. [a] -> Maybe [a]
safeInit
- = \ (@a_aQY) (xs_awU :: [a_aQY]) ->
- case xs_awU of {
- [] -> GHC.Internal.Maybe.Nothing @[a_aQY];
- : y_a1dy ys_a1dz -> GHC.Internal.Maybe.Just @[a_aQY] (case T18401.$w$spoly_$wgo1 @a_aQY y_a1dy ys_a1dz of { (# ww_s1eA #) -> ww_s1eA })
+ = \ (@a_aUv) (xs_ax5 :: [a_aUv]) ->
+ case xs_ax5 of {
+ [] -> GHC.Internal.Maybe.Nothing @[a_aUv];
+ : y_a1eg ys_a1eh -> GHC.Internal.Maybe.Just @[a_aUv] (case T18401.$w$spoly_$wgo1 @a_aUv ys_a1eh y_a1eg of { (# ww_s1fr #) -> ww_s1fr })
}
=====================================
testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr
=====================================
@@ -5,13 +5,13 @@ deriving-via-fail4.hs:15:12: error: [GHC-18872]
• When deriving the instance for (Eq F1)
deriving-via-fail4.hs:18:13: error: [GHC-25897]
- • Couldn't match representation of type ‘a2’ with that of ‘a1’
+ • Couldn't match representation of type ‘a1’ with that of ‘a2’
arising from the coercion of the method ‘c’
from type ‘a -> a -> Bool’ to type ‘a -> F2 a1 -> Bool’
- ‘a2’ is a rigid type variable bound by
+ ‘a1’ is a rigid type variable bound by
the deriving clause for ‘C a (F2 a1)’
at deriving-via-fail4.hs:18:13-15
- ‘a1’ is a rigid type variable bound by
+ ‘a2’ is a rigid type variable bound by
the deriving clause for ‘C a (F2 a1)’
at deriving-via-fail4.hs:18:13-15
• When deriving the instance for (C a (F2 a1))
=====================================
testsuite/tests/indexed-types/should_fail/T2693.stderr
=====================================
@@ -1,38 +1,38 @@
T2693.hs:12:15: error: [GHC-83865]
- • Couldn't match expected type: (a8, b1)
+ • Couldn't match expected type: (a7, b1)
with actual type: TFn a6
The type variable ‘a6’ is ambiguous
• In the first argument of ‘fst’, namely ‘x’
In the first argument of ‘(+)’, namely ‘fst x’
In the expression: fst x + fst x
- • Relevant bindings include n :: a8 (bound at T2693.hs:12:7)
+ • Relevant bindings include n :: a7 (bound at T2693.hs:12:7)
T2693.hs:12:23: error: [GHC-83865]
- • Couldn't match expected type: (a8, b2)
- with actual type: TFn a7
- The type variable ‘a7’ is ambiguous
+ • Couldn't match expected type: (a7, b2)
+ with actual type: TFn a8
+ The type variable ‘a8’ is ambiguous
• In the first argument of ‘fst’, namely ‘x’
In the second argument of ‘(+)’, namely ‘fst x’
In the expression: fst x + fst x
- • Relevant bindings include n :: a8 (bound at T2693.hs:12:7)
+ • Relevant bindings include n :: a7 (bound at T2693.hs:12:7)
T2693.hs:19:15: error: [GHC-83865]
- • Couldn't match expected type: (a5, b0)
+ • Couldn't match expected type: (a3, b0)
with actual type: TFn a2
The type variable ‘a2’ is ambiguous
• In the first argument of ‘fst’, namely ‘x’
In the first argument of ‘(+)’, namely ‘fst x’
In the expression: fst x + snd x
- • Relevant bindings include n :: a5 (bound at T2693.hs:19:7)
+ • Relevant bindings include n :: a3 (bound at T2693.hs:19:7)
T2693.hs:19:23: error: [GHC-83865]
- • Couldn't match expected type: (a4, a5)
- with actual type: TFn a3
- The type variable ‘a3’ is ambiguous
+ • Couldn't match expected type: (a5, a3)
+ with actual type: TFn a4
+ The type variable ‘a4’ is ambiguous
• In the first argument of ‘snd’, namely ‘x’
In the second argument of ‘(+)’, namely ‘snd x’
In the expression: fst x + snd x
- • Relevant bindings include n :: a5 (bound at T2693.hs:19:7)
+ • Relevant bindings include n :: a3 (bound at T2693.hs:19:7)
T2693.hs:29:20: error: [GHC-83865]
• Couldn't match type: TFn a0
=====================================
testsuite/tests/partial-sigs/should_compile/T10403.stderr
=====================================
@@ -7,14 +7,14 @@ T10403.hs:16:7: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
T10403.hs:16:12: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘(t -> b) -> f t -> H f’
- Where: ‘b’, ‘t’, ‘f’ are rigid type variables bound by
+ Where: ‘t’, ‘b’, ‘f’ are rigid type variables bound by
the inferred type of h1 :: Functor f => (t -> b) -> f t -> H f
at T10403.hs:18:1-41
• In the type signature: h1 :: _ => _
T10403.hs:20:7: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘(t -> b) -> f t -> H f’
- Where: ‘b’, ‘t’, ‘f’ are rigid type variables bound by
+ Where: ‘t’, ‘b’, ‘f’ are rigid type variables bound by
the inferred type of h2 :: (t -> b) -> f t -> H f
at T10403.hs:23:1-41
• In the type signature: h2 :: _
=====================================
testsuite/tests/partial-sigs/should_compile/T12844.stderr
=====================================
@@ -1,10 +1,10 @@
-
T12844.hs:12:9: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found extra-constraints wildcard standing for
‘(Head rngs ~ '(r, r'), Foo rngs)’
- Where: ‘r’, ‘r'’, ‘k1’, ‘k2’, ‘rngs’
+ Where: ‘k1’, ‘k2’, ‘rngs’, ‘r’, ‘r'’
are rigid type variables bound by
the inferred type of
bar :: (Head rngs ~ '(r, r'), Foo rngs) => FooData rngs
at T12844.hs:(12,1)-(13,9)
• In the type signature: bar :: _ => FooData rngs
+
=====================================
testsuite/tests/partial-sigs/should_compile/T15039a.stderr
=====================================
@@ -1,4 +1,3 @@
-
T15039a.hs:19:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Dict (a ~ b)’
Where: ‘a’, ‘b’ are rigid type variables bound by
@@ -25,7 +24,7 @@ T15039a.hs:22:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)
T15039a.hs:25:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Dict (a ~~ b)’
- Where: ‘a’, ‘k’, ‘b’ are rigid type variables bound by
+ Where: ‘k’, ‘a’, ‘b’ are rigid type variables bound by
the type signature for:
ex3 :: forall a k (b :: k). Dict (a ~~ b) -> ()
at T15039a.hs:24:1-43
@@ -54,3 +53,4 @@ T15039a.hs:35:8: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
at T15039a.hs:35:1-44
• In the type signature:
ex7 :: _ => Coercion (a :: Type) (b :: Type)
+
=====================================
testsuite/tests/partial-sigs/should_compile/T15039b.stderr
=====================================
@@ -1,4 +1,3 @@
-
T15039b.hs:19:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Dict ((a :: *) ~ (b :: *))’
Where: ‘a’, ‘b’ are rigid type variables bound by
@@ -26,7 +25,7 @@ T15039b.hs:22:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)
T15039b.hs:25:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’
standing for ‘Dict ((a :: *) ~~ (b :: k))’
- Where: ‘a’, ‘k’, ‘b’ are rigid type variables bound by
+ Where: ‘k’, ‘a’, ‘b’ are rigid type variables bound by
the type signature for:
ex3 :: forall a k (b :: k). Dict ((a :: *) ~~ (b :: k)) -> ()
at T15039b.hs:24:1-43
@@ -56,3 +55,4 @@ T15039b.hs:35:8: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
at T15039b.hs:35:1-44
• In the type signature:
ex7 :: _ => Coercion (a :: Type) (b :: Type)
+
=====================================
testsuite/tests/partial-sigs/should_compile/T15039c.stderr
=====================================
@@ -1,4 +1,3 @@
-
T15039c.hs:19:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Dict (a ~ b)’
Where: ‘a’, ‘b’ are rigid type variables bound by
@@ -25,7 +24,7 @@ T15039c.hs:22:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)
T15039c.hs:25:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Dict (a ~~ b)’
- Where: ‘a’, ‘k’, ‘b’ are rigid type variables bound by
+ Where: ‘k’, ‘a’, ‘b’ are rigid type variables bound by
the type signature for:
ex3 :: forall a k (b :: k). Dict (a ~~ b) -> ()
at T15039c.hs:24:1-43
@@ -54,3 +53,4 @@ T15039c.hs:35:8: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
at T15039c.hs:35:1-44
• In the type signature:
ex7 :: _ => Coercion (a :: Type) (b :: Type)
+
=====================================
testsuite/tests/partial-sigs/should_compile/T15039d.stderr
=====================================
@@ -1,4 +1,3 @@
-
T15039d.hs:19:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Dict ((a :: *) ~ (b :: *))’
Where: ‘a’, ‘b’ are rigid type variables bound by
@@ -27,7 +26,7 @@ T15039d.hs:22:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)
T15039d.hs:25:14: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’
standing for ‘Dict ((a :: *) ~~ (b :: k))’
- Where: ‘a’, ‘k’, ‘b’ are rigid type variables bound by
+ Where: ‘k’, ‘a’, ‘b’ are rigid type variables bound by
the type signature for:
ex3 :: forall a k (b :: k). Dict ((a :: *) ~~ (b :: k)) -> ()
at T15039d.hs:24:1-43
@@ -57,3 +56,4 @@ T15039d.hs:35:8: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
at T15039d.hs:35:1-44
• In the type signature:
ex7 :: _ => Coercion (a :: Type) (b :: Type)
+
=====================================
testsuite/tests/partial-sigs/should_fail/T10999.stderr
=====================================
@@ -15,10 +15,10 @@ T10999.hs:5:17: error: [GHC-88464]
• In the type signature: f :: _ => () -> _
T10999.hs:8:28: error: [GHC-39999]
- • Ambiguous type variable ‘b1’ arising from a use of ‘f’
- prevents the constraint ‘(Ord b1)’ from being solved.
- Relevant bindings include g :: [b1] (bound at T10999.hs:8:1)
- Probable fix: use a type annotation to specify what ‘b1’ should be.
+ • Ambiguous type variable ‘b0’ arising from a use of ‘f’
+ prevents the constraint ‘(Ord b0)’ from being solved.
+ Relevant bindings include g :: [b0] (bound at T10999.hs:8:1)
+ Probable fix: use a type annotation to specify what ‘b0’ should be.
Potentially matching instances:
instance Ord a => Ord (Set.Intersection a)
-- Defined in ‘Data.Set.Internal’
=====================================
testsuite/tests/partial-sigs/should_fail/T12634.stderr
=====================================
@@ -1,9 +1,9 @@
-
T12634.hs:15:58: error: [GHC-83865]
• Expected a type,
but ‘'(t, m, m', r)’ has kind
- ‘(k1 -> k2 -> *, k0, k1, k2)’
+ ‘(k0 -> k1 -> *, k2, k0, k1)’
• In the first argument of ‘Bench’, namely ‘'(t, m, m', r)’
In the type signature:
bench_twacePow :: forall t m m' r. _ =>
t m' r -> Bench '(t, m, m', r)
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c714cafd41c42f19debb2fca76667b…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c714cafd41c42f19debb2fca76667b…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/int-index/star-exp] Extend HsExpr with the StarIsType syntax (#26587, #26967)
by Vladislav Zavialov (＠int-index) 28 Feb '26
by Vladislav Zavialov (＠int-index) 28 Feb '26
28 Feb '26
Vladislav Zavialov pushed to branch wip/int-index/star-exp at Glasgow Haskell Compiler / GHC
Commits:
11243c8d by Vladislav Zavialov at 2026-03-01T01:58:10+03:00
Extend HsExpr with the StarIsType syntax (#26587, #26967)
This patch allows kinds of the form `k -> *` and `* -> k` to occur in
expression syntax, i.e. to be used as required type arguments.
For example:
{-# LANGUAGE RequiredTypeArguments, StarIsType #-}
x1 = f (* -> * -> *)
x2 = f (forall k. k -> *)
x3 = f ((* -> *) -> Constraint)
Summary of the changes:
* Introduce the HsStar constructor of HsExpr and its extension field XStar.
It is analogous to HsStarTy in HsType.
* Refactor HsStarTy to store the unicode flag as TokStar, defined as
type TokStar = EpUniToken "*" "★" -- similar to TokForall, TokRArrow, etc.
The token is stored in the extension field and replaces the Bool field.
* Extend the `infixexp2` nonterminal to parse `*` as a direct argument of `->`.
This is more limited than the full StarIsType syntax, but has the nice
property of not conflicting with the multiplication operator `a * b`.
Test case: T26967
- - - - -
35 changed files:
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Type.hs
- docs/users_guide/exts/required_type_arguments.rst
- + testsuite/tests/vdq-rta/should_compile/T26967.hs
- + testsuite/tests/vdq-rta/should_compile/T26967.stderr
- testsuite/tests/vdq-rta/should_compile/all.T
- utils/check-exact/ExactPrint.hs
- utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Interface/RenameType.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11243c8de7e2d2dd7d79cd1431277c8…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/11243c8de7e2d2dd7d79cd1431277c8…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/int-index/star-exp
by Vladislav Zavialov (＠int-index) 28 Feb '26
by Vladislav Zavialov (＠int-index) 28 Feb '26
28 Feb '26
Vladislav Zavialov pushed new branch wip/int-index/star-exp at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/int-index/star-exp
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/jeltsch/system-io-uncovering] Remove in-package dependencies on `GHC.Internal.System.IO`
by Wolfgang Jeltsch (＠jeltsch) 28 Feb '26
by Wolfgang Jeltsch (＠jeltsch) 28 Feb '26
28 Feb '26
Wolfgang Jeltsch pushed to branch wip/jeltsch/system-io-uncovering at Glasgow Haskell Compiler / GHC
Commits:
d5fe2582 by Wolfgang Jeltsch at 2026-02-28T17:04:55+02:00
Remove in-package dependencies on `GHC.Internal.System.IO`
This contribution eliminates all dependencies on
`GHC.Internal.System.IO` from within `ghc-internal`. It comprises the
following changes:
* Make `GHC.Internal.Fingerprint` independent of I/O support
* Tighten the dependencies of `GHC.Internal.Data.Version`
* Tighten the dependencies of `GHC.Internal.TH.Monad`
* Tighten the dependencies of `GHCi.Helpers`
* Move the `* -> *` `Heap.Closure` instances into `ghc-heap`
* Move some code that needs `System.IO` to `template-haskell`
* Move the `GHC.ResponseFile` implementation into `base`
* Move the `System.Exit` implementation into `base`
* Move the `System.IO.OS` implementation into `base`
Metric Decrease:
size_hello_artifact
size_hello_artifact_gzip
size_hello_unicode
size_hello_unicode_gzip
- - - - -
15 changed files:
- libraries/base/src/GHC/Fingerprint.hs
- libraries/base/src/GHC/ResponseFile.hs
- libraries/base/src/System/Exit.hs
- libraries/base/src/System/IO/OS.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- − libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs
- − libraries/ghc-internal/src/GHC/Internal/System/Exit.hs
- − libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
Changes:
=====================================
libraries/base/src/GHC/Fingerprint.hs
=====================================
@@ -9,3 +9,45 @@ module GHC.Fingerprint (
) where
import GHC.Internal.Fingerprint
+
+import Data.Function (($))
+import Control.Monad (return, when)
+import Data.Bool (not, (&&))
+import Data.List ((++))
+import Data.Maybe (Maybe (Nothing, Just))
+import Data.Int (Int)
+import Data.Word (Word8)
+import Data.Eq ((/=))
+import Text.Show (show)
+import System.IO
+ (
+ IO,
+ FilePath,
+ IOMode (ReadMode),
+ withBinaryFile,
+ hGetBuf,
+ hIsEOF
+ )
+import Foreign.Ptr (Ptr)
+import GHC.Err (errorWithoutStackTrace)
+
+-- | Computes the hash of a given file.
+-- This function runs in constant memory.
+--
+-- @since base-4.7.0.0
+getFileHash :: FilePath -> IO Fingerprint
+getFileHash path = withBinaryFile path ReadMode $ \ hdl ->
+ let
+ readChunk :: Ptr Word8 -> Int -> IO (Maybe Int)
+ readChunk bufferPtr bufferSize = do
+ chunkSize <- hGetBuf hdl bufferPtr bufferSize
+ isFinished <- hIsEOF hdl
+ when (chunkSize /= bufferSize && not isFinished)
+ (
+ errorWithoutStackTrace $
+ "GHC.Fingerprint.getFileHash: could only read " ++
+ show chunkSize ++
+ " bytes, but more are available"
+ )
+ return (if isFinished then Just chunkSize else Nothing)
+ in fingerprintBufferedStream readChunk
=====================================
libraries/base/src/GHC/ResponseFile.hs
=====================================
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Safe #-}
-- |
@@ -19,4 +20,145 @@ module GHC.ResponseFile (
expandResponse
) where
-import GHC.Internal.ResponseFile
+import Control.Monad (return, (>>=), mapM)
+import Control.Exception (IOException, catch)
+import Data.Function (($), (.))
+import Data.Bool (Bool (False, True), otherwise, not, (||))
+import Data.Char (Char, isSpace)
+import Data.List ((++), map, filter, concat, reverse)
+import Data.String (String, unlines)
+import Data.Functor (fmap)
+import Data.Foldable (null, foldl')
+import Data.Eq ((==))
+import Text.Show (show)
+import System.Environment (getArgs)
+import System.IO (IO, hPutStrLn, readFile, stderr)
+import System.Exit (exitFailure)
+
+{-|
+Like 'getArgs', but can also read arguments supplied via response files.
+
+
+For example, consider a program @foo@:
+
+@
+main :: IO ()
+main = do
+ args <- getArgsWithResponseFiles
+ putStrLn (show args)
+@
+
+
+And a response file @args.txt@:
+
+@
+--one 1
+--\'two\' 2
+--"three" 3
+@
+
+Then the result of invoking @foo@ with @args.txt@ is:
+
+> > ./foo @args.txt
+> ["--one","1","--two","2","--three","3"]
+
+-}
+getArgsWithResponseFiles :: IO [String]
+getArgsWithResponseFiles = getArgs >>= expandResponse
+
+-- | Given a string of concatenated strings, separate each by removing
+-- a layer of /quoting/ and\/or /escaping/ of certain characters.
+--
+-- These characters are: any whitespace, single quote, double quote,
+-- and the backslash character. The backslash character always
+-- escapes (i.e., passes through without further consideration) the
+-- character which follows. Characters can also be escaped in blocks
+-- by quoting (i.e., surrounding the blocks with matching pairs of
+-- either single- or double-quotes which are not themselves escaped).
+--
+-- Any whitespace which appears outside of either of the quoting and
+-- escaping mechanisms, is interpreted as having been added by this
+-- special concatenation process to designate where the boundaries
+-- are between the original, un-concatenated list of strings. These
+-- added whitespace characters are removed from the output.
+--
+-- > unescapeArgs "hello\\ \\\"world\\\"\n" == ["hello \"world\""]
+unescapeArgs :: String -> [String]
+unescapeArgs = filter (not . null) . unescape
+
+-- | Given a list of strings, concatenate them into a single string
+-- with escaping of certain characters, and the addition of a newline
+-- between each string. The escaping is done by adding a single
+-- backslash character before any whitespace, single quote, double
+-- quote, or backslash character, so this escaping character must be
+-- removed. Unescaped whitespace (in this case, newline) is part
+-- of this "transport" format to indicate the end of the previous
+-- string and the start of a new string.
+--
+-- While 'unescapeArgs' allows using quoting (i.e., convenient
+-- escaping of many characters) by having matching sets of single- or
+-- double-quotes,'escapeArgs' does not use the quoting mechanism,
+-- and thus will always escape any whitespace, quotes, and
+-- backslashes.
+--
+-- > escapeArgs ["hello \"world\""] == "hello\\ \\\"world\\\"\n"
+escapeArgs :: [String] -> String
+escapeArgs = unlines . map escapeArg
+
+-- | Arguments which look like @\@foo@ will be replaced with the
+-- contents of file @foo@. A gcc-like syntax for response files arguments
+-- is expected. This must re-constitute the argument list by doing an
+-- inverse of the escaping mechanism done by the calling-program side.
+--
+-- We quit if the file is not found or reading somehow fails.
+-- (A convenience routine for haddock or possibly other clients)
+expandResponse :: [String] -> IO [String]
+expandResponse = fmap concat . mapM expand
+ where
+ expand :: String -> IO [String]
+ expand ('@':f) = readFileExc f >>= return . unescapeArgs
+ expand x = return [x]
+
+ readFileExc f =
+ readFile f `catch` \(e :: IOException) -> do
+ hPutStrLn stderr $ "Error while expanding response file: " ++ show e
+ exitFailure
+
+data Quoting = NoneQ | SngQ | DblQ
+
+unescape :: String -> [String]
+unescape args = reverse . map reverse $ go args NoneQ False [] []
+ where
+ -- n.b., the order of these cases matters; these are cribbed from gcc
+ -- case 1: end of input
+ go [] _q _bs a as = a:as
+ -- case 2: back-slash escape in progress
+ go (c:cs) q True a as = go cs q False (c:a) as
+ -- case 3: no back-slash escape in progress, but got a back-slash
+ go (c:cs) q False a as
+ | '\\' == c = go cs q True a as
+ -- case 4: single-quote escaping in progress
+ go (c:cs) SngQ False a as
+ | '\'' == c = go cs NoneQ False a as
+ | otherwise = go cs SngQ False (c:a) as
+ -- case 5: double-quote escaping in progress
+ go (c:cs) DblQ False a as
+ | '"' == c = go cs NoneQ False a as
+ | otherwise = go cs DblQ False (c:a) as
+ -- case 6: no escaping is in progress
+ go (c:cs) NoneQ False a as
+ | isSpace c = go cs NoneQ False [] (a:as)
+ | '\'' == c = go cs SngQ False a as
+ | '"' == c = go cs DblQ False a as
+ | otherwise = go cs NoneQ False (c:a) as
+
+escapeArg :: String -> String
+escapeArg = reverse . foldl' escape []
+
+escape :: String -> Char -> String
+escape cs c
+ | isSpace c
+ || '\\' == c
+ || '\'' == c
+ || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result
+ | otherwise = c:cs
=====================================
libraries/base/src/System/Exit.hs
=====================================
@@ -21,4 +21,67 @@ module System.Exit
die
) where
-import GHC.Internal.System.Exit
\ No newline at end of file
+import GHC.IO.Exception
+ (
+ IOErrorType (InvalidArgument),
+ IOException (IOError),
+ ExitCode (ExitSuccess, ExitFailure)
+ )
+import Control.Monad ((>>))
+import Control.Exception (throwIO, ioError)
+import Data.Bool (otherwise)
+import Data.Maybe (Maybe (Nothing))
+import Data.String (String)
+import Data.Eq ((/=))
+import System.IO (IO, hPutStrLn, stderr)
+
+-- ---------------------------------------------------------------------------
+-- exitWith
+
+-- | Computation 'exitWith' @code@ throws 'ExitCode' @code@.
+-- Normally this terminates the program, returning @code@ to the
+-- program's caller.
+--
+-- On program termination, the standard 'Handle's 'stdout' and
+-- 'stderr' are flushed automatically; any other buffered 'Handle's
+-- need to be flushed manually, otherwise the buffered data will be
+-- discarded.
+--
+-- A program that fails in any other way is treated as if it had
+-- called 'exitFailure'.
+-- A program that terminates successfully without calling 'exitWith'
+-- explicitly is treated as if it had called 'exitWith' 'ExitSuccess'.
+--
+-- As an 'ExitCode' is an 'Control.Exception.Exception', it can be
+-- caught using the functions of "Control.Exception". This means that
+-- cleanup computations added with 'GHC.Internal.Control.Exception.bracket' (from
+-- "Control.Exception") are also executed properly on 'exitWith'.
+--
+-- Note: in GHC, 'exitWith' should be called from the main program
+-- thread in order to exit the process. When called from another
+-- thread, 'exitWith' will throw an 'ExitCode' as normal, but the
+-- exception will not cause the process itself to exit.
+--
+exitWith :: ExitCode -> IO a
+exitWith ExitSuccess = throwIO ExitSuccess
+exitWith code@(ExitFailure n)
+ | n /= 0 = throwIO code
+ | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing Nothing)
+
+-- | The computation 'exitFailure' is equivalent to
+-- 'exitWith' @(@'ExitFailure' /exitfail/@)@,
+-- where /exitfail/ is implementation-dependent.
+exitFailure :: IO a
+exitFailure = exitWith (ExitFailure 1)
+
+-- | The computation 'exitSuccess' is equivalent to
+-- 'exitWith' 'ExitSuccess', It terminates the program
+-- successfully.
+exitSuccess :: IO a
+exitSuccess = exitWith ExitSuccess
+
+-- | Write given error message to `stderr` and terminate with `exitFailure`.
+--
+-- @since base-4.8.0.0
+die :: String -> IO a
+die err = hPutStrLn stderr err >> exitFailure
=====================================
libraries/base/src/System/IO/OS.hs
=====================================
@@ -1,4 +1,6 @@
{-# LANGUAGE Safe #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RankNTypes #-}
{-|
This module bridges between Haskell handles and underlying operating-system
@@ -21,17 +23,293 @@ module System.IO.OS
)
where
-import GHC.Internal.System.IO.OS
+import Control.Monad (return)
+import Control.Concurrent.MVar (MVar)
+import Control.Exception (mask)
+import Data.Function (const, (.), ($))
+import Data.Functor (fmap)
+import Data.Maybe (Maybe (Nothing), maybe)
+#if defined(mingw32_HOST_OS)
+import Data.Bool (otherwise)
+import Data.Maybe (Maybe (Just))
+#endif
+import Data.List ((++))
+import Data.String (String)
+import Data.Typeable (Typeable, cast)
+import System.IO (IO)
+import GHC.IO.FD (fdFD)
+#if defined(mingw32_HOST_OS)
+import GHC.IO.Windows.Handle
(
- withFileDescriptorReadingBiased,
- withFileDescriptorWritingBiased,
- withWindowsHandleReadingBiased,
- withWindowsHandleWritingBiased,
- withFileDescriptorReadingBiasedRaw,
- withFileDescriptorWritingBiasedRaw,
- withWindowsHandleReadingBiasedRaw,
- withWindowsHandleWritingBiasedRaw
+ NativeHandle,
+ ConsoleHandle,
+ IoHandle,
+ toHANDLE
)
+#endif
+import GHC.IO.Handle.Types
+ (
+ Handle (FileHandle, DuplexHandle),
+ Handle__ (Handle__, haDevice)
+ )
+import GHC.IO.Handle.Internals (withHandle_', flushBuffer)
+import GHC.IO.Exception
+ (
+ IOErrorType (InappropriateType),
+ IOException (IOError),
+ ioException
+ )
+import Foreign.Ptr (Ptr)
+import Foreign.C.Types (CInt)
+
+-- * Obtaining POSIX file descriptors and Windows handles
+
+{-|
+ Executes a user-provided action on an operating-system handle that underlies
+ a Haskell handle. Before the user-provided action is run, user-defined
+ preparation based on the handle state that contains the operating-system
+ handle is performed. While the user-provided action is executed, further
+ operations on the Haskell handle are blocked to a degree that interference
+ with this action is prevented.
+
+ See [below](#with-ref-caveats) for caveats regarding this operation.
+-}
+withOSHandle :: String
+ -- ^ The name of the overall operation
+ -> (Handle -> MVar Handle__)
+ {-^
+ Obtaining of the handle state variable that holds the
+ operating-system handle
+ -}
+ -> (forall d. Typeable d => d -> IO a)
+ -- ^ Conversion of a device into an operating-system handle
+ -> (Handle__ -> IO ())
+ -- ^ The preparation
+ -> Handle
+ -- ^ The Haskell handle to use
+ -> (a -> IO r)
+ -- ^ The action to execute on the operating-system handle
+ -> IO r
+withOSHandle opName handleStateVar getOSHandle prepare handle act
+ = mask $ \ withOriginalMaskingState ->
+ withHandleState $ \ handleState@Handle__ {haDevice = dev} -> do
+ osHandle <- getOSHandle dev
+ prepare handleState
+ withOriginalMaskingState $ act osHandle
+ where
+
+ withHandleState = withHandle_' opName handle (handleStateVar handle)
+{-
+ The 'withHandle_'' operation, which we use here, already performs masking.
+ Still, we have to employ 'mask', in order do obtain the operation that
+ restores the original masking state. The user-provided action should be
+ executed with this original masking state, as there is no inherent reason to
+ generally perform it with masking in place. The masking that 'withHandle_''
+ performs is only for safely accessing handle state and thus constitutes an
+ implementation detail; it has nothing to do with the user-provided action.
+-}
+{-
+ The order of actions in 'withOSHandle' is such that any exception from
+ 'getOSHandle' is thrown before the user-defined preparation is performed.
+-}
+
+{-|
+ Obtains the handle state variable that underlies a handle or specifically
+ the handle state variable for reading if the handle uses different state
+ variables for reading and writing.
+-}
+handleStateVarReadingBiased :: Handle -> MVar Handle__
+handleStateVarReadingBiased (FileHandle _ var) = var
+handleStateVarReadingBiased (DuplexHandle _ readingVar _) = readingVar
+
+{-|
+ Obtains the handle state variable that underlies a handle or specifically
+ the handle state variable for writing if the handle uses different state
+ variables for reading and writing.
+-}
+handleStateVarWritingBiased :: Handle -> MVar Handle__
+handleStateVarWritingBiased (FileHandle _ var) = var
+handleStateVarWritingBiased (DuplexHandle _ _ writingVar) = writingVar
+
+{-|
+ Yields the result of another operation if that operation succeeded, and
+ otherwise throws an exception that signals that the other operation failed
+ because some Haskell handle does not use an operating-system handle of a
+ required type.
+-}
+requiringOSHandleOfType :: String
+ -- ^ The name of the operating-system handle type
+ -> Maybe a
+ {-^
+ The result of the other operation if it succeeded
+ -}
+ -> IO a
+requiringOSHandleOfType osHandleTypeName
+ = maybe (ioException osHandleOfTypeRequired) return
+ where
+
+ osHandleOfTypeRequired :: IOException
+ osHandleOfTypeRequired
+ = IOError Nothing
+ InappropriateType
+ ""
+ ("handle does not use " ++ osHandleTypeName ++ "s")
+ Nothing
+ Nothing
+
+{-|
+ Obtains the POSIX file descriptor of a device if the device contains one,
+ and throws an exception otherwise.
+-}
+getFileDescriptor :: Typeable d => d -> IO CInt
+getFileDescriptor = requiringOSHandleOfType "POSIX file descriptor" .
+ fmap fdFD . cast
+
+{-|
+ Obtains the Windows handle of a device if the device contains one, and
+ throws an exception otherwise.
+-}
+getWindowsHandle :: Typeable d => d -> IO (Ptr ())
+getWindowsHandle = requiringOSHandleOfType "Windows handle" .
+ toMaybeWindowsHandle
+ where
+
+ toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ())
+#if defined(mingw32_HOST_OS)
+ toMaybeWindowsHandle dev
+ | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle)
+ = Just (toHANDLE nativeHandle)
+ | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle)
+ = Just (toHANDLE consoleHandle)
+ | otherwise
+ = Nothing
+ {-
+ This is inspired by the implementation of
+ 'System.Win32.Types.withHandleToHANDLENative'.
+ -}
+#else
+ toMaybeWindowsHandle _ = Nothing
+#endif
+
+{-|
+ Executes a user-provided action on the POSIX file descriptor that underlies
+ a handle or specifically on the POSIX file descriptor for reading if the
+ handle uses different file descriptors for reading and writing. The
+ Haskell-managed buffers related to the file descriptor are flushed before
+ the user-provided action is run. While this action is executed, further
+ operations on the handle are blocked to a degree that interference with this
+ action is prevented.
+
+ If the handle does not use POSIX file descriptors, an exception is thrown.
+
+ See [below](#with-ref-caveats) for caveats regarding this operation.
+-}
+withFileDescriptorReadingBiased :: Handle -> (CInt -> IO r) -> IO r
+withFileDescriptorReadingBiased = withOSHandle "withFileDescriptorReadingBiased"
+ handleStateVarReadingBiased
+ getFileDescriptor
+ flushBuffer
+
+{-|
+ Executes a user-provided action on the POSIX file descriptor that underlies
+ a handle or specifically on the POSIX file descriptor for writing if the
+ handle uses different file descriptors for reading and writing. The
+ Haskell-managed buffers related to the file descriptor are flushed before
+ the user-provided action is run. While this action is executed, further
+ operations on the handle are blocked to a degree that interference with this
+ action is prevented.
+
+ If the handle does not use POSIX file descriptors, an exception is thrown.
+
+ See [below](#with-ref-caveats) for caveats regarding this operation.
+-}
+withFileDescriptorWritingBiased :: Handle -> (CInt -> IO r) -> IO r
+withFileDescriptorWritingBiased = withOSHandle "withFileDescriptorWritingBiased"
+ handleStateVarWritingBiased
+ getFileDescriptor
+ flushBuffer
+
+{-|
+ Executes a user-provided action on the Windows handle that underlies a
+ Haskell handle or specifically on the Windows handle for reading if the
+ Haskell handle uses different Windows handles for reading and writing. The
+ Haskell-managed buffers related to the Windows handle are flushed before the
+ user-provided action is run. While this action is executed, further
+ operations on the Haskell handle are blocked to a degree that interference
+ with this action is prevented.
+
+ If the Haskell handle does not use Windows handles, an exception is thrown.
+
+ See [below](#with-ref-caveats) for caveats regarding this operation.
+-}
+withWindowsHandleReadingBiased :: Handle -> (Ptr () -> IO r) -> IO r
+withWindowsHandleReadingBiased = withOSHandle "withWindowsHandleReadingBiased"
+ handleStateVarReadingBiased
+ getWindowsHandle
+ flushBuffer
+
+{-|
+ Executes a user-provided action on the Windows handle that underlies a
+ Haskell handle or specifically on the Windows handle for writing if the
+ Haskell handle uses different Windows handles for reading and writing. The
+ Haskell-managed buffers related to the Windows handle are flushed before the
+ user-provided action is run. While this action is executed, further
+ operations on the Haskell handle are blocked to a degree that interference
+ with this action is prevented.
+
+ If the Haskell handle does not use Windows handles, an exception is thrown.
+
+ See [below](#with-ref-caveats) for caveats regarding this operation.
+-}
+withWindowsHandleWritingBiased :: Handle -> (Ptr () -> IO r) -> IO r
+withWindowsHandleWritingBiased = withOSHandle "withWindowsHandleWritingBiased"
+ handleStateVarWritingBiased
+ getWindowsHandle
+ flushBuffer
+
+{-|
+ Like 'withFileDescriptorReadingBiased' except that Haskell-managed buffers
+ are not flushed.
+-}
+withFileDescriptorReadingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
+withFileDescriptorReadingBiasedRaw
+ = withOSHandle "withFileDescriptorReadingBiasedRaw"
+ handleStateVarReadingBiased
+ getFileDescriptor
+ (const $ return ())
+
+{-|
+ Like 'withFileDescriptorWritingBiased' except that Haskell-managed buffers
+ are not flushed.
+-}
+withFileDescriptorWritingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
+withFileDescriptorWritingBiasedRaw
+ = withOSHandle "withFileDescriptorWritingBiasedRaw"
+ handleStateVarWritingBiased
+ getFileDescriptor
+ (const $ return ())
+
+{-|
+ Like 'withWindowsHandleReadingBiased' except that Haskell-managed buffers
+ are not flushed.
+-}
+withWindowsHandleReadingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
+withWindowsHandleReadingBiasedRaw
+ = withOSHandle "withWindowsHandleReadingBiasedRaw"
+ handleStateVarReadingBiased
+ getWindowsHandle
+ (const $ return ())
+
+{-|
+ Like 'withWindowsHandleWritingBiased' except that Haskell-managed buffers
+ are not flushed.
+-}
+withWindowsHandleWritingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
+withWindowsHandleWritingBiasedRaw
+ = withOSHandle "withWindowsHandleWritingBiasedRaw"
+ handleStateVarWritingBiased
+ getWindowsHandle
+ (const $ return ())
-- ** Caveats
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -1,10 +1,5 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
-{-# LANGUAGE GHCForeignImportPrim #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveTraversable #-}
-- Late cost centres introduce a thunk in the asBox function, which leads to
-- an additional wrapper being added to any value placed inside a box.
@@ -42,3 +37,23 @@ module GHC.Exts.Heap.Closures (
) where
import GHC.Internal.Heap.Closures
+
+import GHC.Internal.Data.Functor
+import GHC.Internal.Data.Foldable
+import GHC.Internal.Data.Traversable
+
+deriving instance Functor GenClosure
+deriving instance Foldable GenClosure
+deriving instance Traversable GenClosure
+
+deriving instance Functor GenStgStackClosure
+deriving instance Foldable GenStgStackClosure
+deriving instance Traversable GenStgStackClosure
+
+deriving instance Functor GenStackField
+deriving instance Foldable GenStackField
+deriving instance Traversable GenStackField
+
+deriving instance Functor GenStackFrame
+deriving instance Foldable GenStackFrame
+deriving instance Traversable GenStackFrame
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -284,7 +284,6 @@ Library
GHC.Internal.Read
GHC.Internal.Real
GHC.Internal.Records
- GHC.Internal.ResponseFile
GHC.Internal.RTS.Flags
GHC.Internal.RTS.Flags.Test
GHC.Internal.ST
@@ -323,10 +322,8 @@ Library
GHC.Internal.Numeric.Natural
GHC.Internal.System.Environment
GHC.Internal.System.Environment.Blank
- GHC.Internal.System.Exit
GHC.Internal.System.IO
GHC.Internal.System.IO.Error
- GHC.Internal.System.IO.OS
GHC.Internal.System.Mem
GHC.Internal.System.Mem.StableName
GHC.Internal.System.Posix.Internals
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
=====================================
@@ -41,8 +41,7 @@ import GHC.Internal.Data.Eq
import GHC.Internal.Int ( Int )
import GHC.Internal.Data.List ( map, sort, concat, concatMap, intersperse, (++) )
import GHC.Internal.Data.Ord
-import GHC.Internal.Data.String ( String )
-import GHC.Internal.Base ( Applicative(..), (&&) )
+import GHC.Internal.Base ( Applicative(..), (&&), String )
import GHC.Internal.Generics
import GHC.Internal.Unicode ( isDigit, isAlphaNum )
import GHC.Internal.Read
=====================================
libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
=====================================
@@ -16,23 +16,22 @@ module GHC.Internal.Fingerprint (
fingerprintData,
fingerprintString,
fingerprintFingerprints,
- getFileHash
+ fingerprintBufferedStream
) where
import GHC.Internal.IO
import GHC.Internal.Base
import GHC.Internal.Bits
import GHC.Internal.Num
+import GHC.Internal.Data.Maybe
import GHC.Internal.List
import GHC.Internal.Real
import GHC.Internal.Word
-import GHC.Internal.Show
import GHC.Internal.Ptr
import GHC.Internal.Foreign.C.Types
import GHC.Internal.Foreign.Marshal.Alloc
import GHC.Internal.Foreign.Marshal.Array
import GHC.Internal.Foreign.Storable
-import GHC.Internal.System.IO
import GHC.Internal.Fingerprint.Type
@@ -71,41 +70,27 @@ fingerprintString str = unsafeDupablePerformIO $
fromIntegral (w32 `shiftR` 8),
fromIntegral w32]
--- | Computes the hash of a given file.
--- This function loops over the handle, running in constant memory.
---
--- @since base-4.7.0.0
-getFileHash :: FilePath -> IO Fingerprint
-getFileHash path = withBinaryFile path ReadMode $ \h ->
+-- | Reads data in chunks and computes its hash.
+-- This function runs in constant memory.
+fingerprintBufferedStream :: (Ptr Word8 -> Int -> IO (Maybe Int))
+ -> IO Fingerprint
+fingerprintBufferedStream readChunk =
allocaBytes SIZEOF_STRUCT_MD5CONTEXT $ \pctxt -> do
c_MD5Init pctxt
-
- processChunks h (\buf size -> c_MD5Update pctxt buf (fromIntegral size))
-
+ allocaBytes _BUFSIZE $ \arrPtr ->
+ let loop = do
+ maybeRemainderSize <- readChunk arrPtr _BUFSIZE
+ c_MD5Update pctxt
+ arrPtr
+ (fromIntegral (fromMaybe _BUFSIZE maybeRemainderSize))
+ when (isNothing maybeRemainderSize) loop
+ in loop
allocaBytes 16 $ \pdigest -> do
c_MD5Final pdigest pctxt
peek (castPtr pdigest :: Ptr Fingerprint)
-
where
_BUFSIZE = 4096
- -- Loop over _BUFSIZE sized chunks read from the handle,
- -- passing the callback a block of bytes and its size.
- processChunks :: Handle -> (Ptr Word8 -> Int -> IO ()) -> IO ()
- processChunks h f = allocaBytes _BUFSIZE $ \arrPtr ->
-
- let loop = do
- count <- hGetBuf h arrPtr _BUFSIZE
- eof <- hIsEOF h
- when (count /= _BUFSIZE && not eof) $ errorWithoutStackTrace $
- "GHC.Internal.Fingerprint.getFileHash: only read " ++ show count ++ " bytes"
-
- f arrPtr count
-
- when (not eof) loop
-
- in loop
-
data MD5Context
foreign import ccall unsafe "__hsbase_MD5Init"
=====================================
libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
=====================================
@@ -24,9 +24,10 @@ module GHC.Internal.GHCi.Helpers
, evalWrapper
) where
-import GHC.Internal.Base
-import GHC.Internal.System.IO
-import GHC.Internal.System.Environment
+import GHC.Internal.Base (String, IO)
+import GHC.Internal.IO.Handle (BufferMode (NoBuffering), hSetBuffering, hFlush)
+import GHC.Internal.IO.StdHandles (stdin, stdout, stderr)
+import GHC.Internal.System.Environment (withProgName, withArgs)
disableBuffering :: IO ()
disableBuffering = do
=====================================
libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
=====================================
@@ -5,7 +5,6 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DeriveTraversable #-}
-- Late cost centres introduce a thunk in the asBox function, which leads to
-- an additional wrapper being added to any value placed inside a box.
-- This can be removed once our boot compiler is no longer affected by #25212
@@ -69,8 +68,7 @@ in the profiling way. (#15197)
import GHC.Internal.Heap.ProfInfo.Types
import GHC.Internal.Data.Bits
-import GHC.Internal.Data.Foldable (Foldable, toList)
-import GHC.Internal.Data.Traversable (Traversable)
+import GHC.Internal.Data.Foldable (toList)
import GHC.Internal.Int
import GHC.Internal.Num
import GHC.Internal.Real
@@ -383,7 +381,7 @@ data GenClosure b
-- or an Int#).
| UnknownTypeWordSizedPrimitive
{ wordVal :: !Word }
- deriving (Show, Generic, Functor, Foldable, Traversable)
+ deriving (Show, Generic)
-- | Get the info table for a heap closure, or Nothing for a prim value
--
@@ -500,7 +498,7 @@ data GenStgStackClosure b = GenStgStackClosure
, ssc_stack_size :: !Word32 -- ^ stack size in *words*
, ssc_stack :: ![GenStackFrame b]
}
- deriving (Foldable, Functor, Generic, Show, Traversable)
+ deriving (Generic, Show)
type StackField = GenStackField Box
@@ -510,7 +508,7 @@ data GenStackField b
= StackWord !Word
-- | A pointer field
| StackBox !b
- deriving (Foldable, Functor, Generic, Show, Traversable)
+ deriving (Generic, Show)
type StackFrame = GenStackFrame Box
@@ -579,7 +577,7 @@ data GenStackFrame b =
{ info_tbl :: !StgInfoTable
, annotation :: !b
}
- deriving (Foldable, Functor, Generic, Show, Traversable)
+ deriving (Generic, Show)
data PrimType
= PInt
=====================================
libraries/ghc-internal/src/GHC/Internal/ResponseFile.hs deleted
=====================================
@@ -1,163 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE Trustworthy #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.Internal.ResponseFile
--- License : BSD-style (see the file LICENSE)
---
--- Maintainer : libraries(a)haskell.org
--- Stability : internal
--- Portability : portable
---
--- GCC style response files.
---
--- @since base-4.12.0.0
-----------------------------------------------------------------------------
-
--- Migrated from Haddock.
-
-module GHC.Internal.ResponseFile (
- getArgsWithResponseFiles,
- unescapeArgs,
- escapeArgs, escapeArg,
- expandResponse
- ) where
-
-import GHC.Internal.Control.Exception
-import GHC.Internal.Data.Foldable (Foldable(..))
-import GHC.Internal.Base
-import GHC.Internal.Unicode (isSpace)
-import GHC.Internal.Data.List (filter, unlines, concat, reverse)
-import GHC.Internal.Text.Show (show)
-import GHC.Internal.System.Environment (getArgs)
-import GHC.Internal.System.Exit (exitFailure)
-import GHC.Internal.System.IO
-
-{-|
-Like 'getArgs', but can also read arguments supplied via response files.
-
-
-For example, consider a program @foo@:
-
-@
-main :: IO ()
-main = do
- args <- getArgsWithResponseFiles
- putStrLn (show args)
-@
-
-
-And a response file @args.txt@:
-
-@
---one 1
---\'two\' 2
---"three" 3
-@
-
-Then the result of invoking @foo@ with @args.txt@ is:
-
-> > ./foo @args.txt
-> ["--one","1","--two","2","--three","3"]
-
--}
-getArgsWithResponseFiles :: IO [String]
-getArgsWithResponseFiles = getArgs >>= expandResponse
-
--- | Given a string of concatenated strings, separate each by removing
--- a layer of /quoting/ and\/or /escaping/ of certain characters.
---
--- These characters are: any whitespace, single quote, double quote,
--- and the backslash character. The backslash character always
--- escapes (i.e., passes through without further consideration) the
--- character which follows. Characters can also be escaped in blocks
--- by quoting (i.e., surrounding the blocks with matching pairs of
--- either single- or double-quotes which are not themselves escaped).
---
--- Any whitespace which appears outside of either of the quoting and
--- escaping mechanisms, is interpreted as having been added by this
--- special concatenation process to designate where the boundaries
--- are between the original, un-concatenated list of strings. These
--- added whitespace characters are removed from the output.
---
--- > unescapeArgs "hello\\ \\\"world\\\"\n" == ["hello \"world\""]
-unescapeArgs :: String -> [String]
-unescapeArgs = filter (not . null) . unescape
-
--- | Given a list of strings, concatenate them into a single string
--- with escaping of certain characters, and the addition of a newline
--- between each string. The escaping is done by adding a single
--- backslash character before any whitespace, single quote, double
--- quote, or backslash character, so this escaping character must be
--- removed. Unescaped whitespace (in this case, newline) is part
--- of this "transport" format to indicate the end of the previous
--- string and the start of a new string.
---
--- While 'unescapeArgs' allows using quoting (i.e., convenient
--- escaping of many characters) by having matching sets of single- or
--- double-quotes,'escapeArgs' does not use the quoting mechanism,
--- and thus will always escape any whitespace, quotes, and
--- backslashes.
---
--- > escapeArgs ["hello \"world\""] == "hello\\ \\\"world\\\"\n"
-escapeArgs :: [String] -> String
-escapeArgs = unlines . map escapeArg
-
--- | Arguments which look like @\@foo@ will be replaced with the
--- contents of file @foo@. A gcc-like syntax for response files arguments
--- is expected. This must re-constitute the argument list by doing an
--- inverse of the escaping mechanism done by the calling-program side.
---
--- We quit if the file is not found or reading somehow fails.
--- (A convenience routine for haddock or possibly other clients)
-expandResponse :: [String] -> IO [String]
-expandResponse = fmap concat . mapM expand
- where
- expand :: String -> IO [String]
- expand ('@':f) = readFileExc f >>= return . unescapeArgs
- expand x = return [x]
-
- readFileExc f =
- readFile f `catch` \(e :: IOException) -> do
- hPutStrLn stderr $ "Error while expanding response file: " ++ show e
- exitFailure
-
-data Quoting = NoneQ | SngQ | DblQ
-
-unescape :: String -> [String]
-unescape args = reverse . map reverse $ go args NoneQ False [] []
- where
- -- n.b., the order of these cases matters; these are cribbed from gcc
- -- case 1: end of input
- go [] _q _bs a as = a:as
- -- case 2: back-slash escape in progress
- go (c:cs) q True a as = go cs q False (c:a) as
- -- case 3: no back-slash escape in progress, but got a back-slash
- go (c:cs) q False a as
- | '\\' == c = go cs q True a as
- -- case 4: single-quote escaping in progress
- go (c:cs) SngQ False a as
- | '\'' == c = go cs NoneQ False a as
- | otherwise = go cs SngQ False (c:a) as
- -- case 5: double-quote escaping in progress
- go (c:cs) DblQ False a as
- | '"' == c = go cs NoneQ False a as
- | otherwise = go cs DblQ False (c:a) as
- -- case 6: no escaping is in progress
- go (c:cs) NoneQ False a as
- | isSpace c = go cs NoneQ False [] (a:as)
- | '\'' == c = go cs SngQ False a as
- | '"' == c = go cs DblQ False a as
- | otherwise = go cs NoneQ False (c:a) as
-
-escapeArg :: String -> String
-escapeArg = reverse . foldl' escape []
-
-escape :: String -> Char -> String
-escape cs c
- | isSpace c
- || '\\' == c
- || '\'' == c
- || '"' == c = c:'\\':cs -- n.b., our caller must reverse the result
- | otherwise = c:cs
=====================================
libraries/ghc-internal/src/GHC/Internal/System/Exit.hs deleted
=====================================
@@ -1,81 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-
------------------------------------------------------------------------------
--- |
--- Module : GHC.Internal.System.Exit
--- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/base/LICENSE)
---
--- Maintainer : libraries(a)haskell.org
--- Stability : provisional
--- Portability : portable
---
--- Exiting the program.
---
------------------------------------------------------------------------------
-
-module GHC.Internal.System.Exit
- (
- ExitCode(ExitSuccess,ExitFailure)
- , exitWith
- , exitFailure
- , exitSuccess
- , die
- ) where
-
-import GHC.Internal.System.IO
-
-import GHC.Internal.Base
-import GHC.Internal.IO
-import GHC.Internal.IO.Exception
-
--- ---------------------------------------------------------------------------
--- exitWith
-
--- | Computation 'exitWith' @code@ throws 'ExitCode' @code@.
--- Normally this terminates the program, returning @code@ to the
--- program's caller.
---
--- On program termination, the standard 'Handle's 'stdout' and
--- 'stderr' are flushed automatically; any other buffered 'Handle's
--- need to be flushed manually, otherwise the buffered data will be
--- discarded.
---
--- A program that fails in any other way is treated as if it had
--- called 'exitFailure'.
--- A program that terminates successfully without calling 'exitWith'
--- explicitly is treated as if it had called 'exitWith' 'ExitSuccess'.
---
--- As an 'ExitCode' is an 'Control.Exception.Exception', it can be
--- caught using the functions of "Control.Exception". This means that
--- cleanup computations added with 'GHC.Internal.Control.Exception.bracket' (from
--- "Control.Exception") are also executed properly on 'exitWith'.
---
--- Note: in GHC, 'exitWith' should be called from the main program
--- thread in order to exit the process. When called from another
--- thread, 'exitWith' will throw an 'ExitCode' as normal, but the
--- exception will not cause the process itself to exit.
---
-exitWith :: ExitCode -> IO a
-exitWith ExitSuccess = throwIO ExitSuccess
-exitWith code@(ExitFailure n)
- | n /= 0 = throwIO code
- | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing Nothing)
-
--- | The computation 'exitFailure' is equivalent to
--- 'exitWith' @(@'ExitFailure' /exitfail/@)@,
--- where /exitfail/ is implementation-dependent.
-exitFailure :: IO a
-exitFailure = exitWith (ExitFailure 1)
-
--- | The computation 'exitSuccess' is equivalent to
--- 'exitWith' 'ExitSuccess', It terminates the program
--- successfully.
-exitSuccess :: IO a
-exitSuccess = exitWith ExitSuccess
-
--- | Write given error message to `stderr` and terminate with `exitFailure`.
---
--- @since base-4.8.0.0
-die :: String -> IO a
-die err = hPutStrLn stderr err >> exitFailure
=====================================
libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs deleted
=====================================
@@ -1,323 +0,0 @@
-{-# LANGUAGE Trustworthy #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE RankNTypes #-}
-
-{-|
- This module bridges between Haskell handles and underlying operating-system
- features.
--}
-module GHC.Internal.System.IO.OS
-(
- -- * Obtaining file descriptors and Windows handles
- withFileDescriptorReadingBiased,
- withFileDescriptorWritingBiased,
- withWindowsHandleReadingBiased,
- withWindowsHandleWritingBiased,
- withFileDescriptorReadingBiasedRaw,
- withFileDescriptorWritingBiasedRaw,
- withWindowsHandleReadingBiasedRaw,
- withWindowsHandleWritingBiasedRaw
-
- -- ** Caveats
- -- $with-ref-caveats
-)
-where
-
-#if defined(mingw32_HOST_OS)
-import GHC.Internal.Base (otherwise)
-#endif
-import GHC.Internal.Control.Monad (return)
-import GHC.Internal.Control.Concurrent.MVar (MVar)
-import GHC.Internal.Control.Exception (mask)
-import GHC.Internal.Data.Function (const, (.), ($))
-import GHC.Internal.Data.Functor (fmap)
-import GHC.Internal.Data.Maybe (Maybe (Nothing), maybe)
-#if defined(mingw32_HOST_OS)
-import GHC.Internal.Data.Maybe (Maybe (Just))
-#endif
-import GHC.Internal.Data.List ((++))
-import GHC.Internal.Data.String (String)
-import GHC.Internal.Data.Typeable (Typeable, cast)
-import GHC.Internal.System.IO (IO)
-import GHC.Internal.IO.FD (fdFD)
-#if defined(mingw32_HOST_OS)
-import GHC.Internal.IO.Windows.Handle
- (
- NativeHandle,
- ConsoleHandle,
- IoHandle,
- toHANDLE
- )
-#endif
-import GHC.Internal.IO.Handle.Types
- (
- Handle (FileHandle, DuplexHandle),
- Handle__ (Handle__, haDevice)
- )
-import GHC.Internal.IO.Handle.Internals (withHandle_', flushBuffer)
-import GHC.Internal.IO.Exception
- (
- IOErrorType (InappropriateType),
- IOException (IOError),
- ioException
- )
-import GHC.Internal.Foreign.Ptr (Ptr)
-import GHC.Internal.Foreign.C.Types (CInt)
-
--- * Obtaining POSIX file descriptors and Windows handles
-
-{-|
- Executes a user-provided action on an operating-system handle that underlies
- a Haskell handle. Before the user-provided action is run, user-defined
- preparation based on the handle state that contains the operating-system
- handle is performed. While the user-provided action is executed, further
- operations on the Haskell handle are blocked to a degree that interference
- with this action is prevented.
-
- See [below](#with-ref-caveats) for caveats regarding this operation.
--}
-withOSHandle :: String
- -- ^ The name of the overall operation
- -> (Handle -> MVar Handle__)
- {-^
- Obtaining of the handle state variable that holds the
- operating-system handle
- -}
- -> (forall d. Typeable d => d -> IO a)
- -- ^ Conversion of a device into an operating-system handle
- -> (Handle__ -> IO ())
- -- ^ The preparation
- -> Handle
- -- ^ The Haskell handle to use
- -> (a -> IO r)
- -- ^ The action to execute on the operating-system handle
- -> IO r
-withOSHandle opName handleStateVar getOSHandle prepare handle act
- = mask $ \ withOriginalMaskingState ->
- withHandleState $ \ handleState@Handle__ {haDevice = dev} -> do
- osHandle <- getOSHandle dev
- prepare handleState
- withOriginalMaskingState $ act osHandle
- where
-
- withHandleState = withHandle_' opName handle (handleStateVar handle)
-{-
- The 'withHandle_'' operation, which we use here, already performs masking.
- Still, we have to employ 'mask', in order do obtain the operation that
- restores the original masking state. The user-provided action should be
- executed with this original masking state, as there is no inherent reason to
- generally perform it with masking in place. The masking that 'withHandle_''
- performs is only for safely accessing handle state and thus constitutes an
- implementation detail; it has nothing to do with the user-provided action.
--}
-{-
- The order of actions in 'withOSHandle' is such that any exception from
- 'getOSHandle' is thrown before the user-defined preparation is performed.
--}
-
-{-|
- Obtains the handle state variable that underlies a handle or specifically
- the handle state variable for reading if the handle uses different state
- variables for reading and writing.
--}
-handleStateVarReadingBiased :: Handle -> MVar Handle__
-handleStateVarReadingBiased (FileHandle _ var) = var
-handleStateVarReadingBiased (DuplexHandle _ readingVar _) = readingVar
-
-{-|
- Obtains the handle state variable that underlies a handle or specifically
- the handle state variable for writing if the handle uses different state
- variables for reading and writing.
--}
-handleStateVarWritingBiased :: Handle -> MVar Handle__
-handleStateVarWritingBiased (FileHandle _ var) = var
-handleStateVarWritingBiased (DuplexHandle _ _ writingVar) = writingVar
-
-{-|
- Yields the result of another operation if that operation succeeded, and
- otherwise throws an exception that signals that the other operation failed
- because some Haskell handle does not use an operating-system handle of a
- required type.
--}
-requiringOSHandleOfType :: String
- -- ^ The name of the operating-system handle type
- -> Maybe a
- {-^
- The result of the other operation if it succeeded
- -}
- -> IO a
-requiringOSHandleOfType osHandleTypeName
- = maybe (ioException osHandleOfTypeRequired) return
- where
-
- osHandleOfTypeRequired :: IOException
- osHandleOfTypeRequired
- = IOError Nothing
- InappropriateType
- ""
- ("handle does not use " ++ osHandleTypeName ++ "s")
- Nothing
- Nothing
-
-{-|
- Obtains the POSIX file descriptor of a device if the device contains one,
- and throws an exception otherwise.
--}
-getFileDescriptor :: Typeable d => d -> IO CInt
-getFileDescriptor = requiringOSHandleOfType "POSIX file descriptor" .
- fmap fdFD . cast
-
-{-|
- Obtains the Windows handle of a device if the device contains one, and
- throws an exception otherwise.
--}
-getWindowsHandle :: Typeable d => d -> IO (Ptr ())
-getWindowsHandle = requiringOSHandleOfType "Windows handle" .
- toMaybeWindowsHandle
- where
-
- toMaybeWindowsHandle :: Typeable d => d -> Maybe (Ptr ())
-#if defined(mingw32_HOST_OS)
- toMaybeWindowsHandle dev
- | Just nativeHandle <- cast dev :: Maybe (IoHandle NativeHandle)
- = Just (toHANDLE nativeHandle)
- | Just consoleHandle <- cast dev :: Maybe (IoHandle ConsoleHandle)
- = Just (toHANDLE consoleHandle)
- | otherwise
- = Nothing
- {-
- This is inspired by the implementation of
- 'System.Win32.Types.withHandleToHANDLENative'.
- -}
-#else
- toMaybeWindowsHandle _ = Nothing
-#endif
-
-{-|
- Executes a user-provided action on the POSIX file descriptor that underlies
- a handle or specifically on the POSIX file descriptor for reading if the
- handle uses different file descriptors for reading and writing. The
- Haskell-managed buffers related to the file descriptor are flushed before
- the user-provided action is run. While this action is executed, further
- operations on the handle are blocked to a degree that interference with this
- action is prevented.
-
- If the handle does not use POSIX file descriptors, an exception is thrown.
-
- See [below](#with-ref-caveats) for caveats regarding this operation.
--}
-withFileDescriptorReadingBiased :: Handle -> (CInt -> IO r) -> IO r
-withFileDescriptorReadingBiased = withOSHandle "withFileDescriptorReadingBiased"
- handleStateVarReadingBiased
- getFileDescriptor
- flushBuffer
-
-{-|
- Executes a user-provided action on the POSIX file descriptor that underlies
- a handle or specifically on the POSIX file descriptor for writing if the
- handle uses different file descriptors for reading and writing. The
- Haskell-managed buffers related to the file descriptor are flushed before
- the user-provided action is run. While this action is executed, further
- operations on the handle are blocked to a degree that interference with this
- action is prevented.
-
- If the handle does not use POSIX file descriptors, an exception is thrown.
-
- See [below](#with-ref-caveats) for caveats regarding this operation.
--}
-withFileDescriptorWritingBiased :: Handle -> (CInt -> IO r) -> IO r
-withFileDescriptorWritingBiased = withOSHandle "withFileDescriptorWritingBiased"
- handleStateVarWritingBiased
- getFileDescriptor
- flushBuffer
-
-{-|
- Executes a user-provided action on the Windows handle that underlies a
- Haskell handle or specifically on the Windows handle for reading if the
- Haskell handle uses different Windows handles for reading and writing. The
- Haskell-managed buffers related to the Windows handle are flushed before the
- user-provided action is run. While this action is executed, further
- operations on the Haskell handle are blocked to a degree that interference
- with this action is prevented.
-
- If the Haskell handle does not use Windows handles, an exception is thrown.
-
- See [below](#with-ref-caveats) for caveats regarding this operation.
--}
-withWindowsHandleReadingBiased :: Handle -> (Ptr () -> IO r) -> IO r
-withWindowsHandleReadingBiased = withOSHandle "withWindowsHandleReadingBiased"
- handleStateVarReadingBiased
- getWindowsHandle
- flushBuffer
-
-{-|
- Executes a user-provided action on the Windows handle that underlies a
- Haskell handle or specifically on the Windows handle for writing if the
- Haskell handle uses different Windows handles for reading and writing. The
- Haskell-managed buffers related to the Windows handle are flushed before the
- user-provided action is run. While this action is executed, further
- operations on the Haskell handle are blocked to a degree that interference
- with this action is prevented.
-
- If the Haskell handle does not use Windows handles, an exception is thrown.
-
- See [below](#with-ref-caveats) for caveats regarding this operation.
--}
-withWindowsHandleWritingBiased :: Handle -> (Ptr () -> IO r) -> IO r
-withWindowsHandleWritingBiased = withOSHandle "withWindowsHandleWritingBiased"
- handleStateVarWritingBiased
- getWindowsHandle
- flushBuffer
-
-{-|
- Like 'withFileDescriptorReadingBiased' except that Haskell-managed buffers
- are not flushed.
--}
-withFileDescriptorReadingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
-withFileDescriptorReadingBiasedRaw
- = withOSHandle "withFileDescriptorReadingBiasedRaw"
- handleStateVarReadingBiased
- getFileDescriptor
- (const $ return ())
-
-{-|
- Like 'withFileDescriptorWritingBiased' except that Haskell-managed buffers
- are not flushed.
--}
-withFileDescriptorWritingBiasedRaw :: Handle -> (CInt -> IO r) -> IO r
-withFileDescriptorWritingBiasedRaw
- = withOSHandle "withFileDescriptorWritingBiasedRaw"
- handleStateVarWritingBiased
- getFileDescriptor
- (const $ return ())
-
-{-|
- Like 'withWindowsHandleReadingBiased' except that Haskell-managed buffers
- are not flushed.
--}
-withWindowsHandleReadingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
-withWindowsHandleReadingBiasedRaw
- = withOSHandle "withWindowsHandleReadingBiasedRaw"
- handleStateVarReadingBiased
- getWindowsHandle
- (const $ return ())
-
-{-|
- Like 'withWindowsHandleWritingBiased' except that Haskell-managed buffers
- are not flushed.
--}
-withWindowsHandleWritingBiasedRaw :: Handle -> (Ptr () -> IO r) -> IO r
-withWindowsHandleWritingBiasedRaw
- = withOSHandle "withWindowsHandleWritingBiasedRaw"
- handleStateVarWritingBiased
- getWindowsHandle
- (const $ return ())
-
--- ** Caveats
-
-{-$with-ref-caveats
- #with-ref-caveats#This subsection is just a dummy, whose purpose is to serve
- as the target of the hyperlinks above. The real documentation of the caveats
- is in the /Caveats/ subsection in the @base@ module @System.IO.OS@, which
- re-exports the above operations.
--}
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
=====================================
@@ -26,17 +26,19 @@ module GHC.Internal.TH.Monad
import Prelude
import Data.Data hiding (Fixity(..))
import Data.IORef
-import System.IO.Unsafe ( unsafePerformIO )
+import System.IO.Unsafe (unsafePerformIO)
import Control.Monad.IO.Class (MonadIO (..))
-import System.IO ( hPutStrLn, stderr )
+import System.IO (FilePath, hPutStrLn, stderr)
import qualified Data.Kind as Kind (Type)
-import GHC.Types (TYPE, RuntimeRep(..))
+import GHC.Types (TYPE, RuntimeRep(..))
#else
import GHC.Internal.Base hiding (NonEmpty(..),Type, Module, sequence)
import GHC.Internal.Data.Data hiding (Fixity(..))
import GHC.Internal.Data.Traversable
import GHC.Internal.IORef
-import GHC.Internal.System.IO
+import GHC.Internal.IO (FilePath)
+import GHC.Internal.IO.Handle.Text (hPutStrLn)
+import GHC.Internal.IO.StdHandles (stderr)
import GHC.Internal.Data.Foldable
import GHC.Internal.Data.Typeable
import GHC.Internal.Control.Monad.IO.Class
@@ -819,38 +821,6 @@ addTempFile suffix = Q (qAddTempFile suffix)
addTopDecls :: [Dec] -> Q ()
addTopDecls ds = Q (qAddTopDecls ds)
-
--- | Emit a foreign file which will be compiled and linked to the object for
--- the current module. Currently only languages that can be compiled with
--- the C compiler are supported, and the flags passed as part of -optc will
--- be also applied to the C compiler invocation that will compile them.
---
--- Note that for non-C languages (for example C++) @extern "C"@ directives
--- must be used to get symbols that we can access from Haskell.
---
--- To get better errors, it is recommended to use #line pragmas when
--- emitting C files, e.g.
---
--- > {-# LANGUAGE CPP #-}
--- > ...
--- > addForeignSource LangC $ unlines
--- > [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__
--- > , ...
--- > ]
-addForeignSource :: ForeignSrcLang -> String -> Q ()
-addForeignSource lang src = do
- let suffix = case lang of
- LangC -> "c"
- LangCxx -> "cpp"
- LangObjc -> "m"
- LangObjcxx -> "mm"
- LangAsm -> "s"
- LangJs -> "js"
- RawObject -> "a"
- path <- addTempFile suffix
- runIO $ writeFile path src
- addForeignFilePath lang path
-
-- | Same as 'addForeignSource', but expects to receive a path pointing to the
-- foreign file instead of a 'String' of its contents. Consider using this in
-- conjunction with 'addTempFile'.
=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -209,7 +209,7 @@ import Data.List.NonEmpty (NonEmpty(..))
import GHC.Lexeme ( startsVarSym, startsVarId )
-- This module completely re-exports 'GHC.Boot.TH.Syntax',
--- and exports additionally functions that depend on filepath.
+-- and exports additionally functions that depend on @filepath@ or @System.IO@.
-- |
addForeignFile :: ForeignSrcLang -> String -> Q ()
@@ -218,6 +218,37 @@ addForeignFile = addForeignSource
"Use 'Language.Haskell.TH.Syntax.addForeignSource' instead"
#-} -- deprecated in 8.6
+-- | Emit a foreign file which will be compiled and linked to the object for
+-- the current module. Currently only languages that can be compiled with
+-- the C compiler are supported, and the flags passed as part of -optc will
+-- be also applied to the C compiler invocation that will compile them.
+--
+-- Note that for non-C languages (for example C++) @extern "C"@ directives
+-- must be used to get symbols that we can access from Haskell.
+--
+-- To get better errors, it is recommended to use #line pragmas when
+-- emitting C files, e.g.
+--
+-- > {-# LANGUAGE CPP #-}
+-- > ...
+-- > addForeignSource LangC $ unlines
+-- > [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__
+-- > , ...
+-- > ]
+addForeignSource :: ForeignSrcLang -> String -> Q ()
+addForeignSource lang src = do
+ let suffix = case lang of
+ LangC -> "c"
+ LangCxx -> "cpp"
+ LangObjc -> "m"
+ LangObjcxx -> "mm"
+ LangAsm -> "s"
+ LangJs -> "js"
+ RawObject -> "a"
+ path <- addTempFile suffix
+ runIO $ writeFile path src
+ addForeignFilePath lang path
+
-- | The input is a filepath, which if relative is offset by the package root.
makeRelativeToProject :: FilePath -> Q FilePath
makeRelativeToProject fp | isRelative fp = do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d5fe25821cac5dcb542e4fd2a045480…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d5fe25821cac5dcb542e4fd2a045480…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T20264] 83 commits: PPC NCG: Use libcall for 64-bit cmpxchg on 32-bit PowerPC
by Simon Peyton Jones (＠simonpj) 28 Feb '26
by Simon Peyton Jones (＠simonpj) 28 Feb '26
28 Feb '26
Simon Peyton Jones pushed to branch wip/T20264 at Glasgow Haskell Compiler / GHC
Commits:
ce2d62fb by Jessica Clarke at 2026-01-29T19:48:51-05:00
PPC NCG: Use libcall for 64-bit cmpxchg on 32-bit PowerPC
There is no native instruction for this, and even if there were a
register pair version we could use, the implementation here is assuming
the values fit in a single register, and we end up only using / defining
the low halves of the registers.
Fixes: b4d39adbb5 ("PrimOps: Add CAS op for all int sizes")
Fixes: #23969
- - - - -
43d97761 by Michael Karcher at 2026-01-29T19:49:43-05:00
NCG for PPC: add pattern for CmmRegOff to iselExpr64
Closes #26828
- - - - -
aeeb4a20 by Matthew Pickering at 2026-01-30T11:42:47-05:00
determinism: Use deterministic map for Strings in TyLitMap
When generating typeable evidence the types we need evidence for all
cached in a TypeMap, the order terms are retrieved from a type map
determines the order the bindings appear in the program.
A TypeMap is quite diligent to use deterministic maps, apart from in the
TyLitMap, which uses a UniqFM for storing strings, whose ordering
depends on the Unique of the FastString.
This can cause non-deterministic .hi and .o files.
An unexpected side-effect is the error message but RecordDotSyntaxFail8
changing. I looked into this with Sam and this change caused the
constraints to be solved in a different order which results in a
slightly different error message. I have accepted the new test, since
the output before was non-deterministic and the new output is consistent
with the other messages in that file.
Fixes #26846
- - - - -
9e4d70c2 by Andrew Lelechenko at 2026-01-30T11:43:29-05:00
Upgrade text submodule to 2.1.4
- - - - -
631fa5ae by Recursion Ninja at 2026-01-31T22:30:11+00:00
Decouple `L.S.H.Decls` from importing `GHC.Types.Basic`
Data-types within `GHC.Types.Basic` which describe components of
the AST are migrated to `Language.Haskell.Syntax.Basic`. Related
function definitions are also moved.
Types moved to L.H.S. because they are part of the AST:
* TopLevelFlag
* RuleName
Types moved from L.H.S. to GHC.Hs. because they are not needed in the AST:
* TyConFlavour
* TypeOrData
* NewOrData
Migrated instances:
* `Outputable` instances moved to in `GHC.Utils.Outputable`
* `Binary` instance of `Boxity` moved to to `GHC.Utils.Binary`
* Other `Binary` instances are orphans to be migrated later.
The `OverlapMode` data-type is given a TTG extension point.
The `OverlapFlag` data-type, which depends on `OverlapMode`,
is updated to support `OverlapMode` with a GHC "pass" type paramerter.
In order to avoid module import cycles, `OverlapMode` and `OverlapFlag`
are migrated to new modules (no way around this).
* Migrated `OverlapMode` to new module `Language.Haskell.Syntax.Overlap`
* Migrated `OverlapFlag` to new module `GHC.Hs.Decls.Overlap`
- - - - -
9769cc03 by Simon Hengel at 2026-02-01T04:21:03-05:00
Update the documentation for MultiWayIf (fixes #25376)
(so that it matches the implementation)
- - - - -
5fc9442a by Peter Trommler at 2026-02-01T04:21:44-05:00
hadrian: Fix dependency generation for assembler
Assembler files allow # for comments unless in column 1. A modern
cpp for C treats those a preprocessor directives. We tell gcc that
a .S file is assembler with cpp and not C.
Fixes #26819
- - - - -
269c4087 by Simon Peyton Jones at 2026-02-01T19:38:10-05:00
Include current phase in the range for rule/unfoldings
This MR fixes a bad loop in the compiler: #26826.
The fix is to add (WAR2) to
Note [What is active in the RHS of a RULE or unfolding?]
in GHC.Core.Opt.Simplify.Utils
- - - - -
ddf1434f by Vladislav Zavialov at 2026-02-01T19:38:52-05:00
Refactor: merge HsMultilineString into HsString (#26860)
Before this patch, HsLit defined two separate constructors to represent
single-line and multi-line strings:
data HsLit x
...
| HsString (XHsString x) FastString
| HsMultilineString (XHsMultilineString x) FastString
I found this to be an unnecessary complication and an obstacle to unifying
HsLit with HsTyLit. Now we use HsString for both kinds of literals.
One user-facing change here is `ppr (HsString st s)` behaving differently for
single-line strings containing newlines:
x = "first line \
\asdf\n\
\second line"
Previously, the literal was fed to `ftext` with its newlines, producing an
ill-formed SDoc. This issue is now addressed by using `split` for both
single-line and multi-line strings:
vcat $ map text $ split '\n' (unpackFS src)
See the parser/should_fail/T26860ppr test.
In addition (and unrelatedly to the main payload of this patch),
drop the unused pmPprHsLit helper.
- - - - -
2b4f463c by Simon Peyton Jones at 2026-02-02T17:32:32+00:00
Remove exprIsCheap from doFloatFromRhs
See #26854 and Note [Float when expandable]
This patch simplifies the code, by removing an extra unnecessary test.
- - - - -
9db7f21f by Brandon Chinn at 2026-02-03T09:15:10-05:00
Refactor: make function patterns exhaustive
Also added missing (==) logic for:
* HsMultilineString
* HsInt{8,16,32}
* HsWord{8,16,32}
- - - - -
aa9c5e2c by Hécate Kleidukos at 2026-02-03T15:58:35-05:00
driver: Hide source paths at verbosity level 1 by default
- - - - -
c64cca1e by mangoiv at 2026-02-03T15:59:29-05:00
ExplicitLevelImports: check staging for types just like for values
Previously, imported types were entirely exempted from staging checks as
the implicit stage persistance assumed to be all imported types to be
well staged. ExplicitLevelImports' change specification, however, does
not do such an exemption. Thus we want to introduce such a check, just
like we have for values.
ExplicitLevelImports does not, however, talk about local names - from
its perspective, we could theoretically keep treating locally introduced
types specially - e.g. an ill-staged used in a quote would only emit a
warning, not an error. To allow for a potential future migration away
from such wrinkles as the staging check in notFound
(see Note [Out of scope might be a staging error]) we consistently do
the strict staging check that we also do for value if ExplicitLevelImports
is on.
Closes #26098
- - - - -
5f0dbeb6 by Simon Hengel at 2026-02-03T16:00:12-05:00
Use Haddock formatting in deprecation message of `initNameCache`
- - - - -
01ecb612 by Andreas Klebinger at 2026-02-04T09:56:25-05:00
testsuite: Explicitly use utf-8 encoding in rts-includes linter.
Not doing so caused failures on windows, as python failed to pick a
reasonable encoding even with locale set.
Fixes #26850
- - - - -
ea0d1317 by Zubin Duggal at 2026-02-04T09:57:06-05:00
Bump transformers submodule to 0.6.3.0
Fixes #26790
- - - - -
cbe4300e by Simon Peyton Jones at 2026-02-05T04:31:04-05:00
Fix subtle bug in GHC.Core.Utils.mkTick
This patch fixes a decade-old bug in `mkTick`, which
could generate type-incorrect code! See the diagnosis
in #26772.
The new code is simpler and easier to understand.
(As #26772 says, I think it could be improved further.)
- - - - -
a193a8da by Simon Peyton Jones at 2026-02-05T04:31:04-05:00
Modify a debug-trace in the Simplifier
...just to show a bit more information.
- - - - -
b579dfdc by Simon Peyton Jones at 2026-02-05T04:31:04-05:00
Fix long-standing interaction between ticks and casts
The code for Note [Eliminate Identity Cases] was simply wrong when
ticks and casts interacted. This patch fixes the interaction.
It was shown up when validating #26772, although it's not the exactly
the bug that's reported by #26772. Nor is it easy to reproduce, hence
no regression test.
- - - - -
fac0de1e by Cheng Shao at 2026-02-05T04:31:49-05:00
libraries: bump Cabal submodule to 3.16.1.0
- - - - -
00589122 by Cheng Shao at 2026-02-05T04:31:49-05:00
libraries: bump deepseq submodule to 1.5.2.0
Also:
- Get rid of usage of deprecated `NFData` function instance in the
compiler
- `T21391` still relies on `NFData` function instance, add
`-Wno-deprecations` for the time being.
- - - - -
84474c71 by Cheng Shao at 2026-02-05T04:31:50-05:00
libraries: bump directory submodule to 1.3.10.1
- - - - -
1a9f4662 by Cheng Shao at 2026-02-05T04:31:50-05:00
libraries: bump exceptions submodule to 0.10.12
- - - - -
2e39a340 by Peng Fan at 2026-02-07T03:42:01-05:00
NCG/LA64: adjust register usage to avoid src-register being clobbered
- - - - -
9faf1b35 by Teo Camarasu at 2026-02-07T03:42:43-05:00
ghc-internal: Delete unnecessary GHC.Internal.Data.Ix
This module merely re-exports GHC.Internal.Ix. It was copied from
`base` when `ghc-internal` was split, but there is no reason to have
this now. So, let's delete it.
Resolves #26848
- - - - -
d112b440 by Sven Tennie at 2026-02-07T10:47:56-05:00
Add cabal.project file to generate-ci
This fixes the HLS setup for our CI code generation script
(generate-ci).
The project file simply makes `generate-ci` of the cabal file
discoverable.
- - - - -
5339f6f0 by Andreas Klebinger at 2026-02-07T10:48:40-05:00
CI: Don't collapse test results.
This puts test output back into the primary test log instead of a
subsection removing the need to expand a section to see test results.
While the intention was good in practice the old behaviour mostly wastes time
by requiring expansion of the section.
Fixes #26882
- - - - -
0e1cd2e0 by Evan Piro at 2026-02-08T10:35:16-08:00
Linker.MacOS reduce dynflags import
- - - - -
1c79a4cd by Michael Alan Dorman at 2026-02-09T08:11:51-05:00
Remove `extra_src_files` variable from `testsuite/driver/testlib.py`
While reading through the test harness code, I noticed this variable
with a TODO attached that referenced #12223. Although that bug is
closed, it strongly implied that this special-case variable that only
affected a single test was expected to be removed at some point.
I also looked at 3415bcaa0b1903b5e12dfaadb5b774718e406eab---where it
was added---whose commit message suggested that it would have been
desirable to remove it, but that there were special circumstances that
meant it had to remain (though it doesn't elucidate what those special
circumstances are).
However, the special circumstances were mentioned as if the test was
in a different location than is currently is, so I decided to try
changing the test to use the standard `extra_files` mechanism, which
works in local testing.
This also seems like a reasonable time to remove the script that was
originally used in the transition, since it doesn't really serve a
purpose anymore.
- - - - -
0020e38a by Matthew Pickering at 2026-02-09T17:29:14-05:00
determinism: Use a stable sort in WithHsDocIdentifiers binary instance
`WithHsDocIdentifiers` is defined as
```
71 data WithHsDocIdentifiers a pass = WithHsDocIdentifiers
72 { hsDocString :: !a
73 , hsDocIdentifiers :: ![Located (IdP pass)]
74 }
```
This list of names is populated from `rnHsDocIdentifiers`, which calls
`lookupGRE`, which calls `lookupOccEnv_AllNameSpaces`, which calls
`nonDetEltsUFM` and returns the results in an order depending on
uniques.
Sorting the list with a stable sort before returning the interface makes
the output deterministic and follows the approach taken by other fields
in `Docs`.
Fixes #26858
- - - - -
89898ce6 by echoumcp1 at 2026-02-09T17:30:01-05:00
Replace putstrln with logMsg in handleSeqHValueStatus
Fixes #26549
- - - - -
7c52c4f9 by John Paul Adrian Glaubitz at 2026-02-10T13:52:43-05:00
rts: Switch prim to use modern atomic compiler builtins
The __sync_*() atomic compiler builtins have been deprecated in GCC
for a while now and also don't provide variants for 64-bit values
such as __sync_fetch_and_add_8().
Thus, replace them with the modern __atomic_*() compiler builtins and
while we're at it, also drop the helper macro CAS_NAND() which is now
no longer needed since we stopped using the __sync_*() compiler builtins
altogether.
Co-authored-by: Ilias Tsitsimpis <iliastsi(a)debian.org>
Fixes #26729
- - - - -
cf60850a by Recursion Ninja at 2026-02-10T13:53:27-05:00
Decoupling L.H.S.Decls from GHC.Types.ForeignCall
- Adding TTG extension point for 'CCallTarget'
- Adding TTG extension point for 'CType'
- Adding TTG extension point for 'Header'
- Moving ForeignCall types that do not need extension
to new L.H.S.Decls.Foreign module
- Replacing 'Bool' parameters with descriptive data-types
to increase clairty and prevent "Boolean Blindness"
- - - - -
11a04cbb by Eric Lee at 2026-02-11T09:20:46-05:00
Derive Semigroup/Monoid for instances believed could be derived in #25871
- - - - -
15d9ce44 by Eric Lee at 2026-02-11T09:20:46-05:00
add Ghc.Data.Pair deriving
- - - - -
c85dc170 by Evan Piro at 2026-02-11T09:21:45-05:00
Linker.MacOS reduce options import
- - - - -
a541dd83 by Chris Wendt at 2026-02-11T16:06:41-05:00
Initialize plugins for `:set +c` in GHCi
Fixes #23110.
- - - - -
0f5a73bc by Cheng Shao at 2026-02-11T16:07:27-05:00
compiler: add Binary Text instance
This patch adds `Binary` instance for strict `Text`, in preparation of
making `Text` usable in certain GHC API use cases (e.g. haddock). This
also introduces `text` as a direct dependency of the `ghc` package.
- - - - -
9e58b8a1 by Cheng Shao at 2026-02-11T16:08:10-05:00
ghc-toolchain: add C11 check
This patch partially reverts commit
b8307eab80c5809df5405d76c822bf86877f5960 that removed C99 check in
autoconf/ghc-toolchain. Now we:
- No longer re-implement `FP_SET_CFLAGS_C11` similar to
`FP_SET_CFLAGS_C99` in the past, since autoconf doesn't provide a
convenient `AC_PROG_CC_C11` function. ghc-toolchain will handle it
anyway.
- The Cmm CPP C99 check is relanded and repurposed for C11.
- The C99 logic in ghc-toolchain is relanded and repurposed for C11.
- The C99 check in Stg.h is corrected to check for C11. The obsolete
_ISOC99_SOURCE trick is dropped.
- Usages of `-std=gnu99` in the testsuite are corrected to use
`-std=gnu11`.
Closes #26908.
- - - - -
4df0adf6 by Simon Peyton Jones at 2026-02-11T21:50:13-05:00
Simplify the treatment of static forms
This MR implements GHC proposal 732: simplify static forms,
https://github.com/ghc-proposals/ghc-proposals/pull/732
thereby addressing #26556.
See `Note [Grand plan for static forms]` in GHC.Iface.Tidy.StaticPtrTable
The main changes are:
* There is a new, simple rule for (static e), namely that the free
term variables of `e` must be bound at top level. The check is
done in the `HsStatic` case of `GHC.Rename.Expr.rnExpr`
* That in turn substantially simplifies the info that the typechecker
carries around in its type environment. Hooray.
* The desugarer emits static bindings to top level directly; see the
`HsStatic` case of `dsExpr`.
* There is no longer any special static-related magic in the FloatOut
pass. And the main Simplifier pipeline no longer needs a special case
to run FloatOut even with -O0. Hooray.
All this forced an unexpected change to the pattern match checker. It
recursively invokes the main Hs desugarer when it wants to take a look
at a term to spot some special cases (notably constructor applications).
We don't want to emit any nested (static e) bindings to top level a
second time! Yikes.
That forced a modest refactor in GHC.HsToCore.Pmc:
* The `dsl_nablas` field of `DsLclEnv` now has a `NoPmc` case, which says
"I'm desugaring just for pattern-match checking purposes".
* When that flag is set we don't emit static binds.
That in turn forces a cascade of refactoring, but the net effect is an
improvement; less risk of duplicated (even exponential?) work.
See Note [Desugaring HsExpr during pattern-match checking].
10% metric decrease, on some architectures, of compile-time max-bytes-used on T15304.
Metric Decrease:
T15304
- - - - -
7922f728 by Teo Camarasu at 2026-02-11T21:50:58-05:00
ghc-internal: avoid depending on GHC.Internal.Exts
This module is mostly just re-exports. It made sense as a user-facing
module, but there's no good reason ghc-internal modules should depend on
it and doing so linearises the module graph
- move considerAccessible to GHC.Internal.Magic
Previously it lived in GHC.Internal.Exts, but it really deserves to live
along with the other magic function, which are already re-exported from .Exts
- move maxTupleSize to GHC.Internal.Tuple
This previously lived in GHC.Internal.Exts but a comment already said it
should be moved to .Tuple
Resolves #26832
- - - - -
b6a4a29b by Eric Lee at 2026-02-11T21:51:55-05:00
Remove unused Semigroup imports to fix GHC 9.14 bootstrapping
- - - - -
99d8c146 by Simon Peyton Jones at 2026-02-12T17:36:59+00:00
Fix subtle bug in cast worker/wrapper
See (CWw4) in Note [Cast worker/wrapper].
The true payload is in the change to the definition of
GHC.Types.Id.Info.hasInlineUnfolding
Everthing else is just documentation.
There is a 2% compile time decrease for T13056;
I'll take the win!
Metric Decrease:
T13056
- - - - -
530e8e58 by Simon Peyton Jones at 2026-02-12T20:17:23-05:00
Add regression tests for four StaticPtr bugs
Tickets #26545, #24464, #24773, #16981 are all solved by the
recently-landed MR
commit 318ee13bcffa6aa8df42ba442ccd92aa0f7e210c
Author: Simon Peyton Jones <simon.peytonjones(a)gmail.com>
Date: Mon Oct 20 23:07:20 2025 +0100
Simplify the treatment of static forms
This MR just adds regression tests for them.
- - - - -
4157160f by Cheng Shao at 2026-02-13T06:27:04-05:00
ci: remove unused hlint-ghc-and-base job definition
This patch removes the unused `hlint-ghc-and-base` job definition,
it's never run since !9806. Note that hadrian lint rules still work
locally, so anyone that wishes to run hlint on the codebase can
continue to do so in their local worktree.
- - - - -
039f1977 by Cheng Shao at 2026-02-13T06:27:47-05:00
wasm: use import.meta.main for proper distinction of nodejs main modules
This patch uses `import.meta.main` for proper distinction of nodejs
main modules, especially when the main module might be installed as a
symlink. Fixes #26916.
- - - - -
14f485ee by ARATA Mizuki at 2026-02-17T09:09:24+09:00
Support more x86 extensions: AVX-512 {BW,DQ,VL} and GFNI
Also, mark AVX-512 ER and PF as deprecated.
AVX-512 instructions can be used for certain 64-bit integer vector operations.
GFNI can be used to implement bitReverse (currently not used by NCG, but LLVM may use it).
Closes #26406
Addresses #26509
- - - - -
016f79d5 by fendor at 2026-02-17T09:16:16-05:00
Hide implementation details from base exception stack traces
Ensure we hide the implementation details of the exception throwing mechanisms:
* `undefined`
* `throwSTM`
* `throw`
* `throwIO`
* `error`
The `HasCallStackBacktrace` should always have a length of exactly 1,
not showing internal implementation details in the stack trace, as these
are vastly distracting to end users.
CLC proposal [#387](https://github.com/haskell/core-libraries-committee/issues/387)
- - - - -
4f2840f2 by Brian J. Cardiff at 2026-02-17T17:04:08-05:00
configure: Accept happy-2.2
In Jan 2026 happy-2.2 was released. The most sensible change is https://github.com/haskell/happy/issues/335 which didn't trigger in a fresh build
- - - - -
10b4d364 by Duncan Coutts at 2026-02-17T17:04:52-05:00
Fix errors in the documentation of the eventlog STOP_THREAD status codes
Fix the code for BlockedOnMsgThrowTo.
Document all the known historical warts.
Fixes issue #26867
- - - - -
c5e15b8b by Phil de Joux at 2026-02-18T05:07:36-05:00
haddock: use snippets for all list examples
- generate snippet output for docs
- reduce font size to better fit snippets
- Use only directive to guard html snippets
- Add latex snippets for lists
- - - - -
d388bac1 by Phil de Joux at 2026-02-18T05:07:36-05:00
haddock: Place the snippet input and output together
- Put the output seemingly inside the example box
- - - - -
016fa306 by Samuel Thibault at 2026-02-18T05:08:35-05:00
Fix linking against libm by moving the -lm option
For those systems that need -lm for getting math functions, this is
currently added on the link line very early, before the object files being
linked together. Newer toolchains enable --as-needed by default, which means
-lm is ignored at that point because no object requires a math function
yet. With such toolchains, we thus have to add -lm after the objects, so the
linker actually includes libm in the link.
- - - - -
68bd0805 by Teo Camarasu at 2026-02-18T05:09:19-05:00
ghc-internal: Move GHC.Internal.Data.Bool to base
This is a tiny module that only defines bool :: Bool -> a -> a -> a. We can just move this to base and delete it from ghc-internal. If we want this functionality there we can just use a case statement or if-then expression.
Resolves 26865
- - - - -
4c40df3d by fendor at 2026-02-20T10:24:48-05:00
Add optional `SrcLoc` to `StackAnnotation` class
`StackAnnotation`s give access to an optional `SrcLoc` field that
user-added stack annotations can use to provide better backtraces in both error
messages and when decoding the callstack.
We update builtin stack annotations such as `StringAnnotation` and
`ShowAnnotation` to also capture the `SrcLoc` of the current `CallStack`
to improve backtraces by default (if stack annotations are used).
This change is backwards compatible with GHC 9.14.1.
- - - - -
fd9aaa28 by Simon Hengel at 2026-02-20T10:25:33-05:00
docs: Fix grammar in explicit_namespaces.rst
- - - - -
44354255 by Vo Minh Thu at 2026-02-20T18:53:06-05:00
GHCi: add a :version command.
This looks like:
ghci> :version
GHCi, version 9.11.20240322
This closes #24576.
Co-Author: Markus Läll <markus.l2ll(a)gmail.com>
- - - - -
eab3dbba by Andreas Klebinger at 2026-02-20T18:53:51-05:00
hadrian/build-cabal: Better respect and utilize -j
* We now respect -j<n> for the cabal invocation to build hadrian rather
than hardcoding -j
* We use the --semaphore flag to ensure cabal/ghc build the hadrian
executable in parallel using the -jsem mechanism.
Saves 10-15s on fresh builds for me.
Fixes #26876
- - - - -
17839248 by Teo Camarasu at 2026-02-24T08:36:03-05:00
ghc-internal: avoid depending on GHC.Internal.Control.Monad.Fix
This module contains the definition of MonadFix, since we want an
instance for IO, that instance requires a lot of machinery and we want
to avoid an orphan instance, this will naturally be quite high up in the
dependency graph.
So we want to avoid other modules depending on it as far as possible.
On Windows, the IO manager depends on the RTSFlags type, which
transtively depends on MonadFix. We refactor things to avoid this
dependency, which would have caused a regression.
Resolves #26875
Metric Decrease:
T12227
- - - - -
fa88d09a by Wolfgang Jeltsch at 2026-02-24T08:36:47-05:00
Refine the imports of `System.IO.OS`
Commit 68bd08055594b8cbf6148a72d108786deb6c12a1 replaced the
`GHC.Internal.Data.Bool` import by a `GHC.Internal.Base` import.
However, while the `GHC.Internal.Data.Bool` import was conditional and
partial, the `GHC.Internal.Base` import is unconditional and total. As a
result, the import list is not tuned to import only the necessary bits
anymore, and furthermore GHC emits a lot of warnings about redundant
imports.
This commit makes the `GHC.Internal.Base` import conditional and partial
in the same way that the `GHC.Internal.Data.Bool` import was.
- - - - -
c951fef1 by Cheng Shao at 2026-02-25T20:58:28+00:00
wasm: add /assets endpoint to serve user-specified assets
This patch adds an `/assets` endpoint to the wasm dyld http server, so
that users can also fetch assets from the same host with sensible
default MIME types, without needing a separate http server for assets
that also introduces CORS headaches:
- A `-fghci-browser-assets-dir` driver flag is added to specify the
assets root directory (defaults to `$PWD`)
- The dyld http server fetches `mime-db` on demand and uses it as
source of truth for mime types.
Closes #26951.
- - - - -
dde22f97 by Sylvain Henry at 2026-02-26T13:14:03-05:00
Fix -fcheck-prim-bounds for non constant args (#26958)
Previously we were only checking bounds for constant (literal)
arguments!
I've refactored the code to simplify the generation of out-of-line Cmm
code for the primop composed of some inline code + some call to an
external Cmm function.
- - - - -
bd3eba86 by Vladislav Zavialov at 2026-02-27T05:48:01-05:00
Check for negative type literals in the type checker (#26861)
GHC disallows negative type literals (e.g., -1), as tested by T8306 and
T8412. This check is currently performed in the renamer:
rnHsTyLit tyLit@(HsNumTy x i) = do
when (i < 0) $
addErr $ TcRnNegativeNumTypeLiteral tyLit
However, this check can be bypassed using RequiredTypeArguments
(see the new test case T26861). Prior to this patch, such programs
caused the compiler to hang instead of reporting a proper error.
This patch addresses the issue by adding an equivalent check in
the type checker, namely in tcHsType.
The diff is deliberately minimal to facilitate backporting. A more
comprehensive rework of HsTyLit is planned for a separate commit.
- - - - -
faf14e0c by Vladislav Zavialov at 2026-02-27T05:48:45-05:00
Consistent pretty-printing of HsString, HsIsString, HsStrTy
Factor out a helper to pretty-print string literals, thus fixing newline
handling for overloaded string literals and type literals.
Test cases: T26860ppr T26860ppr_overloaded T26860ppr_tylit
Follow up to ddf1434ff9bb08cfef3c93f23de6b83ec698aa27
- - - - -
f108a972 by Arnaud Spiwack at 2026-02-27T12:53:01-05:00
Make list comprehension completely non-linear
Fixes #25081
From the note:
The usefulness of list comprehension in conjunction with linear types is dubious.
After all, statements are made to be run many times, for instance in
```haskell
[u | y <- [0,1], stmts]
```
both `u` and `stmts` are going to be run several times.
In principle, though, there are some position in a monad comprehension
expression which could be considered linear. We could try and make it so that
these positions are considered linear by the typechecker, but in practice the
desugarer doesn't take enough care to ensure that these are indeed desugared to
linear sites. We tried in the past, and it turned out that we'd miss a
desugaring corner case (#25772).
Until there's a demand for this very specific improvement, let's instead be
conservative, and consider list comprehension to be completely non-linear.
- - - - -
ae799cab by Simon Jakobi at 2026-02-27T12:53:54-05:00
PmAltConSet: Use Data.Set instead of Data.Map
...to store `PmLit`s.
The Map was only used to map keys to themselves.
Changing the Map to a Set saves a Word of memory per entry.
Resolves #26756.
- - - - -
dcd7819c by Vladislav Zavialov at 2026-02-27T18:46:03-05:00
Drop HsTyLit in favor of HsLit (#26862, #25121)
This patch is a small step towards unification of HsExpr and HsType,
taking care of literals (HsLit) and type literals (HsTyLit).
Additionally, it improves error messages for unsupported type literals,
such as unboxed or fractional literals (test cases: T26862, T26862_th).
Changes to the AST:
* Use HsLit where HsTyLit was previously used
* Use HsChar where HsCharTy was previously used
* Use HsString where HsStrTy was previously used
* Use HsNatural (NEW) where HsNumTy was previously used
* Use HsDouble (NEW) to represent unsupported fractional type literals
Changes to logic:
* Parse unboxed and fractional type literals (to be rejected later)
* Drop the check for negative literals in the renamer (rnHsTyLit)
in favor of checking in the type checker (tc_hs_lit_ty)
* Check for invalid type literals in TH (repTyLit) and report
unrepresentable literals with ThUnsupportedTyLit
* Allow negative type literals in TH (numTyLit). This is fine as
these will be taken care of at splice time (test case: T8306_th)
- - - - -
c927954f by Vladislav Zavialov at 2026-02-27T18:46:50-05:00
Increase test coverage of diagnostics
Add test cases for the previously untested diagnostics:
[GHC-01239] PsErrIfInFunAppExpr
[GHC-04807] PsErrProcInFunAppExpr
[GHC-08195] PsErrInvalidRecordCon
[GHC-16863] PsErrUnsupportedBoxedSumPat
[GHC-18910] PsErrSemiColonsInCondCmd
[GHC-24737] PsErrInvalidWhereBindInPatSynDecl
[GHC-25037] PsErrCaseInFunAppExpr
[GHC-25078] PsErrPrecedenceOutOfRange
[GHC-28021] PsErrRecordSyntaxInPatSynDecl
[GHC-35827] TcRnNonOverloadedSpecialisePragma
[GHC-40845] PsErrUnpackDataCon
[GHC-45106] PsErrInvalidInfixHole
[GHC-50396] PsErrInvalidRuleActivationMarker
[GHC-63930] MultiWayIfWithoutAlts
[GHC-65536] PsErrNoSingleWhereBindInPatSynDecl
[GHC-67630] PsErrMDoInFunAppExpr
[GHC-70526] PsErrLetCmdInFunAppCmd
[GHC-77808] PsErrDoCmdInFunAppCmd
[GHC-86934] ClassPE
[GHC-90355] PsErrLetInFunAppExpr
[GHC-91745] CasesExprWithoutAlts
[GHC-92971] PsErrCaseCmdInFunAppCmd
[GHC-95644] PsErrBangPatWithoutSpace
[GHC-97005] PsErrIfCmdInFunAppCmd
Remove unused error constructors:
[GHC-44524] PsErrExpectedHyphen
[GHC-91382] TcRnIllegalKindSignature
- - - - -
3a9470fd by Torsten Schmits at 2026-02-27T18:47:34-05:00
Avoid expensive computation for debug logging in `mergeDatabases` when log level is low
This computed and traversed a set intersection for every single
dependency unconditionally.
- - - - -
81fa469f by Joseph Fourment at 2026-02-28T12:47:12+00:00
Add type-lets into Core
The plan for #20264 is to introduce let-bound types to have observable sharing in types.
To avoid the need to carry an environment when dealing with occurrences of these type variables,
we embed the types they're bound to (if any) in a `tv_unfolding :: Maybe Type` attribute.
This way, one can look through let-bound type variables using `coreView` and friends.
In particular, definitional equality looks through unfoldings.
simple-opt: don't inline type-lets
specialise: fix type-lets in DFun unfoldings
During specialisation, a dictionary being specialised gets a new unfolding by turning
`DFun \ bndrs -> MkD @<T1> ... @<Tm> <op1> ... <opn>` into
`DFun \ spec_bndrs -> MkD @((\ bndrs -> TYPE: <T1>) spec_args) ... ((\ bndrs -> <opn>) spec_args)`
which in turns gets beta-reduced into
`DFun \ spec_bndrs -> MkD (let { bndrs = spec_args } in TYPE: <T1>) ... (let { bndrs = spec_args } in <opn>)`.
Previously, such let binders would immediately be substituted into the type so it didn't cause any issue,
but now we want to avoid inlining.
Arguments of the form `let { bndrs = spec_args } in TYPE: <T1>` are not considered as type arguments since they're
not of the canonical form `TYPE: something`.
This commit restores the previous behavior of substituting the specialised type arguments.
Alternatively, we could attach some floated type bindings to `DFun`s.
occur-anal: implement occurence analysis for type variables
In order to find out let-bound type variables that are used only once, in the hope of inlining them,
we need to track type variables as well in the occurrence analiser. Just like Id's, we attach an
`OccInfo` to each (immutable) type variable, and we walk into types and coercions to accurately gather
occurrences.
simplifier: don't inline type-lets
Keep propagating type-lets further down the pipeline, in the simplifier.
We also update CallArity, CprAnal, DmdAnal, WorkWrap, and Specialise to ignore type-lets.
prep: make type-lets pass through CorePrep
As a first attempt, ignore type-lets in CorePrep to avoid crashes.
However, this is not enough: CorePrep also does some let-floating.
If we don't float type-lets along with value-level let-bindings,
the latter can float out of the scope of a type variable in use.
simple-opt: fix simple_type_bind
Also:
- Inline small types using a new typeIsSmallEnoughToInline predicate
- Inline single-occurrence variables
simple-opt: make beta-reduction use simple_bind_type
iface: add IfaceTypeLetBndr to represent non-top-level type-let binders
IfaceLetBndr isn't fit to represent type-let binders, as it includes a
bunch of vacuous flags for Ids only.
Instead of putting squares in circles, I added a new constructor for type binders.
The downside is that it breaks existing iface files, so since we can't bootstrap
yet so we have to bootstrap a cherry-picked branch and then checkout again to build
with --freeze1.
To avoid similar issues in the future, IfaceTyVarInfoItem serialises with a tag
despite there being only one constructor for now.
dmd-anal: prefix unused variable with _ to avoid warning
type: inline unfoldView in sORTKind_maybe
tidy: deal with type-lets
notes: add Note [Type and coercion lets]
notes: update Note [Comparing nullary type synonyms] to account for type variables
While updating backlinks, I noticed the optimisation for type variables
could be performed in more places.
simplifier: inline single-occurring type-lets
cleanup: remove NOINLINE on tyVarOccInfo
Wibbles
Wibbles
Progress
Progress
More progress
Progress
...doesn't compile though
Mostly working now
Aggressively create type-lets
more progress
More progress
Temp debug printing
Remove bogus assert
Fix anoher couple of bugs
in SimpleOpt and exprIsTrivial
Improve zonking of foreign decls to avoid TcTyVars escaping
Wibbles
Some small wibbles
Improvements
Rmmove trace
Wibbles
Use lambda, not let, in WorkWrap
Using type let did not work right with type lets and shadowing
Requires Lint to be OK join points under beta redexes -- but it is!
Needs better documentation
Wibbles
More improvements
More improvements
* Less cloning in SpecConstr
* Lint checks RULES for imported binders
Comments only
Wibble
Wibbles
Wibbles
.. getting Lint errors when compiling GHC.Internal.Classes
Wibbles
More improvements
..now getting to the back end an interface file generation
Wibbles
Wibble unsed var
Missing case in tyThingEntityInfo
Add IfaceExtTyVar
Wibbles
Start to make OccAnal count TyCoVars properly [skip ci]
Proper occurrence analysis for TyCoVars
Wibble imports
Wibble imports again
Fix two tricky buglets
More small fixes
Add missing mkAbsCoreApps
...which caused bad Lint errors
More wibbles
More wibbles exp around mkPolyAbsLams
- - - - -
edb80662 by Simon Peyton Jones at 2026-02-28T12:47:12+00:00
Make it compile again
- - - - -
d5f0983b by Simon Peyton Jones at 2026-02-28T12:47:12+00:00
Simplify mkcoreAbsLams a bit
..Needs documentation
- - - - -
e25403b7 by Simon Peyton Jones at 2026-02-28T12:47:12+00:00
Fix build
Several important fixes, need better docs
- - - - -
90e7da0d by Simon Peyton Jones at 2026-02-28T12:47:13+00:00
Wibbles
- - - - -
57533888 by Simon Peyton Jones at 2026-02-28T12:47:13+00:00
Make it compile
- - - - -
1c226b9e by Simon Peyton Jones at 2026-02-28T12:47:13+00:00
Improve Lint error message slightly
- - - - -
9a8e4f5d by Simon Peyton Jones at 2026-02-28T12:47:13+00:00
Wibble lint rules
- - - - -
b0ad947b by Simon Peyton Jones at 2026-02-28T12:47:13+00:00
Wibbles
- - - - -
4c91f804 by Simon Peyton Jones at 2026-02-28T12:47:13+00:00
Wibbles
- - - - -
693257bb by Simon Peyton Jones at 2026-02-28T12:47:13+00:00
Expand tyvars in Specialise
Pretty important!
- - - - -
0a216ee9 by Simon Peyton Jones at 2026-02-28T12:47:13+00:00
Comments only
- - - - -
66675343 by Simon Peyton Jones at 2026-02-28T12:47:13+00:00
More wibbles
* `bindAuxiliaryTyVars` in Specialise
* `trivial_expr_fold` needs to accept big coercions in CoreToStg
because the binder-swap can duplicate big coercions (boo)
Plus renaming in Specialise
- - - - -
c405723a by Simon Peyton Jones at 2026-02-28T12:47:13+00:00
Onward
- - - - -
550 changed files:
- .gitlab-ci.yml
- .gitlab/ci.sh
- + .gitlab/generate-ci/cabal.project
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/CmmToAsm/Config.hs
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToAsm/X86/Instr.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToLlvm/CodeGen.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion/Axiom.hs
- compiler/GHC/Core/DataCon.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/InstEnv.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Make.hs
- compiler/GHC/Core/Map/Type.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/CSE.hs
- compiler/GHC/Core/Opt/CallArity.hs
- compiler/GHC/Core/Opt/CprAnal.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/Exitify.hs
- compiler/GHC/Core/Opt/FloatIn.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Pipeline.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Monad.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Ppr.hs
- compiler/GHC/Core/Predicate.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/Seq.hs
- compiler/GHC/Core/SimpleOpt.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/Tidy.hs
- compiler/GHC/Core/TyCo/Compare.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Ppr.hs
- compiler/GHC/Core/TyCo/Ppr.hs-boot
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToIface.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Data/Pair.hs
- compiler/GHC/Driver/Config/CmmToAsm.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/Config/Interpreter.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- + compiler/GHC/Hs/Decls/Overlap.hs
- compiler/GHC/Hs/Doc.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Lit.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Foreign/Call.hs
- compiler/GHC/HsToCore/Foreign/Decl.hs
- compiler/GHC/HsToCore/Foreign/JavaScript.hs
- compiler/GHC/HsToCore/Foreign/Utils.hs
- compiler/GHC/HsToCore/Foreign/Wasm.hs
- compiler/GHC/HsToCore/GuardedRHSs.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Pmc/Solver.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Pmc/Utils.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/HsToCore/Types.hs
- compiler/GHC/Iface/Decl.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Types.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Iface/Rename.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Iface/Tidy/StaticPtrTable.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Linker/Dynamic.hs
- compiler/GHC/Linker/MacOS.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Errors/Ppr.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/PostProcess/Haddock.hs
- compiler/GHC/Parser/String.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Splice.hs-boot
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Heap/Inspect.hs
- compiler/GHC/Runtime/Interpreter.hs
- compiler/GHC/Runtime/Interpreter/Init.hs
- compiler/GHC/Runtime/Interpreter/Types.hs
- compiler/GHC/Runtime/Interpreter/Wasm.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Foreign.hs
- compiler/GHC/StgToCmm/Prim.hs
- compiler/GHC/StgToJS/FFI.hs
- compiler/GHC/SysTools/Cpp.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Foreign.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Rewrite.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/BasicTypes.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- − compiler/GHC/Tc/Utils/TcMType.hs-boot
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/ForeignCall.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Types/InlinePragma.hs
- compiler/GHC/Types/Name.hs
- compiler/GHC/Types/Name/Cache.hs
- compiler/GHC/Types/SourceText.hs
- compiler/GHC/Types/TyThing.hs
- compiler/GHC/Types/TypeEnv.hs
- compiler/GHC/Types/Unique/DSet.hs
- compiler/GHC/Types/Var.hs
- compiler/GHC/Unit/Module/ModIface.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Unit/Types.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/GHC/Utils/Ppr/Colour.hs
- compiler/GHC/Utils/Trace.hs
- compiler/Language/Haskell/Syntax/Basic.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- + compiler/Language/Haskell/Syntax/Decls/Foreign.hs
- + compiler/Language/Haskell/Syntax/Decls/Overlap.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Lit.hs
- compiler/Language/Haskell/Syntax/Type.hs
- compiler/ghc.cabal.in
- configure.ac
- distrib/configure.ac.in
- + docs/users_guide/10.0.1-notes.rst
- docs/users_guide/9.16.1-notes.rst
- docs/users_guide/eventlog-formats.rst
- docs/users_guide/exts/explicit_namespaces.rst
- docs/users_guide/exts/multiway_if.rst
- docs/users_guide/ghci.rst
- docs/users_guide/phases.rst
- docs/users_guide/using.rst
- docs/users_guide/wasm.rst
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
- hadrian/build-cabal
- hadrian/src/Builder.hs
- hadrian/src/Rules/Compile.hs
- hadrian/src/Settings/Builders/Cc.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Packages.hs
- libraries/Cabal
- libraries/base/changelog.md
- libraries/base/src/Control/Arrow.hs
- libraries/base/src/Data/Bool.hs
- libraries/base/src/Data/Ix.hs
- libraries/base/src/Data/List.hs
- libraries/base/src/Data/List/NubOrdSet.hs
- libraries/base/src/GHC/Exts.hs
- libraries/base/src/System/IO.hs
- libraries/deepseq
- libraries/directory
- libraries/exceptions
- libraries/ghc-experimental/CHANGELOG.md
- libraries/ghc-experimental/src/GHC/Stack/Annotation/Experimental.hs
- + libraries/ghc-experimental/tests/Makefile
- + libraries/ghc-experimental/tests/all.T
- + libraries/ghc-experimental/tests/backtraces/Makefile
- + libraries/ghc-experimental/tests/backtraces/T26806a.hs
- + libraries/ghc-experimental/tests/backtraces/T26806a.stderr
- + libraries/ghc-experimental/tests/backtraces/T26806b.hs
- + libraries/ghc-experimental/tests/backtraces/T26806b.stderr
- + libraries/ghc-experimental/tests/backtraces/T26806c.hs
- + libraries/ghc-experimental/tests/backtraces/T26806c.stderr
- + libraries/ghc-experimental/tests/backtraces/all.T
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Lazy/Imp.hs
- − libraries/ghc-internal/src/GHC/Internal/Data/Bool.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Function.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
- − libraries/ghc-internal/src/GHC/Internal/Data/Ix.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Bool.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/ManagedThreadPool.hs
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Exts.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/Closures.hs
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim/Internal/Build.hs
- libraries/ghc-internal/src/GHC/Internal/Magic.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Annotation.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO/OS.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lib.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Tuple.hs
- libraries/ghc-internal/src/GHC/Internal/TypeError.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Exports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Imports.hs
- libraries/ghc-internal/src/GHC/Internal/Wasm/Prim/Types.hs
- + libraries/ghc-internal/tests/backtraces/T15395.hs
- + libraries/ghc-internal/tests/backtraces/T15395.stdout
- libraries/ghc-internal/tests/backtraces/all.T
- libraries/ghc-internal/tests/stack-annotation/ann_frame001.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame002.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame003.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame004.stdout
- libraries/ghc-internal/tests/stack-annotation/ann_frame005.stdout
- libraries/text
- libraries/transformers
- m4/fp_cmm_cpp_cmd_with_args.m4
- m4/fptools_happy.m4
- rts/include/Stg.h
- rts/prim/atomic.c
- testsuite/driver/cpu_features.py
- − testsuite/driver/kill_extra_files.py
- testsuite/driver/testlib.py
- testsuite/mk/test.mk
- testsuite/tests/arrows/should_compile/T21301.stderr
- testsuite/tests/backpack/cabal/bkpcabal08/bkpcabal08.stdout
- + testsuite/tests/codeGen/should_fail/T26958.hs
- testsuite/tests/codeGen/should_fail/all.T
- testsuite/tests/codeGen/should_gen_asm/all.T
- + testsuite/tests/codeGen/should_gen_asm/avx512-int64-minmax.asm
- + testsuite/tests/codeGen/should_gen_asm/avx512-int64-minmax.hs
- + testsuite/tests/codeGen/should_gen_asm/avx512-int64-mul.asm
- + testsuite/tests/codeGen/should_gen_asm/avx512-int64-mul.hs
- + testsuite/tests/codeGen/should_gen_asm/avx512-word64-minmax.asm
- + testsuite/tests/codeGen/should_gen_asm/avx512-word64-minmax.hs
- testsuite/tests/codeGen/should_run/CgStaticPointers.hs
- testsuite/tests/codeGen/should_run/CgStaticPointersNoFullLazyness.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/deSugar/should_fail/DsStrictFail.stderr
- testsuite/tests/deSugar/should_run/T20024.stderr
- testsuite/tests/deSugar/should_run/dsrun005.stderr
- testsuite/tests/deSugar/should_run/dsrun007.stderr
- testsuite/tests/deSugar/should_run/dsrun008.stderr
- + testsuite/tests/dependent/should_fail/SelfDepCls.hs
- + testsuite/tests/dependent/should_fail/SelfDepCls.stderr
- testsuite/tests/dependent/should_fail/all.T
- testsuite/tests/deriving/should_run/T9576.stderr
- testsuite/tests/diagnostic-codes/codes.stdout
- testsuite/tests/driver/T20030/test1/all.T
- testsuite/tests/driver/T20030/test2/all.T
- testsuite/tests/driver/T20030/test3/all.T
- testsuite/tests/driver/T20030/test4/all.T
- testsuite/tests/driver/T20030/test5/all.T
- testsuite/tests/driver/T20030/test6/all.T
- testsuite/tests/driver/T8526/T8526.script
- testsuite/tests/driver/bytecode-object/Makefile
- testsuite/tests/driver/bytecode-object/bytecode_object19.stdout
- testsuite/tests/driver/dynamicToo/dynamicToo001/Makefile
- testsuite/tests/driver/fat-iface/fat014.script
- testsuite/tests/driver/implicit-dyn-too/Makefile
- testsuite/tests/driver/multipleHomeUnits/all.T
- testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout
- testsuite/tests/ffi/should_run/all.T
- + testsuite/tests/ghc-api/TypeMapStringLiteral.hs
- testsuite/tests/ghc-api/all.T
- testsuite/tests/ghc-api/annotations-literals/parsed.hs
- testsuite/tests/ghci.debugger/scripts/T26042b.stdout
- testsuite/tests/ghci.debugger/scripts/T26042c.stdout
- testsuite/tests/ghci.debugger/scripts/T26042d2.stdout
- testsuite/tests/ghci.debugger/scripts/T26042f2.stdout
- − testsuite/tests/ghci/linking/T11531.stderr
- testsuite/tests/ghci/prog018/prog018.script
- testsuite/tests/ghci/scripts/Defer02.stderr
- testsuite/tests/ghci/scripts/ListTuplePunsPpr.stdout
- testsuite/tests/ghci/scripts/T10963.stderr
- testsuite/tests/ghci/scripts/T13869.script
- testsuite/tests/ghci/scripts/T13997.script
- testsuite/tests/ghci/scripts/T15325.stderr
- testsuite/tests/ghci/scripts/T17669.script
- testsuite/tests/ghci/scripts/T18330.script
- testsuite/tests/ghci/scripts/T18330.stdout
- testsuite/tests/ghci/scripts/T1914.script
- testsuite/tests/ghci/scripts/T20150.stdout
- testsuite/tests/ghci/scripts/T20217.script
- testsuite/tests/ghci/scripts/T4175.stdout
- testsuite/tests/ghci/scripts/T6105.script
- testsuite/tests/ghci/scripts/T8042.script
- testsuite/tests/ghci/scripts/T8042recomp.script
- testsuite/tests/ghci/should_run/Makefile
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- testsuite/tests/interface-stability/template-haskell-exports.stdout
- − testsuite/tests/linear/should_compile/LinearListComprehension.hs
- testsuite/tests/linear/should_compile/all.T
- testsuite/tests/linear/should_fail/T25081.hs
- testsuite/tests/linear/should_fail/T25081.stderr
- testsuite/tests/linters/regex-linters/check-rts-includes.py
- testsuite/tests/mdo/should_fail/mdofail006.stderr
- testsuite/tests/module/all.T
- + testsuite/tests/module/mod70b.hs
- + testsuite/tests/module/mod70b.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- + testsuite/tests/parser/should_fail/NoBlockArgumentsFail4.hs
- + testsuite/tests/parser/should_fail/NoBlockArgumentsFail4.stderr
- testsuite/tests/parser/should_fail/NoBlockArgumentsFailArrowCmds.hs
- testsuite/tests/parser/should_fail/NoBlockArgumentsFailArrowCmds.stderr
- + testsuite/tests/parser/should_fail/NoDoAndIfThenElseArrowCmds.hs
- + testsuite/tests/parser/should_fail/NoDoAndIfThenElseArrowCmds.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr
- + testsuite/tests/parser/should_fail/T26860ppr.hs
- + testsuite/tests/parser/should_fail/T26860ppr.stderr
- + testsuite/tests/parser/should_fail/T26860ppr_overloaded.hs
- + testsuite/tests/parser/should_fail/T26860ppr_overloaded.stderr
- + testsuite/tests/parser/should_fail/T26860ppr_tylit.hs
- + testsuite/tests/parser/should_fail/T26860ppr_tylit.stderr
- testsuite/tests/parser/should_fail/all.T
- + testsuite/tests/parser/should_fail/badRuleMarker.hs
- + testsuite/tests/parser/should_fail/badRuleMarker.stderr
- + testsuite/tests/parser/should_fail/patFail010.hs
- + testsuite/tests/parser/should_fail/patFail010.stderr
- + testsuite/tests/parser/should_fail/patFail011.hs
- + testsuite/tests/parser/should_fail/patFail011.stderr
- + testsuite/tests/parser/should_fail/precOutOfRange.hs
- + testsuite/tests/parser/should_fail/precOutOfRange.stderr
- + testsuite/tests/parser/should_fail/unpack_data_con.hs
- + testsuite/tests/parser/should_fail/unpack_data_con.stderr
- testsuite/tests/patsyn/should_fail/T10426.stderr
- testsuite/tests/patsyn/should_fail/all.T
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail1.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail1.stderr
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail2.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail2.stderr
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail3.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail3.stderr
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail4.hs
- + testsuite/tests/patsyn/should_fail/patsyn_where_fail4.stderr
- testsuite/tests/patsyn/should_run/ghci.stderr
- + testsuite/tests/plugins/T23110.hs
- + testsuite/tests/plugins/T23110.script
- + testsuite/tests/plugins/T23110.stdout
- testsuite/tests/plugins/all.T
- testsuite/tests/process/all.T
- testsuite/tests/quotes/LiftErrMsgDefer.stderr
- testsuite/tests/rename/should_fail/RnStaticPointersFail01.stderr
- testsuite/tests/rename/should_fail/RnStaticPointersFail03.stderr
- + testsuite/tests/rename/should_fail/T26545.hs
- + testsuite/tests/rename/should_fail/T26545.stderr
- testsuite/tests/rename/should_fail/all.T
- testsuite/tests/rts/T13676.script
- testsuite/tests/safeHaskell/safeLanguage/SafeLang15.stderr
- testsuite/tests/showIface/DocsInHiFile1.stdout
- testsuite/tests/showIface/HaddockSpanIssueT24378.stdout
- testsuite/tests/showIface/MagicHashInHaddocks.stdout
- testsuite/tests/simd/should_run/all.T
- testsuite/tests/simplCore/should_compile/T21391.hs
- + testsuite/tests/simplCore/should_compile/T26826.hs
- + testsuite/tests/simplCore/should_compile/T26903.hs
- + testsuite/tests/simplCore/should_compile/T26903.stderr
- testsuite/tests/simplCore/should_compile/T8331.stderr
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/th/T26098A_quote.hs
- + testsuite/tests/th/T26098A_splice.hs
- + testsuite/tests/th/T26098_local.hs
- + testsuite/tests/th/T26098_local.stderr
- + testsuite/tests/th/T26098_quote.hs
- + testsuite/tests/th/T26098_quote.stderr
- + testsuite/tests/th/T26098_splice.hs
- + testsuite/tests/th/T26098_splice.stderr
- + testsuite/tests/th/T26862_th.script
- + testsuite/tests/th/T26862_th.stderr
- + testsuite/tests/th/T8306_th.script
- + testsuite/tests/th/T8306_th.stderr
- + testsuite/tests/th/T8306_th.stdout
- testsuite/tests/th/T8412.stderr
- + testsuite/tests/th/TH_EmptyLamCases.hs
- + testsuite/tests/th/TH_EmptyLamCases.stderr
- + testsuite/tests/th/TH_EmptyMultiIf.hs
- + testsuite/tests/th/TH_EmptyMultiIf.stderr
- testsuite/tests/th/all.T
- testsuite/tests/type-data/should_run/T22332a.stderr
- + testsuite/tests/typecheck/should_compile/T24464.hs
- testsuite/tests/typecheck/should_compile/all.T
- + testsuite/tests/typecheck/should_fail/T26861.hs
- + testsuite/tests/typecheck/should_fail/T26861.stderr
- + testsuite/tests/typecheck/should_fail/T26862.hs
- + testsuite/tests/typecheck/should_fail/T26862.stderr
- testsuite/tests/typecheck/should_fail/T8306.stderr
- testsuite/tests/typecheck/should_fail/all.T
- testsuite/tests/typecheck/should_run/T10284.stderr
- testsuite/tests/typecheck/should_run/T13838.stderr
- + testsuite/tests/typecheck/should_run/T16981.hs
- + testsuite/tests/typecheck/should_run/T16981.stdout
- + testsuite/tests/typecheck/should_run/T24773.hs
- + testsuite/tests/typecheck/should_run/T24773.stdout
- testsuite/tests/typecheck/should_run/T9497a-run.stderr
- testsuite/tests/typecheck/should_run/T9497b-run.stderr
- testsuite/tests/typecheck/should_run/T9497c-run.stderr
- testsuite/tests/typecheck/should_run/all.T
- testsuite/tests/unboxedsums/all.T
- + testsuite/tests/unboxedsums/unboxedsums4p.hs
- + testsuite/tests/unboxedsums/unboxedsums4p.stderr
- testsuite/tests/unsatisfiable/T23816.stderr
- testsuite/tests/unsatisfiable/UnsatDefer.stderr
- + testsuite/tests/warnings/should_compile/SpecMultipleTysMono.hs
- + testsuite/tests/warnings/should_compile/SpecMultipleTysMono.stderr
- testsuite/tests/warnings/should_compile/all.T
- testsuite/tests/warnings/should_fail/CaretDiagnostics1.stderr
- utils/check-exact/ExactPrint.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cc.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Cpp.hs
- utils/haddock/doc/.gitignore
- utils/haddock/doc/Makefile
- + utils/haddock/doc/_static/haddock-custom.css
- utils/haddock/doc/conf.py
- utils/haddock/doc/markup.rst
- + utils/haddock/doc/snippets/.gitignore
- + utils/haddock/doc/snippets/Lists.hs
- + utils/haddock/doc/snippets/Makefile
- + utils/haddock/doc/snippets/Snippet-List-Bulleted.html
- + utils/haddock/doc/snippets/Snippet-List-Bulleted.tex
- + utils/haddock/doc/snippets/Snippet-List-Definition.html
- + utils/haddock/doc/snippets/Snippet-List-Definition.tex
- + utils/haddock/doc/snippets/Snippet-List-Enumerated.html
- + utils/haddock/doc/snippets/Snippet-List-Enumerated.tex
- + utils/haddock/doc/snippets/Snippet-List-Indentation.html
- + utils/haddock/doc/snippets/Snippet-List-Indentation.tex
- + utils/haddock/doc/snippets/Snippet-List-Multiline-Item.html
- + utils/haddock/doc/snippets/Snippet-List-Multiline-Item.tex
- + utils/haddock/doc/snippets/Snippet-List-Nested-Item.html
- + utils/haddock/doc/snippets/Snippet-List-Nested-Item.tex
- + utils/haddock/doc/snippets/Snippet-List-Not-Newline.html
- + utils/haddock/doc/snippets/Snippet-List-Not-Newline.tex
- + utils/haddock/doc/snippets/Snippet-List-Not-Separated.html
- + utils/haddock/doc/snippets/Snippet-List-Not-Separated.tex
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/Backends/LaTeX.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/LexParseRn.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
- utils/haddock/html-test/ref/A.html
- utils/haddock/html-test/ref/Bug1004.html
- utils/haddock/html-test/ref/Bug1033.html
- utils/haddock/html-test/ref/Bug1103.html
- utils/haddock/html-test/ref/Bug548.html
- utils/haddock/html-test/ref/Bug923.html
- utils/haddock/html-test/ref/ConstructorPatternExport.html
- utils/haddock/html-test/ref/FunArgs.html
- utils/haddock/html-test/ref/Hash.html
- utils/haddock/html-test/ref/Instances.html
- utils/haddock/html-test/ref/LinearTypes.html
- utils/haddock/html-test/ref/RedactTypeSynonyms.html
- utils/haddock/html-test/ref/T23616.html
- utils/haddock/html-test/ref/Test.html
- utils/haddock/html-test/ref/TypeFamilies3.html
- utils/jsffi/dyld.mjs
- utils/jsffi/post-link.mjs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99746f25364f1733c037a54421db84…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/99746f25364f1733c037a54421db84…
You're receiving this email because of your account on gitlab.haskell.org.
1
0