sheaf pushed to branch wip/T26878 at Glasgow Haskell Compiler / GHC
Commits:
bf85c633 by sheaf at 2026-04-01T18:11:24+02:00
Simplify mkTick
This commit simplifies 'GHC.Core.Utils.mkTick', removing the
accumulating parameter 'rest' which was suspiciously treating a bunch of
different ticks as a group, and moving the group as a whole around the
AST, ignoring that the ticks in the group might have different placement
properties.
Also adds Note [Pushing SCCs inwards] which clarifies the logic for
pushing SCCs into lambdas, constructor applications, and dropping SCCs
around non-function variables (in particular the treatment of splittable
ticks).
A few other changes are also implemented:
- simplify 'can_split' predicate (no functional change)
- drop profiling ticks around coercions, fixing #26941 and #27121
- combine profiling ticks into one when possible
Fixes #26878, #26941 and #27121
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
9 changed files:
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Types/Tickish.hs
- libraries/ghc-heap/tests/tso_and_stack_closures.hs
- + testsuite/tests/profiling/should_compile/T27121.hs
- + testsuite/tests/profiling/should_compile/T27121_aux.hs
- testsuite/tests/profiling/should_compile/all.T
- + testsuite/tests/simplCore/should_compile/T26941.hs
- + testsuite/tests/simplCore/should_compile/T26941_aux.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -303,101 +303,262 @@ mkCast expr co
* *
********************************************************************* -}
--- | Wraps the given expression in the source annotation, dropping the
--- annotation if possible.
+-- | Wraps the given expression in a Tick, floating the tick as far into
+-- the AST as possible in order to try to satisfy the tick's desired placement
+-- properties (as per Note [Tickish placement] in GHC.Types.Tickish).
+--
+-- Prefer using 'mkTick' over explicit use of the 'Tick' constructor.
+--
+-- Also performs small on-the-fly optimisations:
+--
+-- * Eliminate unnecessary ticks by either absorbing them into existing ones
+-- or dropping them if that is valid (e.g. dropping profiling ticks around
+-- types, coercions and literals).
+-- * Split profiling ticks into counting/scoping parts so that the two parts
+-- can be placed independently into the AST.
mkTick :: CoreTickish -> CoreExpr -> CoreExpr
-mkTick t orig_expr = mkTick' id orig_expr
+mkTick t orig_expr = mkTick' orig_expr
where
-- Some ticks (cost-centres) can be split in two, with the
-- non-counting part having laxer placement properties.
- canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t
+ -- See Note [Scoping ticks and counting ticks] in GHC.Types.Tickish.
+ can_split = tickishCanSplit t
- -- mkTick' handles floating of ticks *into* the expression.
- mkTick' :: (CoreExpr -> CoreExpr) -- Apply before adding tick (float with)
- -- Always a composition of (Tick t) wrappers
- -> CoreExpr -- Current expression
- -> CoreExpr
- -- So in the call (mkTick' rest e), the expression
- -- (rest e)
- -- has the same type as e
- -- Returns an expression equivalent to (Tick t (rest e))
- mkTick' rest expr = case expr of
- -- Float ticks into unsafe coerce the same way we would do with a cast.
- Case scrut bndr ty alts@[Alt ac abs _rhs]
- | Just rhs <- isUnsafeEqualityCase scrut bndr alts
- -> Case scrut bndr ty [Alt ac abs (mkTick' rest rhs)]
-
- -- Cost centre ticks should never be reordered relative to each
- -- other. Therefore we can stop whenever two collide.
+ -- mkTick' handles floating of tick `t` *into* the expression.
+ mkTick' :: CoreExpr -> CoreExpr
+ mkTick' expr = case expr of
Tick t2 e
- | ProfNote{} <- t2, ProfNote{} <- t -> Tick t $ rest expr
-
- -- Otherwise we assume that ticks of different placements float
- -- through each other.
- | tickishPlace t2 /= tickishPlace t -> Tick t2 $ mkTick' rest e
-
- -- For annotations this is where we make sure to not introduce
- -- redundant ticks.
- | tickishContains t t2 -> mkTick' rest e -- Drop t2
- | tickishContains t2 t -> rest e -- Drop t
- | otherwise -> mkTick' (rest . Tick t2) e
-
- -- Ticks don't care about types, so we just float all ticks
- -- through them. Note that it's not enough to check for these
- -- cases top-level. While mkTick will never produce Core with type
- -- expressions below ticks, such constructs can be the result of
- -- unfoldings. We therefore make an effort to put everything into
- -- the right place no matter what we start with.
- Cast e co -> mkCast (mkTick' rest e) co
- Coercion co -> Tick t $ rest (Coercion co)
+
+ -- Common up ticks when possible, including profiling ticks that
+ -- share a cost centre and source notes that subsume one another.
+ | Just t' <- combineTickish_maybe t t2
+ -> mkTick t' e
+
+ -- Profiling ticks for different cost centres should never be reordered
+ -- relative to each other. Therefore, we stop whenever two collide.
+ | ProfNote {} <- t
+ , ProfNote {} <- t2
+ -> Tick t expr
+
+ -- Ticks of different placements float through each other, so that each
+ -- tick can be floated into its expected position in the AST.
+ -- See Note [Tickish placement] in GHC.Types.Tickish.
+ | tickishPlace t2 /= tickishPlace t
+ -> Tick t2 $ mkTick' e
Lam x e
-- Always float through type lambdas. Even for non-type lambdas,
-- floating is allowed for all but the most strict placement rule.
| not (isRuntimeVar x) || tickishPlace t /= PlaceRuntime
- -> Lam x $ mkTick' rest e
+ -> Lam x $ mkTick' e
- -- If it is both counting and scoped, we split the tick into its
- -- two components, often allowing us to keep the counting tick on
- -- the outside of the lambda and push the scoped tick inside.
- -- The point of this is that the counting tick can probably be
- -- floated, and the lambda may then be in a position to be
- -- beta-reduced.
- | canSplit
- -> Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e
+ -- Push SCCs into lambdas.
+ -- See (PSCC2) in Note [Pushing SCCs inwards].
+ | can_split
+ -> Tick (mkNoScope t) $ Lam x $ mkTick (mkNoCount t) e
App f arg
- -- Always float through type applications.
+ -- All ticks float inwards through non-runtime arguments, as per
+ -- Note [Tickish placement] in GHC.Types.Tickish.
| not (isRuntimeArg arg)
- -> App (mkTick' rest f) arg
+ -> App (mkTick' f) arg
- -- We can also float through constructor applications, placement
- -- permitting. Again we can split.
- | isSaturatedConApp expr && (tickishPlace t==PlaceCostCentre || canSplit)
+ -- Push SCCs into saturated constructor applications.
+ -- See (PSCC3) in Note [Pushing SCCs inwards].
+ | isSaturatedConApp expr
+ , tickishPlace t == PlaceCostCentre || can_split
-> if tickishPlace t == PlaceCostCentre
- then rest $ tickHNFArgs t expr
- else Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr
+ then tickHNFArgs t expr
+ else Tick (mkNoScope t) $ tickHNFArgs (mkNoCount t) expr
+
+ -- See Note [No ticks around types or coercions]
+ e@(Coercion {}) -> e
+ e@(Type {}) -> e
+ -- Don't wrap static data in a tick which compiles to code,
+ -- as the code will never be run.
+ e@(Lit {}) | tickishIsCode t -> e
+
+ -- All ticks can be floated through casts, as per Note [Tickish placement].
+ Cast e co -> mkCast (mkTick' e) co
+
+ -- Treat 'unsafeCoerce' as if it was a cast: float all ticks inwards.
+ -- See Note [Push ticks into unsafeCoerce]
+ Case scrut bndr ty alts@[Alt ac abs _rhs]
+ | Just rhs <- isUnsafeEqualityCase scrut bndr alts
+ -> Case scrut bndr ty [Alt ac abs (mkTick' rhs)]
Var x
- | notFunction && tickishPlace t == PlaceCostCentre
- -> rest expr -- Drop t
- | notFunction && canSplit
- -> Tick (mkNoScope t) $ rest expr
- where
- -- SCCs can be eliminated on variables provided the variable
- -- is not a function. In these cases the SCC makes no difference:
- -- the cost of evaluating the variable will be attributed to its
- -- definition site. When the variable refers to a function, however,
- -- an SCC annotation on the variable affects the cost-centre stack
- -- when the function is called, so we must retain those.
- notFunction = not (isFunTy (idType x))
-
- Lit{}
+ -- Don't drop any ticks around a function
+ | isFunTy (idType x)
+ -> Tick t expr
+ -- Drop SCCs around non-function variables.
+ -- See (PSCC1) in Note [Pushing SCCs inwards].
| tickishPlace t == PlaceCostCentre
- -> rest expr -- Drop t
+ -> -- Drop pure SCC ticks: scc<foo> (x :: Int) ==> x
+ expr
+ | can_split
+ -> -- Drop the scoping part of the tick, but keep the counting part.
+ Tick (mkNoScope t) expr
+
+ -- Catch-all: annotate where we stand.
+ -- In particular (but not only): Let, most Cases.
+ _other -> Tick t expr
+
+{- Note [Pushing SCCs inwards]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Amongst all ticks, SCCs have the laxest placement properties (PlaceCostCentre,
+as described in Note [Tickish placement] GHC.Types.Tickish):
+
+ (PSCC1) SCCs around non-function variables can be eliminated.
+ The cost of evaluating the variable will be attributed to its definition
+ site, so the SCC makes no difference. Example:
+
+ scc<foo> (x :: Int) ==> x
+
+ NB: this is only valid when the variable is not a function. For example, in:
+
+ scc<foo> (f :: Int -> Int)
+
+ we must retain the cost centre annotation, as it affects the cost-centre
+ pointer when the function is called. Discarding the SCC in this case would
+ defeat the profiling mechanism entirely!
+
+ (PSCC2) SCCs can be pushed into lambdas.
+
+ scc<foo> (\x -> e) ==> \x -> scc<foo> e
+
+ (PSCC3) We can push SCCs into (saturated) constructor applications.
+ For example, for an arity 2 data constructor 'D':
+
+ scc<foo> (D e1 e2) ==> D (scc<foo> e1) (scc<foo> e2)
+
+Now, two kinds of ticks contain SCCs:
+
+ - bare SCCs (i.e. ProfNote with profNoteCounts = False, profNoteScopes = True)
+ - profiling ticks that both count and scope
+
+The above explanation deals with bare SCCs. When handling profiling ticks that
+both count and scope, we can split tick into two, so that the scoping part can
+be pushed inwards (or even discarded). Specifically, we perform the following
+transformations:
+
+ (PSCC1) Drop the SCC around non-function variables, keeping only the counting
+ part:
+
+ scctick<foo> (x :: Int) ==> tick<foo> x
+
+ (PSCC2) Push the SCC inside lambdas:
+
+ scctick<foo> (\x. e) ==> tick<foo> (\x. scc<foo> e)
+
+ NB: we must keep the counting part outside the lambda, in order to preserve
+ tick counter tallies – it would not be sound to push the counting part inside.
- -- Catch-all: Annotate where we stand
- _any -> Tick t $ rest expr
+ (PSCC3) Push the SCC inside saturated contructor applications.
+
+ scctick<foo> (D e1 e2) ==> tick<foo> (D (scc<foo> e1) (scc<foo> e2))
+
+The benefit of these transformation is that the counting part, tick<foo>, can
+likely be floated out of the way, which may expose additional optimisation
+opportunities. For example, for (PSCC2):
+
+ (scctick<foo> (\x. e)) arg
+
+ ==>{PSCC2}
+
+ (tick<foo> (\x. scc<foo> e)) arg
+
+ ==>{GHC.Core.Opt.FloatOut.floatExpr, because 'tick<foo>' has no scope}
+
+ tick<foo> ((\x. scc<foo> e) arg)
+
+ ==>{beta reduction}
+
+ tick<foo> (let x = arg in scc<foo> e)
+
+For (PSCC3):
+
+ case (scctick<foo> (Just x)) of { Nothing -> 0; Just y -> y + 1 }
+
+ ==>{PSCC3}
+
+ case (tick<foo> (Just (scc<foo> x))) of { Nothing -> 0; Just y -> y + 1 }
+
+ ==>{GHC.Core.Opt.FloatOut.floatExpr, because 'tick<foo>' has no scope}
+
+ tick<foo> (case Just (scc<foo> x) of { Nothing -> 0; Just y -> y + 1 })
+
+ ==>{case of known constructor}
+
+ tick<foo> (let y = scc<foo> x in y + 1)
+
+Note [Push ticks into unsafeCoerce]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In #25212, we had a program of the form:
+
+ data Box = Box Any
+ asBox :: a -> Box
+ asBox x = {-# SCC asBox #-} Box (unsafeCoerce x)
+
+As per Note [Implementing unsafeCoerce] in GHC.Internal.Unsafe.Coerce, the call
+to `unsafeCoerce` turns into
+
+ case unsafeEqualityProof @Type @a @Any of
+ UnsafeRefl (co :: a ~# Any) -> x |> Sub co
+
+The worker for 'asBox' is then of the form:
+
+ $wasBox = \@a (x :: a) ->
+ (# case unsafeEqualityProof @Type @a @Any of
+ UnsafeRefl (co :: a ~# Any) -> x |> Sub co
+ #)
+
+When inserting the SCC, we push it into the constructor as per (PSCC3) in
+Note [Pushing SCCs inwards], so we get:
+
+ $wasBox = \@a (x :: a) ->
+ tick<asBox>
+ (# scc<asBox>
+ case unsafeEqualityProof @Type @a @Any of
+ UnsafeRefl (co :: a ~# Any) -> x |> Sub co
+ #)
+
+Now, if we don't push the SCC tick into the case statement, Core Prep will
+see an expression like 'MkSolo# (scc<asBox> ...)', which it will ANFise to
+'let x = scc<asBox> ... in MkSolo# x', creating an unwanted thunk in the process.
+
+So the strategy is to treat this 'unsafeEqualityProof' case statement as if it
+was a cast. We thus push the SCC into the RHS of the pattern match:
+
+ $wasBox = \@a (x :: a) ->
+ tick<asBox>
+ (# case unsafeEqualityProof @Type @a @Any of
+ UnsafeRefl (co :: a ~# Any) -> scc<asBox> x |> Sub co
+ #)
+
+Then the SCC completely evaporates, as per (PSCC1) in Note [Pushing SCCs inwards].
+
+Note [No ticks around types or coercions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It doesn't make much sense to put a tick around a type or a coercion, as both
+types and coercions are erased in the end.
+
+In fact, it is quite dangerous to add a tick around types or coercions, because
+the optimiser does not robustly look through ticks:
+
+ - 'GHC.Core.SimpleOpt.simple_bind_pair' does not look through ticks when
+ looking at the RHS to decide whether it is a Type or Coercion,
+ - 'GHC.Core.Opt.Simplify.Iteration.completeBind' does not look through ticks
+ when looking at the RHS of an CoVar binding.
+
+This means it is vital to drop ticks around types/coercions:
+
+ - (#26941) Core Lint rejects bindings of the form "let co = tick ..."
+ in which the LHS is a CoVar and the RHS is a ticked Coercion.
+ - (#27121) The simplifier mis-handles ticked coercion bindings, which can
+ result in 'lookupIdSubst' panics (due to failing to extend the substitution
+ with a coercion).
+-}
mkTicks :: [CoreTickish] -> CoreExpr -> CoreExpr
mkTicks ticks expr = foldr mkTick expr ticks
@@ -2573,8 +2734,8 @@ exprIsTickedString = isJust . exprIsTickedString_maybe
exprIsTickedString_maybe :: CoreExpr -> Maybe ByteString
exprIsTickedString_maybe (Lit (LitString bs)) = Just bs
exprIsTickedString_maybe (Tick t e)
- -- we don't tick literals with CostCentre ticks, compare to mkTick
- | tickishPlace t == PlaceCostCentre = Nothing
+ -- Shortcut: ticks with code never wrap literals (compare with 'mkTick')
+ | tickishIsCode t = Nothing
| otherwise = exprIsTickedString_maybe e
exprIsTickedString_maybe _ = Nothing
=====================================
compiler/GHC/Types/Tickish.hs
=====================================
@@ -17,6 +17,7 @@ module GHC.Types.Tickish (
TickishPlacement(..),
tickishPlace,
tickishContains,
+ combineTickish_maybe,
-- * Breakpoint tick identifiers
BreakpointId(..), BreakTickIndex
@@ -261,8 +262,12 @@ Ticks have two independent attributes:
See Note [Scoped ticks]
+Note that profiling notes which both count and scope can be split into two
+separate ticks, one that counts and doesn't scope and one that scopes and doesn't
+count; see 'tickishCanSplit', 'mkNoCount' and 'mkNoScope'.
+
Note [Counting ticks]
-~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~~~~~~~
The following ticks count:
- ProfNote ticks with profNoteCounts = True
- HPC ticks
@@ -290,7 +295,7 @@ 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
@@ -375,6 +380,61 @@ Whether we are allowed to float in additional cost depends on the tick:
While these transformations are legal, we want to make a best effort to
only make use of them where it exposes transformation opportunities.
+
+Note [Tickish placement]
+~~~~~~~~~~~~~~~~~~~~~~~~
+The placement behaviour of ticks (i.e. which nodes we want the tick to be placed
+around in the AST) is governed by 'TickishPlacement'.
+From most restrictive to least restrictive placement rules:
+
+ - PlaceRuntime: counting ticks.
+
+ Ticks with 'PlaceRuntime' placement want to be placed around run-time
+ expressions. They can be moved through pure compile-time constructs such as
+ other type arguments, casts, or type lambdas:
+
+ tick <t> (f @ty) ==> (tick <t> f) @ty
+ tick <t> (e |> co) ==> (tick <t> e) |> co
+ tick <t> (/\a. e) ==> /\a. tick <t> e
+
+ This is the most restrictive placement rule for ticks, as all tickishs have
+ in common that they want to track runtime behaviour.
+
+ Any tick that counts (see Note [Counting ticks]) has 'PlaceRuntime' placement.
+
+ - PlaceNonLam: source notes.
+
+ Like PlaceRuntime, but we can also float the tick through value lambdas:
+
+ tick <t> (\x. e) ==> \x. tick <t> e
+
+ This makes sense where there is little difference between annotating the
+ lambda and annotating the lambda's code.
+
+ - PlaceCostCentre: non-counting profiling ticks.
+
+ In addition to floating through lambdas, cost-centre style tickishs can be
+ pushed into (saturated) constructor applications, and can be eliminated when
+ placed around non-function variables:
+
+ tick <t> (C e1 e2) ==> C (tick <t> e1) (tick <t> e2)
+
+ tick <t> (x :: Int) ==> (x :: Int)
+
+ Neither the constructor application nor the variable 'x' are likely to have
+ any cost worth mentioning.
+
+We generally try to push ticks inwards until they end up placed around a Core
+expression that is appropriate for their placement rule, as described above.
+This gives us the opportunity to eliminate the tick, either by combining it with
+another tick (see 'combineTickish_maybe') or by dropping it altogether. For
+example, a (non-counting) SCC around a non-function variable can be dropped, as
+there is no cost to scope over.
+
+After the tick has been placed by 'mkTick', the simplifier may later (during
+simplification) decide to float it outwards (see e.g. GHC.Core.Opt.Simplify.Iteration.simplTick).
+The story here is not fully worked out, as the simplifier calls 'mkTick', which
+might push the tick inwards again.
-}
-- | Returns @True@ for ticks that can be floated upwards easily even
@@ -441,35 +501,19 @@ isProfTick _ = False
-- annotating for example using @mkTick@. If we find that we want to
-- put a tickish on an expression ruled out here, we try to float it
-- inwards until we find a suitable expression.
+--
+-- See Note [Tickish placement].
data TickishPlacement =
- -- | Place ticks exactly on run-time expressions. We can still
- -- move the tick through pure compile-time constructs such as
- -- other ticks, casts or type lambdas. This is the most
- -- restrictive placement rule for ticks, as all tickishs have in
- -- common that they want to track runtime processes. The only
- -- legal placement rule for counting ticks.
- -- NB: We generally try to move these as close to the relevant
- -- runtime expression as possible. This means they get pushed through
- -- tyoe arguments. E.g. we create `(tick f) @Bool` instead of `tick (f @Bool)`.
+ -- | Place ticks exactly on run-time expressions, moving them through pure
+ -- compile-time constructs such as other ticks, casts or type lambdas.
PlaceRuntime
- -- | As @PlaceRuntime@, but we float the tick through all
- -- lambdas. This makes sense where there is little difference
- -- between annotating the lambda and annotating the lambda's code.
+ -- | As @PlaceRuntime@, but also allow to float the tick through all lambdas.
| PlaceNonLam
- -- | In addition to floating through lambdas, cost-centre style
- -- tickishs can also be moved from constructors, non-function
- -- variables and literals. For example:
- --
- -- let x = scc<...> C (scc<...> y) (scc<...> 3) in ...
- --
- -- Neither the constructor application, the variable or the
- -- literal are likely to have any cost worth mentioning. And even
- -- if y names a thunk, the call would not care about the
- -- evaluation context. Therefore removing all annotations in the
- -- above example is safe.
+ -- | As 'PlaceNonLam', but also float through constructors, non-function
+ -- variables and literals.
| PlaceCostCentre
deriving (Eq,Show)
@@ -477,7 +521,9 @@ data TickishPlacement =
instance Outputable TickishPlacement where
ppr = text . show
--- | Placement behaviour we want for the ticks
+-- | Placement behaviour we want for the ticks.
+--
+-- See Note [Tickish placement].
tickishPlace :: GenTickish pass -> TickishPlacement
tickishPlace n@ProfNote{}
| profNoteCount n = PlaceRuntime
@@ -486,6 +532,43 @@ tickishPlace HpcTick{} = PlaceRuntime
tickishPlace Breakpoint{} = PlaceRuntime
tickishPlace SourceNote{} = PlaceNonLam
+-- | Merge two ticks into one, if that is possible.
+--
+-- Examples:
+--
+-- - combine two source note ticks if one contains the other,
+-- - combine a non-counting profiling tick with a non-scoping profiling tick
+-- for the same cost centre
+-- - combine two equal breakpoint ticks or HPC ticks
+combineTickish_maybe :: Eq (GenTickish pass)
+ => GenTickish pass -> GenTickish pass -> Maybe (GenTickish pass)
+combineTickish_maybe
+ (ProfNote { profNoteCC = cc1, profNoteCount = cnt1, profNoteScope = scope1 })
+ (ProfNote { profNoteCC = cc2, profNoteCount = cnt2, profNoteScope = scope2 })
+ | cc1 == cc2
+ , not cnt1 || not cnt2
+ = Just $ ProfNote { profNoteCC = cc1
+ , profNoteCount = cnt1 || cnt2
+ , profNoteScope = scope1 || scope2
+ }
+combineTickish_maybe t1@(SourceNote sp1 n1) t2@(SourceNote sp2 n2)
+ | n1 == n2
+ , sp1 `containsSpan` sp2
+ = Just t1
+ | n1 == n2
+ , sp2 `containsSpan` sp1
+ = Just t2
+ -- NB: it would be possible to use 'combineRealSrcSpans' instead,
+ -- but that has the risk of combining many source note ticks into a single
+ -- tick with a huge source span.
+combineTickish_maybe t1@(HpcTick {}) t2@(HpcTick {})
+ | t1 == t2
+ = Just t1
+combineTickish_maybe t1@(Breakpoint {}) t2@(Breakpoint {})
+ | t1 == t2
+ = Just t1
+combineTickish_maybe _ _ = Nothing
+
-- | Returns whether one tick "contains" the other one, therefore
-- making the second tick redundant.
tickishContains :: Eq (GenTickish pass)
=====================================
libraries/ghc-heap/tests/tso_and_stack_closures.hs
=====================================
@@ -48,7 +48,9 @@ main = do
assertEqual (cc_module myCostCentre) "Main"
assertEqual (cc_srcloc myCostCentre) (Just "tso_and_stack_closures.hs:24:48-80")
assertEqual (cc_is_caf myCostCentre) False
- Nothing -> error $ "MyCostCentre not found in:\n" ++ unlines (cc_label <$> linkedCostCentres costCentre)
+ Nothing -> error "MyCostCentre not found"
+ -- Don't print all of 'linkedCostCentres costCentre',
+ -- as that is ~20k lines of output.
#endif
linkedCostCentres :: Maybe CostCentre -> [CostCentre]
=====================================
testsuite/tests/profiling/should_compile/T27121.hs
=====================================
@@ -0,0 +1,12 @@
+module T27121 where
+
+import T27121_aux
+
+updateFileDiagnostics
+ :: LanguageContextEnv ()
+ -> IO ()
+updateFileDiagnostics env = do
+ withTrace $ \ _tag ->
+ runLspT env $ do
+ sendNotification SMethod_TextDocumentPublishDiagnostics
+ PublishDiagnosticsParams
=====================================
testsuite/tests/profiling/should_compile/T27121_aux.hs
=====================================
@@ -0,0 +1,354 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module T27121_aux
+ ( withTrace
+ , sendNotification
+ , LspT, runLspT
+ , SMethod(..)
+ , LanguageContextEnv
+ , PublishDiagnosticsParams(..)
+ )
+ where
+
+-- base
+import Control.Monad.IO.Class ( MonadIO, liftIO )
+import Data.Kind ( Type )
+import GHC.TypeLits ( Symbol )
+
+--------------------------------------------------------------------------------
+
+withTrace :: Monad m => ((String -> String -> m ()) -> m a) -> m a
+withTrace act
+ | myUserTracingEnabled
+ = return undefined
+ | otherwise = act (\_ _ -> pure ())
+{-# NOINLINE withTrace #-}
+
+myUserTracingEnabled :: Bool
+myUserTracingEnabled = False
+{-# NOINLINE myUserTracingEnabled #-}
+
+type Text = String
+
+newtype LspT config a = LspT {unLspT :: LanguageContextEnv config -> IO a}
+
+instance Functor (LspT config) where
+ fmap f (LspT g) = LspT (fmap f . g)
+
+instance Applicative (LspT config) where
+ pure = LspT . const . pure
+ LspT f <*> LspT a = LspT $ \ env -> f env <*> a env
+instance Monad (LspT config) where
+ LspT a >>= f = LspT $ \ env -> do
+ b <- a env
+ unLspT ( f b ) env
+instance MonadIO (LspT config) where
+ liftIO = LspT . const . liftIO
+
+type role LspT representational nominal
+
+runLspT :: LanguageContextEnv config -> LspT config a -> IO a
+runLspT env (LspT f) = f env
+{-# INLINE runLspT #-}
+
+data PublishDiagnosticsParams = PublishDiagnosticsParams
+
+data LanguageContextEnv config =
+ LanguageContextEnv
+ { resSendMessage :: FromServerMessage -> IO () }
+
+
+sendNotification ::
+ forall (m :: Method ServerToClient Notification) f config.
+ MonadLsp config f =>
+ SServerMethod m ->
+ MessageParams m ->
+ f ()
+sendNotification m params =
+ let msg = TNotificationMessage { _method = m, _params = params }
+ in case splitServerMethod m of
+ IsServerNot -> sendToClient $ fromServerNot msg
+
+type Method :: MessageDirection -> MessageKind -> Type
+data Method f t where
+ Method_TextDocumentImplementation :: Method ClientToServer Request
+ Method_TextDocumentTypeDefinition :: Method ClientToServer Request
+ Method_WorkspaceWorkspaceFolders :: Method ServerToClient Request
+ Method_WorkspaceConfiguration :: Method ServerToClient Request
+ Method_TextDocumentDocumentColor :: Method ClientToServer Request
+ Method_TextDocumentColorPresentation :: Method ClientToServer Request
+ Method_TextDocumentFoldingRange :: Method ClientToServer Request
+ Method_TextDocumentDeclaration :: Method ClientToServer Request
+ Method_TextDocumentSelectionRange :: Method ClientToServer Request
+ Method_WindowWorkDoneProgressCreate :: Method ServerToClient Request
+ Method_TextDocumentPrepareCallHierarchy :: Method ClientToServer Request
+ Method_CallHierarchyIncomingCalls :: Method ClientToServer Request
+ Method_CallHierarchyOutgoingCalls :: Method ClientToServer Request
+ Method_TextDocumentSemanticTokensFull :: Method ClientToServer Request
+ Method_TextDocumentSemanticTokensFullDelta :: Method ClientToServer Request
+ Method_TextDocumentSemanticTokensRange :: Method ClientToServer Request
+ Method_WorkspaceSemanticTokensRefresh :: Method ServerToClient Request
+ Method_WindowShowDocument :: Method ServerToClient Request
+ Method_TextDocumentLinkedEditingRange :: Method ClientToServer Request
+ Method_WorkspaceWillCreateFiles :: Method ClientToServer Request
+ Method_WorkspaceWillRenameFiles :: Method ClientToServer Request
+ Method_WorkspaceWillDeleteFiles :: Method ClientToServer Request
+ Method_TextDocumentMoniker :: Method ClientToServer Request
+ Method_TextDocumentPrepareTypeHierarchy :: Method ClientToServer Request
+ Method_TypeHierarchySupertypes :: Method ClientToServer Request
+ Method_TypeHierarchySubtypes :: Method ClientToServer Request
+ Method_TextDocumentInlineValue :: Method ClientToServer Request
+ Method_WorkspaceInlineValueRefresh :: Method ServerToClient Request
+ Method_TextDocumentInlayHint :: Method ClientToServer Request
+ Method_InlayHintResolve :: Method ClientToServer Request
+ Method_WorkspaceInlayHintRefresh :: Method ServerToClient Request
+ Method_TextDocumentDiagnostic :: Method ClientToServer Request
+ Method_WorkspaceDiagnostic :: Method ClientToServer Request
+ Method_WorkspaceDiagnosticRefresh :: Method ServerToClient Request
+ Method_ClientRegisterCapability :: Method ServerToClient Request
+ Method_ClientUnregisterCapability :: Method ServerToClient Request
+ Method_Initialize :: Method ClientToServer Request
+ Method_Shutdown :: Method ClientToServer Request
+ Method_WindowShowMessageRequest :: Method ServerToClient Request
+ Method_TextDocumentWillSaveWaitUntil :: Method ClientToServer Request
+ Method_TextDocumentCompletion :: Method ClientToServer Request
+ Method_CompletionItemResolve :: Method ClientToServer Request
+ Method_TextDocumentHover :: Method ClientToServer Request
+ Method_TextDocumentSignatureHelp :: Method ClientToServer Request
+ Method_TextDocumentDefinition :: Method ClientToServer Request
+ Method_TextDocumentReferences :: Method ClientToServer Request
+ Method_TextDocumentDocumentHighlight :: Method ClientToServer Request
+ Method_TextDocumentDocumentSymbol :: Method ClientToServer Request
+ Method_TextDocumentCodeAction :: Method ClientToServer Request
+ Method_CodeActionResolve :: Method ClientToServer Request
+ Method_WorkspaceSymbol :: Method ClientToServer Request
+ Method_WorkspaceSymbolResolve :: Method ClientToServer Request
+ Method_TextDocumentCodeLens :: Method ClientToServer Request
+ Method_CodeLensResolve :: Method ClientToServer Request
+ Method_WorkspaceCodeLensRefresh :: Method ServerToClient Request
+ Method_TextDocumentDocumentLink :: Method ClientToServer Request
+ Method_DocumentLinkResolve :: Method ClientToServer Request
+ Method_TextDocumentFormatting :: Method ClientToServer Request
+ Method_TextDocumentRangeFormatting :: Method ClientToServer Request
+ Method_TextDocumentOnTypeFormatting :: Method ClientToServer Request
+ Method_TextDocumentRename :: Method ClientToServer Request
+ Method_TextDocumentPrepareRename :: Method ClientToServer Request
+ Method_WorkspaceExecuteCommand :: Method ClientToServer Request
+ Method_WorkspaceApplyEdit :: Method ServerToClient Request
+ Method_WorkspaceDidChangeWorkspaceFolders :: Method ClientToServer Notification
+ Method_WindowWorkDoneProgressCancel :: Method ClientToServer Notification
+ Method_WorkspaceDidCreateFiles :: Method ClientToServer Notification
+ Method_WorkspaceDidRenameFiles :: Method ClientToServer Notification
+ Method_WorkspaceDidDeleteFiles :: Method ClientToServer Notification
+ Method_NotebookDocumentDidOpen :: Method ClientToServer Notification
+ Method_NotebookDocumentDidChange :: Method ClientToServer Notification
+ Method_NotebookDocumentDidSave :: Method ClientToServer Notification
+ Method_NotebookDocumentDidClose :: Method ClientToServer Notification
+ Method_Initialized :: Method ClientToServer Notification
+ Method_Exit :: Method ClientToServer Notification
+ Method_WorkspaceDidChangeConfiguration :: Method ClientToServer Notification
+ Method_WindowShowMessage :: Method ServerToClient Notification
+ Method_WindowLogMessage :: Method ServerToClient Notification
+ Method_TelemetryEvent :: Method ServerToClient Notification
+ Method_TextDocumentDidOpen :: Method ClientToServer Notification
+ Method_TextDocumentDidChange :: Method ClientToServer Notification
+ Method_TextDocumentDidClose :: Method ClientToServer Notification
+ Method_TextDocumentDidSave :: Method ClientToServer Notification
+ Method_TextDocumentWillSave :: Method ClientToServer Notification
+ Method_WorkspaceDidChangeWatchedFiles :: Method ClientToServer Notification
+ Method_TextDocumentPublishDiagnostics :: Method ServerToClient Notification
+ Method_SetTrace :: Method ClientToServer Notification
+ Method_LogTrace :: Method ServerToClient Notification
+ Method_CancelRequest :: Method f Notification
+ Method_Progress :: Method f Notification
+ Method_CustomMethod :: Symbol -> Method f t
+
+type SMethod :: forall f t . Method f t -> Type
+data SMethod m where
+ SMethod_TextDocumentImplementation :: SMethod Method_TextDocumentImplementation
+ SMethod_TextDocumentTypeDefinition :: SMethod Method_TextDocumentTypeDefinition
+ SMethod_WorkspaceWorkspaceFolders :: SMethod Method_WorkspaceWorkspaceFolders
+ SMethod_WorkspaceConfiguration :: SMethod Method_WorkspaceConfiguration
+ SMethod_TextDocumentDocumentColor :: SMethod Method_TextDocumentDocumentColor
+ SMethod_TextDocumentColorPresentation :: SMethod Method_TextDocumentColorPresentation
+ SMethod_TextDocumentFoldingRange :: SMethod Method_TextDocumentFoldingRange
+ SMethod_TextDocumentDeclaration :: SMethod Method_TextDocumentDeclaration
+ SMethod_TextDocumentSelectionRange :: SMethod Method_TextDocumentSelectionRange
+ SMethod_WindowWorkDoneProgressCreate :: SMethod Method_WindowWorkDoneProgressCreate
+ SMethod_TextDocumentPrepareCallHierarchy :: SMethod Method_TextDocumentPrepareCallHierarchy
+ SMethod_CallHierarchyIncomingCalls :: SMethod Method_CallHierarchyIncomingCalls
+ SMethod_CallHierarchyOutgoingCalls :: SMethod Method_CallHierarchyOutgoingCalls
+ SMethod_TextDocumentSemanticTokensFull :: SMethod Method_TextDocumentSemanticTokensFull
+ SMethod_TextDocumentSemanticTokensFullDelta :: SMethod Method_TextDocumentSemanticTokensFullDelta
+ SMethod_TextDocumentSemanticTokensRange :: SMethod Method_TextDocumentSemanticTokensRange
+ SMethod_WorkspaceSemanticTokensRefresh :: SMethod Method_WorkspaceSemanticTokensRefresh
+ SMethod_WindowShowDocument :: SMethod Method_WindowShowDocument
+ SMethod_TextDocumentLinkedEditingRange :: SMethod Method_TextDocumentLinkedEditingRange
+ SMethod_WorkspaceWillCreateFiles :: SMethod Method_WorkspaceWillCreateFiles
+ SMethod_WorkspaceWillRenameFiles :: SMethod Method_WorkspaceWillRenameFiles
+ SMethod_WorkspaceWillDeleteFiles :: SMethod Method_WorkspaceWillDeleteFiles
+ SMethod_TextDocumentMoniker :: SMethod Method_TextDocumentMoniker
+ SMethod_TextDocumentPrepareTypeHierarchy :: SMethod Method_TextDocumentPrepareTypeHierarchy
+ SMethod_TypeHierarchySupertypes :: SMethod Method_TypeHierarchySupertypes
+ SMethod_TypeHierarchySubtypes :: SMethod Method_TypeHierarchySubtypes
+ SMethod_TextDocumentInlineValue :: SMethod Method_TextDocumentInlineValue
+ SMethod_WorkspaceInlineValueRefresh :: SMethod Method_WorkspaceInlineValueRefresh
+ SMethod_TextDocumentInlayHint :: SMethod Method_TextDocumentInlayHint
+ SMethod_InlayHintResolve :: SMethod Method_InlayHintResolve
+ SMethod_WorkspaceInlayHintRefresh :: SMethod Method_WorkspaceInlayHintRefresh
+ SMethod_TextDocumentDiagnostic :: SMethod Method_TextDocumentDiagnostic
+ SMethod_WorkspaceDiagnostic :: SMethod Method_WorkspaceDiagnostic
+ SMethod_WorkspaceDiagnosticRefresh :: SMethod Method_WorkspaceDiagnosticRefresh
+ SMethod_ClientRegisterCapability :: SMethod Method_ClientRegisterCapability
+ SMethod_ClientUnregisterCapability :: SMethod Method_ClientUnregisterCapability
+ SMethod_Initialize :: SMethod Method_Initialize
+ SMethod_Shutdown :: SMethod Method_Shutdown
+ SMethod_WindowShowMessageRequest :: SMethod Method_WindowShowMessageRequest
+ SMethod_TextDocumentWillSaveWaitUntil :: SMethod Method_TextDocumentWillSaveWaitUntil
+ SMethod_TextDocumentCompletion :: SMethod Method_TextDocumentCompletion
+ SMethod_CompletionItemResolve :: SMethod Method_CompletionItemResolve
+ SMethod_TextDocumentHover :: SMethod Method_TextDocumentHover
+ SMethod_TextDocumentSignatureHelp :: SMethod Method_TextDocumentSignatureHelp
+ SMethod_TextDocumentDefinition :: SMethod Method_TextDocumentDefinition
+ SMethod_TextDocumentReferences :: SMethod Method_TextDocumentReferences
+ SMethod_TextDocumentDocumentHighlight :: SMethod Method_TextDocumentDocumentHighlight
+ SMethod_TextDocumentDocumentSymbol :: SMethod Method_TextDocumentDocumentSymbol
+ SMethod_TextDocumentCodeAction :: SMethod Method_TextDocumentCodeAction
+ SMethod_CodeActionResolve :: SMethod Method_CodeActionResolve
+ SMethod_WorkspaceSymbol :: SMethod Method_WorkspaceSymbol
+ SMethod_WorkspaceSymbolResolve :: SMethod Method_WorkspaceSymbolResolve
+ SMethod_TextDocumentCodeLens :: SMethod Method_TextDocumentCodeLens
+ SMethod_CodeLensResolve :: SMethod Method_CodeLensResolve
+ SMethod_WorkspaceCodeLensRefresh :: SMethod Method_WorkspaceCodeLensRefresh
+ SMethod_TextDocumentDocumentLink :: SMethod Method_TextDocumentDocumentLink
+ SMethod_DocumentLinkResolve :: SMethod Method_DocumentLinkResolve
+ SMethod_TextDocumentFormatting :: SMethod Method_TextDocumentFormatting
+ SMethod_TextDocumentRangeFormatting :: SMethod Method_TextDocumentRangeFormatting
+ SMethod_TextDocumentOnTypeFormatting :: SMethod Method_TextDocumentOnTypeFormatting
+ SMethod_TextDocumentRename :: SMethod Method_TextDocumentRename
+ SMethod_TextDocumentPrepareRename :: SMethod Method_TextDocumentPrepareRename
+ SMethod_WorkspaceExecuteCommand :: SMethod Method_WorkspaceExecuteCommand
+ SMethod_WorkspaceApplyEdit :: SMethod Method_WorkspaceApplyEdit
+ SMethod_WorkspaceDidChangeWorkspaceFolders :: SMethod Method_WorkspaceDidChangeWorkspaceFolders
+ SMethod_WindowWorkDoneProgressCancel :: SMethod Method_WindowWorkDoneProgressCancel
+ SMethod_WorkspaceDidCreateFiles :: SMethod Method_WorkspaceDidCreateFiles
+ SMethod_WorkspaceDidRenameFiles :: SMethod Method_WorkspaceDidRenameFiles
+ SMethod_WorkspaceDidDeleteFiles :: SMethod Method_WorkspaceDidDeleteFiles
+ SMethod_NotebookDocumentDidOpen :: SMethod Method_NotebookDocumentDidOpen
+ SMethod_NotebookDocumentDidChange :: SMethod Method_NotebookDocumentDidChange
+ SMethod_NotebookDocumentDidSave :: SMethod Method_NotebookDocumentDidSave
+ SMethod_NotebookDocumentDidClose :: SMethod Method_NotebookDocumentDidClose
+ SMethod_Initialized :: SMethod Method_Initialized
+ SMethod_Exit :: SMethod Method_Exit
+ SMethod_WorkspaceDidChangeConfiguration :: SMethod Method_WorkspaceDidChangeConfiguration
+ SMethod_WindowShowMessage :: SMethod Method_WindowShowMessage
+ SMethod_WindowLogMessage :: SMethod Method_WindowLogMessage
+ SMethod_TelemetryEvent :: SMethod Method_TelemetryEvent
+ SMethod_TextDocumentDidOpen :: SMethod Method_TextDocumentDidOpen
+ SMethod_TextDocumentDidChange :: SMethod Method_TextDocumentDidChange
+ SMethod_TextDocumentDidClose :: SMethod Method_TextDocumentDidClose
+ SMethod_TextDocumentDidSave :: SMethod Method_TextDocumentDidSave
+ SMethod_TextDocumentWillSave :: SMethod Method_TextDocumentWillSave
+ SMethod_WorkspaceDidChangeWatchedFiles :: SMethod Method_WorkspaceDidChangeWatchedFiles
+ SMethod_TextDocumentPublishDiagnostics :: SMethod Method_TextDocumentPublishDiagnostics
+ SMethod_SetTrace :: SMethod Method_SetTrace
+ SMethod_LogTrace :: SMethod Method_LogTrace
+ SMethod_CancelRequest :: SMethod Method_CancelRequest
+ SMethod_Progress :: SMethod Method_Progress
+
+type SServerMethod (m :: Method ServerToClient t) = SMethod m
+
+data MessageDirection = ServerToClient | ClientToServer
+
+data MessageKind = Notification | Request
+
+
+type ServerNotOrReq :: forall t. Method ServerToClient t -> Type
+data ServerNotOrReq m where
+ IsServerNot ::
+ ( TMessage m ~ TNotificationMessage m
+ ) =>
+ ServerNotOrReq (m :: Method ServerToClient Notification)
+ IsServerReq ::
+ forall (m :: Method ServerToClient Request).
+ ( TMessage m ~ TRequestMessage m
+ ) =>
+ ServerNotOrReq m
+
+type TMessage :: forall f t. Method f t -> Type
+type family TMessage m where
+ TMessage (Method_CustomMethod s :: Method f t) = ()
+ TMessage (m :: Method f Request) = TRequestMessage m
+ TMessage (m :: Method f Notification) = TNotificationMessage m
+
+
+data TNotificationMessage (m :: Method f Notification) = TNotificationMessage
+ { _method :: SMethod m
+ , _params :: MessageParams m
+ }
+
+data TRequestMessage (m :: Method f Request) = TRequestMessage
+
+type MessageParams :: forall f t . Method f t -> Type
+type family MessageParams (m :: Method f t) where
+ MessageParams Method_TextDocumentPublishDiagnostics = PublishDiagnosticsParams
+
+class MonadIO m => MonadLsp config m | m -> config where
+ getLspEnv :: m (LanguageContextEnv config)
+
+instance MonadLsp config (LspT config) where
+ {-# INLINE getLspEnv #-}
+ getLspEnv = LspT pure
+
+
+{-# INLINE splitServerMethod #-}
+splitServerMethod :: SServerMethod m -> ServerNotOrReq m
+splitServerMethod = \case
+ SMethod_TextDocumentPublishDiagnostics -> IsServerNot
+ SMethod_WindowShowMessage -> IsServerNot
+ SMethod_WindowShowMessageRequest -> IsServerReq
+ SMethod_WindowShowDocument -> IsServerReq
+ SMethod_WindowLogMessage -> IsServerNot
+ SMethod_WindowWorkDoneProgressCreate -> IsServerReq
+ SMethod_Progress -> IsServerNot
+ SMethod_TelemetryEvent -> IsServerNot
+ SMethod_ClientRegisterCapability -> IsServerReq
+ SMethod_ClientUnregisterCapability -> IsServerReq
+ SMethod_WorkspaceWorkspaceFolders -> IsServerReq
+ SMethod_WorkspaceConfiguration -> IsServerReq
+ SMethod_WorkspaceApplyEdit -> IsServerReq
+ SMethod_LogTrace -> IsServerNot
+ SMethod_CancelRequest -> IsServerNot
+ SMethod_WorkspaceCodeLensRefresh -> IsServerReq
+ SMethod_WorkspaceSemanticTokensRefresh -> IsServerReq
+ SMethod_WorkspaceInlineValueRefresh -> IsServerReq
+ SMethod_WorkspaceInlayHintRefresh -> IsServerReq
+ SMethod_WorkspaceDiagnosticRefresh -> IsServerReq
+
+fromServerNot ::
+ forall (m :: Method ServerToClient Notification).
+ TMessage m ~ TNotificationMessage m =>
+ TNotificationMessage m ->
+ FromServerMessage
+fromServerNot m@TNotificationMessage{_method = meth} = FromServerMess meth m
+
+
+data FromServerMessage' a where
+ FromServerMess :: forall t (m :: Method ServerToClient t) a. SMethod m -> TMessage m -> FromServerMessage' a
+ FromServerRsp :: forall (m :: Method ClientToServer Request) a. a m -> TResponseMessage m -> FromServerMessage' a
+
+type FromServerMessage = FromServerMessage' SMethod
+
+data TResponseMessage (m :: Method f Request) = TResponseMessage
+
+sendToClient :: MonadLsp config m => FromServerMessage -> m ()
+sendToClient msg = do
+ f <- resSendMessage <$> getLspEnv
+ liftIO $ f msg
+{-# INLINE sendToClient #-}
=====================================
testsuite/tests/profiling/should_compile/all.T
=====================================
@@ -21,3 +21,4 @@ test('T15108', [test_opts], compile, ['-O -prof -fprof-auto'])
test('T19894', [test_opts, extra_files(['T19894'])], multimod_compile, ['Main', '-v0 -O2 -prof -fprof-auto -iT19894'])
test('T20938', [test_opts], compile, ['-O -prof'])
test('T26056', [test_opts], compile, ['-O -prof'])
+test('T27121', [test_opts], compile, ['-O -prof -fprof-auto'])
=====================================
testsuite/tests/simplCore/should_compile/T26941.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+
+module T26941 where
+
+import GHC.TypeLits
+
+import T26941_aux ( SMayNat(SKnown), ListH, shxHead )
+
+shsHead :: ListH (Just n : sh) Int -> SNat n
+shsHead shx =
+ case shxHead shx of
+ SKnown SNat -> SNat
=====================================
testsuite/tests/simplCore/should_compile/T26941_aux.hs
=====================================
@@ -0,0 +1,20 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+
+module T26941_aux where
+
+import Data.Kind
+import GHC.TypeLits
+
+shxHead :: ListH (n : sh) i -> SMayNat i n
+shxHead list = {-# SCC "bad_scc" #-}
+ ( case list of (i `ConsKnown` _) -> SKnown i )
+
+type ListH :: [Maybe Nat] -> Type -> Type
+data ListH sh i where
+ ConsKnown :: SNat n -> ListH sh i -> ListH (Just n : sh) i
+
+data SMayNat i n where
+ SKnown :: SNat n -> SMayNat i (Just n)
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -576,6 +576,8 @@ test('T26117', [grep_errmsg(r'==')], compile, ['-O -ddump-simpl -dsuppress-uniqu
test('T26349', normal, compile, ['-O -ddump-rules'])
test('T26681', normal, compile, ['-O'])
+test('T26941', [extra_files(['T26941_aux.hs']), req_profiling], multimod_compile, ['T26941', '-v0 -O -prof'])
+
# T26709: we expect three `case` expressions not four
test('T26709', [grep_errmsg(r'case')],
multimod_compile,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf85c63329e08f61a81449b9af963a3…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/bf85c63329e08f61a81449b9af963a3…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
sheaf pushed to branch wip/T26878 at Glasgow Haskell Compiler / GHC
Commits:
c24c792d by sheaf at 2026-04-01T18:02:05+02:00
Simplify mkTick
This commit simplifies 'GHC.Core.Utils.mkTick', removing the
accumulating parameter 'rest' which was suspiciously treating a bunch of
different ticks as a group, and moving the group as a whole around the
AST, ignoring that the ticks in the group might have different placement
properties.
Also adds Note [Pushing SCCs inwards] which clarifies the logic for
pushing SCCs into lambdas, constructor applications, and dropping SCCs
around non-function variables (in particular the treatment of splittable
ticks).
A few other changes are also implemented:
- simplify 'can_split' predicate (no functional change)
- drop profiling ticks around coercions, fixing #26941 and #27121
- combine profiling ticks into one when possible
Fixes #26878, #26941 and #27121
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
9 changed files:
- compiler/GHC/Core/Utils.hs
- compiler/GHC/Types/Tickish.hs
- libraries/ghc-heap/tests/tso_and_stack_closures.hs
- + testsuite/tests/profiling/should_compile/T27121.hs
- + testsuite/tests/profiling/should_compile/T27121_aux.hs
- testsuite/tests/profiling/should_compile/all.T
- + testsuite/tests/simplCore/should_compile/T26941.hs
- + testsuite/tests/simplCore/should_compile/T26941_aux.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Utils.hs
=====================================
@@ -303,101 +303,246 @@ mkCast expr co
* *
********************************************************************* -}
--- | Wraps the given expression in the source annotation, dropping the
--- annotation if possible.
+-- | Wraps the given expression in a Tick, floating the tick as far into
+-- the AST as possible in order to try to satisfy the tick's desired placement
+-- properties (as per Note [Tickish placement] in GHC.Types.Tickish).
+--
+-- Prefer using 'mkTick' over explicit use of the 'Tick' constructor.
+--
+-- Also performs small on-the-fly optimisations:
+--
+-- * Eliminate unnecessary ticks by either absorbing them into existing ones
+-- or dropping them if that is valid (e.g. dropping profiling ticks around
+-- types, coercions and literals).
+-- * Split profiling ticks into counting/scoping parts so that the two parts
+-- can be placed independently into the AST.
mkTick :: CoreTickish -> CoreExpr -> CoreExpr
-mkTick t orig_expr = mkTick' id orig_expr
+mkTick t orig_expr = mkTick' orig_expr
where
-- Some ticks (cost-centres) can be split in two, with the
-- non-counting part having laxer placement properties.
- canSplit = tickishCanSplit t && tickishPlace (mkNoCount t) /= tickishPlace t
-
- -- mkTick' handles floating of ticks *into* the expression.
- mkTick' :: (CoreExpr -> CoreExpr) -- Apply before adding tick (float with)
- -- Always a composition of (Tick t) wrappers
- -> CoreExpr -- Current expression
- -> CoreExpr
- -- So in the call (mkTick' rest e), the expression
- -- (rest e)
- -- has the same type as e
- -- Returns an expression equivalent to (Tick t (rest e))
- mkTick' rest expr = case expr of
- -- Float ticks into unsafe coerce the same way we would do with a cast.
- Case scrut bndr ty alts@[Alt ac abs _rhs]
- | Just rhs <- isUnsafeEqualityCase scrut bndr alts
- -> Case scrut bndr ty [Alt ac abs (mkTick' rest rhs)]
+ -- See Note [Scoping ticks and counting ticks] in GHC.Types.Tickish.
+ can_split = tickishCanSplit t
- -- Cost centre ticks should never be reordered relative to each
- -- other. Therefore we can stop whenever two collide.
+ -- mkTick' handles floating of tick `t` *into* the expression.
+ mkTick' :: CoreExpr -> CoreExpr
+ mkTick' expr = case expr of
Tick t2 e
- | ProfNote{} <- t2, ProfNote{} <- t -> Tick t $ rest expr
-
- -- Otherwise we assume that ticks of different placements float
- -- through each other.
- | tickishPlace t2 /= tickishPlace t -> Tick t2 $ mkTick' rest e
-
- -- For annotations this is where we make sure to not introduce
- -- redundant ticks.
- | tickishContains t t2 -> mkTick' rest e -- Drop t2
- | tickishContains t2 t -> rest e -- Drop t
- | otherwise -> mkTick' (rest . Tick t2) e
-
- -- Ticks don't care about types, so we just float all ticks
- -- through them. Note that it's not enough to check for these
- -- cases top-level. While mkTick will never produce Core with type
- -- expressions below ticks, such constructs can be the result of
- -- unfoldings. We therefore make an effort to put everything into
- -- the right place no matter what we start with.
- Cast e co -> mkCast (mkTick' rest e) co
- Coercion co -> Tick t $ rest (Coercion co)
+
+ -- Common up ticks when possible, including profiling ticks that
+ -- share a cost centre and source notes that subsume one another.
+ | Just t' <- combineTickish_maybe t t2
+ -> mkTick t' e
+
+ -- Profiling ticks for different cost centres should never be reordered
+ -- relative to each other. Therefore, we stop whenever two collide.
+ | ProfNote {} <- t
+ , ProfNote {} <- t2
+ -> Tick t expr
+
+ -- Ticks of different placements float through each other, so that each
+ -- tick can be floated into its expected position in the AST.
+ -- See Note [Tickish placement] in GHC.Types.Tickish.
+ | tickishPlace t2 /= tickishPlace t
+ -> Tick t2 $ mkTick' e
Lam x e
-- Always float through type lambdas. Even for non-type lambdas,
-- floating is allowed for all but the most strict placement rule.
| not (isRuntimeVar x) || tickishPlace t /= PlaceRuntime
- -> Lam x $ mkTick' rest e
+ -> Lam x $ mkTick' e
- -- If it is both counting and scoped, we split the tick into its
- -- two components, often allowing us to keep the counting tick on
- -- the outside of the lambda and push the scoped tick inside.
- -- The point of this is that the counting tick can probably be
- -- floated, and the lambda may then be in a position to be
- -- beta-reduced.
- | canSplit
- -> Tick (mkNoScope t) $ rest $ Lam x $ mkTick (mkNoCount t) e
+ -- Push SCCs into lambdas.
+ -- See (PSCC2) in Note [Pushing SCCs inwards].
+ | can_split
+ -> Tick (mkNoScope t) $ Lam x $ mkTick (mkNoCount t) e
App f arg
- -- Always float through type applications.
+ -- All ticks float inwards through non-runtime arguments, as per
+ -- Note [Tickish placement] in GHC.Types.Tickish.
| not (isRuntimeArg arg)
- -> App (mkTick' rest f) arg
+ -> App (mkTick' f) arg
- -- We can also float through constructor applications, placement
- -- permitting. Again we can split.
- | isSaturatedConApp expr && (tickishPlace t==PlaceCostCentre || canSplit)
+ -- Push SCCs into saturated constructor applications.
+ -- See (PSCC3) in Note [Pushing SCCs inwards].
+ | isSaturatedConApp expr
+ , tickishPlace t == PlaceCostCentre || can_split
-> if tickishPlace t == PlaceCostCentre
- then rest $ tickHNFArgs t expr
- else Tick (mkNoScope t) $ rest $ tickHNFArgs (mkNoCount t) expr
+ then tickHNFArgs t expr
+ else Tick (mkNoScope t) $ tickHNFArgs (mkNoCount t) expr
+
+ -- See Note [No ticks around types or coercions]
+ e@(Coercion {}) -> e
+ e@(Type {}) -> e
+ -- Don't wrap static data in a tick which compiles to code,
+ -- as the code will never be run.
+ e@(Lit {}) | tickishIsCode t -> e
+
+ -- All ticks can be floated through casts, as per Note [Tickish placement].
+ Cast e co -> mkCast (mkTick' e) co
+
+ -- Treat 'unsafeCoerce' as if it was a cast: float all ticks inwards.
+ -- See Note [Push ticks into unsafeCoerce]
+ Case scrut bndr ty alts@[Alt ac abs _rhs]
+ | Just rhs <- isUnsafeEqualityCase scrut bndr alts
+ -> Case scrut bndr ty [Alt ac abs (mkTick' rhs)]
Var x
- | notFunction && tickishPlace t == PlaceCostCentre
- -> rest expr -- Drop t
- | notFunction && canSplit
- -> Tick (mkNoScope t) $ rest expr
- where
- -- SCCs can be eliminated on variables provided the variable
- -- is not a function. In these cases the SCC makes no difference:
- -- the cost of evaluating the variable will be attributed to its
- -- definition site. When the variable refers to a function, however,
- -- an SCC annotation on the variable affects the cost-centre stack
- -- when the function is called, so we must retain those.
- notFunction = not (isFunTy (idType x))
-
- Lit{}
+ -- Don't drop any ticks around a function
+ | isFunTy (idType x)
+ -> Tick t expr
+ -- Drop SCCs around non-function variables.
+ -- See (PSCC1) in Note [Pushing SCCs inwards].
| tickishPlace t == PlaceCostCentre
- -> rest expr -- Drop t
+ -> -- Drop pure SCC ticks: scc<foo> (x :: Int) ==> x
+ expr
+ | can_split
+ -> -- Drop the scoping part of the tick, but keep the counting part.
+ Tick (mkNoScope t) expr
+
+ -- Catch-all: annotate where we stand.
+ -- In particular (but not only): Let, most Cases.
+ _other -> Tick t expr
+
+{- Note [Pushing SCCs inwards]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Amongst all ticks, SCCs have the laxest placement properties (PlaceCostCentre,
+as described in Note [Tickish placement] GHC.Types.Tickish):
+
+ (PSCC1) SCCs around non-function variables can be eliminated.
+ The cost of evaluating the variable will be attributed to its definition
+ site, so the SCC makes no difference. Example:
+
+ scc<foo> (x :: Int) ==> x
+
+ NB: this is only valid when the variable is not a function. For example, in:
+
+ scc<foo> (f :: Int -> Int)
+
+ we must retain the cost centre annotation, as it affects the cost-centre
+ pointer when the function is called. Discarding the SCC in this case would
+ defeat the profiling mechanism entirely!
+
+ (PSCC2) SCCs can be pushed into lambdas.
+
+ scc<foo> (\x -> e) ==> \x -> scc<foo> e
+
+ (PSCC3) We can push SCCs into (saturated) constructor applications.
+ For example, for an arity 2 data constructor 'D':
+
+ scc<foo> (D e1 e2) ==> D (scc<foo> e1) (scc<foo> e2)
+
+Now, two kinds of ticks contain SCCs:
+
+ - bare SCCs (i.e. ProfNote with profNoteCounts = False, profNoteScopes = True)
+ - profiling ticks that both count and scope
+
+The above explanation deals with bare SCCs. When handling profiling ticks that
+both count and scope, we can split tick into two, so that the scoping part can
+be pushed inwards (or even discarded). Specifically, we perform the following
+transformations:
+
+ (PSCC1) Drop the SCC around non-function variables, keeping only the counting
+ part:
- -- Catch-all: Annotate where we stand
- _any -> Tick t $ rest expr
+ scctick<foo> (x :: Int) ==> tick<foo> x
+
+ (PSCC2) Push the SCC inside lambdas:
+
+ scctick<foo> (\x. e) ==> tick<foo> (\x. scc<foo> e)
+
+ NB: we must keep the counting part outside the lambda, in order to preserve
+ tick counter tallies – it would not be sound to push the counting part inside.
+
+ (PSCC3) Push the SCC inside saturated contructor applications.
+
+ scctick<foo> (D e1 e2) ==> tick<foo> (D (scc<foo> e1) (scc<foo> e2))
+
+The benefit of these transformation is that the counting part, tick<foo>, can
+likely be floated out of the way, which may expose additional optimisation
+opportunities. For example:
+
+ (scctick<foo> (\x. e)) arg
+
+ ==>{PSCC2}
+
+ (tick<foo> (\x. scc<foo> e)) arg
+
+ ==>{GHC.Core.Opt.FloatOut.floatExpr, because 'tick<foo>' has no scope}
+
+ tick<foo> ((\x. scc<foo> e) arg)
+
+ ==>{beta reduction}
+
+ tick<foo> (let x = arg in scc<foo> e)
+
+Note [Push ticks into unsafeCoerce]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In #25212, we had a program of the form:
+
+ data Box = Box Any
+ asBox :: a -> Box
+ asBox x = {-# SCC asBox #-} Box (unsafeCoerce x)
+
+As per Note [Implementing unsafeCoerce] in GHC.Internal.Unsafe.Coerce, the call
+to `unsafeCoerce` turns into
+
+ case unsafeEqualityProof @Type @a @Any of
+ UnsafeRefl (co :: a ~# Any) -> x |> Sub co
+
+The worker for 'asBox' is then of the form:
+
+ $wasBox = \@a (x :: a) ->
+ (# case unsafeEqualityProof @Type @a @Any of
+ UnsafeRefl (co :: a ~# Any) -> x |> Sub co
+ #)
+
+When inserting the SCC, we push it into the constructor as per (PSCC3) in
+Note [Pushing SCCs inwards], so we get:
+
+ $wasBox = \@a (x :: a) ->
+ tick<asBox>
+ (# scc<asBox>
+ case unsafeEqualityProof @Type @a @Any of
+ UnsafeRefl (co :: a ~# Any) -> x |> Sub co
+ #)
+
+Now, if we don't push the SCC tick into the case statement, Core Prep will
+see an expression like 'MkSolo# (scc<asBox> ...)', which it will ANFise to
+'let x = scc<asBox> ... in MkSolo# x', creating an unwanted thunk in the process.
+
+So the strategy is to treat this 'unsafeEqualityProof' case statement as if it
+was a cast. We thus push the SCC into the RHS of the pattern match:
+
+ $wasBox = \@a (x :: a) ->
+ tick<asBox>
+ (# case unsafeEqualityProof @Type @a @Any of
+ UnsafeRefl (co :: a ~# Any) -> scc<asBox> x |> Sub co
+ #)
+
+Then the SCC completely evaporates, as per (PSCC1) in Note [Pushing SCCs inwards].
+
+Note [No ticks around types or coercions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+It doesn't make much sense to put a tick around a type or a coercion, as both
+types and coercions are erased in the end.
+
+In fact, it is quite dangerous to add a tick around types or coercions, because
+the optimiser does not robustly look through ticks:
+
+ - 'GHC.Core.SimpleOpt.simple_bind_pair' does not look through ticks when
+ looking at the RHS to decide whether it is a Type or Coercion,
+ - 'GHC.Core.Opt.Simplify.Iteration.completeBind' does not look through ticks
+ when looking at the RHS of an CoVar binding.
+
+This means it is vital to drop ticks around types/coercions:
+
+ - (#26941) Core Lint rejects bindings of the form "let co = tick ..."
+ in which the LHS is a CoVar and the RHS is a ticked Coercion.
+ - (#27121) The simplifier mis-handles ticked coercion bindings, which can
+ result in 'lookupIdSubst' panics (due to failing to extend the substitution
+ with a coercion).
+-}
mkTicks :: [CoreTickish] -> CoreExpr -> CoreExpr
mkTicks ticks expr = foldr mkTick expr ticks
@@ -2573,8 +2718,8 @@ exprIsTickedString = isJust . exprIsTickedString_maybe
exprIsTickedString_maybe :: CoreExpr -> Maybe ByteString
exprIsTickedString_maybe (Lit (LitString bs)) = Just bs
exprIsTickedString_maybe (Tick t e)
- -- we don't tick literals with CostCentre ticks, compare to mkTick
- | tickishPlace t == PlaceCostCentre = Nothing
+ -- Shortcut: ticks with code never wrap literals (compare with 'mkTick')
+ | tickishIsCode t = Nothing
| otherwise = exprIsTickedString_maybe e
exprIsTickedString_maybe _ = Nothing
=====================================
compiler/GHC/Types/Tickish.hs
=====================================
@@ -17,6 +17,7 @@ module GHC.Types.Tickish (
TickishPlacement(..),
tickishPlace,
tickishContains,
+ combineTickish_maybe,
-- * Breakpoint tick identifiers
BreakpointId(..), BreakTickIndex
@@ -261,8 +262,12 @@ Ticks have two independent attributes:
See Note [Scoped ticks]
+Note that profiling notes which both count and scope can be split into two
+separate ticks, one that counts and doesn't scope and one that scopes and doesn't
+count; see 'tickishCanSplit', 'mkNoCount' and 'mkNoScope'.
+
Note [Counting ticks]
-~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~~~~~~~
The following ticks count:
- ProfNote ticks with profNoteCounts = True
- HPC ticks
@@ -290,7 +295,7 @@ 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
@@ -375,6 +380,61 @@ Whether we are allowed to float in additional cost depends on the tick:
While these transformations are legal, we want to make a best effort to
only make use of them where it exposes transformation opportunities.
+
+Note [Tickish placement]
+~~~~~~~~~~~~~~~~~~~~~~~~
+The placement behaviour of ticks (i.e. which nodes we want the tick to be placed
+around in the AST) is governed by 'TickishPlacement'.
+From most restrictive to least restrictive placement rules:
+
+ - PlaceRuntime: counting ticks.
+
+ Ticks with 'PlaceRuntime' placement want to be placed around run-time
+ expressions. They can be moved through pure compile-time constructs such as
+ other type arguments, casts, or type lambdas:
+
+ tick <t> (f @ty) ==> (tick <t> f) @ty
+ tick <t> (e |> co) ==> (tick <t> e) |> co
+ tick <t> (/\a. e) ==> /\a. tick <t> e
+
+ This is the most restrictive placement rule for ticks, as all tickishs have
+ in common that they want to track runtime behaviour.
+
+ Any tick that counts (see Note [Counting ticks]) has 'PlaceRuntime' placement.
+
+ - PlaceNonLam: source notes.
+
+ Like PlaceRuntime, but we can also float the tick through value lambdas:
+
+ tick <t> (\x. e) ==> \x. tick <t> e
+
+ This makes sense where there is little difference between annotating the
+ lambda and annotating the lambda's code.
+
+ - PlaceCostCentre: non-counting profiling ticks.
+
+ In addition to floating through lambdas, cost-centre style tickishs can be
+ pushed into (saturated) constructor applications, and can be eliminated when
+ placed around non-function variables:
+
+ tick <t> (C e1 e2) ==> C (tick <t> e1) (tick <t> e2)
+
+ tick <t> (x :: Int) ==> (x :: Int)
+
+ Neither the constructor application nor the variable 'x' are likely to have
+ any cost worth mentioning.
+
+We generally try to push ticks inwards until they end up placed around a Core
+expression that is appropriate for their placement rule, as described above.
+This gives us the opportunity to eliminate the tick, either by combining it with
+another tick (see 'combineTickish_maybe') or by dropping it altogether. For
+example, a (non-counting) SCC around a non-function variable can be dropped, as
+there is no cost to scope over.
+
+After the tick has been placed by 'mkTick', the simplifier may later (during
+simplification) decide to float it outwards (see e.g. GHC.Core.Opt.Simplify.Iteration.simplTick).
+The story here is not fully worked out, as the simplifier calls 'mkTick', which
+might push the tick inwards again.
-}
-- | Returns @True@ for ticks that can be floated upwards easily even
@@ -441,35 +501,19 @@ isProfTick _ = False
-- annotating for example using @mkTick@. If we find that we want to
-- put a tickish on an expression ruled out here, we try to float it
-- inwards until we find a suitable expression.
+--
+-- See Note [Tickish placement].
data TickishPlacement =
- -- | Place ticks exactly on run-time expressions. We can still
- -- move the tick through pure compile-time constructs such as
- -- other ticks, casts or type lambdas. This is the most
- -- restrictive placement rule for ticks, as all tickishs have in
- -- common that they want to track runtime processes. The only
- -- legal placement rule for counting ticks.
- -- NB: We generally try to move these as close to the relevant
- -- runtime expression as possible. This means they get pushed through
- -- tyoe arguments. E.g. we create `(tick f) @Bool` instead of `tick (f @Bool)`.
+ -- | Place ticks exactly on run-time expressions, moving them through pure
+ -- compile-time constructs such as other ticks, casts or type lambdas.
PlaceRuntime
- -- | As @PlaceRuntime@, but we float the tick through all
- -- lambdas. This makes sense where there is little difference
- -- between annotating the lambda and annotating the lambda's code.
+ -- | As @PlaceRuntime@, but also allow to float the tick through all lambdas.
| PlaceNonLam
- -- | In addition to floating through lambdas, cost-centre style
- -- tickishs can also be moved from constructors, non-function
- -- variables and literals. For example:
- --
- -- let x = scc<...> C (scc<...> y) (scc<...> 3) in ...
- --
- -- Neither the constructor application, the variable or the
- -- literal are likely to have any cost worth mentioning. And even
- -- if y names a thunk, the call would not care about the
- -- evaluation context. Therefore removing all annotations in the
- -- above example is safe.
+ -- | As 'PlaceNonLam', but also float through constructors, non-function
+ -- variables and literals.
| PlaceCostCentre
deriving (Eq,Show)
@@ -477,7 +521,9 @@ data TickishPlacement =
instance Outputable TickishPlacement where
ppr = text . show
--- | Placement behaviour we want for the ticks
+-- | Placement behaviour we want for the ticks.
+--
+-- See Note [Tickish placement].
tickishPlace :: GenTickish pass -> TickishPlacement
tickishPlace n@ProfNote{}
| profNoteCount n = PlaceRuntime
@@ -486,6 +532,43 @@ tickishPlace HpcTick{} = PlaceRuntime
tickishPlace Breakpoint{} = PlaceRuntime
tickishPlace SourceNote{} = PlaceNonLam
+-- | Merge two ticks into one, if that is possible.
+--
+-- Examples:
+--
+-- - combine two source note ticks if one contains the other,
+-- - combine a non-counting profiling tick with a non-scoping profiling tick
+-- for the same cost centre
+-- - combine two equal breakpoint ticks or HPC ticks
+combineTickish_maybe :: Eq (GenTickish pass)
+ => GenTickish pass -> GenTickish pass -> Maybe (GenTickish pass)
+combineTickish_maybe
+ (ProfNote { profNoteCC = cc1, profNoteCount = cnt1, profNoteScope = scope1 })
+ (ProfNote { profNoteCC = cc2, profNoteCount = cnt2, profNoteScope = scope2 })
+ | cc1 == cc2
+ , not cnt1 || not cnt2
+ = Just $ ProfNote { profNoteCC = cc1
+ , profNoteCount = cnt1 || cnt2
+ , profNoteScope = scope1 || scope2
+ }
+combineTickish_maybe t1@(SourceNote sp1 n1) t2@(SourceNote sp2 n2)
+ | n1 == n2
+ , sp1 `containsSpan` sp2
+ = Just t1
+ | n1 == n2
+ , sp2 `containsSpan` sp1
+ = Just t2
+ -- NB: it would be possible to use 'combineRealSrcSpans' instead,
+ -- but that has the risk of combining many source note ticks into a single
+ -- tick with a huge source span.
+combineTickish_maybe t1@(HpcTick {}) t2@(HpcTick {})
+ | t1 == t2
+ = Just t1
+combineTickish_maybe t1@(Breakpoint {}) t2@(Breakpoint {})
+ | t1 == t2
+ = Just t1
+combineTickish_maybe _ _ = Nothing
+
-- | Returns whether one tick "contains" the other one, therefore
-- making the second tick redundant.
tickishContains :: Eq (GenTickish pass)
=====================================
libraries/ghc-heap/tests/tso_and_stack_closures.hs
=====================================
@@ -48,7 +48,9 @@ main = do
assertEqual (cc_module myCostCentre) "Main"
assertEqual (cc_srcloc myCostCentre) (Just "tso_and_stack_closures.hs:24:48-80")
assertEqual (cc_is_caf myCostCentre) False
- Nothing -> error $ "MyCostCentre not found in:\n" ++ unlines (cc_label <$> linkedCostCentres costCentre)
+ Nothing -> error "MyCostCentre not found"
+ -- Don't print all of 'linkedCostCentres costCentre',
+ -- as that is ~20k lines of output.
#endif
linkedCostCentres :: Maybe CostCentre -> [CostCentre]
=====================================
testsuite/tests/profiling/should_compile/T27121.hs
=====================================
@@ -0,0 +1,12 @@
+module T27121 where
+
+import T27121_aux
+
+updateFileDiagnostics
+ :: LanguageContextEnv ()
+ -> IO ()
+updateFileDiagnostics env = do
+ withTrace $ \ _tag ->
+ runLspT env $ do
+ sendNotification SMethod_TextDocumentPublishDiagnostics
+ PublishDiagnosticsParams
=====================================
testsuite/tests/profiling/should_compile/T27121_aux.hs
=====================================
@@ -0,0 +1,354 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module T27121_aux
+ ( withTrace
+ , sendNotification
+ , LspT, runLspT
+ , SMethod(..)
+ , LanguageContextEnv
+ , PublishDiagnosticsParams(..)
+ )
+ where
+
+-- base
+import Control.Monad.IO.Class ( MonadIO, liftIO )
+import Data.Kind ( Type )
+import GHC.TypeLits ( Symbol )
+
+--------------------------------------------------------------------------------
+
+withTrace :: Monad m => ((String -> String -> m ()) -> m a) -> m a
+withTrace act
+ | myUserTracingEnabled
+ = return undefined
+ | otherwise = act (\_ _ -> pure ())
+{-# NOINLINE withTrace #-}
+
+myUserTracingEnabled :: Bool
+myUserTracingEnabled = False
+{-# NOINLINE myUserTracingEnabled #-}
+
+type Text = String
+
+newtype LspT config a = LspT {unLspT :: LanguageContextEnv config -> IO a}
+
+instance Functor (LspT config) where
+ fmap f (LspT g) = LspT (fmap f . g)
+
+instance Applicative (LspT config) where
+ pure = LspT . const . pure
+ LspT f <*> LspT a = LspT $ \ env -> f env <*> a env
+instance Monad (LspT config) where
+ LspT a >>= f = LspT $ \ env -> do
+ b <- a env
+ unLspT ( f b ) env
+instance MonadIO (LspT config) where
+ liftIO = LspT . const . liftIO
+
+type role LspT representational nominal
+
+runLspT :: LanguageContextEnv config -> LspT config a -> IO a
+runLspT env (LspT f) = f env
+{-# INLINE runLspT #-}
+
+data PublishDiagnosticsParams = PublishDiagnosticsParams
+
+data LanguageContextEnv config =
+ LanguageContextEnv
+ { resSendMessage :: FromServerMessage -> IO () }
+
+
+sendNotification ::
+ forall (m :: Method ServerToClient Notification) f config.
+ MonadLsp config f =>
+ SServerMethod m ->
+ MessageParams m ->
+ f ()
+sendNotification m params =
+ let msg = TNotificationMessage { _method = m, _params = params }
+ in case splitServerMethod m of
+ IsServerNot -> sendToClient $ fromServerNot msg
+
+type Method :: MessageDirection -> MessageKind -> Type
+data Method f t where
+ Method_TextDocumentImplementation :: Method ClientToServer Request
+ Method_TextDocumentTypeDefinition :: Method ClientToServer Request
+ Method_WorkspaceWorkspaceFolders :: Method ServerToClient Request
+ Method_WorkspaceConfiguration :: Method ServerToClient Request
+ Method_TextDocumentDocumentColor :: Method ClientToServer Request
+ Method_TextDocumentColorPresentation :: Method ClientToServer Request
+ Method_TextDocumentFoldingRange :: Method ClientToServer Request
+ Method_TextDocumentDeclaration :: Method ClientToServer Request
+ Method_TextDocumentSelectionRange :: Method ClientToServer Request
+ Method_WindowWorkDoneProgressCreate :: Method ServerToClient Request
+ Method_TextDocumentPrepareCallHierarchy :: Method ClientToServer Request
+ Method_CallHierarchyIncomingCalls :: Method ClientToServer Request
+ Method_CallHierarchyOutgoingCalls :: Method ClientToServer Request
+ Method_TextDocumentSemanticTokensFull :: Method ClientToServer Request
+ Method_TextDocumentSemanticTokensFullDelta :: Method ClientToServer Request
+ Method_TextDocumentSemanticTokensRange :: Method ClientToServer Request
+ Method_WorkspaceSemanticTokensRefresh :: Method ServerToClient Request
+ Method_WindowShowDocument :: Method ServerToClient Request
+ Method_TextDocumentLinkedEditingRange :: Method ClientToServer Request
+ Method_WorkspaceWillCreateFiles :: Method ClientToServer Request
+ Method_WorkspaceWillRenameFiles :: Method ClientToServer Request
+ Method_WorkspaceWillDeleteFiles :: Method ClientToServer Request
+ Method_TextDocumentMoniker :: Method ClientToServer Request
+ Method_TextDocumentPrepareTypeHierarchy :: Method ClientToServer Request
+ Method_TypeHierarchySupertypes :: Method ClientToServer Request
+ Method_TypeHierarchySubtypes :: Method ClientToServer Request
+ Method_TextDocumentInlineValue :: Method ClientToServer Request
+ Method_WorkspaceInlineValueRefresh :: Method ServerToClient Request
+ Method_TextDocumentInlayHint :: Method ClientToServer Request
+ Method_InlayHintResolve :: Method ClientToServer Request
+ Method_WorkspaceInlayHintRefresh :: Method ServerToClient Request
+ Method_TextDocumentDiagnostic :: Method ClientToServer Request
+ Method_WorkspaceDiagnostic :: Method ClientToServer Request
+ Method_WorkspaceDiagnosticRefresh :: Method ServerToClient Request
+ Method_ClientRegisterCapability :: Method ServerToClient Request
+ Method_ClientUnregisterCapability :: Method ServerToClient Request
+ Method_Initialize :: Method ClientToServer Request
+ Method_Shutdown :: Method ClientToServer Request
+ Method_WindowShowMessageRequest :: Method ServerToClient Request
+ Method_TextDocumentWillSaveWaitUntil :: Method ClientToServer Request
+ Method_TextDocumentCompletion :: Method ClientToServer Request
+ Method_CompletionItemResolve :: Method ClientToServer Request
+ Method_TextDocumentHover :: Method ClientToServer Request
+ Method_TextDocumentSignatureHelp :: Method ClientToServer Request
+ Method_TextDocumentDefinition :: Method ClientToServer Request
+ Method_TextDocumentReferences :: Method ClientToServer Request
+ Method_TextDocumentDocumentHighlight :: Method ClientToServer Request
+ Method_TextDocumentDocumentSymbol :: Method ClientToServer Request
+ Method_TextDocumentCodeAction :: Method ClientToServer Request
+ Method_CodeActionResolve :: Method ClientToServer Request
+ Method_WorkspaceSymbol :: Method ClientToServer Request
+ Method_WorkspaceSymbolResolve :: Method ClientToServer Request
+ Method_TextDocumentCodeLens :: Method ClientToServer Request
+ Method_CodeLensResolve :: Method ClientToServer Request
+ Method_WorkspaceCodeLensRefresh :: Method ServerToClient Request
+ Method_TextDocumentDocumentLink :: Method ClientToServer Request
+ Method_DocumentLinkResolve :: Method ClientToServer Request
+ Method_TextDocumentFormatting :: Method ClientToServer Request
+ Method_TextDocumentRangeFormatting :: Method ClientToServer Request
+ Method_TextDocumentOnTypeFormatting :: Method ClientToServer Request
+ Method_TextDocumentRename :: Method ClientToServer Request
+ Method_TextDocumentPrepareRename :: Method ClientToServer Request
+ Method_WorkspaceExecuteCommand :: Method ClientToServer Request
+ Method_WorkspaceApplyEdit :: Method ServerToClient Request
+ Method_WorkspaceDidChangeWorkspaceFolders :: Method ClientToServer Notification
+ Method_WindowWorkDoneProgressCancel :: Method ClientToServer Notification
+ Method_WorkspaceDidCreateFiles :: Method ClientToServer Notification
+ Method_WorkspaceDidRenameFiles :: Method ClientToServer Notification
+ Method_WorkspaceDidDeleteFiles :: Method ClientToServer Notification
+ Method_NotebookDocumentDidOpen :: Method ClientToServer Notification
+ Method_NotebookDocumentDidChange :: Method ClientToServer Notification
+ Method_NotebookDocumentDidSave :: Method ClientToServer Notification
+ Method_NotebookDocumentDidClose :: Method ClientToServer Notification
+ Method_Initialized :: Method ClientToServer Notification
+ Method_Exit :: Method ClientToServer Notification
+ Method_WorkspaceDidChangeConfiguration :: Method ClientToServer Notification
+ Method_WindowShowMessage :: Method ServerToClient Notification
+ Method_WindowLogMessage :: Method ServerToClient Notification
+ Method_TelemetryEvent :: Method ServerToClient Notification
+ Method_TextDocumentDidOpen :: Method ClientToServer Notification
+ Method_TextDocumentDidChange :: Method ClientToServer Notification
+ Method_TextDocumentDidClose :: Method ClientToServer Notification
+ Method_TextDocumentDidSave :: Method ClientToServer Notification
+ Method_TextDocumentWillSave :: Method ClientToServer Notification
+ Method_WorkspaceDidChangeWatchedFiles :: Method ClientToServer Notification
+ Method_TextDocumentPublishDiagnostics :: Method ServerToClient Notification
+ Method_SetTrace :: Method ClientToServer Notification
+ Method_LogTrace :: Method ServerToClient Notification
+ Method_CancelRequest :: Method f Notification
+ Method_Progress :: Method f Notification
+ Method_CustomMethod :: Symbol -> Method f t
+
+type SMethod :: forall f t . Method f t -> Type
+data SMethod m where
+ SMethod_TextDocumentImplementation :: SMethod Method_TextDocumentImplementation
+ SMethod_TextDocumentTypeDefinition :: SMethod Method_TextDocumentTypeDefinition
+ SMethod_WorkspaceWorkspaceFolders :: SMethod Method_WorkspaceWorkspaceFolders
+ SMethod_WorkspaceConfiguration :: SMethod Method_WorkspaceConfiguration
+ SMethod_TextDocumentDocumentColor :: SMethod Method_TextDocumentDocumentColor
+ SMethod_TextDocumentColorPresentation :: SMethod Method_TextDocumentColorPresentation
+ SMethod_TextDocumentFoldingRange :: SMethod Method_TextDocumentFoldingRange
+ SMethod_TextDocumentDeclaration :: SMethod Method_TextDocumentDeclaration
+ SMethod_TextDocumentSelectionRange :: SMethod Method_TextDocumentSelectionRange
+ SMethod_WindowWorkDoneProgressCreate :: SMethod Method_WindowWorkDoneProgressCreate
+ SMethod_TextDocumentPrepareCallHierarchy :: SMethod Method_TextDocumentPrepareCallHierarchy
+ SMethod_CallHierarchyIncomingCalls :: SMethod Method_CallHierarchyIncomingCalls
+ SMethod_CallHierarchyOutgoingCalls :: SMethod Method_CallHierarchyOutgoingCalls
+ SMethod_TextDocumentSemanticTokensFull :: SMethod Method_TextDocumentSemanticTokensFull
+ SMethod_TextDocumentSemanticTokensFullDelta :: SMethod Method_TextDocumentSemanticTokensFullDelta
+ SMethod_TextDocumentSemanticTokensRange :: SMethod Method_TextDocumentSemanticTokensRange
+ SMethod_WorkspaceSemanticTokensRefresh :: SMethod Method_WorkspaceSemanticTokensRefresh
+ SMethod_WindowShowDocument :: SMethod Method_WindowShowDocument
+ SMethod_TextDocumentLinkedEditingRange :: SMethod Method_TextDocumentLinkedEditingRange
+ SMethod_WorkspaceWillCreateFiles :: SMethod Method_WorkspaceWillCreateFiles
+ SMethod_WorkspaceWillRenameFiles :: SMethod Method_WorkspaceWillRenameFiles
+ SMethod_WorkspaceWillDeleteFiles :: SMethod Method_WorkspaceWillDeleteFiles
+ SMethod_TextDocumentMoniker :: SMethod Method_TextDocumentMoniker
+ SMethod_TextDocumentPrepareTypeHierarchy :: SMethod Method_TextDocumentPrepareTypeHierarchy
+ SMethod_TypeHierarchySupertypes :: SMethod Method_TypeHierarchySupertypes
+ SMethod_TypeHierarchySubtypes :: SMethod Method_TypeHierarchySubtypes
+ SMethod_TextDocumentInlineValue :: SMethod Method_TextDocumentInlineValue
+ SMethod_WorkspaceInlineValueRefresh :: SMethod Method_WorkspaceInlineValueRefresh
+ SMethod_TextDocumentInlayHint :: SMethod Method_TextDocumentInlayHint
+ SMethod_InlayHintResolve :: SMethod Method_InlayHintResolve
+ SMethod_WorkspaceInlayHintRefresh :: SMethod Method_WorkspaceInlayHintRefresh
+ SMethod_TextDocumentDiagnostic :: SMethod Method_TextDocumentDiagnostic
+ SMethod_WorkspaceDiagnostic :: SMethod Method_WorkspaceDiagnostic
+ SMethod_WorkspaceDiagnosticRefresh :: SMethod Method_WorkspaceDiagnosticRefresh
+ SMethod_ClientRegisterCapability :: SMethod Method_ClientRegisterCapability
+ SMethod_ClientUnregisterCapability :: SMethod Method_ClientUnregisterCapability
+ SMethod_Initialize :: SMethod Method_Initialize
+ SMethod_Shutdown :: SMethod Method_Shutdown
+ SMethod_WindowShowMessageRequest :: SMethod Method_WindowShowMessageRequest
+ SMethod_TextDocumentWillSaveWaitUntil :: SMethod Method_TextDocumentWillSaveWaitUntil
+ SMethod_TextDocumentCompletion :: SMethod Method_TextDocumentCompletion
+ SMethod_CompletionItemResolve :: SMethod Method_CompletionItemResolve
+ SMethod_TextDocumentHover :: SMethod Method_TextDocumentHover
+ SMethod_TextDocumentSignatureHelp :: SMethod Method_TextDocumentSignatureHelp
+ SMethod_TextDocumentDefinition :: SMethod Method_TextDocumentDefinition
+ SMethod_TextDocumentReferences :: SMethod Method_TextDocumentReferences
+ SMethod_TextDocumentDocumentHighlight :: SMethod Method_TextDocumentDocumentHighlight
+ SMethod_TextDocumentDocumentSymbol :: SMethod Method_TextDocumentDocumentSymbol
+ SMethod_TextDocumentCodeAction :: SMethod Method_TextDocumentCodeAction
+ SMethod_CodeActionResolve :: SMethod Method_CodeActionResolve
+ SMethod_WorkspaceSymbol :: SMethod Method_WorkspaceSymbol
+ SMethod_WorkspaceSymbolResolve :: SMethod Method_WorkspaceSymbolResolve
+ SMethod_TextDocumentCodeLens :: SMethod Method_TextDocumentCodeLens
+ SMethod_CodeLensResolve :: SMethod Method_CodeLensResolve
+ SMethod_WorkspaceCodeLensRefresh :: SMethod Method_WorkspaceCodeLensRefresh
+ SMethod_TextDocumentDocumentLink :: SMethod Method_TextDocumentDocumentLink
+ SMethod_DocumentLinkResolve :: SMethod Method_DocumentLinkResolve
+ SMethod_TextDocumentFormatting :: SMethod Method_TextDocumentFormatting
+ SMethod_TextDocumentRangeFormatting :: SMethod Method_TextDocumentRangeFormatting
+ SMethod_TextDocumentOnTypeFormatting :: SMethod Method_TextDocumentOnTypeFormatting
+ SMethod_TextDocumentRename :: SMethod Method_TextDocumentRename
+ SMethod_TextDocumentPrepareRename :: SMethod Method_TextDocumentPrepareRename
+ SMethod_WorkspaceExecuteCommand :: SMethod Method_WorkspaceExecuteCommand
+ SMethod_WorkspaceApplyEdit :: SMethod Method_WorkspaceApplyEdit
+ SMethod_WorkspaceDidChangeWorkspaceFolders :: SMethod Method_WorkspaceDidChangeWorkspaceFolders
+ SMethod_WindowWorkDoneProgressCancel :: SMethod Method_WindowWorkDoneProgressCancel
+ SMethod_WorkspaceDidCreateFiles :: SMethod Method_WorkspaceDidCreateFiles
+ SMethod_WorkspaceDidRenameFiles :: SMethod Method_WorkspaceDidRenameFiles
+ SMethod_WorkspaceDidDeleteFiles :: SMethod Method_WorkspaceDidDeleteFiles
+ SMethod_NotebookDocumentDidOpen :: SMethod Method_NotebookDocumentDidOpen
+ SMethod_NotebookDocumentDidChange :: SMethod Method_NotebookDocumentDidChange
+ SMethod_NotebookDocumentDidSave :: SMethod Method_NotebookDocumentDidSave
+ SMethod_NotebookDocumentDidClose :: SMethod Method_NotebookDocumentDidClose
+ SMethod_Initialized :: SMethod Method_Initialized
+ SMethod_Exit :: SMethod Method_Exit
+ SMethod_WorkspaceDidChangeConfiguration :: SMethod Method_WorkspaceDidChangeConfiguration
+ SMethod_WindowShowMessage :: SMethod Method_WindowShowMessage
+ SMethod_WindowLogMessage :: SMethod Method_WindowLogMessage
+ SMethod_TelemetryEvent :: SMethod Method_TelemetryEvent
+ SMethod_TextDocumentDidOpen :: SMethod Method_TextDocumentDidOpen
+ SMethod_TextDocumentDidChange :: SMethod Method_TextDocumentDidChange
+ SMethod_TextDocumentDidClose :: SMethod Method_TextDocumentDidClose
+ SMethod_TextDocumentDidSave :: SMethod Method_TextDocumentDidSave
+ SMethod_TextDocumentWillSave :: SMethod Method_TextDocumentWillSave
+ SMethod_WorkspaceDidChangeWatchedFiles :: SMethod Method_WorkspaceDidChangeWatchedFiles
+ SMethod_TextDocumentPublishDiagnostics :: SMethod Method_TextDocumentPublishDiagnostics
+ SMethod_SetTrace :: SMethod Method_SetTrace
+ SMethod_LogTrace :: SMethod Method_LogTrace
+ SMethod_CancelRequest :: SMethod Method_CancelRequest
+ SMethod_Progress :: SMethod Method_Progress
+
+type SServerMethod (m :: Method ServerToClient t) = SMethod m
+
+data MessageDirection = ServerToClient | ClientToServer
+
+data MessageKind = Notification | Request
+
+
+type ServerNotOrReq :: forall t. Method ServerToClient t -> Type
+data ServerNotOrReq m where
+ IsServerNot ::
+ ( TMessage m ~ TNotificationMessage m
+ ) =>
+ ServerNotOrReq (m :: Method ServerToClient Notification)
+ IsServerReq ::
+ forall (m :: Method ServerToClient Request).
+ ( TMessage m ~ TRequestMessage m
+ ) =>
+ ServerNotOrReq m
+
+type TMessage :: forall f t. Method f t -> Type
+type family TMessage m where
+ TMessage (Method_CustomMethod s :: Method f t) = ()
+ TMessage (m :: Method f Request) = TRequestMessage m
+ TMessage (m :: Method f Notification) = TNotificationMessage m
+
+
+data TNotificationMessage (m :: Method f Notification) = TNotificationMessage
+ { _method :: SMethod m
+ , _params :: MessageParams m
+ }
+
+data TRequestMessage (m :: Method f Request) = TRequestMessage
+
+type MessageParams :: forall f t . Method f t -> Type
+type family MessageParams (m :: Method f t) where
+ MessageParams Method_TextDocumentPublishDiagnostics = PublishDiagnosticsParams
+
+class MonadIO m => MonadLsp config m | m -> config where
+ getLspEnv :: m (LanguageContextEnv config)
+
+instance MonadLsp config (LspT config) where
+ {-# INLINE getLspEnv #-}
+ getLspEnv = LspT pure
+
+
+{-# INLINE splitServerMethod #-}
+splitServerMethod :: SServerMethod m -> ServerNotOrReq m
+splitServerMethod = \case
+ SMethod_TextDocumentPublishDiagnostics -> IsServerNot
+ SMethod_WindowShowMessage -> IsServerNot
+ SMethod_WindowShowMessageRequest -> IsServerReq
+ SMethod_WindowShowDocument -> IsServerReq
+ SMethod_WindowLogMessage -> IsServerNot
+ SMethod_WindowWorkDoneProgressCreate -> IsServerReq
+ SMethod_Progress -> IsServerNot
+ SMethod_TelemetryEvent -> IsServerNot
+ SMethod_ClientRegisterCapability -> IsServerReq
+ SMethod_ClientUnregisterCapability -> IsServerReq
+ SMethod_WorkspaceWorkspaceFolders -> IsServerReq
+ SMethod_WorkspaceConfiguration -> IsServerReq
+ SMethod_WorkspaceApplyEdit -> IsServerReq
+ SMethod_LogTrace -> IsServerNot
+ SMethod_CancelRequest -> IsServerNot
+ SMethod_WorkspaceCodeLensRefresh -> IsServerReq
+ SMethod_WorkspaceSemanticTokensRefresh -> IsServerReq
+ SMethod_WorkspaceInlineValueRefresh -> IsServerReq
+ SMethod_WorkspaceInlayHintRefresh -> IsServerReq
+ SMethod_WorkspaceDiagnosticRefresh -> IsServerReq
+
+fromServerNot ::
+ forall (m :: Method ServerToClient Notification).
+ TMessage m ~ TNotificationMessage m =>
+ TNotificationMessage m ->
+ FromServerMessage
+fromServerNot m@TNotificationMessage{_method = meth} = FromServerMess meth m
+
+
+data FromServerMessage' a where
+ FromServerMess :: forall t (m :: Method ServerToClient t) a. SMethod m -> TMessage m -> FromServerMessage' a
+ FromServerRsp :: forall (m :: Method ClientToServer Request) a. a m -> TResponseMessage m -> FromServerMessage' a
+
+type FromServerMessage = FromServerMessage' SMethod
+
+data TResponseMessage (m :: Method f Request) = TResponseMessage
+
+sendToClient :: MonadLsp config m => FromServerMessage -> m ()
+sendToClient msg = do
+ f <- resSendMessage <$> getLspEnv
+ liftIO $ f msg
+{-# INLINE sendToClient #-}
=====================================
testsuite/tests/profiling/should_compile/all.T
=====================================
@@ -21,3 +21,4 @@ test('T15108', [test_opts], compile, ['-O -prof -fprof-auto'])
test('T19894', [test_opts, extra_files(['T19894'])], multimod_compile, ['Main', '-v0 -O2 -prof -fprof-auto -iT19894'])
test('T20938', [test_opts], compile, ['-O -prof'])
test('T26056', [test_opts], compile, ['-O -prof'])
+test('T27121', [test_opts], compile, ['-O -prof -fprof-auto'])
=====================================
testsuite/tests/simplCore/should_compile/T26941.hs
=====================================
@@ -0,0 +1,14 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE TypeOperators #-}
+
+module T26941 where
+
+import GHC.TypeLits
+
+import T26941_aux ( SMayNat(SKnown), ListH, shxHead )
+
+shsHead :: ListH (Just n : sh) Int -> SNat n
+shsHead shx =
+ case shxHead shx of
+ SKnown SNat -> SNat
=====================================
testsuite/tests/simplCore/should_compile/T26941_aux.hs
=====================================
@@ -0,0 +1,20 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+
+module T26941_aux where
+
+import Data.Kind
+import GHC.TypeLits
+
+shxHead :: ListH (n : sh) i -> SMayNat i n
+shxHead list = {-# SCC "bad_scc" #-}
+ ( case list of (i `ConsKnown` _) -> SKnown i )
+
+type ListH :: [Maybe Nat] -> Type -> Type
+data ListH sh i where
+ ConsKnown :: SNat n -> ListH sh i -> ListH (Just n : sh) i
+
+data SMayNat i n where
+ SKnown :: SNat n -> SMayNat i (Just n)
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -576,6 +576,8 @@ test('T26117', [grep_errmsg(r'==')], compile, ['-O -ddump-simpl -dsuppress-uniqu
test('T26349', normal, compile, ['-O -ddump-rules'])
test('T26681', normal, compile, ['-O'])
+test('T26941', [extra_files(['T26941_aux.hs']), req_profiling], multimod_compile, ['T26941', '-v0 -O -prof'])
+
# T26709: we expect three `case` expressions not four
test('T26709', [grep_errmsg(r'case')],
multimod_compile,
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c24c792daa196f65997e8cb3e569017…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c24c792daa196f65997e8cb3e569017…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-apporv-Oct24] Streamline expansions using HsExpansion (#25001)
by Apoorv Ingle (＠ani) 01 Apr '26
by Apoorv Ingle (＠ani) 01 Apr '26
01 Apr '26
Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC
Commits:
b77460c3 by Apoorv Ingle at 2026-04-01T10:05:40-05:00
Streamline expansions using HsExpansion (#25001)
Notes added [Error Context Stack] [Typechecking by expansion: overview]
Notes updated Note [Expanding HsDo with XXExprGhcRn]
-------------------------
Metric Decrease:
T9020
-------------------------
There are 2 key changes:
* splitHsApps is moved out of tcApp and can expand expressions to look through expandable expressions
* Cleanup of `ExpandedThingRn` to remove ad-hoc cases in `addArgCtxt` and removing `VACtxt`
This has some consequences detailed below:
* Simplifies the implementations of `tcExpr` to work on `XExpr`
* Removes `VACtxt` (and its associated `VAExpansion` and `VACall`) datatype, it is subsumed by simply a `SrcSpan`.
* Removes the function `addHeadCtxt` as it is now mearly setting a
location
* The function `tcValArgs` does its own argument number management
* move `splitHsTypes` out of `tcApp`
* Removes location information from `OrigPat` payload
* Removes special case of tcBody from `tcLambdaMatches`
* Removes special case of `dsExpr` for `ExpandedThingTc`
* Merge `HsThingRn` to `HsCtxt`
* Renames `tcMonoExpr` -> `tcMonoLExpr`, `tcMonoExprNC` -> `tcMonoLExpr`
* Renames `EValArg`, `EValArgQL` fields: `ea_ctxt` -> `ea_loc_span` and `eaql_ctx` -> `eaql_loc_span`
* Remove `PopErrCtxt` from `XXExprGhcRn`
* `fun_orig` in tcInstFun depends on the SrcSpan of the head of the application chain (similar to addArgCtxt)
- it references the application chain head if it is user located, or
uses the error context stack as a fallback if it's a generated
location
* Make a new variant `GeneratedSrcSpan` in `SrcSpan` for HIEAst Nodes
- Expressions wrapped around `GeneratedSrcSpan` are ignored and never added to the error context stack
- In Explicit list expansion `fromListN` is wrapped with a `GeneratedSrcSpan` with `GeneratedSrcSpanDetails` field to store the original srcspan
* Landmark Error messages are now just computed on the fly
* Make HsExpandedRn and HsExpandedTc payload LExpr,
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
114 changed files:
- compiler/GHC.hs
- compiler/GHC/Hs/DocString.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Expr.hs-boot
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Match.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Utils.hs
- compiler/GHC/Parser/HaddockLex.x
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Debugger/Breakpoints.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/Do.hs
- + compiler/GHC/Tc/Gen/Expand.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs-boot
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Match.hs-boot
- 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/Solve.hs
- compiler/GHC/Tc/TyCl.hs
- compiler/GHC/Tc/TyCl/Class.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/BasicTypes.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/CtLoc.hs
- compiler/GHC/Tc/Types/ErrCtxt.hs
- compiler/GHC/Tc/Types/LclEnv.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Types/Origin.hs-boot
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs-boot
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Types/Error.hs
- + compiler/GHC/Types/Error.hs-boot
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/SrcLoc.hs
- + compiler/GHC/Unit/State.hs-boot
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Logger.hs
- compiler/ghc.cabal.in
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/ghci/prog-mhu001/prog-mhu001c.stdout
- testsuite/tests/indexed-types/should_fail/T2693.stderr
- testsuite/tests/indexed-types/should_fail/T5439.stderr
- testsuite/tests/monadfail/MonadFailErrors.stderr
- testsuite/tests/overloadedrecflds/should_fail/T26480b.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail11.stderr
- testsuite/tests/parser/should_fail/RecordDotSyntaxFail9.stderr
- testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
- testsuite/tests/plugins/test-defaulting-plugin.stderr
- testsuite/tests/printer/T17697.stderr
- testsuite/tests/profiling/should_run/callstack001.stdout
- testsuite/tests/rebindable/rebindable6.stderr
- testsuite/tests/rep-poly/RepPolyRecordUpdate.stderr
- + testsuite/tests/typecheck/should_compile/ExpansionQLIm.hs
- testsuite/tests/typecheck/should_compile/T14590.stderr
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/valid_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion1.stderr
- testsuite/tests/typecheck/should_fail/DoExpansion2.stderr
- testsuite/tests/typecheck/should_fail/T10971d.stderr
- testsuite/tests/typecheck/should_fail/T13311.stderr
- testsuite/tests/typecheck/should_fail/T3323.stderr
- testsuite/tests/typecheck/should_fail/T3613.stderr
- testsuite/tests/typecheck/should_fail/T6069.stderr
- testsuite/tests/typecheck/should_fail/T7851.stderr
- testsuite/tests/typecheck/should_fail/T7857.stderr
- testsuite/tests/typecheck/should_fail/T8603.stderr
- testsuite/tests/typecheck/should_fail/T9612.stderr
- testsuite/tests/typecheck/should_fail/tcfail102.stderr
- testsuite/tests/typecheck/should_fail/tcfail128.stderr
- testsuite/tests/typecheck/should_fail/tcfail140.stderr
- testsuite/tests/typecheck/should_fail/tcfail181.stderr
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Parsers.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b77460c3cf49d18f7ae73b17ade75ab…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b77460c3cf49d18f7ae73b17ade75ab…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/27131] New rts Message to {set,unset} TSO flags
by Rodrigo Mesquita (＠alt-romes) 01 Apr '26
by Rodrigo Mesquita (＠alt-romes) 01 Apr '26
01 Apr '26
Rodrigo Mesquita pushed to branch wip/romes/27131 at Glasgow Haskell Compiler / GHC
Commits:
dbf1e298 by Rodrigo Mesquita at 2026-04-01T15:45:21+01:00
New rts Message to {set,unset} TSO flags
This commit introduces stg_MSG_SET_TSO_FLAG_info and
stg_MSG_UNSET_TSO_FLAG_info, which allows setting flags of a TSO other
than yourself.
This is especially useful/necessary to set breakpoints and toggle
breakpoints of different threads, which is needed to safely implement
features like pausing, toggling step-out, toggling step-in per thread,
etc.
Fixes #27131
- - - - -
7 changed files:
- rts/Interpreter.c
- rts/Messages.c
- rts/StgMiscClosures.cmm
- rts/Threads.c
- rts/Threads.h
- rts/include/rts/storage/Closures.h
- rts/include/stg/MiscClosures.h
Changes:
=====================================
rts/Interpreter.c
=====================================
@@ -416,12 +416,22 @@ void rts_disableStopNextBreakpointAll(void)
void rts_enableStopNextBreakpoint(StgTSO* tso)
{
- tso->flags |= TSO_STOP_NEXT_BREAKPOINT;
+#if defined(THREADED_RTS)
+ Capability* cap = rts_unsafeGetMyCapability();
+ setThreadFlag(cap, tso, TSO_STOP_NEXT_BREAKPOINT);
+#else
+ tso->flags |= TSO_STOP_NEXT_BREAKPOINT;
+#endif
}
void rts_disableStopNextBreakpoint(StgTSO* tso)
{
- tso->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
+#if defined(THREADED_RTS)
+ Capability* cap = rts_unsafeGetMyCapability();
+ unsetThreadFlag(cap, tso, TSO_STOP_NEXT_BREAKPOINT);
+#else
+ tso->flags &= ~TSO_STOP_NEXT_BREAKPOINT;
+#endif
}
/* ---------------------------------------------------------------------------
@@ -430,12 +440,22 @@ void rts_disableStopNextBreakpoint(StgTSO* tso)
void rts_enableStopAfterReturn(StgTSO* tso)
{
+#if defined(THREADED_RTS)
+ Capability* cap = rts_unsafeGetMyCapability();
+ setThreadFlag(cap, tso, TSO_STOP_AFTER_RETURN);
+#else
tso->flags |= TSO_STOP_AFTER_RETURN;
+#endif
}
void rts_disableStopAfterReturn(StgTSO* tso)
{
+#if defined(THREADED_RTS)
+ Capability* cap = rts_unsafeGetMyCapability();
+ unsetThreadFlag(cap, tso, TSO_STOP_AFTER_RETURN);
+#else
tso->flags &= ~TSO_STOP_AFTER_RETURN;
+#endif
}
/*
=====================================
rts/Messages.c
=====================================
@@ -35,7 +35,9 @@ void sendMessage(Capability *from_cap, Capability *to_cap, Message *msg)
i != &stg_MSG_TRY_WAKEUP_info &&
i != &stg_IND_info && // can happen if a MSG_BLACKHOLE is revoked
i != &stg_WHITEHOLE_info &&
- i != &stg_MSG_CLONE_STACK_info) {
+ i != &stg_MSG_CLONE_STACK_info &&
+ i != &stg_MSG_SET_TSO_FLAG_info &&
+ i != &stg_MSG_UNSET_TSO_FLAG_info) {
barf("sendMessage: %p", i);
}
}
@@ -137,6 +139,16 @@ loop:
MessageCloneStack *cloneStackMessage = (MessageCloneStack*) m;
handleCloneStackMessage(cap, cloneStackMessage);
}
+ else if(i == &stg_MSG_SET_TSO_FLAG_info){
+ MessageUpdTSOFlag *u = (MessageUpdTSOFlag*) m;
+ u->tso->flags |= u->flag;
+ return;
+ }
+ else if(i == &stg_MSG_UNSET_TSO_FLAG_info){
+ MessageUpdTSOFlag *u = (MessageUpdTSOFlag*) m;
+ u->tso->flags &= ~u->flag;
+ return;
+ }
else
{
barf("executeMessage: %p", i);
=====================================
rts/StgMiscClosures.cmm
=====================================
@@ -855,6 +855,12 @@ INFO_TABLE_CONSTR(stg_MSG_NULL,1,0,0,PRIM,"MSG_NULL","MSG_NULL")
INFO_TABLE_CONSTR(stg_MSG_CLONE_STACK,3,0,0,PRIM,"MSG_CLONE_STACK","MSG_CLONE_STACK")
{ ccall pbarf("stg_MSG_CLONE_STACK object (%p) entered!", R1 "ptr") never returns; }
+INFO_TABLE_CONSTR(stg_MSG_SET_TSO_FLAG,2,1,0,PRIM,"MSG_SET_TSO_FLAG","MSG_SET_TSO_FLAG")
+{ foreign "C" barf("stg_MSG_SET_TSO_FLAG object (%p) entered!", R1) never returns; }
+
+INFO_TABLE_CONSTR(stg_MSG_UNSET_TSO_FLAG,2,1,0,PRIM,"MSG_UNSET_TSO_FLAG","MSG_UNSET_TSO_FLAG")
+{ foreign "C" barf("stg_MSG_UNSET_TSO_FLAG object (%p) entered!", R1) never returns; }
+
/* ----------------------------------------------------------------------------
END_TSO_QUEUE
=====================================
rts/Threads.c
=====================================
@@ -376,6 +376,38 @@ migrateThread (Capability *from, StgTSO *tso, Capability *to)
tryWakeupThread(from, tso);
}
+/* ----------------------------------------------------------------------------
+ {set,unset}ThreadFlag
+
+ sets or unsets a flag in a given TSO
+ ------------------------------------------------------------------------- */
+
+#if defined(THREADED_RTS)
+static void
+updThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag, const StgInfoTable* info);
+
+void setThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag)
+{
+ updThreadFlag(from, tso, flag, &stg_MSG_SET_TSO_FLAG_info);
+}
+
+void unsetThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag)
+{
+ updThreadFlag(from, tso, flag, &stg_MSG_UNSET_TSO_FLAG_info);
+}
+
+static void
+updThreadFlag(Capability *from, StgTSO *tso, StgWord32 flag, const StgInfoTable* info)
+{
+ MessageUpdTSOFlag *msg;
+ msg = (MessageUpdTSOFlag *)allocate(from,sizeofW(MessageUpdTSOFlag));
+ msg->tso = tso;
+ msg->flag = flag;
+ SET_HDR(msg, info, CCS_SYSTEM);
+ sendMessage(from, tso->cap, (Message*)msg);
+}
+#endif
+
/* ----------------------------------------------------------------------------
awakenBlockedQueue
=====================================
rts/Threads.h
=====================================
@@ -19,6 +19,11 @@ void checkBlockingQueues (Capability *cap, StgTSO *tso);
void tryWakeupThread (Capability *cap, StgTSO *tso);
void migrateThread (Capability *from, StgTSO *tso, Capability *to);
+#if defined(THREADED_RTS)
+void setThreadFlag (Capability *from, StgTSO *tso, StgWord32 flag);
+void unsetThreadFlag (Capability *from, StgTSO *tso, StgWord32 flag);
+#endif
+
// Wakes up a thread on a Capability (probably a different Capability
// from the one held by the current Task).
//
=====================================
rts/include/rts/storage/Closures.h
=====================================
@@ -620,6 +620,12 @@ typedef struct MessageCloneStack_ {
StgTSO *tso;
} MessageCloneStack;
+typedef struct MessageUpdTSOFlag_ {
+ StgHeader header;
+ Message *link;
+ StgTSO *tso;
+ StgWord32 flag;
+} MessageUpdTSOFlag;
/* ----------------------------------------------------------------------------
Compact Regions
=====================================
rts/include/stg/MiscClosures.h
=====================================
@@ -152,6 +152,8 @@ RTS_ENTRY(stg_MSG_TRY_WAKEUP);
RTS_ENTRY(stg_MSG_THROWTO);
RTS_ENTRY(stg_MSG_BLACKHOLE);
RTS_ENTRY(stg_MSG_CLONE_STACK);
+RTS_ENTRY(stg_MSG_SET_TSO_FLAG);
+RTS_ENTRY(stg_MSG_UNSET_TSO_FLAG);
RTS_ENTRY(stg_MSG_NULL);
RTS_ENTRY(stg_MVAR_TSO_QUEUE);
RTS_ENTRY(stg_catch);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dbf1e2984c03433fe15c3416767dcf5…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dbf1e2984c03433fe15c3416767dcf5…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/spj-reinstallable-base] 61 commits: Add 128-bit SIMD support to AArch64 NCG
by Simon Peyton Jones (＠simonpj) 01 Apr '26
by Simon Peyton Jones (＠simonpj) 01 Apr '26
01 Apr '26
Simon Peyton Jones pushed to branch wip/spj-reinstallable-base at Glasgow Haskell Compiler / GHC
Commits:
2a218737 by ARATA Mizuki at 2026-03-23T11:11:39-04:00
Add 128-bit SIMD support to AArch64 NCG
Changes:
- Add `Format` field to vector-capable instructions.
These instructions will emit `vN.4s` (for example) as a operand.
- Additional constructors for `Operand`:
`OpVecLane` represents a vector lane and will be emitted as `vN.<width>[<index>]` (`vN.s[3]` for example).
`OpScalarAsVec` represents a scalar, but printed as a vector lane like `vN.<width>[0]` (`vN.s[0]` for example).
- Integer quot/rem are implemented in C, like x86.
Closes #26536
Metric Increase:
T3294
- - - - -
5d6e2be9 by ARATA Mizuki at 2026-03-23T11:11:39-04:00
AArch64 NCG: Improve code generation for floating-point and vector constants
Some floating-point constants can be directly encoded using the FMOV instruction.
Similarly, a class of vectors with same values can be encoded using FMOV, MOVI, or MVNI.
- - - - -
c6d262aa by Simon Jakobi at 2026-03-23T11:12:22-04:00
Add regression test for #13729
Closes #13729.
- - - - -
aa5dfe67 by Sylvain Henry at 2026-03-26T03:48:56-04:00
Check that shift values are valid
In GHC's codebase in non-DEBUG builds we silently substitute shiftL/R
with unsafeShiftL/R for performance reasons. However we were not
checking that the shift value was valid for unsafeShiftL/R, leading to
wrong computations, but only in non-DEBUG builds.
This patch adds the necessary checks and reports an error when a wrong
shift value is passed.
- - - - -
c8a7b588 by Sylvain Henry at 2026-03-26T03:48:56-04:00
Implement basic value range analysis (#25718)
Perform basic value range analysis to try to determine at compile time
the result of the application of some comparison primops (ltWord#, etc.).
This subsumes the built-in rewrite rules used previously to check if one
of the comparison argument was a bound (e.g. (x :: Word8) <= 255 is
always True). Our analysis is more powerful and handles type
conversions: e.g. word8ToWord x <= 255 is now detected as always True too.
We also use value range analysis to filter unreachable alternatives in
case-expressions. To support this, we had to allow case-expressions for
primitive types to not have a DEFAULT alternative (as was assumed before
and checked in Core lint).
- - - - -
a5ec467e by ARATA Mizuki at 2026-03-26T03:49:49-04:00
rts: Align stack to 64-byte boundary in StgRun on x86
When LLVM spills AVX/AVX-512 vector registers to the stack, it requires
32-byte (__m256) or 64-byte (__m512) alignment. If the stack is not
sufficiently aligned, LLVM inserts a realignment prologue that reserves
%rbp as a frame pointer, conflicting with GHC's use of %rbp as an STG
callee-saved register and breaking the tail-call-based calling convention.
Previously, GHC worked around this by lying to LLVM about the stack
alignment and rewriting aligned vector loads/stores (VMOVDQA, VMOVAPS)
to unaligned ones (VMOVDQU, VMOVUPS) in the LLVM Mangler. This had two
problems:
- It did not extend to AVX-512, which requires 64-byte alignment. (#26595)
- When Haskell calls a C function that takes __m256/__m512 arguments on
the stack, the callee requires genuine alignment, which could cause a
segfault. (#26822)
This patch genuinely aligns the stack to 64 bytes in StgRun by saving
the original stack pointer before alignment and restoring it in
StgReturn. We now unconditionally advertise 64-byte stack alignment to
LLVM for all x86 targets, making rewriteAVX in the LLVM Mangler
unnecessary. STG_RUN_STACK_FRAME_SIZE is increased from 48 to 56 bytes
on non-Windows x86-64 to store the saved stack pointer.
Closes #26595 and #26822
Co-Authored-By: Claude Opus 4.5 <noreply(a)anthropic.com>
- - - - -
661da815 by Teo Camarasu at 2026-03-26T03:50:33-04:00
ghc-internal: Float Generics to near top of module graph
We remove GHC.Internal.Generics from the critical path of the
`ghc-internal` module graph. GHC.Internal.Generics used to be in the
middle of the module graph, but now it is nearer the top (built later).
This change thins out the module graph and allows us to get rid of the
ByteOrder hs-boot file.
We implement this by moving Generics instances from the module where the
datatype is defined to the GHC.Internal.Generics module. This trades off
increasing the compiled size of GHC.Internal.Generics with reducing the
dependency footprint of datatype modules.
Not all instances are moved to GHC.Internal.Generics. For instance,
`GHC.Internal.Control.Monad.Fix` keeps its instance as it is one of the
very last modules compiled in `ghc-internal` and so inverting the
relationship here would risk adding GHC.Internal.Generics back onto the
critical path.
We also don't change modules that are re-exported from the `template-haskell` or `ghc-heap`.
This is done to make it easy to eventually move `Generics` to `base`
once something like #26657 is implemented.
Resolves #26930
Metric Decrease:
T21839c
- - - - -
45428f88 by sheaf at 2026-03-26T03:51:31-04:00
Avoid infinite loop in deep subsumption
This commit ensures we only unify after we recur in the deep subsumption
code in the FunTy vs non-FunTy case of GHC.Tc.Utils.Unify.tc_sub_type_deep,
to avoid falling into an infinite loop.
See the new Wrinkle [Avoiding a loop in tc_sub_type_deep] in
Note [FunTy vs non-FunTy case in tc_sub_type_deep] in GHC.Tc.Utils.Unify.
Fixes #26823
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
2823b039 by Ian Duncan at 2026-03-26T03:52:21-04:00
AArch64: fix MOVK regUsageOfInstr to mark dst as both read and written
MOVK (move with keep) modifies only a 16-bit slice of the destination
register, so the destination is both read and written. The register
allocator must know this to avoid clobbering live values. Update
regUsageOfInstr to list the destination in both src and dst sets.
No regression test: triggering the misallocation requires specific
register pressure around a MOVK sequence, which is difficult to
reliably provoke from Haskell source.
- - - - -
57b7878d by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #12002
Closes #12002.
- - - - -
c8f9df2d by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #12046
Closes #12046.
Co-authored-by: Andreas Klebinger <klebinger.andreas(a)gmx.at>
- - - - -
615d72ac by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #13180
Closes #13180.
- - - - -
423eebcf by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #11141
Closes #11141.
- - - - -
286849a4 by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #11505
Closes #11505.
- - - - -
7db149d9 by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression perf test for #13820
Closes #13820.
- - - - -
e73c4adb by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #10381
Closes #10381.
- - - - -
5ebcfb57 by Benjamin Maurer at 2026-03-26T03:54:02-04:00
Generate assembly on x86 for word2float (#22252)
We used to emit C function call for MO_UF_Conv primitive.
Now emits direct assembly instead.
Co-Authored-By: Sylvain Henry <sylvain(a)haskus.fr>
Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com>
- - - - -
5b550754 by Matthew Pickering at 2026-03-26T03:54:51-04:00
rts: forward clone-stack messages after TSO migration
MSG_CLONE_STACK assumed that the target TSO was still owned by the
capability that received the message. This is not always true: the TSO
can migrate before the inbox entry is handled.
When that happened, handleCloneStackMessage could clone a live stack from
the wrong capability and use the wrong capability for allocation and
performTryPutMVar, leading to stack sanity failures such as
checkStackFrame: weird activation record found on stack.
Fix this by passing the current capability into
handleCloneStackMessage, rechecking msg->tso->cap at handling time, and
forwarding the message if the TSO has migrated. Once ownership matches,
use the executing capability consistently for cloneStack, rts_apply, and
performTryPutMVar.
Fixes #27008
- - - - -
ef0a1bd2 by mangoiv at 2026-03-26T03:55:34-04:00
release tracking: adopt release tracking ticket from #16816
- - - - -
a7f40fd9 by mangoiv at 2026-03-26T03:55:34-04:00
release tracking: add a release tracking ticket
Brings the information in the release tracking ticket up to date with
https://gitlab.haskell.org/ghc/ghc-hq/-/blob/main/release-management.mkd
Resolves #26691
- - - - -
161d3285 by Teo Camarasu at 2026-03-26T03:56:18-04:00
Revert "Set default eventlog-flush-interval to 5s"
Flushing the eventlog forces a synchronisation of all the capabilities
and there was a worry that this might lead to a performance cost for
some highly parallel workloads.
This reverts commit 66b96e2a591d8e3d60e74af3671344dfe4061cf2.
- - - - -
36eed985 by Cheng Shao at 2026-03-26T03:57:03-04:00
ghc-boot: move GHC.Data.SmallArray to ghc-boot
This commit moves `GHC.Data.SmallArray` from the `ghc` library to
`ghc-boot`, so that it can be used by `ghci` as well:
- The `Binary` (from `ghc`) instance of `SmallArray` is moved to
`GHC.Utils.Binary`
- Util functions `replicateSmallArrayIO`, `mapSmallArrayIO`,
`mapSmallArrayM_`, `imapSmallArrayM_` , `smallArrayFromList` and
`smallArrayToList` are added
- The `Show` instance is added
- The `Binary` (from `binary`) instance is added
- - - - -
fdf828ae by Cheng Shao at 2026-03-26T03:57:03-04:00
compiler: use `Binary` instance of `BCOByteArray` for bytecode objects
This commit defines `Binary` (from `compiler`) instance of
`BCOByteArray` which serializes the underlying buffer directly, and
uses it directly in bytecode object serialization. Previously we reuse
the `Binary` (from `binary`) instance, and this change allows us to
avoid double-copying via an intermediate `ByteString` when using
`put`/`get` in `binnary`. Also see added comment for explanation.
- - - - -
3bf62d0a by Cheng Shao at 2026-03-26T03:57:03-04:00
ghci: use SmallArray directly in ResolvedBCO
This patch makes ghci use `SmallArray` directly in `ResolvedBCO` when
applicable, making the memory representation more compact and reducing
marshaling overhead. Closes #27058.
- - - - -
3d6492ce by Wen Kokke at 2026-03-26T03:57:53-04:00
Fix race condition between flushEventLog and start/endEventLogging.
This commit changes `flushEventLog` to acquire/release the `state_change` mutex to prevent interleaving with `startEventLogging` and `endEventLogging`. In the current RTS, `flushEventLog` _does not_ acquire this mutex, which may lead to eventlog corruption on the following interleaving:
- `startEventLogging` writes the new `EventLogWriter` to `event_log_writer`.
- `flushEventLog` flushes some events to `event_log_writer`.
- `startEventLogging` writes the eventlog header to `event_log_writer`.
This causes the eventlog to be written out in an unreadable state, with one or more events preceding the eventlog header.
This commit renames the old function to `flushEventLog_` and defines `flushEventLog` simply as:
```c
void flushEventLog(Capability **cap USED_IF_THREADS)
{
ACQUIRE_LOCK(&state_change_mutex);
flushEventLog_(cap);
RELEASE_LOCK(&state_change_mutex);
}
```
The old function is still needed internally within the compilation unit, where it is used in `endEventLogging` in a context where the `state_change` mutex has already been acquired. I've chosen to mark `flushEventLog_` as static and let other uses of `flushEventLog` within the RTS refer to the new version. There is one use in `hs_init_ghc` via `flushTrace`, where the new locking behaviour should be harmless, and one use in `handle_tick`, which I believe was likely vulnerable to the same race condition, so the new locking behaviour is desirable.
I have not added a test. The behaviour is highly non-deterministic and requires a program that concurrently calls `flushEventLog` and `startEventLogging`/`endEventLogging`. I encountered the issue while developing `eventlog-socket` and within that context have verified that my patch likely addresses the issue: a test that used to fail within the first dozen or so runs now has been running on repeat for several hours.
- - - - -
7b9a75f0 by Phil Hazelden at 2026-03-26T03:58:37-04:00
Fix build with werror on glibc 2.43.
We've been defining `_XOPEN_SOURCE` and `_POSIX_C_SOURCE` to the same
values as defined in glibc prior to 2.43. But in 2.43, glibc changes
them to new values, which means we get a warning when redefining them.
By `#undef`ing them first, we no longer get a warning.
Closes #27076.
- - - - -
fe6e76c5 by Tobias Haslop at 2026-03-26T03:59:30-04:00
Fix broken Haddock link to Bifunctor class in description of Functor class
- - - - -
404b71c1 by Luite Stegeman at 2026-03-27T04:40:49-04:00
Fix assert in Interpreter.c
If we skip exactly the number of words on the stack we end up on
the first word in the next chunk.
- - - - -
a85bd503 by Luite Stegeman at 2026-03-27T04:40:49-04:00
Support arbitrary size unboxed tuples in bytecode
This stores the size (number of words on the stack) of the next
expected tuple in the TSO, ctoi_spill_size field, eliminating
the need of stg_ctoi_tN frames for each size.
Note: On 32 bit platform there is still a bytecode tuple size
limit of 255 words on the stack.
Fixes #26946
- - - - -
e2209031 by Luite Stegeman at 2026-03-27T04:40:49-04:00
Add specialized frames for small tuples
Small tuples are now returned more efficiently to the interpreter.
They use one less word of stack space and don't need manipulation
of the TSO anymore.
- - - - -
b26bb2ea by VeryMilkyJoe at 2026-03-27T04:41:38-04:00
Remove backwards compatibility pattern synonym `ModLocation`
Fixes #24932
- - - - -
66e5e324 by Vladislav Zavialov at 2026-03-27T04:42:25-04: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 T26967_tyop
- - - - -
f8de456f by Sylvain Henry at 2026-03-27T04:43:22-04:00
STM: don't create a transaction in the rhs of catchRetry# (#26028)
We don't need to create a transaction for the rhs of (catchRetry#)
because contrary to the lhs we don't need to abort it on retry. Moreover
it is particularly harmful if we have code such as (#26028):
let cN = readTVar vN >> retry
tree = c1 `orElse` (c2 `orElse` (c3 `orElse` ...))
atomically tree
Because it will stack transactions for the rhss and the read-sets of all
the transactions will be iteratively merged in O(n^2) after the
execution of the most nested retry.
This is the second attempt at implementing this. The first attempt
triggered segfaults (#26291) and has been reverted.
Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com>
- - - - -
fcf092dd by Luite Stegeman at 2026-03-27T04:44:17-04:00
Windows: remove StgAsyncIOResult and fix crash/leaks
In stg_block_async{_void}, a stack slot was reserved for
an StgAsyncIOResult. This slot would be filled by the IO
manager upon completion of the async call.
However, if the blocked thread was interrupted by an async
exception, we would end up in an invalid state:
- If the blocked computation was never re-entered, the
StgAsyncIOResult would never be freed.
- If the blocked computation was re-entered, the thread would
find an unitialized stack slot for the StgAsyncIOResult,
leading to a crash reading its fields, or freeing the pointer.
We fix this by removing the StgAsyncIOResult altogether and writing
the result directly to the stack.
Fixes #26341
- - - - -
05094993 by Luite Stegeman at 2026-03-27T04:45:12-04:00
Don't refine DEFAULT alt for unary typeclasses
A non-DEFAULT data alt for a unary typeclass dictionary would
interfere with Unary Class Magic, leading to segfaults.
fixes #27071
- - - - -
4ee260cf by sheaf at 2026-03-27T04:46:06-04:00
Fix several oversights in hsExprType
This commit fixes several oversights in GHC.Hs.Syn.Type.hsExprType:
- The 'RecordCon' case was returning the type of the constructor,
instead of the constructor application. This is fixed by using
'splitFunTys'.
- The 'ExplicitTuple' case failed to take into account tuple sections,
and was also incorrectly handling 1-tuples (e.g. 'Solo') which can
be constructed using Template Haskell.
- The 'NegApp' case was returning the type of the negation operator,
again failing to apply it to the argument. Fixed by using
'funResultTy'.
- The 'HsProc' case was computing the result type of the arrow proc
block, without taking into account the argument type. Fix that by
adding a new field to 'CmdTopTc' that stores the arrow type, so that
we can construct the correct result type `arr a b` for
`proc (pat :: a) -> (cmd :: b)`.
- The 'ArithSeq' and 'NegApp' cases were failing to take into account
the result 'HsWrapper', which could e.g. silently drop casts.
This is fixed by introducing 'syntaxExpr_wrappedFunResTy' which, on
top of taking the result type, applies the result 'HsWrapper'.
These fixes are validated by the new GHC API test T26910.
Fixes #26910
- - - - -
e97232ce by Hai at 2026-03-27T04:47:04-04:00
Parser.y: avoid looking at token with QualifiedDo
This changes the behavior of 'hintQualifiedDo' so that the supplied
token is not inspected when the QualifiedDo language extension bit is
set.
- - - - -
9831385b by Vladislav Zavialov at 2026-03-27T17:22:30-04:00
Infix holes in types (#11107)
This patch introduces several improvements that follow naturally from
refactoring HsOpTy to represent the operator as an HsType, aligning it
with the approach taken by OpApp and HsExpr.
User-facing changes:
1. Infix holes (t1 `_` t2) are now permitted in types, following the
precedent set by term-level expressions.
Test case: T11107
2. Error messages for illegal promotion ticks are now reported at more
precise source locations.
Test case: T17865
Internal changes:
* The definition of HsOpTy now mirrors that of OpApp:
| HsOpTy (XOpTy p) (LHsType p) (LHsType p) (LHsType p)
| OpApp (XOpApp p) (LHsExpr p) (LHsExpr p) (LHsExpr p)
This moves us one step closer to unifying HsType and HsExpr.
* Ignoring locations,
the old pattern match (HsOpTy x prom lhs op rhs)
is now written as (HsOpTy x lhs (HsTyVar x' prom op) rhs)
but we also handle (HsOpTy x lhs (HsWildCardTy x') rhs)
Constructors other than HsTyVar and HsWildCardTy never appear
in the operator position.
* The various definitions across the compiler have been updated to work
with the new representation, drawing inspiration from the term-level
pipeline where appropriate. For example,
ppr_infix_ty <=> ppr_infix_expr
get_tyop <=> get_op
lookupTypeFixityRn <=> lookupExprFixityRn
(the latter is factored out from rnExpr)
Test cases: T11107 T17865
- - - - -
5b6757d7 by mangoiv at 2026-03-27T17:23:19-04:00
ci: build i386 non-validate for deb12
This is a small fix that will unlock ghcup metadata to run, i386 debian
12 was missing as a job.
- - - - -
cf942119 by Cheng Shao at 2026-03-30T15:24:37-04:00
ghc-boot: remove unused SizedSeq instances and functions
This commit removes unused `SizedSeq` instances and functions, only
keeping the bits we need for hpc tick sequence for now.
- - - - -
22c5b7cc by Cheng Shao at 2026-03-30T15:24:38-04:00
ghci: remove unused GHCi.BinaryArray
This patch removes the unused `GHCi.BinaryArray` module from `ghci`.
Closes #27108.
- - - - -
77abb4ab by Cheng Shao at 2026-03-30T15:25:21-04:00
testsuite: mark T17912 as fragile on Windows
T17912 is still fragile on Windows, it sometimes unexpectedly pass in
CI. This especially strains our already scarce Windows CI runner
resources. Mark it as fragile on Windows for the time being.
- - - - -
d741a6cc by Andreas Klebinger at 2026-03-31T04:39:33-04:00
Bump minimum shake version for hadrian.
We also add the shake version we want to stack.yaml
Fixes #26884
- - - - -
5e556f9e by Vladislav Zavialov at 2026-03-31T04:40:16-04:00
Status check for the HsType~HsExpr refactoring (#25121)
Add a test case to track the status of a refactoring project within GHC
whose goal is to arrive at the following declaration:
type HsType = HsExpr
The rationale for this is to increase code reuse between the term- and
type-level code in the compiler front-end (AST, parser, renamer, type checker).
The status report is saved to testsuite/tests/ghc-api/T25121_status.stdout
and provides useful insights into what needs to happen to make progress on
the ticket.
- - - - -
acffb1b1 by fendor at 2026-03-31T04:41:02-04:00
Extract Binary instances to `GHC.ByteCode.Binary`
- - - - -
e2ea8e25 by fendor at 2026-03-31T04:41:02-04:00
Add `seqNonEmpty` for evaluating `NonEmpty a`
- - - - -
048b00b7 by fendor at 2026-03-31T04:41:02-04:00
Record `LinkableUsage` instead of `Linkable` in `LoaderState`
Retaining a ByteCode `Linkable` after it has been loaded retains its
`UnlinkedBCO`, keeping it alive for the remainder of the program.
This starts accumulating a lot of `UnlinkedBCO` and memory over time.
However, the `Linkable` is merely used to later record its usage in
`mkObjectUsage`, which is used for recompilation checking.
However, this is incorrect, as the interface file and bytecode objects
could be in different states, e.g. the interface changes, but the
bytecode library hasn't changed so we don't need to recompile and vice
versa.
By computing a `Fingerprint` for the `ModuleByteCode`, and recording it
in the `LinkableUsage`, we know precisely whether the `ByteCode` object
on disk is outdated.
Thus, parts of this commit just makes sure that we efficiently compute a
`Fingerprint` for `ModuleByteCode` and store it in the on-disk
representation of `ModuleByteCode`.
We change the `LoaderState` to retain `LinkableUsage`, which is smaller
representation of a `Linkable`. This allows us to free the unneeded
fields of `Linkable` after linking them.
We declare the following memory invariants that this commit implements:
* No `LinkablePart` should be retained from `LoaderState`.
* `Linkable`s should be unloaded after they have been loaded.
These invariants are unfortunately tricky to automatically uphold, so we
are simply documenting our assumptions for now.
We introduce the `linkable-space` test which makes sure that after
loading, no `DotGBC` or `UnlinkedBCO` is retained.
-------------------------
Metric Increase:
MultiLayerModulesTH_OneShot
-------------------------
We allocate a bit more, but the peak number of bytes doesn't change.
While a bit unfortunate, accepting the metric increase.
We add multiple new performance measurements where we were able to
observe the desired memory invariants. Further, we add regression tests
to validate that the recompilation checker behaves more correct than
before.
- - - - -
2d1c1997 by Simon Jakobi at 2026-03-31T04:41:46-04:00
Eliminate dictionary-passing in ListMap operations
Mark the ListMap helpers 'INLINABLE' so importing modules can specialise
the 'TrieMap (ListMap m)' methods and avoid recursive dictionary-passing.
See Note [Making ListMap operations specialisable].
Fixes #27097
- - - - -
ed2c6570 by Cheng Shao at 2026-03-31T04:42:33-04:00
testsuite: fix testdir cleanup logic on Windows
testdir cleanup is unreliable on Windows (#13162) and despite existing
hacks in the driver, new failure mode has occurred. This patch makes
it print the warning and carry on when failed to clean up a testdir,
instead of reporting a spurious framework failure. See added comment
for detailed explanation.
- - - - -
d9388e29 by Simon Jakobi at 2026-03-31T13:14:59-04:00
Add regression test for #18177
Closes #18177.
Assisted-by: Codex
- - - - -
6a10045c by mangoiv at 2026-03-31T13:15:43-04:00
ci: allow metric decrease for two tests on i386
There has been a nightly failure on i386 due to a compiler runtime
improvement on i386 debian 12. We allow that.
Metric Decrease (test_env='i386-linux-deb12'):
T12707 T8095
- - - - -
1faa9d2c by Simon Peyton Jones at 2026-04-01T15:12:18+01:00
Major patch to re-engineer known-key names
This big patch implements the New Plan for known-key names,
described in #27013.
Read the big Note [Overview of known-key names] in GHC.Types.Name
- - - - -
2ff0d12a by Simon Peyton Jones at 2026-04-01T15:13:19+01:00
Moving more into the new mechanism [skip ci]
DOES NOT COMPILE, just work in progress
- - - - -
04888a73 by Simon Peyton Jones at 2026-04-01T15:14:22+01:00
More more stuff into the new mechanism
- - - - -
6e9b0e81 by Simon Peyton Jones at 2026-04-01T15:14:22+01:00
fromString is known-key
- - - - -
e41d728f by Simon Peyton Jones at 2026-04-01T15:14:22+01:00
Onward
- - - - -
13b66dcc by Simon Peyton Jones at 2026-04-01T15:14:22+01:00
Onward more
- - - - -
2976b390 by Simon Peyton Jones at 2026-04-01T15:14:23+01:00
Add imports in ghc-internal for known-key names [skip ci]
- - - - -
02f4fde6 by Simon Peyton Jones at 2026-04-01T15:14:23+01:00
Add known-key imports for ghc-internal [skip ci]
- - - - -
635717fb by Simon Peyton Jones at 2026-04-01T15:14:23+01:00
More [skip ci]
- - - - -
25998e4c by Simon Peyton Jones at 2026-04-01T15:14:23+01:00
More
Particularly using a proxy for `toList` from the IsList class.
- - - - -
513 changed files:
- .gitlab/generate-ci/gen_ci.hs
- + .gitlab/issue_templates/release_tracking.md
- .gitlab/jobs.yaml
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/CodeGen.Platform.h
- compiler/GHC.hs
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Builtin/Names/TH.hs
- compiler/GHC/Builtin/Types.hs
- compiler/GHC/Builtin/Utils.hs
- compiler/GHC/ByteCode/Asm.hs
- + compiler/GHC/ByteCode/Binary.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- + compiler/GHC/ByteCode/Recomp/Binary.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm/Node.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/AArch64/Regs.hs
- compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToLlvm.hs
- compiler/GHC/CmmToLlvm/Config.hs
- compiler/GHC/CmmToLlvm/Mangler.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- + compiler/GHC/Core/Opt/Range.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/Data/TrieMap.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/Config/CmmToLlvm.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/Env/KnotVars.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Hooks.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Plugins.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Arrows.hs
- compiler/GHC/HsToCore/Expr.hs
- compiler/GHC/HsToCore/Foreign/C.hs
- compiler/GHC/HsToCore/Foreign/JavaScript.hs
- compiler/GHC/HsToCore/Foreign/Wasm.hs
- compiler/GHC/HsToCore/Match/Literal.hs
- compiler/GHC/HsToCore/Monad.hs
- compiler/GHC/HsToCore/Pmc/Desugar.hs
- compiler/GHC/HsToCore/Pmc/Solver/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/HsToCore/Types.hs
- compiler/GHC/HsToCore/Usage.hs
- compiler/GHC/Iface/Binary.hs
- compiler/GHC/Iface/Env.hs
- − compiler/GHC/Iface/Env.hs-boot
- compiler/GHC/Iface/Errors/Ppr.hs
- compiler/GHC/Iface/Errors/Types.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Iface/Recomp/Types.hs
- compiler/GHC/Iface/Tidy.hs
- compiler/GHC/Iface/Type.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Linker/ByteCode.hs
- compiler/GHC/Linker/Deps.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Types.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Parser/Header.hs
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Prelude/Basic.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Fixity.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Lit.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToCmm/Utils.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Deriv/Generics.hs
- compiler/GHC/Tc/Deriv/Infer.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Default.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/HsType.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/Instance/Typeable.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/TyCl/Build.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Types/Constraint.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/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/DefaultEnv.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Types/Hint.hs
- compiler/GHC/Types/Hint/Ppr.hs
- compiler/GHC/Types/Name.hs
- compiler/GHC/Types/Name/Cache.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Unit/External.hs
- compiler/GHC/Unit/Home/ModInfo.hs
- compiler/GHC/Unit/Module/Deps.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Unit/Module/ModSummary.hs
- compiler/GHC/Unit/Module/Status.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Misc.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Type.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.16.1-notes.rst
- docs/users_guide/exts/rebindable_syntax.rst
- docs/users_guide/exts/required_type_arguments.rst
- docs/users_guide/separate_compilation.rst
- ghc/GHCi/Leak.hs
- hadrian/hadrian.cabal
- hadrian/stack.yaml
- libraries/base/base.cabal.in
- libraries/base/src/Control/Applicative.hs
- libraries/base/src/Data/Bifoldable1.hs
- libraries/base/src/Data/Bool.hs
- libraries/base/src/Data/Enum.hs
- libraries/base/src/Data/Foldable1.hs
- libraries/base/src/Data/List.hs
- libraries/base/src/Data/List/NubOrdSet.hs
- libraries/base/src/GHC/Fingerprint.hs
- + libraries/base/src/GHC/KnownKeyNames.hs
- libraries/base/src/GHC/RTS/Flags.hs
- libraries/base/src/GHC/ResponseFile.hs
- libraries/base/src/GHC/Stats.hs
- libraries/base/src/GHC/Weak/Finalize.hs
- libraries/base/src/System/Exit.hs
- libraries/base/src/System/IO/OS.hs
- libraries/base/src/System/IO/Unsafe.hs
- libraries/base/tests/IO/all.T
- libraries/ghc-boot/GHC/Data/SizedSeq.hs
- compiler/GHC/Data/SmallArray.hs → libraries/ghc-boot/GHC/Data/SmallArray.hs
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/AllocationLimitHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Arr.hs
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Integer.hs
- libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
- − libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Char.hs
- libraries/ghc-internal/src/GHC/Internal/Classes.hs
- libraries/ghc-internal/src/GHC/Internal/Clock.hsc
- libraries/ghc-internal/src/GHC/Internal/ClosureTypes.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Bound.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Signal.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Arrow.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Category.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Concurrent/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fail.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Fix.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/ST/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Control/Monad/Zip.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Data.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Dynamic.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Either.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Const.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Proxy.hs
- libraries/ghc-internal/src/GHC/Internal/Data/STRef.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/String.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Coercion.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Equality.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Type/Ord.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Typeable/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Debug/Trace.hs
- libraries/ghc-internal/src/GHC/Internal/Enum.hs
- libraries/ghc-internal/src/GHC/Internal/Enum.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Event/EPoll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/IntVar.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Internal/Types.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Poll.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/TimerManager.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Unique.hs
- libraries/ghc-internal/src/GHC/Internal/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Backtrace.hs
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- libraries/ghc-internal/src/GHC/Internal/ExecutionStack/Internal.hsc
- libraries/ghc-internal/src/GHC/Internal/Fingerprint.hs
- libraries/ghc-internal/src/GHC/Internal/Fingerprint/Type.hs
- libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/ConstPtr.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/C/String/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/ForeignPtr/Imp.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Alloc.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Array.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Error.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Marshal/Utils.hs
- libraries/ghc-internal/src/GHC/Internal/Foreign/Storable.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignPtr.hs
- libraries/ghc-internal/src/GHC/Internal/ForeignSrcLang.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/src/GHC/Internal/GHCi/Helpers.hs
- libraries/ghc-internal/src/GHC/Internal/Generics.hs
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTable/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/InfoTableProf.hsc
- libraries/ghc-internal/src/GHC/Internal/Heap/ProfInfo/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Buffer.hs
- libraries/ghc-internal/src/GHC/Internal/IO/BufferedIO.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Device.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Failure.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Iconv.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Encoding/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/FD.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/Flock.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Text.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle/Types.hs
- libraries/ghc-internal/src/GHC/Internal/IO/IOMode.hs
- libraries/ghc-internal/src/GHC/Internal/IOArray.hs
- libraries/ghc-internal/src/GHC/Internal/InfoProv/Types.hsc
- libraries/ghc-internal/src/GHC/Internal/IsList.hs
- libraries/ghc-internal/src/GHC/Internal/Ix.hs
- libraries/ghc-internal/src/GHC/Internal/MVar.hs
- libraries/ghc-internal/src/GHC/Internal/Num.hs
- libraries/ghc-internal/src/GHC/Internal/Num.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Numeric.hs
- libraries/ghc-internal/src/GHC/Internal/OverloadedLabels.hs
- libraries/ghc-internal/src/GHC/Internal/Ptr.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs
- libraries/ghc-internal/src/GHC/Internal/Real.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Records.hs
- libraries/ghc-internal/src/GHC/Internal/ST.hs
- libraries/ghc-internal/src/GHC/Internal/Show.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/CCS.hsc
- libraries/ghc-internal/src/GHC/Internal/Stack/CloneStack.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Decode.hs
- libraries/ghc-internal/src/GHC/Internal/Stack/Types.hs
- libraries/ghc-internal/src/GHC/Internal/StaticPtr.hs
- libraries/ghc-internal/src/GHC/Internal/Stats.hsc
- libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
- libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/System/IO/Error.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.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/Syntax.hs
- libraries/ghc-internal/src/GHC/Internal/Text/Read.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Tuple.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/DerivedCoreProperties.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Char/UnicodeData/GeneralCategory.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Weak/Finalize.hs
- libraries/ghc-prim/ghc-prim.cabal
- − libraries/ghci/GHCi/BinaryArray.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/ResolvedBCO.hs
- libraries/ghci/ghci.cabal.in
- rts/Apply.cmm
- rts/CloneStack.c
- rts/CloneStack.h
- rts/Continuation.c
- rts/ContinuationOps.cmm
- rts/HeapStackCheck.cmm
- rts/IOManager.c
- rts/Interpreter.c
- rts/Messages.c
- rts/PrimOps.cmm
- rts/Printer.c
- rts/RaiseAsync.c
- rts/RtsFlags.c
- rts/RtsSymbols.c
- rts/STM.c
- rts/STM.h
- rts/Schedule.c
- rts/StgCRun.c
- rts/StgMiscClosures.cmm
- rts/Threads.c
- rts/Threads.h
- rts/eventlog/EventLog.c
- rts/include/rts/Bytecodes.h
- rts/include/rts/Constants.h
- rts/include/rts/PosixSource.h
- rts/include/rts/storage/TSO.h
- rts/include/stg/MiscClosures.h
- rts/include/stg/Prim.h
- rts/prim/vectorQuotRem.c
- rts/win32/AsyncMIO.c
- rts/win32/AsyncMIO.h
- testsuite/driver/testlib.py
- + testsuite/tests/bytecode/TLinkable/BCOTemplate.hs
- + testsuite/tests/bytecode/TLinkable/LinkableUsage01.stderr
- + testsuite/tests/bytecode/TLinkable/LinkableUsage02.stderr
- + testsuite/tests/bytecode/TLinkable/Makefile
- + testsuite/tests/bytecode/TLinkable/all.T
- + testsuite/tests/bytecode/TLinkable/genLinkables.sh
- + testsuite/tests/bytecode/TLinkable/linkable-space.hs
- + testsuite/tests/bytecode/TLinkable/linkable-space.stdout
- + testsuite/tests/bytecode/tuplestress/ByteCode.hs
- + testsuite/tests/bytecode/tuplestress/Common.hs-incl
- + testsuite/tests/bytecode/tuplestress/Obj.hs
- + testsuite/tests/bytecode/tuplestress/TupleStress.hs
- + testsuite/tests/bytecode/tuplestress/TupleStress.stdout
- + testsuite/tests/bytecode/tuplestress/all.T
- testsuite/tests/codeGen/should_run/Word2Float32.hs
- testsuite/tests/codeGen/should_run/Word2Float32.stdout
- testsuite/tests/codeGen/should_run/Word2Float64.hs
- testsuite/tests/codeGen/should_run/Word2Float64.stdout
- + testsuite/tests/concurrent/should_run/T26341.hs
- + testsuite/tests/concurrent/should_run/T26341.stdout
- + testsuite/tests/concurrent/should_run/T26341a.hs
- + testsuite/tests/concurrent/should_run/T26341a.stdout
- + testsuite/tests/concurrent/should_run/T26341b.hs
- + testsuite/tests/concurrent/should_run/T26341b.stdout
- testsuite/tests/concurrent/should_run/all.T
- testsuite/tests/count-deps/CountDepsAst.stdout
- testsuite/tests/count-deps/CountDepsParser.stdout
- + testsuite/tests/driver/T13729/A/A.cabal
- + testsuite/tests/driver/T13729/A/Setup.hs
- + testsuite/tests/driver/T13729/A/TH.hs
- + testsuite/tests/driver/T13729/A/Types1.hs
- + testsuite/tests/driver/T13729/A/Types2.hs
- + testsuite/tests/driver/T13729/B/B.cabal
- + testsuite/tests/driver/T13729/B/Main.hs
- + testsuite/tests/driver/T13729/B/Setup.hs
- + testsuite/tests/driver/T13729/Makefile
- + testsuite/tests/driver/T13729/Setup.hs
- + testsuite/tests/driver/T13729/all.T
- + testsuite/tests/driver/T18177.hs
- testsuite/tests/driver/all.T
- testsuite/tests/driver/multipleHomeUnits/multipleHomeUnits_recomp_th.stdout
- + testsuite/tests/driver/recomp022/A1.hs
- + testsuite/tests/driver/recomp022/A2.hs
- + testsuite/tests/driver/recomp022/A3.hs
- + testsuite/tests/driver/recomp022/B.hs
- + testsuite/tests/driver/recomp022/C.hs
- + testsuite/tests/driver/recomp022/Makefile
- + testsuite/tests/driver/recomp022/all.T
- + testsuite/tests/driver/recomp022/recomp022a.stdout
- + testsuite/tests/driver/recomp022/recomp022b.stdout
- + testsuite/tests/ghc-api/T25121_status.hs
- + testsuite/tests/ghc-api/T25121_status.stdout
- + testsuite/tests/ghc-api/T26910.hs
- + testsuite/tests/ghc-api/T26910.stdout
- + testsuite/tests/ghc-api/T26910_Input.hs
- testsuite/tests/ghc-api/all.T
- testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
- testsuite/tests/ghci/scripts/ListTuplePunsPpr.stdout
- testsuite/tests/ghci/scripts/T10963.stderr
- testsuite/tests/ghci/scripts/ghci064.stdout
- testsuite/tests/ghci/should_run/BinaryArray.hs
- 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/lib/stm/T26028.hs
- + testsuite/tests/lib/stm/T26028.stdout
- + testsuite/tests/lib/stm/T26291a.hs
- + testsuite/tests/lib/stm/T26291a.stdout
- + testsuite/tests/lib/stm/T26291b.hs
- + testsuite/tests/lib/stm/T26291b.stdout
- + testsuite/tests/lib/stm/all.T
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- + testsuite/tests/parser/should_compile/T12002.hs
- + testsuite/tests/parser/should_compile/T12002.stderr
- testsuite/tests/parser/should_compile/all.T
- testsuite/tests/parser/should_fail/T16270h.hs
- testsuite/tests/parser/should_fail/T17865.stderr
- + testsuite/tests/partial-sigs/should_compile/T11107.hs
- + testsuite/tests/partial-sigs/should_compile/T11107.stderr
- testsuite/tests/partial-sigs/should_compile/all.T
- + testsuite/tests/perf/compiler/T13820.hs
- testsuite/tests/perf/compiler/all.T
- + testsuite/tests/rebindable/T10381.hs
- testsuite/tests/rebindable/all.T
- testsuite/tests/rts/all.T
- + testsuite/tests/rts/cloneThreadStackMigrating.hs
- + testsuite/tests/simd/should_run/FloatConstant.hs
- + testsuite/tests/simd/should_run/FloatConstant.stdout
- + testsuite/tests/simd/should_run/IntConstant.hs
- + testsuite/tests/simd/should_run/IntConstant.stdout
- + testsuite/tests/simd/should_run/StackAlignment32.hs
- + testsuite/tests/simd/should_run/StackAlignment32.stdout
- + testsuite/tests/simd/should_run/StackAlignment32_main.c
- + testsuite/tests/simd/should_run/StackAlignment64.hs
- + testsuite/tests/simd/should_run/StackAlignment64.stdout
- + testsuite/tests/simd/should_run/StackAlignment64_main.c
- testsuite/tests/simd/should_run/all.T
- testsuite/tests/simd/should_run/int16x8_shuffle.hs
- testsuite/tests/simd/should_run/int16x8_shuffle.stdout
- testsuite/tests/simd/should_run/int16x8_shuffle_baseline.hs
- testsuite/tests/simd/should_run/int16x8_shuffle_baseline.stdout
- testsuite/tests/simd/should_run/int8x16_shuffle.hs
- testsuite/tests/simd/should_run/int8x16_shuffle.stdout
- testsuite/tests/simd/should_run/int8x16_shuffle_baseline.hs
- testsuite/tests/simd/should_run/int8x16_shuffle_baseline.stdout
- testsuite/tests/simd/should_run/simd013C.c
- + testsuite/tests/simplCore/should_compile/T19166.hs
- + testsuite/tests/simplCore/should_compile/T19166.stderr
- + testsuite/tests/simplCore/should_compile/T25718.hs
- + testsuite/tests/simplCore/should_compile/T25718.stderr
- + testsuite/tests/simplCore/should_compile/T25718a.hs
- + testsuite/tests/simplCore/should_compile/T25718a.stderr
- + testsuite/tests/simplCore/should_compile/T25718b.hs
- + testsuite/tests/simplCore/should_compile/T25718b.stderr
- + testsuite/tests/simplCore/should_compile/T25718c.hs
- + testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32
- + testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/simplCore/should_run/T27071.hs
- + testsuite/tests/simplCore/should_run/T27071.stdout
- testsuite/tests/simplCore/should_run/all.T
- + testsuite/tests/typecheck/T13180/T13180.hs
- + testsuite/tests/typecheck/T13180/T13180.hs-boot
- + testsuite/tests/typecheck/T13180/T13180.stderr
- + testsuite/tests/typecheck/T13180/T13180A.hs
- + testsuite/tests/typecheck/T13180/all.T
- + testsuite/tests/typecheck/should_compile/T11141.hs
- + testsuite/tests/typecheck/should_compile/T11141.stderr
- + testsuite/tests/typecheck/should_compile/T11505Bar.hs
- + testsuite/tests/typecheck/should_compile/T11505Foo.hs
- + testsuite/tests/typecheck/should_compile/T11505Foo.hs-boot
- + testsuite/tests/typecheck/should_compile/T12046.hs
- testsuite/tests/typecheck/should_compile/T26225.hs
- testsuite/tests/typecheck/should_compile/all.T
- + testsuite/tests/typecheck/should_fail/T26823.hs
- + testsuite/tests/typecheck/should_fail/T26823.stderr
- testsuite/tests/typecheck/should_fail/all.T
- + testsuite/tests/vdq-rta/should_compile/T26967.hs
- + testsuite/tests/vdq-rta/should_compile/T26967.stderr
- + testsuite/tests/vdq-rta/should_compile/T26967_tyop.hs
- + testsuite/tests/vdq-rta/should_compile/T26967_tyop.stderr
- testsuite/tests/vdq-rta/should_compile/all.T
- utils/check-exact/ExactPrint.hs
- utils/deriveConstants/Main.hs
- 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/GhcUtils.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/-/compare/545fa3065669fb33613a5762d06dbb…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/545fa3065669fb33613a5762d06dbb…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Add Invariant (NoTypeShadowing) to Core
by Marge Bot (＠marge-bot) 01 Apr '26
by Marge Bot (＠marge-bot) 01 Apr '26
01 Apr '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
8de5d55b by Simon Peyton Jones at 2026-04-01T10:46:26-04:00
Add Invariant (NoTypeShadowing) to Core
This commit addresses #26868, by adding
a new invariant (NoTypeShadowing) to Core.
See Note [No type-shadowing in Core] in GHC.Core
- - - - -
90296d9a by Simon Peyton Jones at 2026-04-01T10:46:26-04:00
Major refactor of free-variable functions
For some time we have had two free-variable mechanims for types:
* The "FV" mechanism, embodied in GHC.Utils.FV, which worked OK, but
was fragile where eta-expansion was concerned.
* The TyCoFolder mechanism, using a one-shot EndoOS accumulator
I finally got tired of this and refactored the whole thing, thereby
addressing #27080. Now we have
* `GHC.Types.Var.FV`, which has a composable free-variable result type,
very much in the spirit of the old `FV`, but much more robust.
(It uses the "one shot trick".)
* GHC.Core.TyCo.FVs now has just one technology for free variables.
All this led to a lot of renaming.
There are couple of error-message changes. The change in T18451
makes an already-poor error message even more mysterious. But
it really needs a separate look.
We also now traverse the AST in a different order leading to a different
but still deterministic order for FVs and test output has been adjusted
accordingly.
- - - - -
b01b219c by Peng Fan at 2026-04-01T10:46:36-04:00
NCG/LA64: add cmpxchg and xchg primops
And append some new instructions for LA664 uarch.
Apply fix to cmpxchg-prim by Andreas Klebinger.
Suggestions in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/15515
- - - - -
5ccf7e71 by Duncan Coutts at 2026-04-01T10:46:37-04:00
Remove signal-based ticker implementations
Fixes issue #27073
All supported platforms should work with the pthreads + nanosleep based
ticker implementation. This avoids all the problems with using signals.
In practice, all supported platforms were probably using the non-signal
tickers already, which is probably why we do not get lots of reports
about deadlocks and other weirdness: we were definately using functions
that are not async signal safe in the tick handler (such as fflush to
flussh the eventlog).
Only Solaris was explicitly using the timer_create ticker impl, and even
Solaris could probably use the pthreads one (if anyone cared: Solaris is
no longer a Teir 3 supported platform).
Plausibly the only supported platform that this will change will be AIX,
which should now use the pthreads impl.
- - - - -
63852111 by Duncan Coutts at 2026-04-01T10:46:37-04:00
Tidy up some timer/ticker comments elsewhere
- - - - -
3c896866 by Duncan Coutts at 2026-04-01T10:46:37-04:00
Remove now-unused install_vtalrm_handler
Support function used by both of the signal-based ticker
implementations.
- - - - -
6b939a3e by Duncan Coutts at 2026-04-01T10:46:37-04:00
No longer probe for timer_create in rts/configure
It was only used by the TimerCreate.c ticker impl.
- - - - -
8697282f by Duncan Coutts at 2026-04-01T10:46:37-04:00
Note that rtsTimerSignal is deprecated.
- - - - -
e468cf67 by Simon Jakobi at 2026-04-01T10:46:39-04:00
Add perf test for #13960
Closes #13960.
- - - - -
103 changed files:
- compiler/GHC/CmmToAsm/LA64/CodeGen.hs
- compiler/GHC/CmmToAsm/LA64/Instr.hs
- compiler/GHC/CmmToAsm/LA64/Ppr.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Binds.hs
- compiler/GHC/HsToCore/Ticks.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Expr.hs-boot
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Lit.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Splice.hs-boot
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Instance/FunDeps.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Types/Name/Set.hs
- + compiler/GHC/Types/Var/FV.hs
- compiler/GHC/Types/Var/Set.hs
- compiler/GHC/Utils/EndoOS.hs
- − compiler/GHC/Utils/FV.hs
- compiler/ghc.cabal.in
- − m4/fp_check_timer_create.m4
- rts/Timer.c
- rts/configure.ac
- rts/include/rts/Timer.h
- rts/include/stg/SMP.h
- rts/posix/Signals.c
- rts/posix/Signals.h
- rts/posix/Ticker.c
- − rts/posix/ticker/Setitimer.c
- − rts/posix/ticker/TimerCreate.c
- 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/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- 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
- + testsuite/tests/perf/compiler/T13960.hs
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/polykinds/T15789.stderr
- testsuite/tests/polykinds/T18451.stderr
- testsuite/tests/polykinds/T7328.stderr
- testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr
- testsuite/tests/simplCore/should_compile/T24229a.stderr
- testsuite/tests/simplCore/should_compile/T24229b.stderr
- testsuite/tests/simplCore/should_compile/T24359a.stderr
- testsuite/tests/simplCore/should_compile/T26116.stderr
- testsuite/tests/simplCore/should_compile/T4908.stderr
- testsuite/tests/simplCore/should_compile/spec-inline.stderr
- testsuite/tests/typecheck/no_skolem_info/T20063.stderr
- testsuite/tests/typecheck/should_compile/T25180.stderr
- testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T10971d.stderr
- testsuite/tests/typecheck/should_fail/T12589.stderr
- testsuite/tests/typecheck/should_fail/T13311.stderr
- testsuite/tests/typecheck/should_fail/T17773.stderr
- testsuite/tests/typecheck/should_fail/T2846b.stderr
- testsuite/tests/typecheck/should_fail/T7851.stderr
- testsuite/tests/typecheck/should_fail/T8603.stderr
- utils/haddock/haddock-api/src/Haddock/GhcUtils.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e85479538801468b587c6198ab7455…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e85479538801468b587c6198ab7455…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
01 Apr '26
Apoorv Ingle pushed to branch wip/ani/better-expansion at Glasgow Haskell Compiler / GHC
Commits:
a091fcbb by Apoorv Ingle at 2026-04-01T09:43:04-05:00
Do expansions properly
- move splitHsTypes out of tcApp
- splitHsApps now looks through HsExpansions
- create a new file for expansions
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
11 changed files:
- compiler/GHC/Tc/Gen/App.hs
- − compiler/GHC/Tc/Gen/App.hs-boot
- + compiler/GHC/Tc/Gen/Expand.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/Expr.hs-boot
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/ghc.cabal.in
- testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
Changes:
=====================================
compiler/GHC/Tc/Gen/App.hs
=====================================
@@ -11,7 +11,6 @@
module GHC.Tc.Gen.App
( tcApp
- , tcExprSigma
, tcExprPrag ) where
import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcPolyExpr )
@@ -165,34 +164,6 @@ Note [Instantiation variables are short lived]
-}
-{- *********************************************************************
-* *
- tcInferSigma
-* *
-********************************************************************* -}
-
--- Very similar to tcApp, but returns a sigma (uninstantiated) type
--- CAUTION: Any changes to tcApp should be reflected here
--- cf. T19167. the head is an expanded expression applied to a type
--- Caution: Currently we assume that the expression is compiler generated/expanded
--- Because that is what T19167 test case expects.
--- This function should go away after MR!15778 lands
-tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
-tcExprSigma inst fun_orig rn_expr
- = do { (fun@(rn_fun,fun_lspan), rn_args) <- splitHsApps rn_expr
- ; do_ql <- wantQuickLook rn_fun
- ; (tc_fun, fun_sigma) <- tcInferAppHead fun
- ; inGenCode <- inGeneratedCode
- ; traceTc "tcExprSigma" (vcat [ text "rn_expr:" <+> ppr rn_expr
- , text "tc_fun" <+> ppr tc_fun
- , text "inGeneratedCode:" <+> ppr inGenCode])
- ; (inst_args, app_res_sigma) <- tcInstFun do_ql inst (fun_orig, rn_fun, fun_lspan)
- tc_fun fun_sigma rn_args
- ; tc_args <- tcValArgs do_ql (rn_fun, fun_lspan) inst_args
- ; let tc_expr = rebuildHsApps (tc_fun, fun_lspan) tc_args
- ; return (tc_expr, app_res_sigma) }
-
-
{- *********************************************************************
* *
Typechecking n-ary applications
@@ -379,24 +350,22 @@ Unify result type /before/ typechecking the args
The latter is much better. That is why we call `checkResultTy` before tcValArgs.
-}
--- CAUTION: Any changes to tcApp should be reflected in tcExprSigma
-tcApp :: HsExpr GhcRn
+
+--------------------
+tcApp :: HsExpr GhcRn -- The whole application
+ -> HsExpr GhcRn -> [HsExprArg 'TcpRn] -- Function and arguments
-> ExpRhoType -- When checking, -XDeepSubsumption <=> deeply skolemised
-> TcM (HsExpr GhcTc)
-- See Note [tcApp: typechecking applications]
-tcApp rn_expr exp_res_ty
- = do { -- Step 1: Split the application chain
- (fun@(rn_fun, fun_lspan), rn_args) <- splitHsApps rn_expr
- ; inGenCode <- inGeneratedCode
+tcApp rn_expr rn_fun rn_args exp_res_ty
+ = do { fun_lspan <- getFunSrcSpan rn_args
; traceTc "tcApp {" $
- vcat [ text "generated? " <+> ppr inGenCode
- , text "rn_expr:" <+> ppr rn_expr
- , text "rn_fun:" <+> ppr rn_fun
+ vcat [ text "rn_fun:" <+> ppr rn_fun
, text "fun_lspan:" <+> ppr fun_lspan
, text "rn_args:" <+> ppr rn_args ]
-- Step 2: Infer the type of `fun`, the head of the application
- ; (tc_fun, fun_sigma) <- tcInferAppHead fun
+ ; (tc_fun, fun_sigma) <- tcInferAppHead (rn_fun, fun_lspan)
; let tc_head = (tc_fun, fun_lspan)
-- inst_final: top-instantiate the result type of the application,
-- EXCEPT if we are trying to infer a sigma-type
@@ -411,22 +380,12 @@ tcApp rn_expr exp_res_ty
-- Step 3.1: Instantiate the function type (taking a quick look at args)
; do_ql <- wantQuickLook rn_fun
- -- Setp 3.2 Set the correct origin to blame for the error message
- -- What should be the origin for this function call?
- -- If the head of the function is user written
- -- then it can be used in the error message
- -- If it is generated code location span, blame it on the
- -- origin that can be retrived from the top of the error ctxt stack.
- -- See Note [Error contexts in generated code]
- ; fun_orig <- mk_origin fun_lspan rn_fun
-
; traceTc "tcApp:inferAppHead" $
vcat [ text "tc_fun:" <+> ppr tc_fun
, text "fun_sigma:" <+> ppr fun_sigma
- , text "fun_origin" <+> ppr fun_orig
, text "do_ql:" <+> ppr do_ql]
; (inst_args, app_res_rho)
- <- tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_args
+ <- tcInstFun do_ql inst_final (rn_fun, fun_lspan) tc_fun fun_sigma rn_args
-- See (TCAPP1) and (TCAPP2) in
-- Note [tcApp: typechecking applications]
@@ -440,7 +399,7 @@ tcApp rn_expr exp_res_ty
-- Step 4.2: typecheck the arguments
; tc_args <- tcValArgs NoQL (rn_fun, fun_lspan) inst_args
-- Step 4.3: wrap up
- ; finishApp tc_head tc_args app_res_rho res_wrap }
+ ; finishApp tc_fun tc_args app_res_rho res_wrap }
DoQL -> do { traceTc "tcApp:DoQL" (ppr rn_fun $$ ppr app_res_rho)
@@ -458,7 +417,7 @@ tcApp rn_expr exp_res_ty
; res_wrap <- checkResultTy rn_expr tc_head inst_args
app_res_rho exp_res_ty
-- Step 5.5: wrap up
- ; finishApp tc_head tc_args app_res_rho res_wrap } }
+ ; finishApp tc_fun tc_args app_res_rho res_wrap } }
quickLookResultType :: TcRhoType -> ExpRhoType -> TcM ()
-- This function implements the shaded bit of rule APP-Downarrow in
@@ -466,16 +425,16 @@ quickLookResultType :: TcRhoType -> ExpRhoType -> TcM ()
quickLookResultType app_res_rho (Check exp_rho) = qlUnify app_res_rho exp_rho
quickLookResultType _ _ = return ()
-finishApp :: (HsExpr GhcTc, SrcSpan) -> [HsExprArg 'TcpTc]
+finishApp :: HsExpr GhcTc -> [HsExprArg 'TcpTc]
-> TcRhoType -> HsWrapper
-> TcM (HsExpr GhcTc)
-- Do final checks and wrap up the result
-finishApp tc_head@(tc_fun,_) tc_args app_res_rho res_wrap
+finishApp tc_fun tc_args app_res_rho res_wrap
= do {
-- Reconstruct, with a horrible special case for tagToEnum#.
res_expr <- if isTagToEnum tc_fun
- then tcTagToEnum tc_head tc_args app_res_rho
- else return (rebuildHsApps tc_head tc_args)
+ then tcTagToEnum tc_fun tc_args app_res_rho
+ else return (rebuildHsApps tc_fun tc_args)
; traceTc "End tcApp }" (ppr tc_fun)
; return (mkHsWrap res_wrap res_expr) }
@@ -488,11 +447,12 @@ checkResultTy :: HsExpr GhcRn
-- expose foralls, but maybe not /deeply/ instantiated
-> ExpRhoType -- Expected type; this is deeply skolemised
-> TcM HsWrapper
-checkResultTy rn_expr (tc_fun, _) _ app_res_rho (Infer inf_res)
+checkResultTy rn_expr (tc_fun,_) _ app_res_rho (Infer inf_res)
= do { ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun
+ -- Why the "DataConHead" bit? See (IIR5) in
+ -- Note [Instantiation of InferResult] in GHC.Tc.Utils.Unify.
; fillInferResult ds_flag (exprCtOrigin rn_expr) app_res_rho inf_res }
-
checkResultTy rn_expr (tc_fun, fun_loc) inst_args app_res_rho (Check res_ty)
-- Unify with expected type from the context
-- See Note [Unify with expected type before typechecking arguments]
@@ -561,7 +521,7 @@ tcValArgs do_ql (fun, fun_lspan) args = go do_ql 0 args
| EValArgQL{} <- arg
= pos + 1
| ETypeArg{ ea_loc_span = l } <- arg
- , not (isGeneratedSrcSpan l)
+ , not (isGeneratedSrcSpan (locA l))
= pos + 1
| otherwise
= pos
@@ -618,7 +578,7 @@ tcValArg _ pos (fun, fun_lspan) (EValArgQL {
, eaql_loc_span = lspan
, eaql_arg_ty = sc_arg_ty
, eaql_larg = larg@(L arg_loc rn_expr)
- , eaql_tc_fun = tc_head
+ , eaql_tc_fun = tc_head@(tc_fun,_)
, eaql_rn_fun = rn_fun
, eaql_fun_ue = head_ue
, eaql_args = inst_args
@@ -636,7 +596,8 @@ tcValArg _ pos (fun, fun_lspan) (EValArgQL {
, text "app_lspan" <+> ppr lspan
, text "head_lspan" <+> ppr fun_lspan
, text "tc_head" <+> ppr tc_head])
- ; ds_flag <- getDeepSubsumptionFlag_DataConHead (fst tc_head)
+ ; ds_flag <- getDeepSubsumptionFlag
+ -- NB: whether to do deep /skolemisation/ is independent of data constructors
; (wrap, arg')
<- tcScalingUsage mult $
tcSkolemise ds_flag GenSigCtxt exp_arg_ty $ \ exp_arg_rho ->
@@ -656,7 +617,7 @@ tcValArg _ pos (fun, fun_lspan) (EValArgQL {
; app_res_rho <- liftZonkM $ zonkTcType app_res_rho
; res_wrap <- checkResultTy rn_expr tc_head inst_args
app_res_rho (mkCheckExpType exp_arg_rho)
- ; finishApp tc_head tc_args app_res_rho res_wrap }
+ ; finishApp tc_fun tc_args app_res_rho res_wrap }
; traceTc "tcEValArgQL }" $
vcat [ text "app_res_rho:" <+> ppr app_res_rho ]
@@ -690,26 +651,48 @@ tcInstFun :: QLFlag
-- always return a rho-type (but not a deep-rho type)
-- Generally speaking we pass in True; in Fig 5 of the paper
-- |-inst returns a rho-type
- -> (CtOrigin, HsExpr GhcRn, SrcSpan)
+ -> (HsExpr GhcRn, SrcSpan)
-> HsExpr GhcTc
-> TcSigmaType -> [HsExprArg 'TcpRn]
-> TcM ( [HsExprArg 'TcpInst]
, TcSigmaType ) -- Does not instantiate trailing invisible foralls
--- This crucial function implements the |-inst judgement in Fig 4, plus the
--- modification in Fig 5, of the QL paper:
+-- This crucial function implements the |-inst judgement in Fig 4,
+-- plus the modification in Fig 5, of the QL paper:
-- "A quick look at impredicativity" (ICFP'20).
-tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_args
- = do { traceTc "tcInstFun" (vcat [ text "origin" <+> ppr fun_orig
- , text "tc_fun" <+> ppr tc_fun
+tcInstFun do_ql inst_final rn_head@(_, fun_lspan) tc_fun fun_sigma rn_args
+ = do { traceTc "tcInstFun" (vcat [ text "tc_fun" <+> ppr tc_fun
+ , text "rn_fun" <+> ppr rn_head
, text "fun_sigma" <+> ppr fun_sigma
, text "args:" <+> ppr rn_args
- , text "do_ql" <+> ppr do_ql
- , text "ctx" <+> ppr fun_lspan])
- ; res@(_, fun_ty) <- go 1 [] fun_sigma rn_args
+ , text "do_ql" <+> ppr do_ql])
+ ; fun_origin <- mk_origin rn_head
+ ; res@(_, fun_ty) <- go fun_origin 1 [] fun_sigma rn_args
; traceTc "tcInstFun:ret" (ppr fun_ty)
; return res
}
where
+ -- What should be the origin for this function call?
+ -- If the head of the function is user written
+ -- then it can be used in the error message
+ -- If it is generated code location span, blame it on the
+ -- origin that can be retrived from the top of the error ctxt stack.
+ -- See Note [Error contexts in generated code]
+ mk_origin :: (HsExpr GhcRn, SrcSpan) -- The head of the application chain and its location
+ -> TcM CtOrigin
+ mk_origin (rn_fun, fun_lspan)
+ | not (isGeneratedSrcSpan fun_lspan)
+ = return $ exprCtOrigin rn_fun
+
+ | otherwise -- If the location is generated, the best we can do is to
+ -- approximate by looking on top of the error message stack
+ = do { err_ctxt_stack <- getErrCtxt
+ ; let hs_ctxt = case err_ctxt_stack of
+ (c:_) -> c
+ [] -> pprPanic "mk_origin" (ppr rn_fun)
+ ; traceTc "mk_origin" (pprHsCtxt hs_ctxt)
+ ; return $ hsCtxtCtOrigin hs_ctxt
+ }
+
-- These are the type variables which must be instantiated to concrete
-- types. See Note [Representation-polymorphic Ids with no binding]
-- in GHC.Tc.Utils.Concrete
@@ -741,34 +724,35 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg
inst_fun _ = isInferredForAllTyFlag
-----------
- go, go1 :: Int -- Value-argument position of next arg
+ go, go1 :: CtOrigin -- Of the function
+ -> Int -- Value-argument position of next arg
-> [HsExprArg 'TcpInst] -- Accumulator, reversed
-> TcSigmaType -> [HsExprArg 'TcpRn]
-> TcM ([HsExprArg 'TcpInst], TcSigmaType)
-- go: If fun_ty=kappa, look it up in Theta
- go pos acc fun_ty args
+ go fun_orig pos acc fun_ty args
| Just kappa <- getTyVar_maybe fun_ty
, isQLInstTyVar kappa
= do { cts <- readMetaTyVar kappa
; case cts of
- Indirect fun_ty' -> go pos acc fun_ty' args
- Flexi -> go1 pos acc fun_ty args }
+ Indirect fun_ty' -> go fun_orig pos acc fun_ty' args
+ Flexi -> go1 fun_orig pos acc fun_ty args }
| otherwise
- = go1 pos acc fun_ty args
+ = go1 fun_orig pos acc fun_ty args
-- go1: fun_ty is not filled-in instantiation variable
-- ('go' dealt with that case)
-- Handle out-of-scope functions gracefully
- go1 pos acc fun_ty (arg : rest_args)
+ go1 fun_orig pos acc fun_ty (arg : rest_args)
| fun_is_out_of_scope, looks_like_type_arg arg -- See Note [VTA for out-of-scope functions]
- = go pos acc fun_ty rest_args
+ = go fun_orig pos acc fun_ty rest_args
-- Rule IALL from Fig 4 of the QL paper; applies even if args = []
-- Instantiate invisible foralls and dictionaries.
-- c.f. GHC.Tc.Utils.Instantiate.topInstantiate
- go1 pos acc fun_ty args
+ go1 fun_orig pos acc fun_ty args
| (tvs, body1) <- tcSplitSomeForAllTyVars (inst_fun args) fun_ty
, (theta, body2) <- if inst_fun args Inferred
then tcSplitPhiTy body1
@@ -797,12 +781,12 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg
-- argument of (#,#) to @LiftedRep, but want to rule out the
-- second instantiation @r.
- ; go pos (addArgWrap wrap acc) fun_rho args }
+ ; go fun_orig pos (addArgWrap wrap acc) fun_rho args }
-- Going around again means we deal easily with
-- nested forall a. Eq a => forall b. Show b => blah
-- Rule IRESULT from Fig 4 of the QL paper; no more arguments
- go1 _pos acc fun_ty []
+ go1 _fun_orig _pos acc fun_ty []
| XExpr (ConLikeTc (RealDataCon dc)) <- tc_fun
, isNewDataCon dc
, [Scaled _ orig_arg_ty] <- dataConOrigArgTys dc
@@ -822,30 +806,30 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg
= return (reverse acc, fun_ty)
-- Rule ITVDQ from the GHC Proposal #281
- go1 pos acc fun_ty ((EValArg { ea_arg = arg }) : rest_args)
+ go1 fun_orig pos acc fun_ty ((EValArg { ea_arg = arg }) : rest_args)
| Just (tvb, body) <- tcSplitForAllTyVarBinder_maybe fun_ty
= assertPpr (binderFlag tvb == Required) (ppr fun_ty $$ ppr arg) $
-- Any invisible binders have been instantiated by IALL above,
-- so this forall must be visible (i.e. Required)
do { (ty_arg, inst_body) <- tcVDQ fun_conc_tvs (tvb, body) arg
; let wrap = mkWpTyApps [ty_arg]
- ; go (pos+1) (addArgWrap wrap acc) inst_body rest_args }
+ ; go fun_orig (pos+1) (addArgWrap wrap acc) inst_body rest_args }
- go1 pos acc fun_ty (EWrap w : args)
- = go1 pos (EWrap w : acc) fun_ty args
+ go1 fun_orig pos acc fun_ty (EWrap w : args)
+ = go1 fun_orig pos (EWrap w : acc) fun_ty args
- go1 pos acc fun_ty (EPrag sp prag : args)
- = go1 pos (EPrag sp prag : acc) fun_ty args
+ go1 fun_orig pos acc fun_ty (EPrag sp prag : args)
+ = go1 fun_orig pos (EPrag sp prag : acc) fun_ty args
-- Rule ITYARG from Fig 4 of the QL paper
- go1 pos acc fun_ty ( ETypeArg { ea_loc_span = ctxt, ea_hs_ty = hs_ty }
- : rest_args )
+ go1 fun_orig pos acc fun_ty ( ETypeArg { ea_loc_span = ctxt, ea_hs_ty = hs_ty }
+ : rest_args )
= do { (ty_arg, inst_ty) <- tcVTA fun_conc_tvs fun_ty hs_ty
; let arg' = ETypeArg { ea_loc_span = ctxt, ea_hs_ty = hs_ty, ea_ty_arg = ty_arg }
- ; go pos (arg' : acc) inst_ty rest_args }
+ ; go fun_orig pos (arg' : acc) inst_ty rest_args }
-- Rule IVAR from Fig 4 of the QL paper:
- go1 pos acc fun_ty args@(EValArg {} : _)
+ go1 fun_orig pos acc fun_ty args@(EValArg {} : _)
| Just kappa <- getTyVar_maybe fun_ty
, isQLInstTyVar kappa
= -- Function type was of form f :: forall a b. t1 -> t2 -> b
@@ -861,7 +845,7 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg
-- - We must be sure to actually update the variable right now,
-- not defer in any way, because this is a QL instantiation variable.
-- It's easier just to do the job directly here.
- do { arg_tys <- zipWithM new_arg_ty (leadingValArgs args) [pos..]
+ do { arg_tys <- zipWithM (new_arg_ty fun_orig) (leadingValArgs args) [pos..]
; res_ty <- newOpenFlexiTyVarTyQL do_ql TauTv
; let fun_ty' = mkScaledFunTys arg_tys res_ty
@@ -877,12 +861,12 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg
-- Then fun_ty :: kk, fun_ty' :: Type, kind_co :: Type ~ kk
-- co_wrap :: (fun_ty' |> kind_co) ~ fun_ty'
- ; go pos acc' fun_ty' args }
+ ; go fun_orig pos acc' fun_ty' args }
-- Rule IARG from Fig 4 of the QL paper:
- go1 pos acc fun_ty
+ go1 fun_orig pos acc fun_ty
(EValArg { ea_arg = arg, ea_loc_span = ctxt } : rest_args)
- = do { let herald = mk_herald tc_fun (unLoc arg)
+ = do { let herald = mk_herald fun_orig tc_fun (unLoc arg)
; (fun_co, arg_ty, res_ty) <-
-- NB: matchActualFunTy does the rep-poly check.
-- For example, suppose we have f :: forall r (a::TYPE r). a -> Int
@@ -894,16 +878,15 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg
matchActualFunTy herald
(Just $ HsExprTcThing tc_fun)
(n_val_args, fun_sigma) fun_ty
- ; ds_flag <- getDeepSubsumptionFlag_DataConHead tc_fun
- ; arg' <- quickLookArg ds_flag do_ql pos ctxt (rn_fun, fun_lspan) arg arg_ty
+ ; arg' <- quickLookArg do_ql pos ctxt rn_head arg arg_ty
; let acc' = arg' : addArgWrap (mkWpCastN fun_co) acc
- ; go (pos+1) acc' res_ty rest_args }
+ ; go fun_orig (pos+1) acc' res_ty rest_args }
- new_arg_ty :: LHsExpr GhcRn -> Int -> TcM (Scaled TcType)
+ new_arg_ty :: CtOrigin -> LHsExpr GhcRn -> Int -> TcM (Scaled TcType)
-- Make a fresh nus for each argument in rule IVAR
- new_arg_ty (L _ arg) i
+ new_arg_ty fun_orig (L _ arg) i
= do { arg_nu <- newArgTyVarTyQL do_ql $
- FRRExpectedFunTy (mk_herald tc_fun arg) i
+ FRRExpectedFunTy (mk_herald fun_orig tc_fun arg) i
-- Following matchActualFunTy, we create nu_i :: TYPE kappa_i[conc],
-- thereby ensuring that the arguments have concrete runtime representations
@@ -913,12 +896,13 @@ tcInstFun do_ql inst_final (fun_orig, rn_fun, fun_lspan) tc_fun fun_sigma rn_arg
; return (mkScaled mult_ty arg_nu) }
- mk_herald :: HsExpr GhcTc -> HsExpr GhcRn -> ExpectedFunTyCtxt
- mk_herald tc_fun arg
+ mk_herald :: CtOrigin -> HsExpr GhcTc -> HsExpr GhcRn -> ExpectedFunTyCtxt
+ mk_herald fun_orig tc_fun arg
= case fun_orig of
DoStmtOrigin -> ExpectedFunTySyntaxOp DoStmtOrigin tc_fun
_ -> ExpectedFunTyArg (HsExprTcThing tc_fun) arg
+
-- Is the argument supposed to instantiate a forall?
--
-- In other words, given a function application `fn arg`,
@@ -1883,23 +1867,23 @@ This turned out to be more subtle than I expected. Wrinkles:
-}
-quickLookArg :: DeepSubsumptionFlag -> QLFlag -> Int
- -> SrcSpan -- ^ location span of the whole application
+quickLookArg :: QLFlag -> Int
+ -> HsExprLoc -- ^ location span of the whole application
-> (HsExpr GhcRn, SrcSpan) -- ^ Head of the application chain and its source span
-> LHsExpr GhcRn -- ^ Argument
-> Scaled TcSigmaTypeFRR -- ^ Type expected by the function
-> TcM (HsExprArg 'TcpInst)
-- See Note [Quick Look at value arguments]
-quickLookArg _ NoQL _ app_lspan _ larg orig_arg_ty
+quickLookArg NoQL _ app_lspan _ larg orig_arg_ty
= skipQuickLook app_lspan larg orig_arg_ty
-quickLookArg ds_flag DoQL pos app_lspan fun_and_lspan larg orig_arg_ty
- = do { is_rho <- tcIsDeepRho ds_flag (scaledThing orig_arg_ty)
+quickLookArg DoQL pos app_lspan fun_and_lspan larg orig_arg_ty
+ = do { is_rho <- qlArgHasRhoType (scaledThing orig_arg_ty)
; traceTc "qla" (ppr orig_arg_ty $$ ppr is_rho)
; if not is_rho
then skipQuickLook app_lspan larg orig_arg_ty
else quickLookArg1 pos app_lspan fun_and_lspan larg orig_arg_ty }
-skipQuickLook :: SrcSpan -> LHsExpr GhcRn -> Scaled TcRhoType
+skipQuickLook :: HsExprLoc -> LHsExpr GhcRn -> Scaled TcRhoType
-> TcM (HsExprArg 'TcpInst)
skipQuickLook app_lspan larg arg_ty
= return (EValArg { ea_loc_span = app_lspan
@@ -1910,13 +1894,26 @@ whenQL :: QLFlag -> ZonkM () -> TcM ()
whenQL DoQL thing_inside = liftZonkM thing_inside
whenQL NoQL _ = return ()
-tcIsDeepRho :: DeepSubsumptionFlag -> TcType -> TcM Bool
--- This top-level zonk step, which is the reason we need a local 'go' loop,
--- is subtle. See Section 9 of the QL paper
+qlArgHasRhoType :: TcType -> TcM Bool
+-- `qlArgHasRhoType` checks that the expected argument type in rule
+-- App-lightning-bolt (Fig 5 in the paper) is indeed a rho-type.
+--
+-- It must apply the current QL substitution, so it any QLInstTyVar that it
+-- comes across. Why? See Section 5.7 in the paper; argument order matters.
+--
+-- What if we find an /un-filled/ QLInstVar? We treat this as a rho-type
+-- even though a later argument might force it to be sigma-type. See
+-- Section 9 in the paper.
+--
+-- With -XDeepSubsunption we need a /deep/ rho-type.
+-- (We don't need getDeepSubsumptionFlag_DataConHead here because this
+-- is only about QuickLook.)
-tcIsDeepRho ds_flag = go
+qlArgHasRhoType ty
+ = do { ds_flag <- getDeepSubsumptionFlag
+ ; go ds_flag ty }
where
- go ty
+ go ds_flag ty
| isSigmaTy ty
= return False
@@ -1924,12 +1921,12 @@ tcIsDeepRho ds_flag = go
, isQLInstTyVar kappa
= do { info <- readMetaTyVar kappa
; case info of
- Indirect arg_ty' -> go arg_ty'
+ Indirect arg_ty' -> go ds_flag arg_ty'
Flexi -> return True }
| Deep {} <- ds_flag
, Just (_, res_ty) <- tcSplitFunTy_maybe ty
- = go res_ty
+ = go ds_flag res_ty
| otherwise
= return True
@@ -1940,14 +1937,20 @@ isGuardedTy ty
| Just {} <- tcSplitAppTy_maybe ty = True
| otherwise = False
-quickLookArg1 :: Int -> SrcSpan -> (HsExpr GhcRn, SrcSpan) -> LHsExpr GhcRn
+quickLookArg1 :: Int -> HsExprLoc -> (HsExpr GhcRn, SrcSpan) -> LHsExpr GhcRn
-> Scaled TcRhoType -- Deeply skolemised
-> TcM (HsExprArg 'TcpInst)
-- quickLookArg1 implements the "QL Argument" judgement in Fig 5 of the paper
quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _ orig_arg_rho)
= addArgCtxt pos (fun, fun_lspan) larg $ -- Context needed for constraints
- -- generated by calls in arg
- do { ((rn_fun_arg, fun_lspan_arg), rn_args) <- splitHsApps arg
+ -- generated by calls in arg
+ do { traceTc "qla1" (ppr arg)
+
+ ; (rn_fun_arg, rn_args) <- splitHsApps arg
+
+ ; traceTc "qla2" (ppr arg)
+
+ ; fun_lspan_arg <- getFunSrcSpan rn_args
-- Step 1: get the type of the head of the argument
; (fun_ue, mb_fun_ty) <- tcCollectingUsage $ tcInferAppHead_maybe rn_fun_arg
@@ -1970,17 +1973,15 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _
do { let arg_tc_head = (tc_fun_arg_head, fun_lspan_arg)
; do_ql <- wantQuickLook rn_fun_arg
- ; arg_orig <- mk_origin fun_lspan_arg rn_fun_arg
; ((inst_args, app_res_rho), wanted)
<- captureConstraints $
- tcInstFun do_ql True (arg_orig, rn_fun_arg, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_args
+ tcInstFun do_ql True (rn_fun_arg, fun_lspan_arg) tc_fun_arg_head fun_sigma_arg_head rn_args
-- We must capture type-class and equality constraints here, but
-- not usage information. See (QLA6) in Note [Quick Look at
-- value arguments]
; traceTc "quickLookArg 2" $
vcat [ text "arg:" <+> ppr arg
- , text "orig:" <+> ppr arg_orig
, text "orig_arg_rho:" <+> ppr orig_arg_rho
, text "app_res_rho:" <+> ppr app_res_rho ]
@@ -2018,24 +2019,6 @@ quickLookArg1 pos app_lspan (fun, fun_lspan) larg@(L _ arg) sc_arg_ty@(Scaled _
, eaql_res_rho = app_res_rho }) }}}
-mk_origin :: SrcSpan -- SrcSpan of the function
- -> HsExpr GhcRn -- The head of the expression application chain
- -> TcM CtOrigin
-mk_origin fun_lspan rn_fun
- | not (isGeneratedSrcSpan fun_lspan)
- = return $ exprCtOrigin rn_fun
-
- | otherwise -- If the location is generated, the best we can do is to
- -- approximate by looking on top of the error message stack
- = do { err_ctxt_stack <- getErrCtxt
- ; let hs_ctxt = case err_ctxt_stack of
- (c:_) -> c
- [] -> pprPanic "mk_origin" (ppr rn_fun)
- ; traceTc "mk_origin" (pprHsCtxt hs_ctxt)
- ; return $ hsCtxtCtOrigin hs_ctxt
- }
-
-
{- *********************************************************************
* *
Folding over instantiation variables
@@ -2437,12 +2420,11 @@ isTagToEnum :: HsExpr GhcTc -> Bool
isTagToEnum (HsVar _ (L _ fun_id)) = fun_id `hasKey` tagToEnumKey
isTagToEnum _ = False
-tcTagToEnum :: (HsExpr GhcTc, SrcSpan) -> [HsExprArg 'TcpTc]
- -> TcRhoType
+tcTagToEnum :: HsExpr GhcTc -> [HsExprArg 'TcpTc] -> TcRhoType
-> TcM (HsExpr GhcTc)
-- tagToEnum# :: forall a. Int# -> a
-- See Note [tagToEnum#] Urgh!
-tcTagToEnum (tc_fun, fun_lspan) tc_args res_ty
+tcTagToEnum tc_fun tc_args res_ty
| [val_arg] <- dropWhile (not . isHsValArg) tc_args
= do { res_ty <- liftZonkM $ zonkTcType res_ty
@@ -2464,14 +2446,14 @@ tcTagToEnum (tc_fun, fun_lspan) tc_args res_ty
; let rep_ty = mkTyConApp rep_tc rep_args
tc_fun' = mkHsWrap (WpTyApp rep_ty) tc_fun
df_wrap = mkWpCastR (mkSymCo coi)
- tc_expr = rebuildHsApps (tc_fun', fun_lspan) [val_arg]
+ tc_expr = rebuildHsApps tc_fun' [val_arg]
; return (mkHsWrap df_wrap tc_expr) }}}}}
| otherwise
= failWithTc TcRnTagToEnumMissingValArg
where
- vanilla_result = return (rebuildHsApps (tc_fun, fun_lspan) tc_args)
+ vanilla_result = return (rebuildHsApps tc_fun tc_args)
check_enumeration ty' tc
| -- isTypeDataTyCon: see wrinkle (W1) in
=====================================
compiler/GHC/Tc/Gen/App.hs-boot deleted
=====================================
@@ -1,12 +0,0 @@
-module GHC.Tc.Gen.App where
-
-import GHC.Hs ( HsExpr )
-import GHC.Tc.Types ( TcM )
-import GHC.Tc.Types.Origin ( CtOrigin )
-import GHC.Tc.Utils.TcType ( TcSigmaType )
-import GHC.Hs.Extension ( GhcRn, GhcTc )
-
-
-import GHC.Prelude (Bool)
-
-tcExprSigma :: Bool -> CtOrigin -> HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
=====================================
compiler/GHC/Tc/Gen/Expand.hs
=====================================
@@ -0,0 +1,107 @@
+{-# LANGUAGE TypeFamilies #-}
+
+{-
+(c) The University of Glasgow 2006
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+-}
+
+module GHC.Tc.Gen.Expand( tcExpand ) where
+
+import GHC.Prelude
+
+import {-# SOURCE #-} GHC.Tc.Gen.Splice( getUntypedSpliceBody )
+
+import GHC.Hs
+
+import GHC.Tc.Utils.Monad
+import GHC.Tc.Types.ErrCtxt
+
+import GHC.Rename.Utils
+
+{- Note [Typechecking by expansion: overview]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+For many constructs, rather than typechecking the user-written code
+directly, it's much easier to
+ * Expand (or desugar) the code to something simpler
+ * Typecheck that simpler expression
+
+Example: Typechecking the do expression. The typechecker looks (somewhat) like this:
+
+ tcExpr e@(HsDo _ stmts) rho = do { hse <- expandDoStmts stmts
+ ; tcHsExpansion hse rho }
+
+The `expandDoStmts` replaces the HsDo { x <- e1; return x }
+with something like
+ HSE { hse_ctxt = ExprCtxt e
+ , hse_exp = e1 >>= \ x -> x }
+and we then typecheck the expression `e1 >>= \ x -> x`
+
+See also Note [Handling overloaded and rebindable constructs]
+ and Note [Doing XXExprGhcRn in the Renamer vs Typechecker]
+
+The Big Question is how to ensure that error messages mention
+only user-written source code, and never talk about the expanded code.
+The rest of this Note explains how that is done.
+
+* The expansion process typically takes a user written thing
+ L lspan ue
+ and returns
+ L lspan (XExpr (ExpandedThingRn (HSE { hse_ctxt = ue
+ , hse_exp = ee } ))
+ where `ee` is the expansion of the user written thing `ue`
+
+* The type checker context has 3 key fields that describe the context:
+ TcLclCtxt { tcl_loc :: RealSrcSpan
+ , tcl_in_gen_code :: Bool
+ , tcl_err_ctxt :: ErrCtxtStack
+ , ... }
+ Note `tcl_loc` always points to a real place in the source code,
+ hence `RealSrcSpan`.
+
+ The `tcl_err_ctxt` is a stack of contexts, each saying something
+ like "In the expression: x+y" or "In second argument of `$` namely 'r { x=2 }'"
+
+ The `tcl_in_gen_code` is a boolean that keeps track of whether
+ the current expression being typechecked is compiler generated
+ or user generated.
+
+ INVARIANT: `tcl_loc` and `tcl_in_gen_code` are modified only in `setSrcSpan`.
+
+* Now, when
+ tcMonoLExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
+ gets a located expression, it does 3 things:
+ (a) Calls `setSrcSpanA` to set the ambient source-code location
+ (b) Calls `addExprCtxt` to push a suitable `HsCtxt` on top of the `tcl_err_ctxt`.
+ (c) Calls `tcExpr` to typecheck the expression.
+
+* In these calls, if the `span` is generated (see `isGeneratedSrcSpan`), then
+ - `setSrcSpanA` sets `tcl_in_gen_code` to `True`, and leaves `tcl_loc` unchanged
+ - `addExprCtxt` is a no-op if `tcl_in_gen_code` is True
+ The result is that `tcl_loc` has the span from the innermost /user/ tree node;
+ and the ErrCtxtStack in `tcl_err_ctxt` only has contexts arisign from user code.
+
+* Note that inside an expansion we have sub-expressions from the original program.
+ As soon as we enter one of those, identified by a /user/ span, `setSrcSpanA` will
+ sets the `tcl_loc` to reflect that span, and switch off `tcl_in_gen_code`. Nice!
+-}
+
+---------------
+tcExpand :: HsExpr GhcRn -> TcM (Maybe (HsExpansion GhcRn))
+tcExpand e@(OpApp _ arg1 op arg2)
+ = return $ Just $
+ HSE { hse_ctxt = ExprCtxt e
+ , hse_exp = foldl ap op [arg1,arg2] }
+ where
+ ap f a = wrapGenSpan (HsApp noExtField f a)
+
+tcExpand (XExpr (ExpandedThingRn hse))
+ = return (Just hse)
+
+tcExpand e@(HsUntypedSplice splice_res _)
+-- See Note [Looking through Template Haskell splices in splitHsApps]
+ = do { fun <- getUntypedSpliceBody splice_res
+ ; return $ Just $
+ HSE { hse_ctxt = ExprCtxt e
+ , hse_exp = wrapGenSpan fun } }
+
+tcExpand _ = return Nothing
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -13,7 +13,7 @@
module GHC.Tc.Gen.Expr
( tcCheckPolyExpr, tcCheckPolyExprNC,
tcCheckMonoExpr, tcCheckMonoExprNC,
- tcInferExpr, tcInferSigma,
+ tcInferExpr, tcInferSigma, tcInferExprSigma,
tcInferRho, tcInferRhoNC,
tcMonoLExpr, tcMonoLExprNC,
tcInferRhoFRR, tcInferRhoFRRNC,
@@ -30,10 +30,10 @@ import {-# SOURCE #-} GHC.Tc.Gen.Splice
import GHC.Hs
import GHC.Hs.Syn.Type
-
import GHC.Rename.Utils
import GHC.Rename.Env ( addUsedGRE, getUpdFieldLbls )
+import GHC.Tc.Gen.Expand( tcExpand )
import GHC.Tc.Gen.App
import GHC.Tc.Gen.Head
import GHC.Tc.Gen.Do
@@ -237,6 +237,9 @@ tcPolyExprCheck expr res_ty
tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcSigmaType)
tcInferSigma = tcInferExpr IIF_Sigma
+tcInferExprSigma :: HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
+tcInferExprSigma e = runInfer IIF_Sigma IFRR_Any (tcExpr e)
+
tcInferRho, tcInferRhoNC :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)
-- Infer a *rho*-type. The return type is always instantiated.
tcInferRho = tcInferExpr IIF_DeepRho
@@ -291,6 +294,12 @@ tcMonoLExprNC (L loc expr) res_ty
do { expr' <- tcExpr expr res_ty
; return (L loc expr') }
+---------------
+tcCollectApp :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
+tcCollectApp the_app res_ty
+ = do { (fun, args) <- splitHsApps the_app
+ ; tcApp the_app fun args res_ty }
+
---------------
tcExpr :: HsExpr GhcRn
-> ExpRhoType -- DeepSubsumption <=> when checking, this type
@@ -312,19 +321,11 @@ tcExpr :: HsExpr GhcRn
-- - ones taken apart by GHC.Tc.Gen.Head.splitHsApps
-- - ones understood by GHC.Tc.Gen.Head.tcInferAppHead_maybe
-- See Note [Application chains and heads] in GHC.Tc.Gen.App
-tcExpr e@(HsVar {}) res_ty = tcApp e res_ty
-tcExpr e@(HsApp {}) res_ty = tcApp e res_ty
-tcExpr e@(OpApp {}) res_ty = tcApp e res_ty
-tcExpr e@(HsAppType {}) res_ty = tcApp e res_ty
-tcExpr e@(ExprWithTySig {}) res_ty = tcApp e res_ty
-tcExpr e@(XExpr (HsRecSelRn{})) res_ty = tcApp e res_ty
-
--- Renamer expanded expressions (eg. Right/Left sections)
--- or tcExpr expanded expressions (eg. Do statements and Record updates)
--- are type checked using tcHsExpansion.
--- See Note [Typechecking by expansion: overview]
-tcExpr (XExpr (ExpandedThingRn hse)) res_ty = tcHsExpansion hse res_ty
-
+tcExpr e@(HsVar {}) res_ty = tcApp e e [] res_ty
+tcExpr e@(ExprWithTySig {}) res_ty = tcApp e e [] res_ty
+tcExpr e@(XExpr (HsRecSelRn{})) res_ty = tcApp e e [] res_ty
+tcExpr e@(HsAppType {}) res_ty = tcCollectApp e res_ty
+tcExpr e@(HsApp {}) res_ty = tcCollectApp e res_ty
-- Typecheck an occurrence of an unbound Id
--
@@ -392,7 +393,7 @@ tcExpr e@(HsOverLit _ lit) res_ty
-- See Note [Short cut for overloaded literals] in GHC.Tc.Utils.TcMType
; case mb_res of
Just lit' -> return (HsOverLit noExtField lit')
- Nothing -> tcApp e res_ty }
+ Nothing -> tcApp e e [] res_ty }
-- Why go via tcApp? See Note [Typechecking overloaded literals]
{- Note [Typechecking overloaded literals]
@@ -530,8 +531,9 @@ tcExpr (HsCase ctxt scrut matches) res_ty
tcExpr (HsIf x pred b1 b2) res_ty
= do { pred' <- tcCheckMonoExpr pred boolTy
- ; (u1,b1') <- tcCollectingUsage $ tcMonoLExpr b1 res_ty
- ; (u2,b2') <- tcCollectingUsage $ tcMonoLExpr b2 res_ty
+ ; let res_ty' = adjustExpTypeForCaseBranches res_ty [b1,b2]
+ ; (u1,b1') <- tcCollectingUsage $ tcMonoLExpr b1 res_ty'
+ ; (u2,b2') <- tcCollectingUsage $ tcMonoLExpr b2 res_ty'
; tcEmitBindingUsage (supUE u1 u2)
; return (HsIf x pred' b1' b2') }
@@ -730,19 +732,6 @@ tcExpr e@(RecordUpd { rupd_flds = OverloadedRecUpdFields {}}) _
tcExpr (ArithSeq _ witness seq) res_ty
= tcArithSeq witness seq res_ty
-{-
-************************************************************************
-* *
- Record dot syntax
-* *
-************************************************************************
--}
-
--- These terms have been replaced by their expanded expressions in the renamer. See
--- Note [Overview of record dot syntax].
-tcExpr (HsGetField _ _ _) _ = panic "GHC.Tc.Gen.Expr: tcExpr: HsGetField: Not implemented"
-tcExpr (HsProjection _ _) _ = panic "GHC.Tc.Gen.Expr: tcExpr: HsProjection: Not implemented"
-
{-
************************************************************************
* *
@@ -755,17 +744,7 @@ tcExpr (HsProjection _ _) _ = panic "GHC.Tc.Gen.Expr: tcExpr: HsProjection: Not
-- See Note [Delaying modFinalizers in untyped splices] in GHC.Rename.Splice.
tcExpr (HsTypedSplice ext splice) res_ty = tcTypedSplice ext splice res_ty
tcExpr e@(HsTypedBracket _ext body) res_ty = tcTypedBracket e body res_ty
-
tcExpr e@(HsUntypedBracket ps body) res_ty = tcUntypedBracket e body ps res_ty
-tcExpr (HsUntypedSplice splice _) res_ty
- -- Since `tcApp` deals with `HsUntypedSplice` (in `splitHsApps`), you might
- -- wonder why we don't delegate to `tcApp` as we do for `HsVar`, etc.
- -- (See the initial block of equations for `tcExpr`.) But we can't do this
- -- for `HsUntypedSplice`; to see why, read Wrinkle (UTS1) in
- -- Note [Looking through Template Haskell splices in splitHsApps] in
- -- GHC.Tc.Gen.Head.
- = do { expr <- getUntypedSpliceBody splice
- ; tcExpr expr res_ty }
{-
************************************************************************
@@ -775,10 +754,12 @@ tcExpr (HsUntypedSplice splice _) res_ty
************************************************************************
-}
-tcExpr (HsOverLabel {}) ty = pprPanic "tcExpr:HsOverLabel" (ppr ty)
-tcExpr (SectionL {}) ty = pprPanic "tcExpr:SectionL" (ppr ty)
-tcExpr (SectionR {}) ty = pprPanic "tcExpr:SectionR" (ppr ty)
-
+-- See Note [Typechecking by expansion: overview]
+tcExpr e res_ty
+ = do { mb_hse <- tcExpand e
+ ; case mb_hse of
+ Just hse -> tcHsExpansion hse res_ty
+ Nothing -> pprPanic "tcExpr: unhandled case:" (ppr e) }
{-
************************************************************************
@@ -788,73 +769,6 @@ tcExpr (SectionR {}) ty = pprPanic "tcExpr:SectionR" (ppr ty)
************************************************************************
-}
-{- Note [Typechecking by expansion: overview]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-For many constructs, rather than typechecking the user-written code
-directly, it's much easier to
- * Expand (or desugar) the code to something simpler
- * Typecheck that simpler expression
-
-Example: Typechecking the do expression. The typechecker looks (somewhat) like this:
-
- tcExpr e@(HsDo _ stmts) rho = do { hse <- expandDoStmts stmts
- ; tcHsExpansion hse rho }
-
-The `expandDoStmts` replaces the HsDo { x <- e1; return x }
-with something like
- HSE { hse_ctxt = ExprCtxt e
- , hse_exp = e1 >>= \ x -> x }
-and we then typecheck the expression `e1 >>= \ x -> x`
-
-See also Note [Handling overloaded and rebindable constructs]
- and Note [Doing XXExprGhcRn in the Renamer vs Typechecker]
-
-The Big Question is how to ensure that error messages mention
-only user-written source code, and never talk about the expanded code.
-The rest of this Note explains how that is done.
-
-* The expansion process typically takes a user written thing
- L lspan ue
- and returns
- L lspan (XExpr (ExpandedThingRn (HSE { hse_ctxt = ue
- , hse_exp = ee } ))
- where `ee` is the expansion of the user written thing `ue`
-
-* The type checker context has 3 key fields that describe the context:
- TcLclCtxt { tcl_loc :: RealSrcSpan
- , tcl_in_gen_code :: Bool
- , tcl_err_ctxt :: ErrCtxtStack
- , ... }
- Note `tcl_loc` always points to a real place in the source code,
- hence `RealSrcSpan`.
-
- The `tcl_err_ctxt` is a stack of contexts, each saying something
- like "In the expression: x+y" or "In second argument of `$` namely 'r { x=2 }'"
-
- The `tcl_in_gen_code` is a boolean that keeps track of whether
- the current expression being typechecked is compiler generated
- or user generated.
-
- INVARIANT: `tcl_loc` and `tcl_in_gen_code` are modified only in `setSrcSpan`.
-
-* Now, when
- tcMonoLExpr :: LHsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
- gets a located expression, it does 3 things:
- (a) Calls `setSrcSpanA` to set the ambient source-code location
- (b) Calls `addExprCtxt` to push a suitable `HsCtxt` on top of the `tcl_err_ctxt`.
- (c) Calls `tcExpr` to typecheck the expression.
-
-* In these calls, if the `span` is generated (see `isGeneratedSrcSpan`), then
- - `setSrcSpanA` sets `tcl_in_gen_code` to `True`, and leaves `tcl_loc` unchanged
- - `addExprCtxt` is a no-op if `tcl_in_gen_code` is True
- The result is that `tcl_loc` has the span from the innermost /user/ tree node;
- and the ErrCtxtStack in `tcl_err_ctxt` only has contexts arisign from user code.
-
-* Note that inside an expansion we have sub-expressions from the original program.
- As soon as we enter one of those, identified by a /user/ span, `setSrcSpanA` will
- sets the `tcl_loc` to reflect that span, and switch off `tcl_in_gen_code`. Nice!
--}
-
tcHsExpansion :: HsExpansion GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
tcHsExpansion (HSE { hse_ctxt = o, hse_exp = e }) res_ty
= do { e' <- tcMonoLExpr e res_ty
=====================================
compiler/GHC/Tc/Gen/Expr.hs-boot
=====================================
@@ -35,6 +35,8 @@ tcInferRho, tcInferRhoNC ::
tcInferRhoFRR, tcInferRhoFRRNC ::
FixedRuntimeRepContext -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)
+tcInferExprSigma :: HsExpr GhcRn -> TcM (HsExpr GhcTc, TcSigmaType)
+
tcInferExpr :: InferInstFlag -> LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcType)
tcSyntaxOp :: CtOrigin
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -9,9 +9,9 @@
-}
module GHC.Tc.Gen.Head
- ( HsExprArg(..), TcPass(..), QLFlag(..), EWrap(..)
+ ( HsExprArg(..), HsExprLoc, TcPass(..), QLFlag(..), EWrap(..)
, splitHsApps, rebuildHsApps
- , addArgWrap, isHsValArg
+ , addArgWrap, isHsValArg, getFunSrcSpan
, leadingValArgs, isVisibleArg, getDeepSubsumptionFlag_DataConHead
, tcInferAppHead, tcInferAppHead_maybe
@@ -22,16 +22,13 @@ module GHC.Tc.Gen.Head
, pprArgInst, addFunResCtxt ) where
import {-# SOURCE #-} GHC.Tc.Gen.Expr( tcExpr, tcCheckPolyExprNC, tcPolyLExprSig )
-import {-# SOURCE #-} GHC.Tc.Gen.Splice( getUntypedSpliceBody )
-import {-# SOURCE #-} GHC.Tc.Gen.App( tcExprSigma )
import GHC.Prelude
import GHC.Hs
import GHC.Hs.Syn.Type
-import GHC.Rename.Utils (mkExpandedTc, mkExpandedExprTc)
-
import GHC.Tc.Gen.HsType
+import GHC.Tc.Gen.Expand( tcExpand )
import GHC.Tc.Gen.Bind( chooseInferredQuantifiers )
import GHC.Tc.Gen.Sig( tcUserTypeSig, tcInstSig )
import GHC.Tc.TyCl.PatSyn( patSynBuilderOcc )
@@ -86,7 +83,7 @@ import GHC.Data.Maybe
The data type HsExprArg :: TcPass -> Type
is a very local type, used only within this module and GHC.Tc.Gen.App
-* It's really a zipper for an application chain
+* It's just a bog-standard zipper for an application chain
See Note [Application chains and heads] in GHC.Tc.Gen.App for
what an "application chain" is.
@@ -147,6 +144,8 @@ takes apart either an HsApp, or an infix OpApp, returning
* We do not look through expanded expressions (except PopErrCtxt.)
-}
+type HsExprLoc = EpAnn AnnListItem -- The location attached to a HsExpr
+
data TcPass = TcpRn -- Arguments decomposed
| TcpInst -- Function instantiated
| TcpTc -- Typechecked
@@ -154,34 +153,34 @@ data TcPass = TcpRn -- Arguments decomposed
data HsExprArg (p :: TcPass) where -- See Note [HsExprArg]
-- Data constructor EValArg represents a value argument
- EValArg :: { ea_loc_span :: SrcSpan
- , ea_arg_ty :: !(XEVAType p)
- , ea_arg :: LHsExpr (GhcPass (XPass p)) }
+ EValArg :: { ea_loc_span :: HsExprLoc
+ , ea_arg_ty :: !(XEVAType p)
+ , ea_arg :: LHsExpr (GhcPass (XPass p)) }
-> HsExprArg p
-- Data constructor EValArgQL represents an argument that has been
-- partly-type-checked by Quick Look; see Note [EValArgQL]
- EValArgQL :: { eaql_loc_span :: SrcSpan
- , eaql_arg_ty :: Scaled TcSigmaType -- Argument type expected by function
- , eaql_larg :: LHsExpr GhcRn -- Original application, for
- -- location and error msgs
- , eaql_rn_fun :: HsExpr GhcRn -- Head of the argument if it is an application
- , eaql_tc_fun :: (HsExpr GhcTc, SrcSpan) -- Typechecked head and its location span
- , eaql_fun_ue :: UsageEnv -- Usage environment of the typechecked head (QLA5)
- , eaql_args :: [HsExprArg 'TcpInst] -- Args: instantiated, not typechecked
- , eaql_wanted :: WantedConstraints
- , eaql_encl :: Bool -- True <=> we have already qlUnified
- -- eaql_arg_ty and eaql_res_rho
- , eaql_res_rho :: TcRhoType } -- Result type of the application
+ EValArgQL :: { eaql_loc_span :: HsExprLoc
+ , eaql_arg_ty :: Scaled TcSigmaType -- Argument type expected by function
+ , eaql_larg :: LHsExpr GhcRn -- Original application, for
+ -- location and error msgs
+ , eaql_rn_fun :: HsExpr GhcRn -- Head of the argument if it is an application
+ , eaql_tc_fun :: (HsExpr GhcTc, SrcSpan) -- Typechecked head and its location span
+ , eaql_fun_ue :: UsageEnv -- Usage environment of the typechecked head (QLA5)
+ , eaql_args :: [HsExprArg 'TcpInst] -- Args: instantiated, not typechecked
+ , eaql_wanted :: WantedConstraints
+ , eaql_encl :: Bool -- True <=> we have already qlUnified
+ -- eaql_arg_ty and eaql_res_rho
+ , eaql_res_rho :: TcRhoType } -- Result type of the application
-> HsExprArg 'TcpInst -- Only exists in TcpInst phase
- ETypeArg :: { ea_loc_span :: SrcSpan
- , ea_hs_ty :: LHsWcType GhcRn -- The type arg
- , ea_ty_arg :: !(XETAType p) } -- Kind-checked type arg
+ ETypeArg :: { ea_loc_span :: HsExprLoc
+ , ea_hs_ty :: LHsWcType GhcRn -- The type arg
+ , ea_ty_arg :: !(XETAType p) } -- Kind-checked type arg
-> HsExprArg p
- EPrag :: SrcSpan -> (HsPragE (GhcPass (XPass p))) -> HsExprArg p
- EWrap :: EWrap -> HsExprArg p
+ EPrag :: HsExprLoc -> (HsPragE (GhcPass (XPass p))) -> HsExprArg p
+ EWrap :: EWrap -> HsExprArg p
type family XETAType (p :: TcPass) where -- Type arguments
XETAType 'TcpRn = NoExtField
@@ -193,8 +192,8 @@ type family XEVAType (p :: TcPass) where -- Value arguments
data QLFlag = DoQL | NoQL
-data EWrap = EPar SrcSpan
- | EExpand (HsExpr GhcRn)
+data EWrap = EPar HsExprLoc
+ | EExpand HsExprLoc HsCtxt
| EHsWrap HsWrapper
@@ -207,11 +206,11 @@ type family XPass (p :: TcPass) where
XPass 'TcpInst = 'Renamed
XPass 'TcpTc = 'Typechecked
-mkEValArg :: SrcSpan -> LHsExpr GhcRn -> HsExprArg 'TcpRn
+mkEValArg :: HsExprLoc -> LHsExpr GhcRn -> HsExprArg 'TcpRn
mkEValArg src_loc e = EValArg { ea_arg = e, ea_loc_span = src_loc
, ea_arg_ty = noExtField }
-mkETypeArg :: SrcSpan -> LHsWcType GhcRn -> HsExprArg 'TcpRn
+mkETypeArg :: HsExprLoc -> LHsWcType GhcRn -> HsExprArg 'TcpRn
mkETypeArg src_loc hs_ty =
ETypeArg { ea_loc_span = src_loc
, ea_hs_ty = hs_ty
@@ -223,74 +222,17 @@ addArgWrap wrap args
| otherwise = EWrap (EHsWrap wrap) : args
-splitHsApps :: HsExpr GhcRn
- -> TcM ( (HsExpr GhcRn, SrcSpan) -- Head
- , [HsExprArg 'TcpRn]) -- Args
--- See Note [splitHsApps].
---
--- This uses the TcM monad solely because we must run modFinalizers when looking
--- through HsUntypedSplices
--- (see Note [Looking through Template Haskell splices in splitHsApps]).
-splitHsApps e = go e noSrcSpan []
- where
- go :: HsExpr GhcRn -> SrcSpan -> [HsExprArg 'TcpRn]
- -> TcM ((HsExpr GhcRn, SrcSpan), [HsExprArg 'TcpRn])
- -- Modify the SrcSpan as we walk inwards, so it describes the next argument
- go (HsPar _ (L l fun)) lspan args = go fun (locA l) (EWrap (EPar lspan) : args)
- go (HsPragE _ p (L l fun)) lspan args = go fun (locA l) (EPrag lspan p : args)
- go (HsAppType _ (L l fun) ty) lspan args = go fun (locA l) (mkETypeArg lspan ty : args)
- go (HsApp _ (L l fun) arg) lspan args = go fun (locA l) (mkEValArg lspan arg : args)
-
- -- See Note [Looking through Template Haskell splices in splitHsApps]
- go e@(HsUntypedSplice splice_res splice) _ args
- = do { fun <- getUntypedSpliceBody splice_res
- ; go fun lspan' (EWrap (EExpand e) : args) }
- where
- lspan' :: SrcSpan
- lspan' = case splice of
- HsUntypedSpliceExpr _ (L l _) -> locA l -- l :: SrcAnn AnnListItem
- HsQuasiQuote _ _ (L l _) -> locA l -- l :: SrcAnn NoEpAnns
- (XUntypedSplice (HsImplicitLiftSplice _ _ _ (L l _))) -> locA l
-
- -- See Note [Desugar OpApp in the typechecker]
- go e@(OpApp _ arg1 (L l op) arg2) _ args
- = pure ( (op, locA l)
- , mkEValArg noSrcSpan arg1
- : mkEValArg noSrcSpan arg2
- -- noSrcSpan because this the span of the call,
- -- and its hard to say exactly what that is
- : EWrap (EExpand e)
- : args )
-
- go e lspan args = pure ((e, lspan), args)
-
-
--- | Rebuild an application: takes a type-checked application head
--- expression together with arguments in the form of typechecked 'HsExprArg's
--- and returns a typechecked application of the head to the arguments.
-rebuildHsApps :: (HsExpr GhcTc, SrcSpan)
- -- ^ the function being applied
- -> [HsExprArg 'TcpTc]
- -- ^ the arguments to the function
- -> HsExpr GhcTc
-rebuildHsApps (fun, _) [] = fun
-rebuildHsApps (fun, sloc) (arg : args)
- = case arg of
- EValArg { ea_arg = arg, ea_loc_span = sloc' }
- -> rebuildHsApps (HsApp noExtField lfun arg, sloc') args
- ETypeArg { ea_hs_ty = hs_ty, ea_ty_arg = ty, ea_loc_span = sloc' }
- -> rebuildHsApps (HsAppType ty lfun hs_ty, sloc') args
- EPrag sloc' p
- -> rebuildHsApps (HsPragE noExtField p lfun, sloc') args
- EWrap (EPar sloc')
- -> rebuildHsApps (gHsPar lfun, sloc') args
- EWrap (EExpand o)
- -> rebuildHsApps (mkExpandedExprTc o fun, sloc) args
- EWrap (EHsWrap wrap)
- -> rebuildHsApps (mkHsWrap wrap fun, sloc) args
- where
- lfun = L (noAnnSrcSpan sloc) fun
+--------------------
+getFunSrcSpan :: [HsExprArg 'TcpRn] -> TcM SrcSpan
+getFunSrcSpan [] = getSrcSpanM
+getFunSrcSpan (ETypeArg { ea_loc_span = l } : _) = return (locA l)
+getFunSrcSpan (EValArg { ea_loc_span = l } : _) = return (locA l)
+getFunSrcSpan (EPrag l _ : _) = return (locA l)
+getFunSrcSpan (EWrap (EPar l) : _) = return (locA l)
+getFunSrcSpan (EWrap (EExpand l _) : _) = return (locA l)
+getFunSrcSpan (EWrap (EHsWrap {}) : args) = getFunSrcSpan args
+--------------------
isHsValArg :: HsExprArg id -> Bool
isHsValArg (EValArg {}) = True
isHsValArg _ = False
@@ -334,13 +276,60 @@ pprArgInst (EValArgQL { eaql_tc_fun = fun, eaql_args = args, eaql_res_rho = ty})
2 (vcat [ vcat (map pprArgInst args), text "ea_ql_ty:" <+> ppr ty ])
instance Outputable EWrap where
- ppr (EPar _) = text "EPar"
- ppr (EHsWrap w) = text "EHsWrap" <+> ppr w
- ppr (EExpand orig) = text "EExpand" <+> ppr orig
+ ppr (EPar _) = text "EPar"
+ ppr (EHsWrap w) = text "EHsWrap" <+> ppr w
+ ppr (EExpand _ _) = text "EExpand" -- No Outputable instance for HsCtxt yet
+
+
+
+{- *********************************************************************
+* *
+ Splitting and rebuilding
+* *
+********************************************************************* -}
+
+splitHsApps :: HsExpr GhcRn -> TcM (HsExpr GhcRn, [HsExprArg 'TcpRn])
+splitHsApps e = go e []
+ where
+ go (HsPar _ (L l fun)) args = go fun (EWrap (EPar l) : args)
+ go (HsPragE _ p (L l fun)) args = go fun (EPrag l p : args)
+ go (HsAppType _ (L l fun) ty) args = go fun (mkETypeArg l ty : args)
+ go (HsApp _ (L l fun) arg) args = go fun (mkEValArg l arg : args)
+ go fun args = do { mb_hse <- tcExpand fun
+ ; case mb_hse of
+ Just (HSE { hse_ctxt = orig, hse_exp = L l fun' })
+ -> go fun' (EWrap (EExpand l orig) : args)
+ Nothing
+ -> return (fun, args) }
+
+-- | Rebuild an application: takes a type-checked application head
+-- expression together with arguments in the form of typechecked 'HsExprArg's
+-- and returns a typechecked application of the head to the arguments.
+rebuildHsApps :: HsExpr GhcTc
+ -- ^ the function being applied
+ -> [HsExprArg 'TcpTc]
+ -- ^ the arguments to the function
+ -> HsExpr GhcTc
+rebuildHsApps fun [] = fun
+rebuildHsApps fun (arg : args)
+ = case arg of
+ EValArg { ea_arg = arg, ea_loc_span = l }
+ -> rebuildHsApps (HsApp noExtField (L l fun) arg) args
+ ETypeArg { ea_hs_ty = hs_ty, ea_ty_arg = ty, ea_loc_span = l }
+ -> rebuildHsApps (HsAppType ty (L l fun) hs_ty) args
+ EPrag l p
+ -> rebuildHsApps (HsPragE noExtField p (L l fun)) args
+ EWrap (EPar l)
+ -> rebuildHsApps (HsPar noExtField (L l fun)) args
+ EWrap (EExpand l o)
+ -> rebuildHsApps (XExpr (ExpandedThingTc (HSE o (L l fun)))) args
+ EWrap (EHsWrap wrap)
+ -> rebuildHsApps (mkHsWrap wrap fun) args
+
{- Note [Desugar OpApp in the typechecker]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Operator sections are desugared in the renamer; see GHC.Rename.Expr
+pOperator sections are desugared in the renamer; see GHC.Rename.Expr
Note [Handling overloaded and rebindable constructs].
But for reasons explained there, we rename OpApp to OpApp. Then,
here in the typechecker, we desugar it to a use of ExpandedThingRn.
@@ -401,6 +390,8 @@ handling splices and quasiquotes has already been performed by the renamer by
the time we get to `splitHsApps`.
Wrinkle (UTS1):
+*** TODO *** put this somewhere else
+
`tcExpr` has a separate case for `HsUntypedSplice`s that do /not/ occur at the
head of an application. This is important to handle programs like this one:
@@ -446,9 +437,7 @@ tcInferAppHead (fun,fun_lspan)
do { mb_tc_fun <- tcInferAppHead_maybe fun
; case mb_tc_fun of
Just (fun', fun_sigma) -> return (fun', fun_sigma)
- Nothing -> runInferRho (tcExpr fun)
-
- }
+ Nothing -> runInferRho (tcExpr fun) }
tcInferAppHead_maybe :: HsExpr GhcRn
-> TcM (Maybe (HsExpr GhcTc, TcSigmaType))
@@ -457,23 +446,11 @@ tcInferAppHead_maybe :: HsExpr GhcRn
-- 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 <$> tcInferId nm
- ExprWithTySig _ e hs_ty
- -> Just <$>tcExprWithSig e hs_ty
- HsOverLit _ lit
- -> Just <$> tcInferOverLit lit
- XExpr (HsRecSelRn f)
- -> Just <$> tcInferRecSelId f
- XExpr (ExpandedThingRn (HSE o (L loc e)))
- -> setSrcSpan (locA loc) $ Just <$>
- do { (e', ty) <- tcExprSigma False (hsCtxtCtOrigin o) e
- ; return (mkExpandedTc o (L loc e'), ty) }
- -- We do not want to instantiate the type of the head as there may be
- -- visible type applications in the argument.
- -- c.f. T19167
- _
- -> return Nothing
+ HsVar _ nm -> Just <$> tcInferId nm
+ ExprWithTySig _ e hs_ty -> Just <$> tcExprWithSig e hs_ty
+ HsOverLit _ lit -> Just <$> tcInferOverLit lit
+ XExpr (HsRecSelRn f) -> Just <$> tcInferRecSelId f
+ _ -> return Nothing
{- *********************************************************************
* *
=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -219,10 +219,10 @@ tcMatches :: (AnnoBody body, Outputable (body GhcTc))
-> MatchGroup GhcRn (LocatedA (body GhcRn))
-> TcM (MatchGroup GhcTc (LocatedA (body GhcTc)))
-tcMatches ctxt tc_body pat_tys rhs_ty (MG { mg_alts = L l matches
+tcMatches ctxt tc_body pat_tys exp_ty (MG { mg_alts = L l matches
, mg_ext = origin })
| null matches -- Deal with case e of {}
- -- Since there are no branches, no one else will fill in rhs_ty
+ -- Since there are no branches, no one else will fill in exp_ty
-- when in inference mode, so we must do it ourselves,
-- here, using expTypeToType
= do { tcEmitBindingUsage bottomUE
@@ -233,17 +233,19 @@ tcMatches ctxt tc_body pat_tys rhs_ty (MG { mg_alts = L l matches
[ExpForAllPatTy tvb] -> failWithTc $ TcRnEmptyCase ctxt (EmptyCaseForall tvb)
[] -> panic "tcMatches: no arguments in EmptyCase"
_t1:(_t2:_ts) -> panic "tcMatches: multiple arguments in EmptyCase"
- ; rhs_ty <- expTypeToType rhs_ty
+ ; rhs_ty <- expTypeToType exp_ty
; return (MG { mg_alts = L l []
, mg_ext = MatchGroupTc [pat_ty] rhs_ty origin
}) }
| otherwise
- = do { umatches <- mapM (tcCollectingUsage . tcMatch tc_body pat_tys rhs_ty) matches
- ; let (usages, matches') = unzip umatches
+ = do { let exp_ty' = adjustExpTypeForCaseBranches exp_ty matches
+ tc_match match = tcCollectingUsage $
+ tcMatch tc_body pat_tys exp_ty' match
+ ; (usages, matches') <- mapAndUnzipM tc_match matches
; tcEmitBindingUsage $ supUEs usages
; pat_tys <- mapM readScaledExpType (filter_out_forall_pat_tys pat_tys)
- ; rhs_ty <- readExpType rhs_ty
+ ; rhs_ty <- readExpType exp_ty
; traceTc "tcMatches" (ppr matches' $$ ppr pat_tys $$ ppr rhs_ty)
; return (MG { mg_alts = L l matches'
, mg_ext = MatchGroupTc pat_tys rhs_ty origin
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -63,7 +63,7 @@ module GHC.Tc.Utils.TcMType (
mkCheckExpType, newInferExpType, newInferExpTypeFRR,
runInfer, runInferRho, runInferSigma, runInferKind, runInferRhoFRR, runInferSigmaFRR,
readExpType, readExpType_maybe, readScaledExpType,
- expTypeToType, scaledExpTypeToType,
+ expTypeToType, scaledExpTypeToType, adjustExpTypeForCaseBranches,
checkingExpType_maybe, checkingExpType,
inferResultToType, ensureMonoType, promoteTcType,
@@ -499,6 +499,17 @@ inferResultToType (IR { ir_uniq = u, ir_lvl = tc_lvl
; let conc_orig = ConcreteFRR $ FixedRuntimeRepOrigin tau frr
; return tau }
+adjustExpTypeForCaseBranches :: ExpRhoType -> [branch] -> ExpRhoType
+-- See Note [fillInferResult: multiple branches]
+adjustExpTypeForCaseBranches exp_ty branches
+ = case exp_ty of
+ Infer ir | IR { ir_inst = IIF_Sigma } <- ir
+ , branches `lengthAtLeast` 2
+ -> Infer (ir { ir_inst = IIF_DeepRho })
+ | otherwise
+ -> exp_ty
+ Check {} -> exp_ty
+
{- Note [inferResultToType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
expTypeToType and inferResultType convert an InferResult to a monotype.
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -99,13 +99,12 @@ import qualified GHC.LanguageExtensions as LangExt
import GHC.Builtin.Types
import GHC.Types.Name
-import GHC.Types.Id( idType, isDataConId )
+import GHC.Types.Id( idType )
import GHC.Types.Var as Var
import GHC.Types.Var.Set
import GHC.Types.Var.Env
import GHC.Types.Basic
import GHC.Types.Unique.Set (nonDetEltsUniqSet)
-import GHC.Types.SrcLoc (unLoc, GenLocated (..))
import GHC.Utils.Misc
import GHC.Utils.Outputable as Outputable
@@ -426,7 +425,7 @@ Some examples:
tcSkolemiseGeneral
:: HasDebugCallStack
- => DeepSubsumptionFlag
+ => DeepSubsumptionFlag -- Ignores the DeepSubsumptionDepth
-> UserTypeCtxt
-> TcType -> TcType -- top_ty and expected_ty
-- Here, top_ty is the type we started to skolemise; used only in SigSkol
@@ -1169,7 +1168,7 @@ fillInferResultNoInst act_res_ty (IR { ir_uniq = u
; return final_co } }
-fillInferResult :: DeepSubsumptionFlag -> CtOrigin -> TcType -> InferResult -> TcM HsWrapper
+fillInferResult :: DeepSubsumptionFlag -> CtOrigin -> TcSigmaType -> InferResult -> TcM HsWrapper
-- See Note [Instantiation of InferResult]
fillInferResult ds_flag ct_orig res_ty ires@(IR { ir_inst = iif })
= case iif of
@@ -1203,7 +1202,7 @@ There are two things to worry about:
T1 -> e1
T2 -> e2
-Our typing rules are:
+In general our typing rules are:
* The RHS of a existential or GADT alternative must always be a
monotype, regardless of the number of alternatives.
@@ -1218,17 +1217,13 @@ Our typing rules are:
We use choice (2) in that Section.
(GHC 8.10 and earlier used choice (1).)
- But note that
- case e of
- True -> hr
- False -> \x -> hr x
- will fail, because we still /infer/ both branches, so the \x will get
- a (monotype) unification variable, which will fail to unify with
- (forall a. a->a)
+Note [fillInferResult: GADTs and existentials]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We can detect the GADT/existential situation, case (1) of Note [fillInferResult],
+by seeing that the current TcLevel is greater than that stored in ir_lvl of the
+Infer ExpType. We bump the level whenever we go past a GADT/existential match.
-For (1) we can detect the GADT/existential situation by seeing that
-the current TcLevel is greater than that stored in ir_lvl of the Infer
-ExpType. We bump the level whenever we go past a GADT/existential match.
+We insist that the RHS has a monotype, regardless of the number of alternatives.
Then, before filling the hole use promoteTcType to promote the type
to the outer ir_lvl. promoteTcType does this
@@ -1239,11 +1234,6 @@ That forces the type to be a monotype (since unification variables can
only unify with monotypes); and catches skolem-escapes because the
alpha is untouchable until the equality floats out.
-For (2), we simply look to see if the hole is filled already.
- - if not, we promote (as above) and fill the hole
- - if it is filled, we simply unify with the type that is
- already there
-
(FIR1) There is one wrinkle. Suppose we have
case e of
T1 -> e1 :: (forall a. a->a) -> Int
@@ -1258,7 +1248,47 @@ For (2), we simply look to see if the hole is filled already.
So if we check G2 second, we still want to emit a constraint that restricts
the RHS to be a monotype. This is done by ensureMonoType, and it works
by simply generating a constraint (alpha ~ ty), where alpha is a fresh
-unification variable. We discard the evidence.
+ unification variable. We discard the evidence.
+
+Note [fillInferResult: multiple branches]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If there are multiple case branches, case (2) of Note [fillInferResult]
+we simply look to see if the hole is filled already.
+ - if not, we promote (as above) and fill the hole
+ - if it is filled, we simply unify with the type that is already there
+
+But consider
+ case x of
+ True -> True
+ False -> undefined
+and suppose we call `tcInferSigma` on this expression, so that the `ir_inst`
+field of the expected result type is `IIF_Sigma`. The danger is that we'll
+fill the hole with `Bool` (from the `True`) and then reject when we try to
+unify that with `forall a. a->a`, from the call to `undefined`.
+
+Another example:
+ case x of
+ True -> (e1 :: forall a b. a->b)
+ False -> (e3 :: forall b a. a->b)
+
+To avoid this, we never infer a sigma-type from a multi-branch `case`. Instead
+we just zap the `IIF_Sigma` to `IIF_DeepRho` when walking inside the branches
+of multi-arm case-expression, or an if-expression. See calls to
+`adjustExpTypeForCaseBranches`.
+
+This does mean that this would work:
+ (let x = 77+55 in h x x) @Int
+where
+ h :: Int -> Int -> forall a. a->a
+The `@Int` would instantiate the `forall a`.
+
+Note that
+ case e of
+ True -> hr
+ False -> \x -> hr x
+ where hr :: (forall a. a->a) -> Int
+will fail, because we still /infer/ both branches, so the \x will get a
+(monotype) unification variable, which will fail to unify with (forall a. a->a)
Note [Instantiation of InferResult]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1274,7 +1304,7 @@ Usually this field is `IIF_DeepRho` meaning "return a (possibly deep) rho-type".
Why is this the common case? See #17173 for discussion. Here are some examples
of why:
-1. Consider
+(IIR1) Consider
f x = (*)
We want to instantiate the type of (*) before returning, else we
will infer the type
@@ -1286,21 +1316,46 @@ of why:
instantiating. This could perhaps be worked around, but it may be
hard to know even when instantiation should happen.
-2. Another reason. Consider
+(IIR2) Another reason. Consider
f :: (?x :: Int) => a -> a
g y = let ?x = 3::Int in f
Here want to instantiate f's type so that the ?x::Int constraint
gets discharged by the enclosing implicit-parameter binding.
-3. Suppose one defines plus = (+). If we instantiate lazily, we will
+(IIR3) Suppose one defines plus = (+). If we instantiate lazily, we will
infer plus :: forall a. Num a => a -> a -> a. However, the monomorphism
restriction compels us to infer
plus :: Integer -> Integer -> Integer
(or similar monotype). Indeed, the only way to know whether to apply
the monomorphism restriction at all is to instantiate
-HOWEVER, not always! Here are places where we want `IIF_Sigma` meaning
-"return a sigma-type":
+(IIR4) When -XDeepSubsumption is on, we /deeply/ instantiate. Why isn't
+ top-instantiation enough? Answer: to accept the following program (T26225b) with
+ -XDeepSubsumption, we need to deeply instantiate when inferring in checkResultTy:
+
+ f :: Int -> (forall a. a->a)
+ g :: Int -> Bool -> Bool
+
+ test b = case b of
+ True -> f
+ False -> g
+
+ If we don't deeply instantiate in the branches of the case expression, we will
+ try to unify the type of `f` with that of `g`, which fails. If we instead
+ deeply instantiate `f`, we will fill the `InferResult` with `Int -> alpha -> alpha`
+ which then successfully unifies with the type of `g` when we come to fill the
+ `InferResult` hole a second time for the second case branch.
+
+(IIR5) When inferring, even /without/ -XDeepSubsumption, we must deeply instantiate
+ the types of data constructors. E.g
+ data T = MkT Int int
+ f = MkT 3
+ We must infer MkT 3 :: Int ->{mu} T (fresh mu)
+ and not MkT 3 :: Int ->{one} T
+ See Note [Typechecking data constructors] in GHC.Tc.Gen.Head
+ Hence the use of `getDeepSubsumptionFlag_DataConHead` in `checkResultTy`.
+
+HOWEVER, `ir_inst` is not always `IIF_DeepRho`! Here are places when it isn't:
* IIF_Sigma: In GHC.Tc.Module.tcRnExpr, which implements GHCi's :type
command, we want to return a completely uninstantiated type.
@@ -1316,23 +1371,6 @@ HOWEVER, not always! Here are places where we want `IIF_Sigma` meaning
but /not/ deeply instantiate (#26331). See Note [View patterns and polymorphism]
in GHC.Tc.Gen.Pat. This the only place we use IIF_ShallowRho.
-Why do we want to deeply instantiate, ever? Why isn't top-instantiation enough?
-Answer: to accept the following program (T26225b) with -XDeepSubsumption, we
-need to deeply instantiate when inferring in checkResultTy:
-
- f :: Int -> (forall a. a->a)
- g :: Int -> Bool -> Bool
-
- test b =
- case b of
- True -> f
- False -> g
-
-If we don't deeply instantiate in the branches of the case expression, we will
-try to unify the type of 'f' with that of 'g', which fails. If we instead
-deeply instantiate 'f', we will fill the 'InferResult' with 'Int -> alpha -> alpha'
-which then successfully unifies with the type of 'g' when we come to fill the
-'InferResult' hole a second time for the second case branch.
-}
{-
@@ -2068,24 +2106,14 @@ getDeepSubsumptionFlag =
-- | Variant of 'getDeepSubsumptionFlag' which enables a top-level subsumption
-- in order to implement the plan of Note [Typechecking data constructors].
getDeepSubsumptionFlag_DataConHead :: HsExpr GhcTc -> TcM DeepSubsumptionFlag
-getDeepSubsumptionFlag_DataConHead app_head =
- do { user_ds <- xoptM LangExt.DeepSubsumption
- ; traceTc "getDeepSubsumptionFlag_DataConHead" (ppr app_head)
- ; return $
- if | user_ds
- -> Deep DeepSub
- | otherwise
- -> go app_head
- }
+getDeepSubsumptionFlag_DataConHead app_head
+ = do { user_ds <- xoptM LangExt.DeepSubsumption
+ ; return $ if | user_ds -> Deep DeepSub
+ | dc_head app_head -> Deep TopSub
+ | otherwise -> Shallow }
where
- go :: HsExpr GhcTc -> DeepSubsumptionFlag
- go (XExpr (ConLikeTc (RealDataCon {}))) = Deep TopSub
- go (XExpr (ExpandedThingTc (HSE _ (L _ f)))) = go f
- go (XExpr (WrapExpr _ f)) = go f
- go (HsApp _ f _) = go (unLoc f)
- go (HsAppType _ f _) = go (unLoc f)
- go _ = Shallow
-
+ dc_head (XExpr (ConLikeTc (RealDataCon {}))) = True
+ dc_head _ = False
-- | 'tc_sub_type_deep' is where the actual work happens for deep subsumption.
--
=====================================
compiler/ghc.cabal.in
=====================================
@@ -832,6 +832,7 @@ Library
GHC.Tc.Gen.Bind
GHC.Tc.Gen.Default
GHC.Tc.Gen.Do
+ GHC.Tc.Gen.Expand
GHC.Tc.Gen.Export
GHC.Tc.Gen.Expr
GHC.Tc.Gen.Foreign
=====================================
testsuite/tests/partial-sigs/should_compile/SplicesUsed.stderr
=====================================
@@ -1,6 +1,5 @@
[1 of 2] Compiling Splices ( Splices.hs, Splices.o )
[2 of 2] Compiling SplicesUsed ( SplicesUsed.hs, SplicesUsed.o )
-
SplicesUsed.hs:7:15: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefault)]
• Found type wildcard ‘_’ standing for ‘Maybe Bool’
• In the type signature: maybeBool :: _
@@ -21,8 +20,7 @@ SplicesUsed.hs:8:26: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefau
• Found type wildcard ‘_’ standing for ‘Bool’
• In the first argument of ‘Maybe’, namely ‘_’
In an expression type signature: Maybe _
- In the first argument of ‘id :: _a -> _a’, namely
- ‘(Just True :: Maybe _)’
+ In the expression: Just True :: Maybe _
• Relevant bindings include
maybeBool :: Maybe Bool (bound at SplicesUsed.hs:8:1)
@@ -78,3 +76,4 @@ SplicesUsed.hs:18:2: warning: [GHC-88464] [-Wpartial-type-signatures (in -Wdefau
the inferred type of bar :: Bool -> w -> (Bool, w)
at SplicesUsed.hs:18:2-11
• In the type signature: bar :: _a -> _b -> (_a, _b)
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a091fcbb975d514542e66e4d456bb99…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a091fcbb975d514542e66e4d456bb99…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T27078] 48 commits: rts: fix -Wcompare-distinct-pointer-types errors
by Simon Peyton Jones (＠simonpj) 01 Apr '26
by Simon Peyton Jones (＠simonpj) 01 Apr '26
01 Apr '26
Simon Peyton Jones pushed to branch wip/T27078 at Glasgow Haskell Compiler / GHC
Commits:
de54e264 by Cheng Shao at 2026-03-21T17:52:08+01:00
rts: fix -Wcompare-distinct-pointer-types errors
This commit fixes `-Wcompare-distinct-pointer-types` errors in the RTS
which should have been caught by the `validate` flavour but was
warnings in CI due to the recent `+werror` regression.
- - - - -
b9bd73de by Cheng Shao at 2026-03-21T17:52:08+01:00
ghc-internal: fix unused imports
This commit fixes unused imports in `ghc-internal` which should have
been caught by the `validate` flavour but was warnings in CI due to
the recent `+werror` regression. Fixes #26987 #27059.
- - - - -
da946a16 by Cheng Shao at 2026-03-21T17:03:51+00:00
ghci: fix unused imports
This commit fixes unused imports in `ghci` which should have been
caught by the `validate` flavour but was warnings in CI due to the
recent `+werror` regression. Fixes #26987 #27059.
- - - - -
955b1cf8 by Cheng Shao at 2026-03-21T17:03:51+00:00
compiler: fix unused imports in GHC.Tc.Types.Origin
This commit fixes unused imports in `GHC.Tc.Types.Origin` which should
have been caught by the `validate` flavour but was warnings in CI due
to the recent `+werror` regression. Fixes #27059.
- - - - -
3b1aeb50 by Cheng Shao at 2026-03-21T17:03:51+00:00
hadrian: fix missing +werror in validate flavour
This patch fixes missing `+werror` in validate flavour, which was an
oversight in bb3a2ba1eefadf0b2ef4f39b31337a23eec67f29. Fixes #27066.
- - - - -
44f118f0 by Cheng Shao at 2026-03-22T04:54:01-04:00
ci: bump CACHE_REV and add the missing reminder
This patch bumps `CACHE_REV` to address recent `[Cabal-7159]` CI
errors due to stale cabal cache on some runners, and also adds a
reminder to remind future maintainers. Fixes #27075.
- - - - -
2a218737 by ARATA Mizuki at 2026-03-23T11:11:39-04:00
Add 128-bit SIMD support to AArch64 NCG
Changes:
- Add `Format` field to vector-capable instructions.
These instructions will emit `vN.4s` (for example) as a operand.
- Additional constructors for `Operand`:
`OpVecLane` represents a vector lane and will be emitted as `vN.<width>[<index>]` (`vN.s[3]` for example).
`OpScalarAsVec` represents a scalar, but printed as a vector lane like `vN.<width>[0]` (`vN.s[0]` for example).
- Integer quot/rem are implemented in C, like x86.
Closes #26536
Metric Increase:
T3294
- - - - -
5d6e2be9 by ARATA Mizuki at 2026-03-23T11:11:39-04:00
AArch64 NCG: Improve code generation for floating-point and vector constants
Some floating-point constants can be directly encoded using the FMOV instruction.
Similarly, a class of vectors with same values can be encoded using FMOV, MOVI, or MVNI.
- - - - -
c6d262aa by Simon Jakobi at 2026-03-23T11:12:22-04:00
Add regression test for #13729
Closes #13729.
- - - - -
aa5dfe67 by Sylvain Henry at 2026-03-26T03:48:56-04:00
Check that shift values are valid
In GHC's codebase in non-DEBUG builds we silently substitute shiftL/R
with unsafeShiftL/R for performance reasons. However we were not
checking that the shift value was valid for unsafeShiftL/R, leading to
wrong computations, but only in non-DEBUG builds.
This patch adds the necessary checks and reports an error when a wrong
shift value is passed.
- - - - -
c8a7b588 by Sylvain Henry at 2026-03-26T03:48:56-04:00
Implement basic value range analysis (#25718)
Perform basic value range analysis to try to determine at compile time
the result of the application of some comparison primops (ltWord#, etc.).
This subsumes the built-in rewrite rules used previously to check if one
of the comparison argument was a bound (e.g. (x :: Word8) <= 255 is
always True). Our analysis is more powerful and handles type
conversions: e.g. word8ToWord x <= 255 is now detected as always True too.
We also use value range analysis to filter unreachable alternatives in
case-expressions. To support this, we had to allow case-expressions for
primitive types to not have a DEFAULT alternative (as was assumed before
and checked in Core lint).
- - - - -
a5ec467e by ARATA Mizuki at 2026-03-26T03:49:49-04:00
rts: Align stack to 64-byte boundary in StgRun on x86
When LLVM spills AVX/AVX-512 vector registers to the stack, it requires
32-byte (__m256) or 64-byte (__m512) alignment. If the stack is not
sufficiently aligned, LLVM inserts a realignment prologue that reserves
%rbp as a frame pointer, conflicting with GHC's use of %rbp as an STG
callee-saved register and breaking the tail-call-based calling convention.
Previously, GHC worked around this by lying to LLVM about the stack
alignment and rewriting aligned vector loads/stores (VMOVDQA, VMOVAPS)
to unaligned ones (VMOVDQU, VMOVUPS) in the LLVM Mangler. This had two
problems:
- It did not extend to AVX-512, which requires 64-byte alignment. (#26595)
- When Haskell calls a C function that takes __m256/__m512 arguments on
the stack, the callee requires genuine alignment, which could cause a
segfault. (#26822)
This patch genuinely aligns the stack to 64 bytes in StgRun by saving
the original stack pointer before alignment and restoring it in
StgReturn. We now unconditionally advertise 64-byte stack alignment to
LLVM for all x86 targets, making rewriteAVX in the LLVM Mangler
unnecessary. STG_RUN_STACK_FRAME_SIZE is increased from 48 to 56 bytes
on non-Windows x86-64 to store the saved stack pointer.
Closes #26595 and #26822
Co-Authored-By: Claude Opus 4.5 <noreply(a)anthropic.com>
- - - - -
661da815 by Teo Camarasu at 2026-03-26T03:50:33-04:00
ghc-internal: Float Generics to near top of module graph
We remove GHC.Internal.Generics from the critical path of the
`ghc-internal` module graph. GHC.Internal.Generics used to be in the
middle of the module graph, but now it is nearer the top (built later).
This change thins out the module graph and allows us to get rid of the
ByteOrder hs-boot file.
We implement this by moving Generics instances from the module where the
datatype is defined to the GHC.Internal.Generics module. This trades off
increasing the compiled size of GHC.Internal.Generics with reducing the
dependency footprint of datatype modules.
Not all instances are moved to GHC.Internal.Generics. For instance,
`GHC.Internal.Control.Monad.Fix` keeps its instance as it is one of the
very last modules compiled in `ghc-internal` and so inverting the
relationship here would risk adding GHC.Internal.Generics back onto the
critical path.
We also don't change modules that are re-exported from the `template-haskell` or `ghc-heap`.
This is done to make it easy to eventually move `Generics` to `base`
once something like #26657 is implemented.
Resolves #26930
Metric Decrease:
T21839c
- - - - -
45428f88 by sheaf at 2026-03-26T03:51:31-04:00
Avoid infinite loop in deep subsumption
This commit ensures we only unify after we recur in the deep subsumption
code in the FunTy vs non-FunTy case of GHC.Tc.Utils.Unify.tc_sub_type_deep,
to avoid falling into an infinite loop.
See the new Wrinkle [Avoiding a loop in tc_sub_type_deep] in
Note [FunTy vs non-FunTy case in tc_sub_type_deep] in GHC.Tc.Utils.Unify.
Fixes #26823
Co-authored-by: simonpj <simon.peytonjones(a)gmail.com>
- - - - -
2823b039 by Ian Duncan at 2026-03-26T03:52:21-04:00
AArch64: fix MOVK regUsageOfInstr to mark dst as both read and written
MOVK (move with keep) modifies only a 16-bit slice of the destination
register, so the destination is both read and written. The register
allocator must know this to avoid clobbering live values. Update
regUsageOfInstr to list the destination in both src and dst sets.
No regression test: triggering the misallocation requires specific
register pressure around a MOVK sequence, which is difficult to
reliably provoke from Haskell source.
- - - - -
57b7878d by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #12002
Closes #12002.
- - - - -
c8f9df2d by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #12046
Closes #12046.
Co-authored-by: Andreas Klebinger <klebinger.andreas(a)gmx.at>
- - - - -
615d72ac by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #13180
Closes #13180.
- - - - -
423eebcf by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #11141
Closes #11141.
- - - - -
286849a4 by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #11505
Closes #11505.
- - - - -
7db149d9 by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression perf test for #13820
Closes #13820.
- - - - -
e73c4adb by Simon Jakobi at 2026-03-26T03:53:07-04:00
Add regression test for #10381
Closes #10381.
- - - - -
5ebcfb57 by Benjamin Maurer at 2026-03-26T03:54:02-04:00
Generate assembly on x86 for word2float (#22252)
We used to emit C function call for MO_UF_Conv primitive.
Now emits direct assembly instead.
Co-Authored-By: Sylvain Henry <sylvain(a)haskus.fr>
Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com>
- - - - -
5b550754 by Matthew Pickering at 2026-03-26T03:54:51-04:00
rts: forward clone-stack messages after TSO migration
MSG_CLONE_STACK assumed that the target TSO was still owned by the
capability that received the message. This is not always true: the TSO
can migrate before the inbox entry is handled.
When that happened, handleCloneStackMessage could clone a live stack from
the wrong capability and use the wrong capability for allocation and
performTryPutMVar, leading to stack sanity failures such as
checkStackFrame: weird activation record found on stack.
Fix this by passing the current capability into
handleCloneStackMessage, rechecking msg->tso->cap at handling time, and
forwarding the message if the TSO has migrated. Once ownership matches,
use the executing capability consistently for cloneStack, rts_apply, and
performTryPutMVar.
Fixes #27008
- - - - -
ef0a1bd2 by mangoiv at 2026-03-26T03:55:34-04:00
release tracking: adopt release tracking ticket from #16816
- - - - -
a7f40fd9 by mangoiv at 2026-03-26T03:55:34-04:00
release tracking: add a release tracking ticket
Brings the information in the release tracking ticket up to date with
https://gitlab.haskell.org/ghc/ghc-hq/-/blob/main/release-management.mkd
Resolves #26691
- - - - -
161d3285 by Teo Camarasu at 2026-03-26T03:56:18-04:00
Revert "Set default eventlog-flush-interval to 5s"
Flushing the eventlog forces a synchronisation of all the capabilities
and there was a worry that this might lead to a performance cost for
some highly parallel workloads.
This reverts commit 66b96e2a591d8e3d60e74af3671344dfe4061cf2.
- - - - -
36eed985 by Cheng Shao at 2026-03-26T03:57:03-04:00
ghc-boot: move GHC.Data.SmallArray to ghc-boot
This commit moves `GHC.Data.SmallArray` from the `ghc` library to
`ghc-boot`, so that it can be used by `ghci` as well:
- The `Binary` (from `ghc`) instance of `SmallArray` is moved to
`GHC.Utils.Binary`
- Util functions `replicateSmallArrayIO`, `mapSmallArrayIO`,
`mapSmallArrayM_`, `imapSmallArrayM_` , `smallArrayFromList` and
`smallArrayToList` are added
- The `Show` instance is added
- The `Binary` (from `binary`) instance is added
- - - - -
fdf828ae by Cheng Shao at 2026-03-26T03:57:03-04:00
compiler: use `Binary` instance of `BCOByteArray` for bytecode objects
This commit defines `Binary` (from `compiler`) instance of
`BCOByteArray` which serializes the underlying buffer directly, and
uses it directly in bytecode object serialization. Previously we reuse
the `Binary` (from `binary`) instance, and this change allows us to
avoid double-copying via an intermediate `ByteString` when using
`put`/`get` in `binnary`. Also see added comment for explanation.
- - - - -
3bf62d0a by Cheng Shao at 2026-03-26T03:57:03-04:00
ghci: use SmallArray directly in ResolvedBCO
This patch makes ghci use `SmallArray` directly in `ResolvedBCO` when
applicable, making the memory representation more compact and reducing
marshaling overhead. Closes #27058.
- - - - -
3d6492ce by Wen Kokke at 2026-03-26T03:57:53-04:00
Fix race condition between flushEventLog and start/endEventLogging.
This commit changes `flushEventLog` to acquire/release the `state_change` mutex to prevent interleaving with `startEventLogging` and `endEventLogging`. In the current RTS, `flushEventLog` _does not_ acquire this mutex, which may lead to eventlog corruption on the following interleaving:
- `startEventLogging` writes the new `EventLogWriter` to `event_log_writer`.
- `flushEventLog` flushes some events to `event_log_writer`.
- `startEventLogging` writes the eventlog header to `event_log_writer`.
This causes the eventlog to be written out in an unreadable state, with one or more events preceding the eventlog header.
This commit renames the old function to `flushEventLog_` and defines `flushEventLog` simply as:
```c
void flushEventLog(Capability **cap USED_IF_THREADS)
{
ACQUIRE_LOCK(&state_change_mutex);
flushEventLog_(cap);
RELEASE_LOCK(&state_change_mutex);
}
```
The old function is still needed internally within the compilation unit, where it is used in `endEventLogging` in a context where the `state_change` mutex has already been acquired. I've chosen to mark `flushEventLog_` as static and let other uses of `flushEventLog` within the RTS refer to the new version. There is one use in `hs_init_ghc` via `flushTrace`, where the new locking behaviour should be harmless, and one use in `handle_tick`, which I believe was likely vulnerable to the same race condition, so the new locking behaviour is desirable.
I have not added a test. The behaviour is highly non-deterministic and requires a program that concurrently calls `flushEventLog` and `startEventLogging`/`endEventLogging`. I encountered the issue while developing `eventlog-socket` and within that context have verified that my patch likely addresses the issue: a test that used to fail within the first dozen or so runs now has been running on repeat for several hours.
- - - - -
7b9a75f0 by Phil Hazelden at 2026-03-26T03:58:37-04:00
Fix build with werror on glibc 2.43.
We've been defining `_XOPEN_SOURCE` and `_POSIX_C_SOURCE` to the same
values as defined in glibc prior to 2.43. But in 2.43, glibc changes
them to new values, which means we get a warning when redefining them.
By `#undef`ing them first, we no longer get a warning.
Closes #27076.
- - - - -
fe6e76c5 by Tobias Haslop at 2026-03-26T03:59:30-04:00
Fix broken Haddock link to Bifunctor class in description of Functor class
- - - - -
404b71c1 by Luite Stegeman at 2026-03-27T04:40:49-04:00
Fix assert in Interpreter.c
If we skip exactly the number of words on the stack we end up on
the first word in the next chunk.
- - - - -
a85bd503 by Luite Stegeman at 2026-03-27T04:40:49-04:00
Support arbitrary size unboxed tuples in bytecode
This stores the size (number of words on the stack) of the next
expected tuple in the TSO, ctoi_spill_size field, eliminating
the need of stg_ctoi_tN frames for each size.
Note: On 32 bit platform there is still a bytecode tuple size
limit of 255 words on the stack.
Fixes #26946
- - - - -
e2209031 by Luite Stegeman at 2026-03-27T04:40:49-04:00
Add specialized frames for small tuples
Small tuples are now returned more efficiently to the interpreter.
They use one less word of stack space and don't need manipulation
of the TSO anymore.
- - - - -
b26bb2ea by VeryMilkyJoe at 2026-03-27T04:41:38-04:00
Remove backwards compatibility pattern synonym `ModLocation`
Fixes #24932
- - - - -
66e5e324 by Vladislav Zavialov at 2026-03-27T04:42:25-04: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 T26967_tyop
- - - - -
f8de456f by Sylvain Henry at 2026-03-27T04:43:22-04:00
STM: don't create a transaction in the rhs of catchRetry# (#26028)
We don't need to create a transaction for the rhs of (catchRetry#)
because contrary to the lhs we don't need to abort it on retry. Moreover
it is particularly harmful if we have code such as (#26028):
let cN = readTVar vN >> retry
tree = c1 `orElse` (c2 `orElse` (c3 `orElse` ...))
atomically tree
Because it will stack transactions for the rhss and the read-sets of all
the transactions will be iteratively merged in O(n^2) after the
execution of the most nested retry.
This is the second attempt at implementing this. The first attempt
triggered segfaults (#26291) and has been reverted.
Co-Authored-By: Claude Sonnet 4.6 <noreply(a)anthropic.com>
- - - - -
fcf092dd by Luite Stegeman at 2026-03-27T04:44:17-04:00
Windows: remove StgAsyncIOResult and fix crash/leaks
In stg_block_async{_void}, a stack slot was reserved for
an StgAsyncIOResult. This slot would be filled by the IO
manager upon completion of the async call.
However, if the blocked thread was interrupted by an async
exception, we would end up in an invalid state:
- If the blocked computation was never re-entered, the
StgAsyncIOResult would never be freed.
- If the blocked computation was re-entered, the thread would
find an unitialized stack slot for the StgAsyncIOResult,
leading to a crash reading its fields, or freeing the pointer.
We fix this by removing the StgAsyncIOResult altogether and writing
the result directly to the stack.
Fixes #26341
- - - - -
05094993 by Luite Stegeman at 2026-03-27T04:45:12-04:00
Don't refine DEFAULT alt for unary typeclasses
A non-DEFAULT data alt for a unary typeclass dictionary would
interfere with Unary Class Magic, leading to segfaults.
fixes #27071
- - - - -
4ee260cf by sheaf at 2026-03-27T04:46:06-04:00
Fix several oversights in hsExprType
This commit fixes several oversights in GHC.Hs.Syn.Type.hsExprType:
- The 'RecordCon' case was returning the type of the constructor,
instead of the constructor application. This is fixed by using
'splitFunTys'.
- The 'ExplicitTuple' case failed to take into account tuple sections,
and was also incorrectly handling 1-tuples (e.g. 'Solo') which can
be constructed using Template Haskell.
- The 'NegApp' case was returning the type of the negation operator,
again failing to apply it to the argument. Fixed by using
'funResultTy'.
- The 'HsProc' case was computing the result type of the arrow proc
block, without taking into account the argument type. Fix that by
adding a new field to 'CmdTopTc' that stores the arrow type, so that
we can construct the correct result type `arr a b` for
`proc (pat :: a) -> (cmd :: b)`.
- The 'ArithSeq' and 'NegApp' cases were failing to take into account
the result 'HsWrapper', which could e.g. silently drop casts.
This is fixed by introducing 'syntaxExpr_wrappedFunResTy' which, on
top of taking the result type, applies the result 'HsWrapper'.
These fixes are validated by the new GHC API test T26910.
Fixes #26910
- - - - -
e97232ce by Hai at 2026-03-27T04:47:04-04:00
Parser.y: avoid looking at token with QualifiedDo
This changes the behavior of 'hintQualifiedDo' so that the supplied
token is not inspected when the QualifiedDo language extension bit is
set.
- - - - -
9831385b by Vladislav Zavialov at 2026-03-27T17:22:30-04:00
Infix holes in types (#11107)
This patch introduces several improvements that follow naturally from
refactoring HsOpTy to represent the operator as an HsType, aligning it
with the approach taken by OpApp and HsExpr.
User-facing changes:
1. Infix holes (t1 `_` t2) are now permitted in types, following the
precedent set by term-level expressions.
Test case: T11107
2. Error messages for illegal promotion ticks are now reported at more
precise source locations.
Test case: T17865
Internal changes:
* The definition of HsOpTy now mirrors that of OpApp:
| HsOpTy (XOpTy p) (LHsType p) (LHsType p) (LHsType p)
| OpApp (XOpApp p) (LHsExpr p) (LHsExpr p) (LHsExpr p)
This moves us one step closer to unifying HsType and HsExpr.
* Ignoring locations,
the old pattern match (HsOpTy x prom lhs op rhs)
is now written as (HsOpTy x lhs (HsTyVar x' prom op) rhs)
but we also handle (HsOpTy x lhs (HsWildCardTy x') rhs)
Constructors other than HsTyVar and HsWildCardTy never appear
in the operator position.
* The various definitions across the compiler have been updated to work
with the new representation, drawing inspiration from the term-level
pipeline where appropriate. For example,
ppr_infix_ty <=> ppr_infix_expr
get_tyop <=> get_op
lookupTypeFixityRn <=> lookupExprFixityRn
(the latter is factored out from rnExpr)
Test cases: T11107 T17865
- - - - -
5b6757d7 by mangoiv at 2026-03-27T17:23:19-04:00
ci: build i386 non-validate for deb12
This is a small fix that will unlock ghcup metadata to run, i386 debian
12 was missing as a job.
- - - - -
196cc1fa by Simon Peyton Jones at 2026-03-30T12:45:45+01:00
Add Invariant (NoTypeShadowing) to Core
This commit addresses #26868, by adding
a new invariant (NoTypeShadowing) to Core.
See Note [No type-shadowing in Core] in GHC.Core
- - - - -
56ab30db by Simon Peyton Jones at 2026-03-30T12:51:31+01:00
Major refactor of free-variable functions
For some time we have had two free-variable mechanims for types:
* The "FV" mechanism, embodied in GHC.Utils.FV, which worked OK, but
was fragile where eta-expansion was concerned.
* The TyCoFolder mechanism, using a one-shot EndoOS accumulator
I finally got tired of this and refactored the whole thing, thereby
addressing #27080. Now we have
* `GHC.Types.Var.FV`, which has a composable free-variable result type,
very much in the spirit of the old `FV`, but much more robust.
(It uses the "one shot trick".)
* GHC.Core.TyCo.FVs now has just one technology for free variables.
All this led to a lot of renaming.
There are couple of error-message changes. The change in T18451
makes an already-poor error message even more mysterious. But
it really needs a separate look.
- - - - -
e2a965b2 by Simon Peyton Jones at 2026-04-01T15:38:53+01:00
Experiement wth killing off special treatment...
...of type lets in Lint,
* add special treatment of join points in OccurAnal
* special passs after the desugarer
* Worker-wrapper uses lambdas
- - - - -
349 changed files:
- .gitlab-ci.yml
- .gitlab/generate-ci/gen_ci.hs
- + .gitlab/issue_templates/release_tracking.md
- .gitlab/jobs.yaml
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/CodeGen.Platform.h
- compiler/GHC.hs
- compiler/GHC/ByteCode/Asm.hs
- compiler/GHC/ByteCode/Instr.hs
- compiler/GHC/ByteCode/Linker.hs
- compiler/GHC/ByteCode/Serialize.hs
- compiler/GHC/ByteCode/Types.hs
- compiler/GHC/Cmm/Node.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/AArch64/Regs.hs
- compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs
- compiler/GHC/CmmToAsm/X86/CodeGen.hs
- compiler/GHC/CmmToLlvm.hs
- compiler/GHC/CmmToLlvm/Config.hs
- compiler/GHC/CmmToLlvm/Mangler.hs
- compiler/GHC/Core.hs
- compiler/GHC/Core/Coercion.hs
- compiler/GHC/Core/FVs.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/ConstantFold.hs
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- + compiler/GHC/Core/Opt/Range.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/Subst.hs
- + compiler/GHC/Core/SubstTypeLets.hs
- compiler/GHC/Core/TyCo/FVs.hs
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCon.hs
- compiler/GHC/Core/Type.hs
- compiler/GHC/Core/Unify.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg/AddImplicitBinds.hs
- compiler/GHC/Driver/Config/CmmToLlvm.hs
- compiler/GHC/Driver/Config/Core/Lint.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Arrows.hs
- compiler/GHC/HsToCore/Binds.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/Syntax.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/Prelude/Basic.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Expr.hs-boot
- compiler/GHC/Rename/Fixity.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Lit.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Pat.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Rename/Splice.hs-boot
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/StgToByteCode.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToCmm/Utils.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Errors.hs
- compiler/GHC/Tc/Errors/Hole.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Gen/App.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Gen/HsType.hs
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Sig.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Instance/FunDeps.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/TcType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Validity.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Name/Set.hs
- + compiler/GHC/Types/Var/FV.hs
- compiler/GHC/Types/Var/Set.hs
- compiler/GHC/Unit/Module/Location.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/EndoOS.hs
- − compiler/GHC/Utils/FV.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/Expr.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- compiler/Language/Haskell/Syntax/Type.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.16.1-notes.rst
- docs/users_guide/exts/required_type_arguments.rst
- hadrian/cabal.project
- hadrian/src/Settings/Flavours/Validate.hs
- compiler/GHC/Data/SmallArray.hs → libraries/ghc-boot/GHC/Data/SmallArray.hs
- libraries/ghc-boot/ghc-boot.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Base.hs
- libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs
- − libraries/ghc-internal/src/GHC/Internal/ByteOrder.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Char.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Foldable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Const.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Functor/Identity.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Monoid.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Semigroup/Internal.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Traversable.hs
- libraries/ghc-internal/src/GHC/Internal/Data/Version.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Control.hs
- libraries/ghc-internal/src/GHC/Internal/Event/KQueue.hsc
- libraries/ghc-internal/src/GHC/Internal/Float.hs
- libraries/ghc-internal/src/GHC/Internal/Float/RealFracMethods.hs
- libraries/ghc-internal/src/GHC/Internal/Functor/ZipList.hs
- libraries/ghc-internal/src/GHC/Internal/Generics.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs
- libraries/ghc-internal/src/GHC/Internal/IO/FD.hs
- libraries/ghc-internal/src/GHC/Internal/Int.hs
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags.hsc
- libraries/ghc-internal/src/GHC/Internal/RTS/Flags/Test.hsc
- libraries/ghc-internal/src/GHC/Internal/Read.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/Blank.hsc
- libraries/ghc-internal/src/GHC/Internal/System/IO.hs
- libraries/ghc-internal/src/GHC/Internal/System/Posix/Internals.hs
- libraries/ghc-internal/src/GHC/Internal/TopHandler.hs
- libraries/ghc-internal/src/GHC/Internal/Unicode/Bits.hs
- libraries/ghci/GHCi/CreateBCO.hs
- libraries/ghci/GHCi/Message.hs
- libraries/ghci/GHCi/ResolvedBCO.hs
- libraries/ghci/GHCi/Server.hs
- rts/Apply.cmm
- rts/CloneStack.c
- rts/CloneStack.h
- rts/Continuation.c
- rts/ContinuationOps.cmm
- rts/HeapStackCheck.cmm
- rts/IOManager.c
- rts/Interpreter.c
- rts/Messages.c
- rts/PrimOps.cmm
- rts/Printer.c
- rts/RaiseAsync.c
- rts/RtsFlags.c
- rts/RtsSymbols.c
- rts/STM.c
- rts/STM.h
- rts/Schedule.c
- rts/StgCRun.c
- rts/StgMiscClosures.cmm
- rts/Threads.c
- rts/Threads.h
- rts/eventlog/EventLog.c
- rts/include/rts/Bytecodes.h
- rts/include/rts/Constants.h
- rts/include/rts/PosixSource.h
- rts/include/rts/storage/TSO.h
- rts/include/stg/MiscClosures.h
- rts/include/stg/Prim.h
- rts/prim/vectorQuotRem.c
- rts/win32/AsyncMIO.c
- rts/win32/AsyncMIO.h
- + testsuite/tests/bytecode/tuplestress/ByteCode.hs
- + testsuite/tests/bytecode/tuplestress/Common.hs-incl
- + testsuite/tests/bytecode/tuplestress/Obj.hs
- + testsuite/tests/bytecode/tuplestress/TupleStress.hs
- + testsuite/tests/bytecode/tuplestress/TupleStress.stdout
- + testsuite/tests/bytecode/tuplestress/all.T
- testsuite/tests/codeGen/should_run/Word2Float32.hs
- testsuite/tests/codeGen/should_run/Word2Float32.stdout
- testsuite/tests/codeGen/should_run/Word2Float64.hs
- testsuite/tests/codeGen/should_run/Word2Float64.stdout
- + testsuite/tests/concurrent/should_run/T26341.hs
- + testsuite/tests/concurrent/should_run/T26341.stdout
- + testsuite/tests/concurrent/should_run/T26341a.hs
- + testsuite/tests/concurrent/should_run/T26341a.stdout
- + testsuite/tests/concurrent/should_run/T26341b.hs
- + testsuite/tests/concurrent/should_run/T26341b.stdout
- testsuite/tests/concurrent/should_run/all.T
- 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/driver/T13729/A/A.cabal
- + testsuite/tests/driver/T13729/A/Setup.hs
- + testsuite/tests/driver/T13729/A/TH.hs
- + testsuite/tests/driver/T13729/A/Types1.hs
- + testsuite/tests/driver/T13729/A/Types2.hs
- + testsuite/tests/driver/T13729/B/B.cabal
- + testsuite/tests/driver/T13729/B/Main.hs
- + testsuite/tests/driver/T13729/B/Setup.hs
- + testsuite/tests/driver/T13729/Makefile
- + testsuite/tests/driver/T13729/Setup.hs
- + testsuite/tests/driver/T13729/all.T
- + testsuite/tests/ghc-api/T26910.hs
- + testsuite/tests/ghc-api/T26910.stdout
- + testsuite/tests/ghc-api/T26910_Input.hs
- testsuite/tests/ghc-api/all.T
- testsuite/tests/ghc-api/fixed-nodes/FixedNodes.hs
- testsuite/tests/ghc-api/fixed-nodes/ModuleGraphInvariants.hs
- testsuite/tests/ghci/scripts/ListTuplePunsPpr.stdout
- testsuite/tests/ghci/scripts/T10963.stderr
- testsuite/tests/ghci/scripts/ghci064.stdout
- testsuite/tests/indexed-types/should_fail/T2693.stderr
- 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/lib/stm/T26028.hs
- + testsuite/tests/lib/stm/T26028.stdout
- + testsuite/tests/lib/stm/T26291a.hs
- + testsuite/tests/lib/stm/T26291a.stdout
- + testsuite/tests/lib/stm/T26291b.hs
- + testsuite/tests/lib/stm/T26291b.stdout
- + testsuite/tests/lib/stm/all.T
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- + testsuite/tests/parser/should_compile/T12002.hs
- + testsuite/tests/parser/should_compile/T12002.stderr
- testsuite/tests/parser/should_compile/all.T
- testsuite/tests/parser/should_fail/T17865.stderr
- testsuite/tests/partial-sigs/should_compile/T10403.stderr
- + testsuite/tests/partial-sigs/should_compile/T11107.hs
- + testsuite/tests/partial-sigs/should_compile/T11107.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_compile/all.T
- testsuite/tests/partial-sigs/should_fail/T10999.stderr
- testsuite/tests/partial-sigs/should_fail/T12634.stderr
- + testsuite/tests/perf/compiler/T13820.hs
- testsuite/tests/perf/compiler/all.T
- testsuite/tests/polykinds/T15789.stderr
- testsuite/tests/polykinds/T18451.stderr
- testsuite/tests/polykinds/T7328.stderr
- + testsuite/tests/rebindable/T10381.hs
- testsuite/tests/rebindable/all.T
- testsuite/tests/rts/all.T
- + testsuite/tests/rts/cloneThreadStackMigrating.hs
- + testsuite/tests/simd/should_run/FloatConstant.hs
- + testsuite/tests/simd/should_run/FloatConstant.stdout
- + testsuite/tests/simd/should_run/IntConstant.hs
- + testsuite/tests/simd/should_run/IntConstant.stdout
- + testsuite/tests/simd/should_run/StackAlignment32.hs
- + testsuite/tests/simd/should_run/StackAlignment32.stdout
- + testsuite/tests/simd/should_run/StackAlignment32_main.c
- + testsuite/tests/simd/should_run/StackAlignment64.hs
- + testsuite/tests/simd/should_run/StackAlignment64.stdout
- + testsuite/tests/simd/should_run/StackAlignment64_main.c
- testsuite/tests/simd/should_run/all.T
- testsuite/tests/simd/should_run/int16x8_shuffle.hs
- testsuite/tests/simd/should_run/int16x8_shuffle.stdout
- testsuite/tests/simd/should_run/int16x8_shuffle_baseline.hs
- testsuite/tests/simd/should_run/int16x8_shuffle_baseline.stdout
- testsuite/tests/simd/should_run/int8x16_shuffle.hs
- testsuite/tests/simd/should_run/int8x16_shuffle.stdout
- testsuite/tests/simd/should_run/int8x16_shuffle_baseline.hs
- testsuite/tests/simd/should_run/int8x16_shuffle_baseline.stdout
- testsuite/tests/simd/should_run/simd013C.c
- testsuite/tests/simplCore/should_compile/DsSpecPragmas.stderr
- + testsuite/tests/simplCore/should_compile/T19166.hs
- + testsuite/tests/simplCore/should_compile/T19166.stderr
- testsuite/tests/simplCore/should_compile/T24229a.stderr
- testsuite/tests/simplCore/should_compile/T24229b.stderr
- testsuite/tests/simplCore/should_compile/T24359a.stderr
- + testsuite/tests/simplCore/should_compile/T25718.hs
- + testsuite/tests/simplCore/should_compile/T25718.stderr
- + testsuite/tests/simplCore/should_compile/T25718a.hs
- + testsuite/tests/simplCore/should_compile/T25718a.stderr
- + testsuite/tests/simplCore/should_compile/T25718b.hs
- + testsuite/tests/simplCore/should_compile/T25718b.stderr
- + testsuite/tests/simplCore/should_compile/T25718c.hs
- + testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-32
- + testsuite/tests/simplCore/should_compile/T25718c.stderr-ws-64
- testsuite/tests/simplCore/should_compile/T26116.stderr
- testsuite/tests/simplCore/should_compile/T4908.stderr
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplCore/should_compile/spec-inline.stderr
- + testsuite/tests/simplCore/should_run/T27071.hs
- + testsuite/tests/simplCore/should_run/T27071.stdout
- testsuite/tests/simplCore/should_run/all.T
- + testsuite/tests/typecheck/T13180/T13180.hs
- + testsuite/tests/typecheck/T13180/T13180.hs-boot
- + testsuite/tests/typecheck/T13180/T13180.stderr
- + testsuite/tests/typecheck/T13180/T13180A.hs
- + testsuite/tests/typecheck/T13180/all.T
- testsuite/tests/typecheck/no_skolem_info/T20063.stderr
- + testsuite/tests/typecheck/should_compile/T11141.hs
- + testsuite/tests/typecheck/should_compile/T11141.stderr
- + testsuite/tests/typecheck/should_compile/T11505Bar.hs
- + testsuite/tests/typecheck/should_compile/T11505Foo.hs
- + testsuite/tests/typecheck/should_compile/T11505Foo.hs-boot
- + testsuite/tests/typecheck/should_compile/T12046.hs
- testsuite/tests/typecheck/should_compile/T25180.stderr
- testsuite/tests/typecheck/should_compile/T26225.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_compile/free_monad_hole_fits.stderr
- testsuite/tests/typecheck/should_fail/T10971d.stderr
- testsuite/tests/typecheck/should_fail/T12589.stderr
- testsuite/tests/typecheck/should_fail/T13311.stderr
- testsuite/tests/typecheck/should_fail/T17773.stderr
- + testsuite/tests/typecheck/should_fail/T26823.hs
- + testsuite/tests/typecheck/should_fail/T26823.stderr
- testsuite/tests/typecheck/should_fail/T2846b.stderr
- testsuite/tests/typecheck/should_fail/T7851.stderr
- testsuite/tests/typecheck/should_fail/T8603.stderr
- testsuite/tests/typecheck/should_fail/all.T
- + testsuite/tests/vdq-rta/should_compile/T26967.hs
- + testsuite/tests/vdq-rta/should_compile/T26967.stderr
- + testsuite/tests/vdq-rta/should_compile/T26967_tyop.hs
- + testsuite/tests/vdq-rta/should_compile/T26967_tyop.stderr
- testsuite/tests/vdq-rta/should_compile/all.T
- utils/check-exact/ExactPrint.hs
- utils/deriveConstants/Main.hs
- 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/GhcUtils.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/-/compare/f8ddc8c3b61ac4fc2d2399db876351…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8ddc8c3b61ac4fc2d2399db876351…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/25636] test: Validate topoSort logic in createBCOs
by Rodrigo Mesquita (＠alt-romes) 01 Apr '26
by Rodrigo Mesquita (＠alt-romes) 01 Apr '26
01 Apr '26
Rodrigo Mesquita pushed to branch wip/romes/25636 at Glasgow Haskell Compiler / GHC
Commits:
638eef06 by Rodrigo Mesquita at 2026-04-01T15:19:15+01:00
test: Validate topoSort logic in createBCOs
This test validates that the topological sorting and ordering of the
unlifted constructors and lifted constructors in `createBCOs` is
correct.
See `Note [Tying the knot in createBCOs]` for why tying the knot for the
created BCOs is slightly difficult and why the topological sorting is
necessary.
This test fails when `let topoSortedObjs = topSortObjs objs` is
substituted by `let topoSortedObjs = zip [0..] objs`, thus witnessing
the toposort logic is correct and necessary.
The test calls the ghci `createBCOs` directly because it is currently
impossible to construct in Source Haskell a situation where a top-level
static unlifted constructor depends on another (we don't have top-level
unlifted constructors except for nullary constructors like `Leaf ::
(UTree :: UnliftedType)`).
This is another test for fix for #25636
- - - - -
3 changed files:
- + testsuite/tests/ghci/should_run/T25636f.hs
- + testsuite/tests/ghci/should_run/T25636f.stdout
- testsuite/tests/ghci/should_run/all.T
Changes:
=====================================
testsuite/tests/ghci/should_run/T25636f.hs
=====================================
@@ -0,0 +1,160 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedDatatypes #-}
+
+module Main where
+
+import Prelude
+import Control.Monad (unless)
+import Data.Array.Unboxed (UArray, listArray)
+import qualified Data.ByteString.Char8 as BS
+import Data.Word (Word)
+import GHC.Data.SmallArray (smallArrayFromList)
+import GHC.Exts
+import GHCi.CreateBCO (createBCOs)
+import GHCi.InfoTable (mkConInfoTable)
+import GHCi.RemoteTypes (HValue(..), HValueRef, RemotePtr, localRef, toRemotePtr)
+import GHCi.ResolvedBCO
+ ( BCOByteArray
+ , ResolvedBCO(..)
+ , ResolvedBCOPtr(..)
+ , isLittleEndian
+ , mkBCOByteArray
+ )
+import qualified GHC.Exts.Heap as Heap
+
+type UTree :: UnliftedType
+data UTree where
+ LeafA :: UTree
+ LeafB :: UTree
+ Bin :: UTree -> UTree -> UTree
+
+data Boxed where
+ RootBox :: UTree -> Boxed
+ PairBox :: UTree -> UTree -> Boxed
+
+main :: IO ()
+main = do
+ leafAInfo <- mkInfoTable 1 0 "LeafA"
+ leafBInfo <- mkInfoTable 2 0 "LeafB"
+ binInfo <- mkInfoTable 3 2 "Bin"
+ rootInfo <- mkInfoTable 1 1 "RootBox"
+ pairInfo <- mkInfoTable 2 2 "PairBox"
+ -- This test tests the topological sorting done to unlifted constructor
+ -- applications in `createBCOs` (call to `createUnliftedStaticCons`)
+ -- When the topological sort isn't done, this test fails with weird results.
+ refs <- createBCOs
+ [ rootBoxCon rootInfo 1
+ , binCon binInfo 1 2
+ , binCon binInfo 3 4
+ , binCon binInfo 4 3 -- recall ResolvedUnliftedStaticConRef are indices into the unl-objs-only-array
+ , rootBoxCon rootInfo 0
+ , leafCon leafAInfo
+ , leafCon leafBInfo
+ , pairBoxCon pairInfo 3 1 -- these are indices into unl-objs-array too (ResolvedUnliftedStaticConRef)
+ ]
+ actual <- mapM (\(unbx, ref) -> if unbx then extractUTree ref else extractBoxedRef ref)
+ -- test also that output order of references from createBCOs matches the
+ -- input order of Resolved objects
+ $ zip [False, True, True, True, False, True, True, False] refs
+ let expected =
+ ["RootBox (Bin LeafA LeafB)"
+ ,"Bin (Bin LeafA LeafB) (Bin LeafB LeafA)"
+ ,"Bin LeafA LeafB"
+ ,"Bin LeafB LeafA"
+ ,"RootBox (Bin (Bin LeafA LeafB) (Bin LeafB LeafA))"
+ ,"LeafA"
+ ,"LeafB"
+ ,"PairBox (LeafA) (Bin LeafA LeafB)"]
+ unless (actual == expected) $
+ putStrLn "expected result of createBCOs differ from actual!"
+ print actual
+ where
+ leafCon leafInfo =
+ ResolvedStaticCon
+ { resolvedBCOIsLE = isLittleEndian
+ , resolvedStaticConInfoPtr = leafInfo
+ , resolvedStaticConArity = 0
+ , resolvedStaticConLits = wordArray []
+ , resolvedStaticConPtrs = smallArrayFromList []
+ , resolvedStaticConIsUnlifted = True
+ }
+
+ binCon binInfo left right =
+ ResolvedStaticCon
+ { resolvedBCOIsLE = isLittleEndian
+ , resolvedStaticConInfoPtr = binInfo
+ , resolvedStaticConArity = 2
+ , resolvedStaticConLits = wordArray []
+ , resolvedStaticConPtrs =
+ smallArrayFromList
+ [ ResolvedUnliftedStaticConRef left
+ , ResolvedUnliftedStaticConRef right
+ ]
+ , resolvedStaticConIsUnlifted = True
+ }
+
+ rootBoxCon rootBoxInfo tree =
+ ResolvedStaticCon
+ { resolvedBCOIsLE = isLittleEndian
+ , resolvedStaticConInfoPtr = rootBoxInfo
+ , resolvedStaticConArity = 1
+ , resolvedStaticConLits = wordArray []
+ , resolvedStaticConPtrs =
+ smallArrayFromList [ResolvedUnliftedStaticConRef tree]
+ , resolvedStaticConIsUnlifted = False
+ }
+
+ pairBoxCon pairBoxInfo left right =
+ ResolvedStaticCon
+ { resolvedBCOIsLE = isLittleEndian
+ , resolvedStaticConInfoPtr = pairBoxInfo
+ , resolvedStaticConArity = 2
+ , resolvedStaticConLits = wordArray []
+ , resolvedStaticConPtrs =
+ smallArrayFromList
+ [ ResolvedUnliftedStaticConRef left
+ , ResolvedUnliftedStaticConRef right
+ ]
+ , resolvedStaticConIsUnlifted = False
+ }
+
+mkInfoTable :: Int -> Int -> String -> IO (RemotePtr Heap.StgInfoTable)
+mkInfoTable tag ptrs desc =
+ toRemotePtr <$> mkConInfoTable True ptrs 0 (tag - 1) tag (BS.pack desc)
+
+extractBoxedRef :: HValueRef -> IO String
+extractBoxedRef ref = do
+ HValue hv <- localRef ref
+ pure $ case unsafeCoerce# hv of
+ boxed -> flattenBoxed boxed
+
+extractUTree :: HValueRef -> IO String
+extractUTree ref = do
+ HValue hv <- localRef ref
+ pure $ case unsafeCoerce# hv of
+ utree -> flattenUTree utree
+
+flattenBoxed :: Boxed -> String
+flattenBoxed = \case
+ RootBox tree -> "RootBox (" ++ flattenUTree tree ++ ")"
+ PairBox left right ->
+ "PairBox (" ++ flattenUTree left ++ ") (" ++ flattenUTree right ++ ")"
+
+flattenUTree :: UTree -> String
+flattenUTree = \case
+ LeafA -> "LeafA"
+ LeafB -> "LeafB"
+ Bin left right -> "Bin " ++ par (flattenUTree left) ++ " " ++ par (flattenUTree right)
+ where
+ par s
+ | s == "LeafA" || s == "LeafB" = s
+ | otherwise = "(" ++ s ++ ")"
+
+wordArray :: [Word] -> BCOByteArray Word
+wordArray ws = mkBCOByteArray (listArray (0, length ws - 1) ws)
=====================================
testsuite/tests/ghci/should_run/T25636f.stdout
=====================================
@@ -0,0 +1 @@
+["RootBox (Bin LeafA LeafB)","Bin (Bin LeafA LeafB) (Bin LeafB LeafA)","Bin LeafA LeafB","Bin LeafB LeafA","RootBox (Bin (Bin LeafA LeafB) (Bin LeafB LeafA))","LeafA","LeafB","PairBox (LeafA) (Bin LeafA LeafB)"]
=====================================
testsuite/tests/ghci/should_run/all.T
=====================================
@@ -98,3 +98,10 @@ test('T24115', just_ghci + [extra_run_opts("-e ':add T24115.hs'")], ghci_script,
test('T10920', [only_ways(ghci_ways), extra_files(['LocalPrelude/Prelude.hs'])], ghci_script, ['T10920.script'])
test('TopEnvIface', [only_ways(ghci_ways)], makefile_test, [])
test('T25790', [only_ways(ghci_ways), extra_ways(["ghci-opt"])], ghci_script, ['T25790.script'])
+test('T25636f',
+ just_ghci + [
+ extra_hc_opts("-package ghci -package ghc-heap"),
+ when(arch('wasm32'), skip)
+ ],
+ compile_and_run,
+ [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/638eef0609d0f4a2cb9924b8667808a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/638eef0609d0f4a2cb9924b8667808a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/T26831] Make inlining a bit more eager for overloaded functions
by Simon Peyton Jones (＠simonpj) 01 Apr '26
by Simon Peyton Jones (＠simonpj) 01 Apr '26
01 Apr '26
Simon Peyton Jones pushed to branch wip/T26831 at Glasgow Haskell Compiler / GHC
Commits:
c60d2eb6 by Simon Peyton Jones at 2026-04-01T15:06:31+01:00
Make inlining a bit more eager for overloaded functions
If we have
f d = ... (class-op d x y) ...
we should be eager to inline `f`, because that may change the
higher order call (class-op d x y) into a call to a statically
known function.
See the discussion on #26831.
Even though this does a bit /more/ inlining, compile times
decrease by an average of 0.4%.
Compile time changes:
DsIncompleteRecSel3(normal) 431,786,104 -2.2%
ManyAlternatives(normal) 670,883,768 -1.6%
ManyConstructors(normal) 3,758,493,832 -2.6% GOOD
MultilineStringsPerf(normal) 29,900,576 -2.8%
T14052Type(ghci) 1,047,600,848 -1.2%
T17836(normal) 392,852,328 -5.2%
T18478(normal) 442,785,768 -1.4%
T21839c(normal) 341,536,992 -14.1% GOOD
T3064(normal) 174,086,152 +5.3% BAD
T5631(normal) 506,867,800 +1.0%
hard_hole_fits(normal) 209,530,736 -1.3%
info_table_map_perf(normal) 19,523,093,184 -1.2%
parsing001(normal) 377,810,528 -1.1%
pmcOrPats(normal) 60,075,264 -0.5%
geo. mean -0.4%
minimum -14.1%
maximum +5.3%
Runtime changes
haddock.Cabal(normal) 27,351,988,792 -0.7%
haddock.base(normal) 26,997,212,560 -0.6%
haddock.compiler(normal) 219,531,332,960 -1.0%
Metric Decrease:
LinkableUsage01
ManyConstructors
T17949
T21839c
T13035
TcPlugin_RewritePerf
hard_hole_fits
Metric Increase:
T3064
- - - - -
7 changed files:
- compiler/GHC/Core/Unfold.hs
- testsuite/tests/arityanal/should_compile/Arity01.stderr
- testsuite/tests/arityanal/should_compile/Arity05.stderr
- testsuite/tests/arityanal/should_compile/Arity08.stderr
- testsuite/tests/arityanal/should_compile/Arity11.stderr
- testsuite/tests/arityanal/should_compile/Arity14.stderr
- testsuite/tests/simplCore/should_compile/T15205.stderr
Changes:
=====================================
compiler/GHC/Core/Unfold.hs
=====================================
@@ -779,22 +779,28 @@ litSize _other = 0 -- Must match size of nullary constructors
classOpSize :: UnfoldingOpts -> Class -> [Id] -> [CoreExpr] -> ExprSize
-- See (IA1) in Note [Interesting arguments] in GHC.Core.Opt.Simplify.Utils
-classOpSize opts cls top_args args
- | isUnaryClass cls
- = sizeZero -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon
- | otherwise
- = case args of
- [] -> sizeZero
- (arg1:other_args) -> SizeIs (size other_args) (arg_discount arg1) 0
+classOpSize _opts _cls _top_args []
+ = sizeZero -- A non-applied classop
+classOpSize opts cls top_args (dict_arg:other_val_args)
+ = SizeIs size (arg_discount dict_arg) 0
where
- size other_args = 20 + (10 * length other_args)
+ size | isUnaryClass cls = 0 -- See (UCM4) in Note [Unary class magic] in GHC.Core.TyCon
+ | otherwise = 20 + (10 * length other_val_args)
-- If the class op is scrutinising a lambda bound dictionary then
-- give it a discount, to encourage the inlining of this function
- -- The actual discount is rather arbitrarily chosen
- arg_discount (Var dict) | dict `elem` top_args
- = unitBag (dict, unfoldingDictDiscount opts)
- arg_discount _ = emptyBag
+ arg_discount (Cast arg _co) = arg_discount arg
+ arg_discount (Var dict) | dict `elem` top_args = unitBag (dict, dict_discount)
+ arg_discount _ = emptyBag
+
+ -- If we have (class-op d arg1 .. argn) then it's super-good to inline
+ -- to expose `d`; not only can we do the dictionary selection
+ -- (class-op d), but that will likely expose a lambda which we can then
+ -- apply. In that case (n > 0), we add `unfoldingFunAppDiscount`.
+ -- See the discussion on #26831, esp "Delicate inlining".
+ dict_discount
+ | null other_val_args = unfoldingDictDiscount opts
+ | otherwise = unfoldingDictDiscount opts + unfoldingFunAppDiscount opts
-- | The size of a function call
callSize
=====================================
testsuite/tests/arityanal/should_compile/Arity01.stderr
=====================================
@@ -5,19 +5,19 @@ Result size of Tidy Core = {terms: 71, types: 43, coercions: 0, joins: 0/0}
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F1.f2 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F1.f2 = GHC.Num.Integer.IS 1#
+F1.f2 = GHC.Internal.Bignum.Integer.IS 1#
Rec {
-- RHS size: {terms: 24, types: 6, coercions: 0, joins: 0/0}
F1.f1_h1 [Occ=LoopBreaker] :: Integer -> Integer -> Integer -> Integer
[GblId, Arity=3, Str=<1L><1L><SL>, Unf=OtherCon []]
F1.f1_h1
- = \ (n :: Integer) (x :: Integer) (eta [OS=OneShot] :: Integer) ->
+ = \ (n :: Integer) (x [OS=OneShot] :: Integer) (eta [OS=OneShot] :: Integer) ->
case x of x1 { __DEFAULT ->
case n of y1 { __DEFAULT ->
- case GHC.Num.Integer.integerLt# x1 y1 of {
+ case GHC.Internal.Bignum.Integer.integerLt# x1 y1 of {
__DEFAULT -> eta;
- 1# -> F1.f1_h1 y1 (GHC.Num.Integer.integerAdd x1 F1.f2) (GHC.Num.Integer.integerAdd x1 eta)
+ 1# -> F1.f1_h1 y1 (GHC.Internal.Bignum.Integer.integerAdd x1 F1.f2) (GHC.Internal.Bignum.Integer.integerAdd x1 eta)
}
}
}
@@ -26,7 +26,7 @@ end Rec }
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F1.f3 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F1.f3 = GHC.Num.Integer.IS 5#
+F1.f3 = GHC.Internal.Bignum.Integer.IS 5#
-- RHS size: {terms: 4, types: 0, coercions: 0, joins: 0/0}
f1 :: Integer
@@ -36,27 +36,27 @@ f1 = F1.f1_h1 F1.f3 F1.f2 F1.f3
-- RHS size: {terms: 14, types: 5, coercions: 0, joins: 0/0}
g :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer
[GblId, Arity=5, Str=<1L><SL><SL><SL><SL>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0 0 0 0 0] 120 0}]
-g = \ (x1 :: Integer) (x2 :: Integer) (x3 :: Integer) (x4 :: Integer) (x5 :: Integer) -> GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd (GHC.Num.Integer.integerAdd x1 x2) x3) x4) x5
+g = \ (x1 :: Integer) (x2 :: Integer) (x3 :: Integer) (x4 :: Integer) (x5 :: Integer) -> GHC.Internal.Bignum.Integer.integerAdd (GHC.Internal.Bignum.Integer.integerAdd (GHC.Internal.Bignum.Integer.integerAdd (GHC.Internal.Bignum.Integer.integerAdd x1 x2) x3) x4) x5
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F1.s1 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F1.s1 = GHC.Num.Integer.IS 3#
+F1.s1 = GHC.Internal.Bignum.Integer.IS 3#
-- RHS size: {terms: 8, types: 7, coercions: 0, joins: 0/0}
s :: forall {t1} {t2}. Num t1 => (t1 -> t2) -> t2
-[GblId, Arity=2, Str=<MP(A,A,A,A,A,A,1C(1,L))><1C(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 60] 50 0}]
+[GblId, Arity=2, Str=<MP(A,A,A,A,A,A,1C(1,L))><1C(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 60] 50 0}]
s = \ (@t) (@t1) ($dNum :: Num t) (f :: t -> t1) -> f (fromInteger @t $dNum F1.s1)
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F1.h1 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F1.h1 = GHC.Num.Integer.IS 24#
+F1.h1 = GHC.Internal.Bignum.Integer.IS 24#
-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0}
h :: Integer -> Integer
[GblId, Arity=1, Str=<SL>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 30 0}]
-h = \ (x5 :: Integer) -> GHC.Num.Integer.integerAdd F1.h1 x5
+h = \ (x5 :: Integer) -> GHC.Internal.Bignum.Integer.integerAdd F1.h1 x5
=====================================
testsuite/tests/arityanal/should_compile/Arity05.stderr
=====================================
@@ -5,27 +5,27 @@ Result size of Tidy Core = {terms: 42, types: 44, coercions: 0, joins: 0/0}
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F5.f5g1 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F5.f5g1 = GHC.Num.Integer.IS 1#
+F5.f5g1 = GHC.Internal.Bignum.Integer.IS 1#
-- RHS size: {terms: 12, types: 9, coercions: 0, joins: 0/0}
f5g :: forall {a} {t}. Num a => (t -> a) -> t -> a
-[GblId, Arity=3, Str=<SP(1C(1,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60 0] 90 0}]
+[GblId, Arity=3, Str=<SP(1C(1,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [180 60 0] 90 0}]
f5g = \ (@a) (@t) ($dNum :: Num a) (h :: t -> a) (z :: t) -> + @a $dNum (h z) (fromInteger @a $dNum F5.f5g1)
-- RHS size: {terms: 17, types: 12, coercions: 0, joins: 0/0}
f5h :: forall {a} {t}. Num a => (t -> a) -> t -> (t -> a) -> a
-[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L><MC(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 60 0 60] 150 0}]
+[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A,A,A,A,A,MC(1,L))><MC(1,L)><L><MC(1,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [270 60 0 60] 150 0}]
f5h = \ (@a) (@t) ($dNum :: Num a) (f :: t -> a) (x :: t) (g :: t -> a) -> + @a $dNum (f x) (+ @a $dNum (g x) (fromInteger @a $dNum F5.f5g1))
-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0}
f5y :: Integer -> Integer
[GblId, Arity=1, Str=<1L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 30 0}]
-f5y = \ (y :: Integer) -> GHC.Num.Integer.integerAdd y F5.f5g1
+f5y = \ (y :: Integer) -> GHC.Internal.Bignum.Integer.integerAdd y F5.f5g1
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
f5 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-f5 = GHC.Num.Integer.IS 3#
+f5 = GHC.Internal.Bignum.Integer.IS 3#
=====================================
testsuite/tests/arityanal/should_compile/Arity08.stderr
=====================================
@@ -4,7 +4,7 @@ Result size of Tidy Core = {terms: 24, types: 18, coercions: 0, joins: 0/0}
-- RHS size: {terms: 20, types: 10, coercions: 0, joins: 0/0}
f8f :: forall {p}. Num p => Bool -> p -> p -> p
-[GblId, Arity=4, Str=<LP(SC(S,C(1,L)),A,MC(1,C(1,L)),A,A,A,A)><1L><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 30 0 0] 140 0}]
+[GblId, Arity=4, Str=<LP(SC(S,C(1,L)),A,MC(1,C(1,L)),A,A,A,A)><1L><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [270 30 0 0] 140 0}]
f8f
= \ (@p) ($dNum :: Num p) (b :: Bool) (x :: p) (y :: p) ->
case b of {
@@ -15,7 +15,7 @@ f8f
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
f8 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-f8 = GHC.Num.Integer.IS 2#
+f8 = GHC.Internal.Bignum.Integer.IS 2#
=====================================
testsuite/tests/arityanal/should_compile/Arity11.stderr
=====================================
@@ -5,57 +5,23 @@ Result size of Tidy Core = {terms: 136, types: 75, coercions: 0, joins: 2/7}
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F11.fib3 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F11.fib3 = GHC.Num.Integer.IS 1#
+F11.fib3 = GHC.Internal.Bignum.Integer.IS 1#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F11.fib2 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F11.fib2 = GHC.Num.Integer.IS 2#
-
-Rec {
--- RHS size: {terms: 38, types: 13, coercions: 0, joins: 2/2}
-F11.f11_fib [Occ=LoopBreaker] :: Integer -> Integer
-[GblId, Arity=1, Str=<SL>, Unf=OtherCon []]
-F11.f11_fib
- = \ (ds :: Integer) ->
- join {
- $j [Dmd=ML] :: Integer
- [LclId[JoinId(0)(Nothing)]]
- $j
- = join {
- $j1 [Dmd=ML] :: Integer
- [LclId[JoinId(0)(Nothing)]]
- $j1 = GHC.Num.Integer.integerAdd (F11.f11_fib (GHC.Num.Integer.integerSub ds F11.fib3)) (F11.f11_fib (GHC.Num.Integer.integerSub ds F11.fib2)) } in
- case ds of {
- GHC.Num.Integer.IS x1 ->
- case x1 of {
- __DEFAULT -> jump $j1;
- 1# -> F11.fib3
- };
- GHC.Num.Integer.IP x1 -> jump $j1;
- GHC.Num.Integer.IN x1 -> jump $j1
- } } in
- case ds of {
- GHC.Num.Integer.IS x1 ->
- case x1 of {
- __DEFAULT -> jump $j;
- 0# -> F11.fib3
- };
- GHC.Num.Integer.IP x1 -> jump $j;
- GHC.Num.Integer.IN x1 -> jump $j
- }
-end Rec }
+F11.fib2 = GHC.Internal.Bignum.Integer.IS 2#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F11.fib1 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F11.fib1 = GHC.Num.Integer.IS 0#
+F11.fib1 = GHC.Internal.Bignum.Integer.IS 0#
-- RHS size: {terms: 54, types: 27, coercions: 0, joins: 0/5}
-fib :: forall {t} {a}. (Eq t, Num t, Num a) => t -> a
-[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A)><LP(A,LC(L,C(1,L)),A,A,A,A,L)><LP(LC(S,C(1,L)),A,A,A,A,A,MC(1,L))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 150 60 0] 480 0}]
+fib :: forall {t1} {t2}. (Eq t1, Num t1, Num t2) => t1 -> t2
+[GblId, Arity=4, Str=<SP(SC(S,C(1,L)),A)><LP(A,LC(L,C(1,L)),A,A,A,A,L)><LP(LC(S,C(1,L)),A,A,A,A,A,MC(1,L))><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [180 450 180 0] 480 0}]
fib
- = \ (@t) (@a) ($dEq :: Eq t) ($dNum :: Num t) ($dNum1 :: Num a) (eta :: t) ->
+ = \ (@t) (@t1) ($dEq :: Eq t) ($dNum :: Num t) ($dNum1 :: Num t1) (eta :: t) ->
let {
lvl :: t
[LclId]
@@ -65,32 +31,66 @@ fib
[LclId]
lvl1 = fromInteger @t $dNum F11.fib2 } in
let {
- lvl2 :: a
+ lvl2 :: t1
[LclId]
- lvl2 = fromInteger @a $dNum1 F11.fib3 } in
+ lvl2 = fromInteger @t1 $dNum1 F11.fib3 } in
let {
lvl3 :: t
[LclId]
lvl3 = fromInteger @t $dNum F11.fib1 } in
letrec {
- fib4 [Occ=LoopBreaker, Dmd=SC(S,L)] :: t -> a
+ fib4 [Occ=LoopBreaker, Dmd=SC(S,L)] :: t -> t1
[LclId, Arity=1, Str=<L>, Unf=OtherCon []]
fib4
= \ (ds :: t) ->
case == @t $dEq ds lvl3 of {
False ->
case == @t $dEq ds lvl of {
- False -> + @a $dNum1 (fib4 (- @t $dNum ds lvl)) (fib4 (- @t $dNum ds lvl1));
+ False -> + @t1 $dNum1 (fib4 (- @t $dNum ds lvl)) (fib4 (- @t $dNum ds lvl1));
True -> lvl2
};
True -> lvl2
}; } in
fib4 eta
+Rec {
+-- RHS size: {terms: 38, types: 13, coercions: 0, joins: 2/2}
+F11.f11_fib [Occ=LoopBreaker] :: Integer -> Integer
+[GblId, Arity=1, Str=<SL>, Unf=OtherCon []]
+F11.f11_fib
+ = \ (ds :: Integer) ->
+ join {
+ $j [Dmd=ML] :: Integer
+ [LclId[JoinId(0)(Nothing)]]
+ $j
+ = join {
+ $j1 [Dmd=ML] :: Integer
+ [LclId[JoinId(0)(Nothing)]]
+ $j1 = GHC.Internal.Bignum.Integer.integerAdd (F11.f11_fib (GHC.Internal.Bignum.Integer.integerSub ds F11.fib3)) (F11.f11_fib (GHC.Internal.Bignum.Integer.integerSub ds F11.fib2)) } in
+ case ds of {
+ GHC.Internal.Bignum.Integer.IS x ->
+ case x of {
+ __DEFAULT -> jump $j1;
+ 1# -> F11.fib3
+ };
+ GHC.Internal.Bignum.Integer.IP x -> jump $j1;
+ GHC.Internal.Bignum.Integer.IN x -> jump $j1
+ } } in
+ case ds of {
+ GHC.Internal.Bignum.Integer.IS x ->
+ case x of {
+ __DEFAULT -> jump $j;
+ 0# -> F11.fib3
+ };
+ GHC.Internal.Bignum.Integer.IP x -> jump $j;
+ GHC.Internal.Bignum.Integer.IN x -> jump $j
+ }
+end Rec }
+
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F11.f3 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F11.f3 = GHC.Num.Integer.IS 1000#
+F11.f3 = GHC.Internal.Bignum.Integer.IS 1000#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F11.f11_x :: Integer
@@ -100,7 +100,7 @@ F11.f11_x = F11.f11_fib F11.f3
-- RHS size: {terms: 4, types: 1, coercions: 0, joins: 0/0}
F11.f11f1 :: Integer -> Integer
[GblId, Arity=1, Str=<SL>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [0] 30 0}]
-F11.f11f1 = \ (y :: Integer) -> GHC.Num.Integer.integerAdd F11.f11_x y
+F11.f11f1 = \ (y :: Integer) -> GHC.Internal.Bignum.Integer.integerAdd F11.f11_x y
-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
f11f :: forall {p}. p -> Integer -> Integer
@@ -110,22 +110,22 @@ f11f = \ (@p) _ [Occ=Dead] -> F11.f11f1
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F11.f5 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F11.f5 = GHC.Num.Integer.IS 6#
+F11.f5 = GHC.Internal.Bignum.Integer.IS 6#
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
F11.f4 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}]
-F11.f4 = GHC.Num.Integer.integerAdd F11.f11_x F11.f5
+F11.f4 = GHC.Internal.Bignum.Integer.integerAdd F11.f11_x F11.f5
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F11.f2 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F11.f2 = GHC.Num.Integer.IS 8#
+F11.f2 = GHC.Internal.Bignum.Integer.IS 8#
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
F11.f1 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}]
-F11.f1 = GHC.Num.Integer.integerAdd F11.f11_x F11.f2
+F11.f1 = GHC.Internal.Bignum.Integer.integerAdd F11.f11_x F11.f2
-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
f11 :: (Integer, Integer)
@@ -133,7 +133,4 @@ f11 :: (Integer, Integer)
f11 = (F11.f4, F11.f1)
------- Local rules for imported ids --------
-"SPEC fib @Integer @Integer" forall ($dEq :: Eq Integer) ($dNum :: Num Integer) ($dNum1 :: Num Integer). fib @Integer @Integer $dEq $dNum $dNum1 = F11.f11_fib
-
=====================================
testsuite/tests/arityanal/should_compile/Arity14.stderr
=====================================
@@ -3,18 +3,18 @@
Result size of Tidy Core = {terms: 44, types: 38, coercions: 0, joins: 0/3}
-- RHS size: {terms: 3, types: 2, coercions: 0, joins: 0/0}
-F14.f1 :: forall {t}. t -> t
+F14.f1 :: forall t. t -> t
[GblId, Arity=1, Str=<1L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=True)}]
F14.f1 = \ (@t) (y :: t) -> y
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
F14.f2 :: Integer
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-F14.f2 = GHC.Num.Integer.IS 1#
+F14.f2 = GHC.Internal.Bignum.Integer.IS 1#
-- RHS size: {terms: 36, types: 23, coercions: 0, joins: 0/3}
f14 :: forall {t}. (Ord t, Num t) => t -> t -> t -> t
-[GblId, Arity=4, Str=<SP(A,A,SC(S,C(1,L)),A,A,A,A,A)><LP(LC(L,C(1,L)),A,A,A,A,A,MC(1,L))><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 90 0 0] 310 0}]
+[GblId, Arity=4, Str=<SP(A,A,SC(S,C(1,L)),A,A,A,A,A)><LP(LC(L,C(1,L)),A,A,A,A,A,MC(1,L))><L><L>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [90 270 0 0] 310 0}]
f14
= \ (@t) ($dOrd :: Ord t) ($dNum :: Num t) (eta :: t) (eta1 :: t) ->
let {
@@ -25,7 +25,7 @@ f14
f3 [Occ=LoopBreaker, Dmd=SC(S,C(1,L))] :: t -> t -> t -> t
[LclId, Arity=2, Str=<L><L>, Unf=OtherCon []]
f3
- = \ (n :: t) (x :: t) ->
+ = \ (n :: t) (x [OS=OneShot] :: t) ->
case < @t $dOrd x n of {
False -> F14.f1 @t;
True ->
=====================================
testsuite/tests/simplCore/should_compile/T15205.stderr
=====================================
@@ -10,7 +10,7 @@ f :: forall a b. C a b => a -> b
Str=<1P(A,1C(1,C(1,L)))><L>,
Unf=Unf{Src=<vanilla>, TopLvl=True,
Value=True, ConLike=True, WorkFree=True, Expandable=True,
- Guidance=IF_ARGS [30 0] 40 0}]
+ Guidance=IF_ARGS [90 0] 40 0}]
f = \ (@a) (@b) ($dC :: C a b) (x :: a) -> op @a @b $dC x x
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c60d2eb698383d4c54dbd393cdc1a31…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c60d2eb698383d4c54dbd393cdc1a31…
You're receiving this email because of your account on gitlab.haskell.org.
1
0