Simon Peyton Jones pushed to branch wip/26805 at Glasgow Haskell Compiler / GHC
Commits:
596c2135 by Simon Peyton Jones at 2026-01-22T23:29:28+00:00
wibble
- - - - -
1 changed file:
- compiler/GHC/Tc/Utils/Monad.hs
Changes:
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1750,7 +1750,7 @@ Other wrinkles
(CERR2) In #26015 I found that from the constraints
[W] alpha ~ Int -- A class constraint
[W] F alpha ~# Bool -- An equality constraint
- we were dropping the first (becuase it's a class constraint) but not the
+ we were dropping the first (because it's a class constraint) but not the
second, and then getting a misleading error message from the second. As
#25607 shows, we can get not just one but a zillion bogus messages, which
conceal the one genuine error. Boo.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/596c213508daa7976fb39fdb60cf71e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/596c213508daa7976fb39fdb60cf71e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/26805] Finally fix the constraints-library bug
by Simon Peyton Jones (＠simonpj) 22 Jan '26
by Simon Peyton Jones (＠simonpj) 22 Jan '26
22 Jan '26
Simon Peyton Jones pushed to branch wip/26805 at Glasgow Haskell Compiler / GHC
Commits:
ed1e2ce4 by Simon Peyton Jones at 2026-01-22T23:28:26+00:00
Finally fix the constraints-library bug
- - - - -
4 changed files:
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Utils/Monad.hs
Changes:
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -748,7 +748,8 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys
= -- There is a matching dictionary in the inert set
do { -- For a Wanted, first to try to solve it /completely/ from top level instances
-- See Note [Shortcut solving]
- ; short_cut_worked <- tryShortCutSolver (isGiven ev_i) dict_w
+ ; dflags <- getDynFlags
+ ; short_cut_worked <- tryShortCutSolver dflags (isGiven ev_i) dict_w
; if | short_cut_worked
-> stopWith ev_w "shortCutSolver worked(1)"
@@ -776,7 +777,8 @@ try_inert_dicts inerts dict_w@(DictCt { di_ev = ev_w, di_cls = cls, di_tys = tys
; continueWith () }
-- See Note [Shortcut solving]
-tryShortCutSolver :: Bool -- True <=> try the short-cut solver; False <=> don't
+tryShortCutSolver :: DynFlags
+ -> Bool -- True <=> try the short-cut solver; False <=> don't
-> DictCt -- Work item
-> TcS Bool -- True <=> success
-- We are about to solve a [W] constraint from a [G] constraint. We take
@@ -784,34 +786,25 @@ tryShortCutSolver :: Bool -- True <=> try the short-cut solver; False <=>
-- Note that we only do this for the sake of performance. Exactly the same
-- programs should typecheck regardless of whether we take this step or
-- not. See Note [Shortcut solving]
-tryShortCutSolver try_short_cut dict_w@(DictCt { di_ev = ev_w })
- | not try_short_cut
- = return False
- | otherwise
- = do { dflags <- getDynFlags
- ; if | CtWanted (WantedCt { ctev_pred = pred_w }) <- ev_w
-
- , not (couldBeIPLike pred_w) -- Not for implicit parameters (#18627)
+tryShortCutSolver dflags try_short_cut dict_w
+ | try_short_cut
+ , DictCt { di_ev = ev_w } <- dict_w
+ , CtWanted (WantedCt { ctev_pred = pred_w }) <- ev_w
+ , not (couldBeIPLike pred_w) -- Not for implicit parameters (#18627)
- , not (xopt LangExt.IncoherentInstances dflags)
+ , not (xopt LangExt.IncoherentInstances dflags)
-- If IncoherentInstances is on then we cannot rely on coherence of proofs
-- in order to justify this optimization: The proof provided by the
-- [G] constraint's superclass may be different from the top-level proof.
-- See Note [Shortcut solving: incoherence]
-
- , gopt Opt_SolveConstantDicts dflags
+ , gopt Opt_SolveConstantDicts dflags
-- Enabled by the -fsolve-constant-dicts flag
- -> tryShortCutTcS $ -- tryTcS tries to completely solve some contraints
- do { residual <- solveSimpleWanteds (unitBag (CDictCan dict_w))
- ; return (isSolvedWC residual) }
- -- NB: isSolvedWC, not isEmptyWC (#26805). We might succeed
- -- in fully-solving the constraint but still leave some
- -- /solved/ implications in the residual.
- -- See (SCS4) in Note [Shortcut solving]
+ = tryShortCutTcS $ -- tryTcS tries to completely solve some contraints
+ solveSimpleWanteds (unitBag (CDictCan dict_w))
- | otherwise
- -> return False }
+ | otherwise
+ = return False
{- *******************************************************************
@@ -846,7 +839,7 @@ try_instances inerts work_item@(DictCt { di_ev = ev@(CtWanted wev), di_cls = cls
; case lkup_res of
OneInst { cir_what = what }
-> do { let is_local_given = case what of { LocalInstance -> True; _ -> False }
- ; take_shortcut <- tryShortCutSolver is_local_given work_item
+ ; take_shortcut <- tryShortCutSolver dflags is_local_given work_item
; if take_shortcut
then stopWith ev "shortCutSolver worked(2)"
else do { insertSafeOverlapFailureTcS what work_item
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -1351,7 +1351,7 @@ nestTcS (TcS thing_inside)
; return res }
-tryShortCutTcS :: TcS Bool -> TcS Bool
+tryShortCutTcS :: TcS WantedConstraints -> TcS Bool
-- Like nestTcS, but
-- (a) be a no-op if the nested computation returns False
-- (b) if (but only if) success, propagate nested bindings to the caller
@@ -1384,28 +1384,38 @@ tryShortCutTcS (TcS thing_inside)
vcat [ text "old_ev_binds:" <+> ppr old_ev_binds_var
, text "new_ev_binds:" <+> ppr new_ev_binds_var
, ppr old_inerts ]
- ; solved <- thing_inside nest_env
+ ; residual <- thing_inside nest_env
+ ; let solved = isSolvedWC residual
+ -- NB: isSolvedWC, not isEmptyWC (#26805). We might succeed
+ -- in fully-solving the constraint but still leave some
+ -- /solved/ implications in the residual.
+ -- See (SCS4) in Note [Shortcut solving]
; TcM.traceTc "tryShortCutTcS }" (ppr solved)
- ; if not solved
- then return False
- else do { -- Successfully solved
- -- Add the new bindings to the existing ones
- ; old_ebvs <- TcM.readTcRef (ebv_binds old_ev_binds_var)
+ ; when solved $ -- Successfully solved
+ do { -- Add the new bindings to the existing ones
+ ; TcM.combineTcEvBinds old_ev_binds_var new_ev_binds_var
- ; TcM.combineTcEvBinds old_ev_binds_var new_ev_binds_var
+ -- We are discarding some implications; we must add their
+ -- NeededEvIds to the current bindings, lest we fail to r
+ ; TcM.addNeededEvIds old_ev_binds_var $
+ foldr add_implic emptyVarSet $
+ wc_impl residual
- ; final_ebvs <- TcM.readTcRef (ebv_binds old_ev_binds_var)
- ; TcM.traceTc "update" (text "old" <+> ppr old_ebvs $$
- text "new" <+> ppr final_ebvs)
+ -- Update the existing inert set
+ ; new_inerts <- TcM.readTcRef new_inert_var
+ ; TcM.updTcRef inerts_var (`updateInertsWith` new_inerts) }
- -- Update the existing inert set
- ; new_inerts <- TcM.readTcRef new_inert_var
- ; TcM.updTcRef inerts_var (`updateInertsWith` new_inerts)
- ; TcM.traceTc "tryTcS update" (ppr (inert_solved_dicts new_inerts))
-
- ; return True } }
+ ; return solved
+ }
+ where
+ add_implic :: Implication -> NeededEvIds -> NeededEvIds
+ add_implic implic@(Implic { ic_status = status }) needs
+ | IC_Solved { ics_dm = dm, ics_non_dm = non_dm } <- status
+ = needs `unionVarSet` dm `unionVarSet` non_dm
+ | otherwise
+ = pprPanic "tryShortCutTcS" (ppr implic)
updateInertsWith :: InertSet -> InertSet -> InertSet
-- Update the current inert set with bits from a nested solve,
=====================================
compiler/GHC/Tc/Types/Evidence.hs
=====================================
@@ -15,7 +15,7 @@ module GHC.Tc.Types.Evidence (
-- * Evidence bindings
TcEvBinds(..), EvBindsVar(..), NeededEvIds,
- EvBindsState(..), emptyEvBindsState, unionEvBindsState, addCoVarsEBS,
+ EvBindsState(..), emptyEvBindsState, unionEvBindsState, addNeededEvIdsEBS,
EvBindsMap(..), emptyEvBindsMap, extendEvBinds, unionEvBindsMap,
lookupEvBind, evBindMapBinds,
foldEvBindsMap, nonDetStrictFoldEvBindsMap,
@@ -765,8 +765,8 @@ unionEvBindsState (EBS { ebs_binds = bs1, ebs_needs = n1 })
= EBS { ebs_binds = bs1 `unionEvBindsMap` bs2
, ebs_needs = n1 `unionVarSet` n2 }
-addCoVarsEBS :: VarSet -> EvBindsState -> EvBindsState
-addCoVarsEBS n1 ebs@(EBS { ebs_needs = n2 })
+addNeededEvIdsEBS :: NeededEvIds -> EvBindsState -> EvBindsState
+addNeededEvIdsEBS n1 ebs@(EBS { ebs_needs = n2 })
= ebs { ebs_needs = n1 `unionVarSet` n2 }
instance Outputable EvBindsState where
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -106,7 +106,7 @@ module GHC.Tc.Utils.Monad(
newTcEvBinds, newNoTcEvBinds, cloneEvBindsVar,
addTcEvCoBind, addTcEvBind, addTopEvBinds,
getTcEvBindsMap, getTcEvBindsState,
- setTcEvBindsMap, combineTcEvBinds,
+ setTcEvBindsMap, combineTcEvBinds, addNeededEvIds,
chooseUniqueOccTc,
getConstraintVar, setConstraintVar,
emitConstraints, emitSimple, emitSimples,
@@ -2018,7 +2018,7 @@ combineTcEvBinds (EvBindsVar { ebv_binds = old_ebv_ref })
combineTcEvBinds (EvBindsVar { ebv_binds = old_tcv_ref })
(CoEvBindsVar { ebv_needs = new_tcv_ref })
= do { new_tcvs <- readTcRef new_tcv_ref
- ; updTcRef old_tcv_ref (addCoVarsEBS new_tcvs) }
+ ; updTcRef old_tcv_ref (addNeededEvIdsEBS new_tcvs) }
combineTcEvBinds (CoEvBindsVar { ebv_needs = old_tcv_ref })
(CoEvBindsVar { ebv_needs = new_tcv_ref })
= do { new_tcvs <- readTcRef new_tcv_ref
@@ -2027,16 +2027,17 @@ combineTcEvBinds old_var new_var
= pprPanic "combineTcEvBinds" (ppr old_var $$ ppr new_var)
-- Terms inside types, no good
+addNeededEvIds :: EvBindsVar -> NeededEvIds -> TcM ()
+addNeededEvIds (EvBindsVar { ebv_binds = bs_ref }) needed
+ = updTcRef bs_ref (addNeededEvIdsEBS needed)
+addNeededEvIds (CoEvBindsVar { ebv_needs = need_ref }) needed
+ = updTcRef need_ref (unionVarSet needed)
+
addTcEvCoBind :: EvBindsVar -> CoercionHole -> CoercionPlusHoles -> TcM ()
addTcEvCoBind ebv hole co_plus_holes@(CPH { cph_co = co })
= do { fillCoercionHole hole co_plus_holes
-- Record usage of the free vars of this coercion
- ; let fvs = coVarsOfCo co
- ; case ebv of
- EvBindsVar { ebv_binds = bs_ref }
- -> updTcRef bs_ref (addCoVarsEBS fvs)
- CoEvBindsVar { ebv_needs = need_ref }
- -> updTcRef need_ref (unionVarSet fvs) }
+ ; addNeededEvIds ebv (coVarsOfCo co) }
addTcEvBind :: EvBindsVar -> EvBind -> TcM ()
-- Add a binding to the TcEvBinds by side effect
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ed1e2ce4564907132f92e484fb0897d…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ed1e2ce4564907132f92e484fb0897d…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/26699] Migrating the simplest types required for Trees That Grow progress
by recursion-ninja (＠recursion-ninja) 22 Jan '26
by recursion-ninja (＠recursion-ninja) 22 Jan '26
22 Jan '26
recursion-ninja pushed to branch wip/26699 at Glasgow Haskell Compiler / GHC
Commits:
d970f2bb by Recursion Ninja at 2026-01-22T16:20:00-05:00
Migrating the simplest types required for Trees That Grow progress
from GHC.Types.Basic to Language.Haskell.Syntax.Basic. Related
function definitions were also moved. Outputable type-class instances
are defined in GHC.Utils.Outputable. Binary instance of Boxity was
moved to GHC.Utils.Binary.
Migrated types:
* TopLevelFlag
* RuleName
* TyConFlavour
* TypeOrData
* NewOrData
- - - - -
18 changed files:
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/Basic.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
Changes:
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -17,7 +17,7 @@ module GHC.Hs.Decls (
-- * Toplevel declarations
HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep,
HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys,
- NewOrData, newOrDataToFlavour, anyLConIsGadt,
+ NewOrData, newOrDataToFlavour, dataDefnConsNewOrData, anyLConIsGadt,
StandaloneKindSig(..), LStandaloneKindSig, standaloneKindSigName,
-- ** Class or type declarations
@@ -1106,6 +1106,11 @@ anyLConIsGadt xs = case toList xs of
{-# SPECIALIZE anyLConIsGadt :: [GenLocated l (ConDecl pass)] -> Bool #-}
{-# SPECIALIZE anyLConIsGadt :: DataDefnCons (GenLocated l (ConDecl pass)) -> Bool #-}
+dataDefnConsNewOrData :: DataDefnCons a -> NewOrData
+dataDefnConsNewOrData = \ case
+ NewTypeCon {} -> NewType
+ DataTypeCons {} -> DataType
+
{-
************************************************************************
* *
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -53,6 +53,7 @@ module GHC.Hs.Utils(
-- * Bindings
mkFunBind, mkVarBind, mkHsVarBind, mkSimpleGeneratedFunBind, mkTopFunBind,
mkPatSynBind,
+ familyInfoTyConFlavour,
isInfixFunBind,
spanHsLocaLBinds,
@@ -148,6 +149,7 @@ import Control.Arrow ( first )
import Data.Foldable ( toList )
import Data.List ( partition )
import Data.List.NonEmpty ( NonEmpty (..), nonEmpty )
+import Data.Maybe ( isNothing )
import qualified Data.List.NonEmpty as NE
import Data.IntMap ( IntMap )
@@ -1502,6 +1504,18 @@ hsLTyClDeclBinders (L loc (DataDecl { tcdLName = (L _ name)
where
flav = newOrDataToFlavour $ dataDefnConsNewOrData $ dd_cons defn
+familyInfoTyConFlavour
+ :: Maybe tc -- ^ Just cls <=> this is an associated family of class cls
+ -> FamilyInfo pass
+ -> TyConFlavour tc
+familyInfoTyConFlavour mb_parent_tycon info =
+ case info of
+ DataFamily -> OpenFamilyFlavour (IAmData DataType) mb_parent_tycon
+ OpenTypeFamily -> OpenFamilyFlavour IAmType mb_parent_tycon
+ ClosedTypeFamily _ -> assert (isNothing mb_parent_tycon)
+ -- See Note [Closed type family mb_parent_tycon]
+ ClosedTypeFamilyFlavour
+
-------------------
hsForeignDeclsBinders :: forall p a. (UnXRec (GhcPass p), IsSrcSpanAnn p a)
=> [LForeignDecl (GhcPass p)] -> [LIdP (GhcPass p)]
=====================================
compiler/GHC/HsToCore/Errors/Types.hs
=====================================
@@ -4,7 +4,7 @@ module GHC.HsToCore.Errors.Types where
import GHC.Prelude
-import GHC.Core (CoreRule, CoreExpr, RuleName)
+import GHC.Core (CoreRule, CoreExpr)
import GHC.Core.DataCon
import GHC.Core.ConLike
import GHC.Core.Type
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -80,7 +80,7 @@ import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.TyCon
import GHC.Builtin.Names( rOOT_MAIN )
-import GHC.Types.Basic ( TopLevelFlag(..), TupleSort(..), tupleSortBoxity )
+import GHC.Types.Basic ( TupleSort(..), tupleSortBoxity )
import GHC.Types.TyThing ( tyThingGREInfo )
import GHC.Types.SrcLoc as SrcLoc
import GHC.Utils.Outputable as Outputable
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -52,7 +52,7 @@ import GHC.Types.ForeignCall ( CCallTarget(..) )
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
-import GHC.Types.Basic ( VisArity, TyConFlavour(..), TypeOrKind(..), RuleName )
+import GHC.Types.Basic ( VisArity, TyConFlavour(..), TypeOrKind(..) )
import GHC.Types.GREInfo (ConLikeInfo (..), ConInfo, mkConInfo, conInfoFields)
import GHC.Types.Hint (SigLike(..))
import GHC.Types.Unique.Set
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -70,7 +70,7 @@ import GHC.Types.FieldLabel
import GHC.Types.Hint
import GHC.Types.SourceFile
import GHC.Types.SrcLoc as SrcLoc
-import GHC.Types.Basic ( TopLevelFlag(..), TyConFlavour (..), convImportLevel )
+import GHC.Types.Basic ( TyConFlavour (..), convImportLevel )
import GHC.Types.SourceText
import GHC.Types.Id
import GHC.Types.PkgQual
=====================================
compiler/GHC/Rename/Splice.hs
=====================================
@@ -32,7 +32,7 @@ import GHC.Rename.Unbound ( isUnboundName )
import GHC.Rename.Module ( rnSrcDecls, findSplice )
import GHC.Rename.Pat ( rnPat )
import GHC.Types.Error
-import GHC.Types.Basic ( TopLevelFlag, isTopLevel, maxPrec )
+import GHC.Types.Basic ( maxPrec )
import GHC.Types.SourceText ( SourceText(..) )
import GHC.Types.ThLevelIndex
import GHC.Utils.Outputable
=====================================
compiler/GHC/Tc/Gen/Head.hs
=====================================
@@ -62,7 +62,6 @@ import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Reader
import GHC.Types.SrcLoc
-import GHC.Types.Basic
import GHC.Types.Error
import GHC.Builtin.Names
=====================================
compiler/GHC/Tc/Utils/Env.hs
=====================================
@@ -119,7 +119,6 @@ import GHC.Data.List.SetOps
import GHC.Data.Maybe( MaybeErr(..), orElse, maybeToList, fromMaybe )
import GHC.Types.SrcLoc
-import GHC.Types.Basic hiding( SuccessFlag(..) )
import GHC.Types.TypeEnv
import GHC.Types.SourceFile
import GHC.Types.Name
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -239,7 +239,7 @@ import GHC.Types.Unique.DFM
import GHC.Types.Unique.Supply
import GHC.Types.Unique (uniqueTag)
import GHC.Types.Annotations
-import GHC.Types.Basic( TopLevelFlag(..), TypeOrKind(..) )
+import GHC.Types.Basic( TypeOrKind(..) )
import GHC.Types.CostCentre.State
import GHC.Types.SourceFile
=====================================
compiler/GHC/Types/Basic.hs
=====================================
@@ -103,7 +103,6 @@ module GHC.Types.Basic (
import GHC.Prelude
import GHC.ForeignSrcLang
-import GHC.Data.FastString
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Binary
@@ -111,15 +110,16 @@ import GHC.Types.Arity
import GHC.Types.SourceText
import qualified GHC.LanguageExtensions as LangExt
import {-# SOURCE #-} Language.Haskell.Syntax.Type (PromotionFlag(..), isPromoted)
-import Language.Haskell.Syntax.Basic (Boxity(..), isBoxed, ConTag)
import {-# SOURCE #-} Language.Haskell.Syntax.Expr (HsDoFlavour)
+
+import Language.Haskell.Syntax.Basic
+import Language.Haskell.Syntax.ImpExp
+
import Control.DeepSeq ( NFData(..) )
import Data.Data
import Data.Maybe
import qualified Data.Semigroup as Semi
-import Language.Haskell.Syntax.ImpExp
-
{-
************************************************************************
* *
@@ -420,55 +420,10 @@ instance NFData FunctionOrData where
************************************************************************
-}
-type RuleName = FastString
-
pprRuleName :: RuleName -> SDoc
pprRuleName rn = doubleQuotes (ftext rn)
-{-
-************************************************************************
-* *
-\subsection[Top-level/local]{Top-level/not-top level flag}
-* *
-************************************************************************
--}
-
-data TopLevelFlag
- = TopLevel
- | NotTopLevel
- deriving Data
-
-isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
-
-isNotTopLevel NotTopLevel = True
-isNotTopLevel TopLevel = False
-
-isTopLevel TopLevel = True
-isTopLevel NotTopLevel = False
-
-instance Outputable TopLevelFlag where
- ppr TopLevel = text "<TopLevel>"
- ppr NotTopLevel = text "<NotTopLevel>"
-
-{-
-************************************************************************
-* *
- Boxity flag
-* *
-************************************************************************
--}
-
-instance Outputable Boxity where
- ppr Boxed = text "Boxed"
- ppr Unboxed = text "Unboxed"
-
-instance Binary Boxity where -- implemented via isBoxed-isomorphism to Bool
- put_ bh = put_ bh . isBoxed
- get bh = do
- b <- get bh
- pure $ if b then Boxed else Unboxed
-
{-
************************************************************************
* *
@@ -1524,11 +1479,13 @@ instance NFData TypeOrConstraint where
TypeLike -> ()
ConstraintLike -> ()
-{- *********************************************************************
+{-
+************************************************************************
* *
- TyConFlavour
+TyConFlavour
* *
-********************************************************************* -}
+************************************************************************
+-}
-- | Paints a picture of what a 'TyCon' represents, in broad strokes.
-- This is used towards more informative error messages.
@@ -1571,7 +1528,6 @@ instance Outputable (TyConFlavour tc) where
go BuiltInTypeFlavour = "built-in type"
go PromotedDataConFlavour = "promoted data constructor"
-
-- | Get the enclosing class TyCon (if there is one) for the given TyConFlavour
tyConFlavourAssoc_maybe :: TyConFlavour tc -> Maybe tc
tyConFlavourAssoc_maybe (OpenFamilyFlavour _ mb_parent) = mb_parent
@@ -1584,22 +1540,10 @@ data TypeOrData
| IAmType
deriving (Eq, Data)
--- | When we only care whether a data-type declaration is `data` or `newtype`,
--- but not what constructors it has.
-data NewOrData
- = NewType -- ^ @newtype Blah ...@
- | DataType -- ^ @data Blah ...@
- deriving ( Eq, Data ) -- Needed because Demand derives Eq
-
instance Outputable TypeOrData where
ppr (IAmData newOrData) = ppr newOrData
ppr IAmType = text "type"
-instance Outputable NewOrData where
- ppr = \case
- NewType -> text "newtype"
- DataType -> text "data"
-
{- *********************************************************************
* *
Defaulting options
=====================================
compiler/GHC/Utils/Binary.hs
=====================================
@@ -117,6 +117,7 @@ module GHC.Utils.Binary
import GHC.Prelude
+import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Binds.InlinePragma
import Language.Haskell.Syntax.Module.Name (ModuleName(..))
import Language.Haskell.Syntax.ImpExp.IsBoot (IsBootInterface(..))
@@ -2011,6 +2012,12 @@ instance NFData a => NFData (FingerprintWithValue a) where
rnf (FingerprintWithValue fp mflags)
= rnf fp `seq` rnf mflags `seq` ()
+instance Binary Boxity where -- implemented via isBoxed-isomorphism to Bool
+ put_ bh = put_ bh . isBoxed
+ get bh = do
+ b <- get bh
+ pure $ if b then Boxed else Unboxed
+
instance Binary ConInfoTable where
get bh = Binary.decode <$> get bh
=====================================
compiler/GHC/Utils/Outputable.hs
=====================================
@@ -112,6 +112,7 @@ module GHC.Utils.Outputable (
import {-# SOURCE #-} GHC.Unit.Types ( Unit, Module, moduleName )
import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName )
+import Language.Haskell.Syntax.Basic
import Language.Haskell.Syntax.Binds.InlinePragma
import Language.Haskell.Syntax.Module.Name ( ModuleName(..) )
@@ -2001,19 +2002,32 @@ instance IsDoc HDoc where
{-# INLINE CONLIKE dualDoc #-}
instance Outputable (ActivationX p) where
- ppr AlwaysActive = empty
- ppr NeverActive = brackets (text "~")
- ppr (ActiveBefore n) = brackets (char '~' <> int n)
- ppr (ActiveAfter n) = brackets (int n)
- ppr (XActivation _) = text "[final]"
+ ppr AlwaysActive = empty
+ ppr NeverActive = brackets (text "~")
+ ppr (ActiveBefore n) = brackets (char '~' <> int n)
+ ppr (ActiveAfter n) = brackets (int n)
+ ppr (XActivation _) = text "[final]"
instance Outputable InlineSpec where
- ppr Inline = text "INLINE"
- ppr NoInline = text "NOINLINE"
- ppr Inlinable = text "INLINABLE"
- ppr Opaque = text "OPAQUE"
- ppr NoUserInlinePrag = empty
+ ppr Inline = text "INLINE"
+ ppr NoInline = text "NOINLINE"
+ ppr Inlinable = text "INLINABLE"
+ ppr Opaque = text "OPAQUE"
+ ppr NoUserInlinePrag = empty
+
+instance Outputable Boxity where
+ ppr Boxed = text "Boxed"
+ ppr Unboxed = text "Unboxed"
instance Outputable RuleMatchInfo where
- ppr ConLike = text "CONLIKE"
- ppr FunLike = text "FUNLIKE"
+ ppr ConLike = text "CONLIKE"
+ ppr FunLike = text "FUNLIKE"
+
+instance Outputable NewOrData where
+ ppr = \case
+ NewType -> text "newtype"
+ DataType -> text "data"
+
+instance Outputable TopLevelFlag where
+ ppr TopLevel = text "<TopLevel>"
+ ppr NotTopLevel = text "<NotTopLevel>"
=====================================
compiler/Language/Haskell/Syntax/Basic.hs
=====================================
@@ -10,6 +10,37 @@ import Prelude
import GHC.Data.FastString (FastString)
import Control.DeepSeq
+{-
+************************************************************************
+* *
+Rules
+* *
+************************************************************************
+-}
+
+type RuleName = FastString
+
+{-
+************************************************************************
+* *
+\subsection[Top-level/local]{Top-level/not-top level flag}
+* *
+************************************************************************
+-}
+
+data TopLevelFlag
+ = TopLevel
+ | NotTopLevel
+ deriving Data
+
+isTopLevel, isNotTopLevel :: TopLevelFlag -> Bool
+
+isNotTopLevel NotTopLevel = True
+isNotTopLevel TopLevel = False
+
+isTopLevel TopLevel = True
+isTopLevel NotTopLevel = False
+
{-
************************************************************************
* *
@@ -125,3 +156,10 @@ data Fixity = Fixity Int FixityDirection
instance NFData Fixity where
rnf (Fixity i d) = rnf i `seq` rnf d `seq` ()
+
+-- | When we only care whether a data-type declaration is `data` or `newtype`,
+-- but not what constructors it has.
+data NewOrData
+ = NewType -- ^ @newtype Blah ...@
+ | DataType -- ^ @data Blah ...@
+ deriving ( Eq, Data ) -- Needed because Demand derives Eq
=====================================
compiler/Language/Haskell/Syntax/Decls.hs
=====================================
@@ -18,7 +18,7 @@ module Language.Haskell.Syntax.Decls (
-- * Toplevel declarations
HsDecl(..), LHsDecl, HsDataDefn(..), HsDeriving, LHsFunDep, FunDep(..),
HsDerivingClause(..), LHsDerivingClause, DerivClauseTys(..), LDerivClauseTys,
- NewOrData(..), DataDefnCons(..), dataDefnConsNewOrData,
+ NewOrData(..), DataDefnCons(..),
isTypeDataDefnCons, firstDataDefnCon,
StandaloneKindSig(..), LStandaloneKindSig,
@@ -31,7 +31,7 @@ module Language.Haskell.Syntax.Decls (
FamilyDecl(..), LFamilyDecl,
-- ** Instance declarations
- InstDecl(..), LInstDecl, FamilyInfo(..), familyInfoTyConFlavour,
+ InstDecl(..), LInstDecl, FamilyInfo(..),
TyFamInstDecl(..), LTyFamInstDecl,
TyFamDefltDecl, LTyFamDefltDecl,
DataFamInstDecl(..), LDataFamInstDecl,
@@ -91,6 +91,7 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr
( HsExpr, HsUntypedSplice )
-- Because Expr imports Decls via HsBracket
+import Language.Haskell.Syntax.Basic (TopLevelFlag, RuleName, NewOrData(..))
import Language.Haskell.Syntax.Binds
import Language.Haskell.Syntax.Binds.InlinePragma (Activation)
import Language.Haskell.Syntax.Extension
@@ -98,8 +99,7 @@ import Language.Haskell.Syntax.Type
import Language.Haskell.Syntax.Basic (Role, LexicalFixity)
import Language.Haskell.Syntax.Specificity (Specificity)
-import GHC.Types.Basic (TopLevelFlag, OverlapMode, RuleName
- ,TyConFlavour(..), TypeOrData(..), NewOrData(..))
+import GHC.Types.Basic (OverlapMode)
import GHC.Types.ForeignCall (CType, CCallConv, Safety, Header, CLabelString, CCallTarget, CExportSpec)
import GHC.Data.FastString (FastString)
@@ -108,7 +108,6 @@ import GHC.Hs.Doc (WithHsDocIdentifiers)
import GHC.Types.SourceText (StringLiteral)
import Control.DeepSeq
-import Control.Exception (assert)
import Control.Monad
import Data.Data hiding (TyCon, Fixity, Infix)
import Data.Maybe
@@ -779,18 +778,6 @@ data FamilyInfo pass
-- said "type family Foo x where .."
| ClosedTypeFamily (Maybe [LTyFamInstEqn pass])
-familyInfoTyConFlavour
- :: Maybe tc -- ^ Just cls <=> this is an associated family of class cls
- -> FamilyInfo pass
- -> TyConFlavour tc
-familyInfoTyConFlavour mb_parent_tycon info =
- case info of
- DataFamily -> OpenFamilyFlavour (IAmData DataType) mb_parent_tycon
- OpenTypeFamily -> OpenFamilyFlavour IAmType mb_parent_tycon
- ClosedTypeFamily _ -> assert (isNothing mb_parent_tycon)
- -- See Note [Closed type family mb_parent_tycon]
- ClosedTypeFamilyFlavour
-
{- Note [Closed type family mb_parent_tycon]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There's no way to write a closed type family inside a class declaration:
@@ -932,11 +919,6 @@ data DataDefnCons a
[a] -- The (possibly empty) list of data constructors
deriving ( Eq, Data, Foldable, Functor, Traversable ) -- Needed because Demand derives Eq
-dataDefnConsNewOrData :: DataDefnCons a -> NewOrData
-dataDefnConsNewOrData = \ case
- NewTypeCon {} -> NewType
- DataTypeCons {} -> DataType
-
-- | Are the constructors within a @type data@ declaration?
-- See Note [Type data declarations] in GHC.Rename.Module.
isTypeDataDefnCons :: DataDefnCons a -> Bool
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
=====================================
@@ -33,7 +33,6 @@ import GHC
import GHC.Core.InstEnv
import qualified GHC.Driver.DynFlags as DynFlags
import GHC.Driver.Ppr
-import GHC.Plugins (TopLevelFlag (..))
import GHC.Types.SourceText
import GHC.Unit.State
import GHC.Utils.Outputable as Outputable
=====================================
utils/haddock/haddock-api/src/Haddock/Convert.hs
=====================================
@@ -59,7 +59,7 @@ import GHC.Core.TyCo.Rep
import GHC.Core.TyCon
import GHC.Core.Type
import GHC.Hs
-import GHC.Types.Basic (DefMethSpec (..), TopLevelFlag (..), TupleSort (..))
+import GHC.Types.Basic (DefMethSpec (..), TupleSort (..))
import GHC.Types.Id (idType, setIdType)
import GHC.Types.Name
import GHC.Types.Name.Reader (mkVarUnqual)
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
=====================================
@@ -37,7 +37,7 @@ import GHC hiding (NoLink, HsTypeGhcPsExt (..))
import GHC.Builtin.Types (eqTyCon_RDR, tupleDataConName, tupleTyConName)
import GHC.Core.TyCon (tyConResKind)
import GHC.Driver.DynFlags (getDynFlags)
-import GHC.Types.Basic (TopLevelFlag (..), TupleSort (..))
+import GHC.Types.Basic (TupleSort (..))
import GHC.Types.Name
import GHC.Types.Name.Reader (RdrName (Exact))
import Language.Haskell.Syntax.BooleanFormula(BooleanFormula(..))
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d970f2bb8e0c5d173becef1c1aa8f1e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d970f2bb8e0c5d173becef1c1aa8f1e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/26699] 23 commits: base: don't expose GHC.Num.{BigNat, Integer, Natural}
by recursion-ninja (＠recursion-ninja) 22 Jan '26
by recursion-ninja (＠recursion-ninja) 22 Jan '26
22 Jan '26
recursion-ninja pushed to branch wip/26699 at Glasgow Haskell Compiler / GHC
Commits:
30f442a9 by Teo Camarasu at 2026-01-20T13:57:26-05:00
base: don't expose GHC.Num.{BigNat, Integer, Natural}
We no longer expose GHC.Num.{BigNat, Integer, Natural} from base instead users should get these modules from ghc-bignum.
We make this change to insulate end users from changes to GHC's implementation of big numbers.
Implements CLC proposal 359: https://github.com/haskell/core-libraries-committee/issues/359
- - - - -
75a9053d by Teo Camarasu at 2026-01-20T13:58:07-05:00
base: deprecate GHC internals in GHC.Num
Implements CLC proposal: https://github.com/haskell/core-libraries-committee/issues/360
- - - - -
9534b032 by Andreas Klebinger at 2026-01-20T13:58:50-05:00
ghc-experimental: Update Changelog
I tried to reconstruct a high level overview of the changes and when
they were made since we introduced it.
Fixes #26506
Co-authored-by: Teo Camarasu <teofilcamarasu(a)gmail.com>
- - - - -
346f2f5a by Cheng Shao at 2026-01-20T13:59:30-05:00
hadrian: remove RTS options in ghc-in-ghci flavour
This patch removes the RTS options passed to ghc in ghc-in-ghci
flavour, to workaround command line argument handling issue in
hls/hie-boot that results in `-O64M` instead of `+RTS -O64M -RTS`
being passed to ghc. It's not a hadrian bug per se, since ghc's own
ghc-in-ghci multi repl works fine, but we should still make sure HLS
works. Closes #26801.
- - - - -
759fd15a by Andreas Klebinger at 2026-01-21T16:05:28-05:00
Don't build GHC with -Wcompat
Without bumping the boot compiler the warnings it produces are often not
actionable leading to pointless noise.
Fixes #26800
- - - - -
3172db94 by Torsten Schmits at 2026-01-21T16:06:11-05:00
Use the correct field of ModOrigin when formatting error message listing hidden reexports
- - - - -
485c12b2 by Cheng Shao at 2026-01-21T16:06:54-05:00
Revert "hadrian: handle findExecutable "" gracefully"
This reverts commit 1e5752f64a522c4025365856d92f78073a7b3bba. The
underlying issue has been fixed in
https://github.com/haskell/directory/commit/75828696e7145adc09179111a0d631b…
and present since 1.3.9.0, and hadrian directory lower bound is
1.3.9.0, so we can revert our own in house hack now.
- - - - -
5efb58dc by Cheng Shao at 2026-01-21T16:07:36-05:00
rts: fix typo in TICK_ALLOC_RTS
This patch fixes a typo in the `TICK_ALLOC_RTS` macro, the original
`bytes` argument was silently dropped. The Cmm code has its own
version of `TICK_ALLOC_RTS` not affected by this typo, it affected the
C RTS, and went unnoticed because the variable `n` happened to also be
available at its call site. But the number was incorrect. Also fixes
its call site since `WDS()` is not available in C.
- - - - -
c406ea69 by Cheng Shao at 2026-01-21T16:07:36-05:00
rts: remove broken & unused ALLOC_P_TICKY
This patch removes the `ALLOC_P_TICKY` macro from the rts, it's
unused, and its expanded code is already broken.
- - - - -
34a27e20 by Simon Peyton Jones at 2026-01-21T16:08:17-05:00
Make the implicit-parameter class have representational role
This MR addresses #26737, by making the built-in class IP
have a representational role for its second parameter.
See Note [IP: implicit parameter class] in
ghc-internal:GHC.Internal.Classes.IP
In fact, IP is (unfortunately, currently) exposed by
base:GHC.Base, so we ran a quick CLC proposal to
agree the change:
https://github.com/haskell/core-libraries-committee/issues/385
Some (small) compilations get faster because they only need to
load (small) interface file GHC.Internal.Classes.IP.hi,
rather than (large) GHC.Internal.Classes.hi.
Metric Decrease:
T10421
T12150
T12425
T24582
T5837
T5030
- - - - -
ca79475f by Cheng Shao at 2026-01-21T16:09:00-05:00
testsuite: avoid re.sub in favor of simple string replacements
This patch refactors the testsuite driver and avoids the usage of
re.sub in favor of simple string replacements when possible. The
changes are not comprehensive, and there are still a lot of re.sub
usages lingering around the tree, but this already addresses a major
performance bottleneck in the testsuite driver that might has to do
with quadratic or worse slowdown in cpython's regular expression
engine when handling certain regex patterns with large strings.
Especially on i386, and i386 jobs are the bottlenecks of all full-ci
validate pipelines!
Here are the elapsed times of testing x86_64/i386 with -j48 before
this patch:
x86_64: `Build completed in 6m06s`
i386: `Build completed in 1h36m`
And with this patch:
x86_64: `Build completed in 4m55s`
i386: `Build completed in 4m23s`
Fixes #26786.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
88c93796 by Zubin Duggal at 2026-01-21T16:09:42-05:00
ghc-toolchain: Also configure windres on non-windows platforms.
It may be needed for cross compilation.
Fixes #24588
- - - - -
9788c0ec by Cheng Shao at 2026-01-21T16:10:24-05:00
ghci: print external interpreter trace messages to stderr instead of stdout
This patch makes ghci print external interpreter trace messages to
stderr instead of stdout, which is a much saner choice for diagnostic
information. Closes #26807.
- - - - -
0491f08a by Sylvain Henry at 2026-01-22T03:44:26-05:00
GC: don't use CAS without PARALLEL_GC on
If we're not using the parallel GC, there is no reason to do a costly
CAS. This was flagged as taking time in a perf profile.
- - - - -
211a8f56 by Sylvain Henry at 2026-01-22T03:44:26-05:00
GC: suffix parallel GC with "par" instead of "thr"
Avoid some potential confusion (see discussion in !15351).
- - - - -
77a23cbd by fendor at 2026-01-22T03:45:08-05:00
Remove blanket ignore that covers libraries/
- - - - -
18bf7f5c by Léana Jiang at 2026-01-22T08:58:45-05:00
doc: update Flavour type in hadrian user-settings
- - - - -
3d5a1365 by Cheng Shao at 2026-01-22T08:59:28-05:00
hadrian: add missing notCross predicate for stage0 -O0
There are a few hard-coded hadrian args that pass -O0 when compiling
some heavy modules in stage0, which only makes sense when not
cross-compiling and when cross-compiling we need properly optimized
stage0 packages. So this patch adds the missing `notCross` predicate
in those places.
- - - - -
ee937134 by Matthew Pickering at 2026-01-22T09:00:10-05:00
Fix ghc-experimental GHC.Exception.Backtrace.Experimental module
This module wasn't added to the cabal file so it was never compiled or
included in the library.
- - - - -
1b490f5a by Zubin Duggal at 2026-01-22T09:00:53-05:00
hadrian: Add ghc-{experimental,internal}.cabal to the list of dependencies of the doc target
We need these files to detect the version of these libraries
Fixes #26738
- - - - -
cdb74049 by Cheng Shao at 2026-01-22T14:52:36-05:00
rts: avoid Cmm loop to initialize Array#/SmallArray#
Previously, `newArray#`/`newSmallArray#` called an RTS C function to
allocate the `Array#`/`SmallArray#`, then used a Cmm loop to
initialize the elements. Cmm doesn't have native for-loop so the code
is a bit awkward, and it's less efficient than a C loop, since the C
compiler can effectively vectorize the loop with optimizations.
So this patch moves the loop that initializes the elements to the C
side. `allocateMutArrPtrs`/`allocateSmallMutArrPtrs` now takes a new
`init` argument and initializes the elements if `init` is non-NULL.
- - - - -
4c784f00 by Cheng Shao at 2026-01-22T14:53:19-05:00
Fix testsuite run for +ipe flavour transformer
This patch makes the +ipe flavour transformer pass the entire
testsuite:
- An RTS debug option `-DI` is added, the IPE trace information is now
only printed with `-DI`. The test cases that do require IPE trace
are now run with `-DI`.
- The testsuite config option `ghc_with_ipe` is added, enabled when
running the testsuite with `+ipe`, which skips a few tests that are
sensitive to eventlog output, allocation patterns etc that can fail
under `+ipe`.
This is the first step towards #26799.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
e84b457e by Recursion Ninja at 2026-01-22T15:56:58-05:00
Migrating the simplest types required for Trees That Grow progress
from GHC.Types.Basic to Language.Haskell.Syntax.Basic. Related
function definitions were also moved. Outputable type-class instances
are defined in GHC.Utils.Outputable. Binary instance of Boxity was
moved to GHC.Utils.Binary.
Migrated types:
* TopLevelFlag
* RuleName
* TyConFlavour
* TypeOrData
* NewOrData
- - - - -
89 changed files:
- .gitignore
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Rename/Splice.hs
- compiler/GHC/Tc/Gen/Head.hs
- compiler/GHC/Tc/Utils/Env.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Basic.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Utils/Binary.hs
- compiler/GHC/Utils/Outputable.hs
- compiler/Language/Haskell/Syntax/Basic.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/ghc.cabal.in
- docs/users_guide/9.16.1-notes.rst
- docs/users_guide/runtime_control.rst
- hadrian/doc/user-settings.md
- hadrian/src/Flavour.hs
- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Rules/Docspec.hs
- hadrian/src/Rules/Documentation.hs
- hadrian/src/Rules/Lint.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- hadrian/src/Settings/Packages.hs
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- libraries/base/src/Data/Array/Byte.hs
- libraries/base/src/GHC/Num.hs
- − libraries/base/src/GHC/Num/BigNat.hs
- − libraries/base/src/GHC/Num/Integer.hs
- − libraries/base/src/GHC/Num/Natural.hs
- libraries/base/src/System/CPUTime/Utils.hs
- libraries/ghc-bignum/ghc-bignum.cabal
- libraries/ghc-compact/tests/all.T
- libraries/ghc-experimental/CHANGELOG.md
- libraries/ghc-experimental/ghc-experimental.cabal.in
- libraries/ghc-experimental/src/GHC/Exception/Backtrace/Experimental.hs
- libraries/ghc-experimental/src/GHC/TypeNats/Experimental.hs
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Classes.hs
- + libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs
- libraries/ghc-internal/tests/backtraces/all.T
- libraries/ghci/GHCi/Server.hs
- rts/AllocArray.c
- rts/AllocArray.h
- rts/ClosureTable.c
- rts/Heap.c
- rts/PrimOps.cmm
- rts/RtsFlags.c
- rts/Threads.c
- rts/Trace.c
- rts/Weak.c
- rts/include/Cmm.h
- rts/include/rts/Flags.h
- rts/include/stg/Ticky.h
- rts/rts.cabal
- rts/sm/Evac.c
- rts/sm/Evac_thr.c → rts/sm/Evac_par.c
- rts/sm/Scav_thr.c → rts/sm/Scav_par.c
- rts/sm/Storage.c
- testsuite/driver/runtests.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/driver/testutil.py
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- testsuite/tests/rts/Makefile
- testsuite/tests/rts/all.T
- testsuite/tests/rts/ipe/all.T
- testsuite/tests/th/TH_implicitParams.stdout
- + testsuite/tests/typecheck/should_compile/T26737.hs
- testsuite/tests/typecheck/should_compile/all.T
- utils/ghc-toolchain/exe/Main.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Hoogle.hs
- utils/haddock/haddock-api/src/Haddock/Convert.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c9295b1dddc52b03dfa418d28d5ae…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7c9295b1dddc52b03dfa418d28d5ae…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: rts: avoid Cmm loop to initialize Array#/SmallArray#
by Marge Bot (＠marge-bot) 22 Jan '26
by Marge Bot (＠marge-bot) 22 Jan '26
22 Jan '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
cdb74049 by Cheng Shao at 2026-01-22T14:52:36-05:00
rts: avoid Cmm loop to initialize Array#/SmallArray#
Previously, `newArray#`/`newSmallArray#` called an RTS C function to
allocate the `Array#`/`SmallArray#`, then used a Cmm loop to
initialize the elements. Cmm doesn't have native for-loop so the code
is a bit awkward, and it's less efficient than a C loop, since the C
compiler can effectively vectorize the loop with optimizations.
So this patch moves the loop that initializes the elements to the C
side. `allocateMutArrPtrs`/`allocateSmallMutArrPtrs` now takes a new
`init` argument and initializes the elements if `init` is non-NULL.
- - - - -
4c784f00 by Cheng Shao at 2026-01-22T14:53:19-05:00
Fix testsuite run for +ipe flavour transformer
This patch makes the +ipe flavour transformer pass the entire
testsuite:
- An RTS debug option `-DI` is added, the IPE trace information is now
only printed with `-DI`. The test cases that do require IPE trace
are now run with `-DI`.
- The testsuite config option `ghc_with_ipe` is added, enabled when
running the testsuite with `+ipe`, which skips a few tests that are
sensitive to eventlog output, allocation patterns etc that can fail
under `+ipe`.
This is the first step towards #26799.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
33c700f6 by Ben Gamari at 2026-01-22T15:26:06-05:00
hadrian: Bump QuickCheck upper bound
This patch bumps QuickCheck upper bound to 2.18. selftest rule
manually tested to work with current latest QuickCheck-2.17.1.0.
- - - - -
b1a60194 by Zubin Duggal at 2026-01-22T15:26:12-05:00
Add genindex to index.rst. This adds a link to the index in the navigation bar.
Fixes #26437
- - - - -
21 changed files:
- docs/users_guide/index.rst
- docs/users_guide/runtime_control.rst
- hadrian/hadrian.cabal
- hadrian/src/Flavour.hs
- libraries/ghc-compact/tests/all.T
- libraries/ghc-internal/tests/backtraces/all.T
- rts/AllocArray.c
- rts/AllocArray.h
- rts/ClosureTable.c
- rts/Heap.c
- rts/PrimOps.cmm
- rts/RtsFlags.c
- rts/Threads.c
- rts/Trace.c
- rts/Weak.c
- rts/include/rts/Flags.h
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/rts/Makefile
- testsuite/tests/rts/all.T
- testsuite/tests/rts/ipe/all.T
Changes:
=====================================
docs/users_guide/index.rst
=====================================
@@ -29,6 +29,7 @@ Contents:
eventlog-formats
glossary
editing-guide
+ genindex
Indices and tables
=====================================
docs/users_guide/runtime_control.rst
=====================================
@@ -1588,6 +1588,7 @@ recommended for everyday use!
.. rts-flag:: -Ds DEBUG: scheduler
.. rts-flag:: -Di DEBUG: interpreter
+.. rts-flag:: -DI DEBUG: IPE
.. rts-flag:: -Dw DEBUG: weak
.. rts-flag:: -DG DEBUG: gccafs
.. rts-flag:: -Dg DEBUG: gc
=====================================
hadrian/hadrian.cabal
=====================================
@@ -190,4 +190,4 @@ executable hadrian
if flag(selftest)
other-modules: Rules.Selftest
cpp-options: -DHADRIAN_ENABLE_SELFTEST
- build-depends: QuickCheck >= 2.6 && < 2.15
+ build-depends: QuickCheck >= 2.6 && < 2.18
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -384,9 +384,15 @@ omitPragmas = addArgs
-- | Build stage2 dependencies with options to enable IPE debugging
-- information.
enableIPE :: Flavour -> Flavour
-enableIPE = addArgs
- $ notStage0 ? builder (Ghc CompileHs)
- ? pure ["-finfo-table-map", "-fdistinct-constructor-tables"]
+enableIPE =
+ addArgs $
+ mconcat
+ [ notStage0
+ ? builder (Ghc CompileHs)
+ ? pure
+ ["-finfo-table-map", "-fdistinct-constructor-tables"],
+ builder Testsuite ? arg "--config=ghc_with_ipe=True"
+ ]
enableLateCCS :: Flavour -> Flavour
enableLateCCS = addArgs
=====================================
libraries/ghc-compact/tests/all.T
=====================================
@@ -20,7 +20,8 @@ test('compact_gc', [fragile_for(17253, ['ghci']), ignore_stdout], compile_and_ru
# this test computes closure sizes and those are affected
# by the ghci and prof ways, because of BCOs and profiling headers.
# Optimization levels slightly change what is/isn't shared so only run in normal mode
-test('compact_share', only_ways(['normal']), compile_and_run, [''])
+test('compact_share', [only_ways(['normal']), when(ghc_with_ipe(), skip)], # IPE changes allocation/layout affecting compactSize output.
+ compile_and_run, [''])
test('compact_bench', [ ignore_stdout, extra_run_opts('100') ],
compile_and_run, [''])
test('T17044', normal, compile_and_run, [''])
=====================================
libraries/ghc-internal/tests/backtraces/all.T
=====================================
@@ -2,5 +2,5 @@ test('T14532a', [], compile_and_run, [''])
test('T14532b', [], compile_and_run, [''])
test('T26507', [ when(have_profiling(), extra_ways(['prof']))
, when(js_arch(), skip)
- , exit_code(1)], compile_and_run, [''])
-
+ , when(ghc_with_ipe(), skip) # IPE builds include an IPE backtrace section on stderr.
+ , exit_code(1)], compile_and_run, [''])
=====================================
rts/AllocArray.c
=====================================
@@ -5,6 +5,7 @@
StgMutArrPtrs *allocateMutArrPtrs (Capability *cap,
StgWord nelements,
+ StgClosure *init,
CostCentreStack *ccs USED_IF_PROFILING)
{
/* All sizes in words */
@@ -25,6 +26,12 @@ StgMutArrPtrs *allocateMutArrPtrs (Capability *cap,
arr->ptrs = nelements;
arr->size = arrsize;
+ if (init != NULL) {
+ for (StgWord i = 0; i < nelements; ++i) {
+ arr->payload[i] = init;
+ }
+ }
+
/* Initialize the card array. Note that memset needs sizes in bytes. */
memset(&(arr->payload[nelements]), 0, mutArrPtrsCards(nelements));
@@ -33,6 +40,7 @@ StgMutArrPtrs *allocateMutArrPtrs (Capability *cap,
StgSmallMutArrPtrs *allocateSmallMutArrPtrs (Capability *cap,
StgWord nelements,
+ StgClosure *init,
CostCentreStack *ccs
USED_IF_PROFILING)
{
@@ -47,6 +55,13 @@ StgSmallMutArrPtrs *allocateSmallMutArrPtrs (Capability *cap,
/* No write barrier needed since this is a new allocation. */
SET_HDR(arr, &stg_SMALL_MUT_ARR_PTRS_DIRTY_info, ccs);
arr->ptrs = nelements;
+
+ if (init != NULL) {
+ for (StgWord i = 0; i < nelements; ++i) {
+ arr->payload[i] = init;
+ }
+ }
+
return arr;
}
=====================================
rts/AllocArray.h
=====================================
@@ -21,16 +21,19 @@
*/
/* Allocate a StgMutArrPtrs for a given number of elements. It is allocated in
- * the DIRTY state.
+ * the DIRTY state. If init is non-NULL, initialize payload elements to init.
*/
StgMutArrPtrs *allocateMutArrPtrs (Capability *cap,
StgWord nelements,
+ StgClosure *init,
CostCentreStack *ccs);
-/* Allocate a StgSmallMutArrPtrs for a given number of elements.
+/* Allocate a StgSmallMutArrPtrs for a given number of elements. If init is
+ * non-NULL, initialize payload elements to init.
*/
StgSmallMutArrPtrs *allocateSmallMutArrPtrs (Capability *cap,
StgWord nelements,
+ StgClosure *init,
CostCentreStack *ccs);
/* Allocate a StgArrBytes for a given number of bytes.
=====================================
rts/ClosureTable.c
=====================================
@@ -46,7 +46,7 @@ bool enlargeClosureTable(Capability *cap, ClosureTable *t, int newcapacity)
ASSERT(newcapacity > oldcapacity);
StgMutArrPtrs *newarr;
- newarr = allocateMutArrPtrs(cap, newcapacity, CCS_SYSTEM_OR_NULL);
+ newarr = allocateMutArrPtrs(cap, newcapacity, NULL, CCS_SYSTEM_OR_NULL);
if (RTS_UNLIKELY(newarr == NULL)) return false;
StgArrBytes *newfree;
@@ -276,4 +276,3 @@ static bool isCompactClosureTable(ClosureTable *t)
}
return isCompact;
}
-
=====================================
rts/Heap.c
=====================================
@@ -279,7 +279,7 @@ StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure) {
StgClosure **ptrs = (StgClosure **) stgMallocBytes(sizeof(StgClosure *) * size, "heap_view_closurePtrs");
StgWord nptrs = collect_pointers(closure, ptrs);
- StgMutArrPtrs *arr = allocateMutArrPtrs(cap, nptrs, cap->r.rCCCS);
+ StgMutArrPtrs *arr = allocateMutArrPtrs(cap, nptrs, NULL, cap->r.rCCCS);
if (RTS_UNLIKELY(arr == NULL)) goto end;
SET_INFO((StgClosure *) arr, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info);
=====================================
rts/PrimOps.cmm
=====================================
@@ -386,24 +386,11 @@ stg_newArrayzh ( W_ n /* words */, gcptr init )
again: MAYBE_GC(again);
- ("ptr" arr) = ccall allocateMutArrPtrs(MyCapability() "ptr", n, CCCS);
+ ("ptr" arr) = ccall allocateMutArrPtrs(MyCapability() "ptr", n, init "ptr", CCCS);
if (arr == NULL) (likely: False) {
jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
- // Initialise all elements of the array with the value init
- W_ p;
- p = arr + SIZEOF_StgMutArrPtrs;
- // Avoid the shift for `WDS(n)` in the inner loop
- W_ limit;
- limit = arr + SIZEOF_StgMutArrPtrs + WDS(n);
- for:
- if (p < limit) (likely: True) {
- W_[p] = init;
- p = p + WDS(1);
- goto for;
- }
-
return (arr);
}
@@ -496,24 +483,11 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init )
again: MAYBE_GC(again);
- ("ptr" arr) = ccall allocateSmallMutArrPtrs(MyCapability() "ptr", n, CCCS);
+ ("ptr" arr) = ccall allocateSmallMutArrPtrs(MyCapability() "ptr", n, init "ptr", CCCS);
if (arr == NULL) (likely: False) {
jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
- // Initialise all elements of the array with the value init
- W_ p;
- p = arr + SIZEOF_StgSmallMutArrPtrs;
- // Avoid the shift for `WDS(n)` in the inner loop
- W_ limit;
- limit = arr + SIZEOF_StgSmallMutArrPtrs + WDS(n);
- for:
- if (p < limit) (likely: True) {
- W_[p] = init;
- p = p + WDS(1);
- goto for;
- }
-
return (arr);
}
=====================================
rts/RtsFlags.c
=====================================
@@ -209,6 +209,8 @@ void initRtsFlagsDefaults(void)
RtsFlags.DebugFlags.numa = false;
RtsFlags.DebugFlags.compact = false;
RtsFlags.DebugFlags.continuation = false;
+ RtsFlags.DebugFlags.iomanager = false;
+ RtsFlags.DebugFlags.ipe = false;
#if defined(PROFILING)
RtsFlags.CcFlags.doCostCentres = COST_CENTRES_NONE;
@@ -482,6 +484,7 @@ usage_text[] = {
#if defined(DEBUG)
" -Ds DEBUG: scheduler",
" -Di DEBUG: interpreter",
+" -DI DEBUG: IPE",
" -Dw DEBUG: weak",
" -DG DEBUG: gccafs",
" -Dg DEBUG: gc",
@@ -2311,6 +2314,9 @@ static void read_debug_flags(const char* arg)
case 'o':
RtsFlags.DebugFlags.iomanager = true;
break;
+ case 'I':
+ RtsFlags.DebugFlags.ipe = true;
+ break;
default:
bad_option( arg );
}
=====================================
rts/Threads.c
=====================================
@@ -894,7 +894,7 @@ StgMutArrPtrs *listThreads(Capability *cap)
}
// Allocate a suitably-sized array...
- StgMutArrPtrs *arr = allocateMutArrPtrs(cap, n_threads, cap->r.rCCCS);
+ StgMutArrPtrs *arr = allocateMutArrPtrs(cap, n_threads, NULL, cap->r.rCCCS);
if (RTS_UNLIKELY(arr == NULL)) goto end;
// Populate it...
=====================================
rts/Trace.c
=====================================
@@ -685,7 +685,8 @@ void traceHeapProfSampleString(const char *label, StgWord residency)
void traceIPE(const InfoProvEnt *ipe)
{
#if defined(DEBUG)
- if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
+ if (RtsFlags.TraceFlags.tracing == TRACE_STDERR
+ && RtsFlags.DebugFlags.ipe) {
ACQUIRE_LOCK(&trace_utx);
char closure_desc_buf[CLOSURE_DESC_BUFFER_SIZE] = {};
=====================================
rts/Weak.c
=====================================
@@ -146,7 +146,7 @@ scheduleFinalizers(Capability *cap, StgWeak *list)
debugTrace(DEBUG_weak, "weak: batching %d finalizers", n);
- StgMutArrPtrs *arr = allocateMutArrPtrs(cap, n, CCS_SYSTEM_OR_NULL);
+ StgMutArrPtrs *arr = allocateMutArrPtrs(cap, n, NULL, CCS_SYSTEM_OR_NULL);
if (RTS_UNLIKELY(arr == NULL)) exitHeapOverflow();
// No write barrier needed here; this array is only going to referred to by this core.
SET_INFO((StgClosure *) arr, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info);
=====================================
rts/include/rts/Flags.h
=====================================
@@ -118,6 +118,7 @@ typedef struct _DEBUG_FLAGS {
bool compact; /* 'C' */
bool continuation; /* 'k' */
bool iomanager; /* 'o' */
+ bool ipe; /* 'I' */
} DEBUG_FLAGS;
/* See Note [Synchronization of flags and base APIs] */
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -72,6 +72,10 @@ class TestConfig:
# Was the compiler compiled with -debug?
self.debug_rts = False
+ # Were the compiler + libraries built with IPE-related options
+ # (e.g. -finfo-table-map, -fdistinct-constructor-tables)?
+ self.ghc_with_ipe = False
+
# Was the compiler compiled with LLVM?
self.ghc_built_by_llvm = False
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1074,6 +1074,9 @@ def have_profiling( ) -> bool:
def have_threaded( ) -> bool:
return config.ghc_with_threaded_rts
+def ghc_with_ipe( ) -> bool:
+ return config.ghc_with_ipe
+
def in_tree_compiler( ) -> bool:
return config.in_tree_compiler
=====================================
testsuite/tests/rts/Makefile
=====================================
@@ -140,7 +140,7 @@ T20199:
.PHONY: EventlogOutput_IPE
EventlogOutput_IPE:
"$(TEST_HC)" $(TEST_HC_OPTS) -debug -finfo-table-map -v0 EventlogOutput.hs
- ./EventlogOutput +RTS -va 2> EventlogOutput_IPE.stderr.log
+ ./EventlogOutput +RTS -va -DI 2> EventlogOutput_IPE.stderr.log
grep "IPE:" EventlogOutput_IPE.stderr.log
.PHONY: T23142
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -535,6 +535,7 @@ test('T13676',
test('InitEventLogging',
[ only_ways(['normal'])
, extra_run_opts('+RTS -RTS')
+ , when(ghc_with_ipe(), skip) # IPE builds can change eventlog writer call counts.
, req_c
],
compile_and_run, ['InitEventLogging_c.c'])
@@ -588,6 +589,7 @@ test('cloneThreadStack', [req_c, only_ways(['threaded1']), extra_ways(['threaded
test('decodeMyStack',
[ omit_ghci, js_broken(22261) # cloneMyStack# not yet implemented
+ , when(ghc_with_ipe(), skip) # IPE builds can change decoded stack output.
], compile_and_run, ['-finfo-table-map'])
# Options:
@@ -595,6 +597,7 @@ test('decodeMyStack',
test('decodeMyStack_underflowFrames',
[ extra_run_opts('+RTS -kc8K -RTS')
, omit_ghci, js_broken(22261) # cloneMyStack# not yet implemented
+ , when(ghc_with_ipe(), skip) # IPE builds can change decoded stack layout/length.
], compile_and_run, ['-finfo-table-map -rtsopts'])
# -finfo-table-map intentionally missing
@@ -602,6 +605,7 @@ test('decodeMyStack_emptyListForMissingFlag',
[ ignore_stdout
, ignore_stderr
, js_broken(22261) # cloneMyStack# not yet implemented
+ , when(ghc_with_ipe(), skip) # IPE builds can populate IPE info even without -finfo-table-map on this module.
], compile_and_run, [''])
# Tests RTS flag parsing. Skipped on JS as it uses a distinct RTS.
@@ -646,7 +650,7 @@ test('T25280', [unless(opsys('linux'),skip),req_process,js_skip], compile_and_ru
test('T25560', [req_c_rts, ignore_stderr], compile_and_run, [''])
test('TestProddableBlockSet', [req_c_rts], multimod_compile_and_run, ['TestProddableBlockSet.c', '-no-hs-main'])
-test('T22859',
+test('T22859',
[js_skip,
# This test is vulnerable to changes in allocation behaviour, so we disable it in some ways
when(arch('wasm32'), skip),
=====================================
testsuite/tests/rts/ipe/all.T
=====================================
@@ -8,7 +8,7 @@ test('ipeMap', [extra_files(['ipe_lib.c', 'ipe_lib.h']), c_src, omit_ghci], comp
test('ipeEventLog',
[ c_src,
extra_files(['ipe_lib.c', 'ipe_lib.h']),
- extra_run_opts('+RTS -va -RTS'),
+ extra_run_opts('+RTS -va -DI -RTS'),
grep_errmsg('table_name_'),
only_ways(debug_ways),
normalise_errmsg_fun(noCapabilityOutputFilter),
@@ -24,7 +24,7 @@ test('ipeEventLog',
test('ipeEventLog_fromMap',
[ c_src,
extra_files(['ipe_lib.c', 'ipe_lib.h']),
- extra_run_opts('+RTS -va -RTS'),
+ extra_run_opts('+RTS -va -DI -RTS'),
grep_errmsg('table_name_'),
only_ways(debug_ways),
normalise_errmsg_fun(noCapabilityOutputFilter),
@@ -34,4 +34,3 @@ test('ipeEventLog_fromMap',
when(opsys('darwin'), fragile(0))
],
compile_and_run, ['ipe_lib.c'])
-
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f45dfca553ce91069e2f9fa10eead…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f45dfca553ce91069e2f9fa10eead…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Fix testsuite run for +ipe flavour transformer
by Marge Bot (＠marge-bot) 22 Jan '26
by Marge Bot (＠marge-bot) 22 Jan '26
22 Jan '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
4c784f00 by Cheng Shao at 2026-01-22T14:53:19-05:00
Fix testsuite run for +ipe flavour transformer
This patch makes the +ipe flavour transformer pass the entire
testsuite:
- An RTS debug option `-DI` is added, the IPE trace information is now
only printed with `-DI`. The test cases that do require IPE trace
are now run with `-DI`.
- The testsuite config option `ghc_with_ipe` is added, enabled when
running the testsuite with `+ipe`, which skips a few tests that are
sensitive to eventlog output, allocation patterns etc that can fail
under `+ipe`.
This is the first step towards #26799.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
12 changed files:
- docs/users_guide/runtime_control.rst
- hadrian/src/Flavour.hs
- libraries/ghc-compact/tests/all.T
- libraries/ghc-internal/tests/backtraces/all.T
- rts/RtsFlags.c
- rts/Trace.c
- rts/include/rts/Flags.h
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/tests/rts/Makefile
- testsuite/tests/rts/all.T
- testsuite/tests/rts/ipe/all.T
Changes:
=====================================
docs/users_guide/runtime_control.rst
=====================================
@@ -1588,6 +1588,7 @@ recommended for everyday use!
.. rts-flag:: -Ds DEBUG: scheduler
.. rts-flag:: -Di DEBUG: interpreter
+.. rts-flag:: -DI DEBUG: IPE
.. rts-flag:: -Dw DEBUG: weak
.. rts-flag:: -DG DEBUG: gccafs
.. rts-flag:: -Dg DEBUG: gc
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -384,9 +384,15 @@ omitPragmas = addArgs
-- | Build stage2 dependencies with options to enable IPE debugging
-- information.
enableIPE :: Flavour -> Flavour
-enableIPE = addArgs
- $ notStage0 ? builder (Ghc CompileHs)
- ? pure ["-finfo-table-map", "-fdistinct-constructor-tables"]
+enableIPE =
+ addArgs $
+ mconcat
+ [ notStage0
+ ? builder (Ghc CompileHs)
+ ? pure
+ ["-finfo-table-map", "-fdistinct-constructor-tables"],
+ builder Testsuite ? arg "--config=ghc_with_ipe=True"
+ ]
enableLateCCS :: Flavour -> Flavour
enableLateCCS = addArgs
=====================================
libraries/ghc-compact/tests/all.T
=====================================
@@ -20,7 +20,8 @@ test('compact_gc', [fragile_for(17253, ['ghci']), ignore_stdout], compile_and_ru
# this test computes closure sizes and those are affected
# by the ghci and prof ways, because of BCOs and profiling headers.
# Optimization levels slightly change what is/isn't shared so only run in normal mode
-test('compact_share', only_ways(['normal']), compile_and_run, [''])
+test('compact_share', [only_ways(['normal']), when(ghc_with_ipe(), skip)], # IPE changes allocation/layout affecting compactSize output.
+ compile_and_run, [''])
test('compact_bench', [ ignore_stdout, extra_run_opts('100') ],
compile_and_run, [''])
test('T17044', normal, compile_and_run, [''])
=====================================
libraries/ghc-internal/tests/backtraces/all.T
=====================================
@@ -2,5 +2,5 @@ test('T14532a', [], compile_and_run, [''])
test('T14532b', [], compile_and_run, [''])
test('T26507', [ when(have_profiling(), extra_ways(['prof']))
, when(js_arch(), skip)
- , exit_code(1)], compile_and_run, [''])
-
+ , when(ghc_with_ipe(), skip) # IPE builds include an IPE backtrace section on stderr.
+ , exit_code(1)], compile_and_run, [''])
=====================================
rts/RtsFlags.c
=====================================
@@ -209,6 +209,8 @@ void initRtsFlagsDefaults(void)
RtsFlags.DebugFlags.numa = false;
RtsFlags.DebugFlags.compact = false;
RtsFlags.DebugFlags.continuation = false;
+ RtsFlags.DebugFlags.iomanager = false;
+ RtsFlags.DebugFlags.ipe = false;
#if defined(PROFILING)
RtsFlags.CcFlags.doCostCentres = COST_CENTRES_NONE;
@@ -482,6 +484,7 @@ usage_text[] = {
#if defined(DEBUG)
" -Ds DEBUG: scheduler",
" -Di DEBUG: interpreter",
+" -DI DEBUG: IPE",
" -Dw DEBUG: weak",
" -DG DEBUG: gccafs",
" -Dg DEBUG: gc",
@@ -2311,6 +2314,9 @@ static void read_debug_flags(const char* arg)
case 'o':
RtsFlags.DebugFlags.iomanager = true;
break;
+ case 'I':
+ RtsFlags.DebugFlags.ipe = true;
+ break;
default:
bad_option( arg );
}
=====================================
rts/Trace.c
=====================================
@@ -685,7 +685,8 @@ void traceHeapProfSampleString(const char *label, StgWord residency)
void traceIPE(const InfoProvEnt *ipe)
{
#if defined(DEBUG)
- if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
+ if (RtsFlags.TraceFlags.tracing == TRACE_STDERR
+ && RtsFlags.DebugFlags.ipe) {
ACQUIRE_LOCK(&trace_utx);
char closure_desc_buf[CLOSURE_DESC_BUFFER_SIZE] = {};
=====================================
rts/include/rts/Flags.h
=====================================
@@ -118,6 +118,7 @@ typedef struct _DEBUG_FLAGS {
bool compact; /* 'C' */
bool continuation; /* 'k' */
bool iomanager; /* 'o' */
+ bool ipe; /* 'I' */
} DEBUG_FLAGS;
/* See Note [Synchronization of flags and base APIs] */
=====================================
testsuite/driver/testglobals.py
=====================================
@@ -72,6 +72,10 @@ class TestConfig:
# Was the compiler compiled with -debug?
self.debug_rts = False
+ # Were the compiler + libraries built with IPE-related options
+ # (e.g. -finfo-table-map, -fdistinct-constructor-tables)?
+ self.ghc_with_ipe = False
+
# Was the compiler compiled with LLVM?
self.ghc_built_by_llvm = False
=====================================
testsuite/driver/testlib.py
=====================================
@@ -1074,6 +1074,9 @@ def have_profiling( ) -> bool:
def have_threaded( ) -> bool:
return config.ghc_with_threaded_rts
+def ghc_with_ipe( ) -> bool:
+ return config.ghc_with_ipe
+
def in_tree_compiler( ) -> bool:
return config.in_tree_compiler
=====================================
testsuite/tests/rts/Makefile
=====================================
@@ -140,7 +140,7 @@ T20199:
.PHONY: EventlogOutput_IPE
EventlogOutput_IPE:
"$(TEST_HC)" $(TEST_HC_OPTS) -debug -finfo-table-map -v0 EventlogOutput.hs
- ./EventlogOutput +RTS -va 2> EventlogOutput_IPE.stderr.log
+ ./EventlogOutput +RTS -va -DI 2> EventlogOutput_IPE.stderr.log
grep "IPE:" EventlogOutput_IPE.stderr.log
.PHONY: T23142
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -535,6 +535,7 @@ test('T13676',
test('InitEventLogging',
[ only_ways(['normal'])
, extra_run_opts('+RTS -RTS')
+ , when(ghc_with_ipe(), skip) # IPE builds can change eventlog writer call counts.
, req_c
],
compile_and_run, ['InitEventLogging_c.c'])
@@ -588,6 +589,7 @@ test('cloneThreadStack', [req_c, only_ways(['threaded1']), extra_ways(['threaded
test('decodeMyStack',
[ omit_ghci, js_broken(22261) # cloneMyStack# not yet implemented
+ , when(ghc_with_ipe(), skip) # IPE builds can change decoded stack output.
], compile_and_run, ['-finfo-table-map'])
# Options:
@@ -595,6 +597,7 @@ test('decodeMyStack',
test('decodeMyStack_underflowFrames',
[ extra_run_opts('+RTS -kc8K -RTS')
, omit_ghci, js_broken(22261) # cloneMyStack# not yet implemented
+ , when(ghc_with_ipe(), skip) # IPE builds can change decoded stack layout/length.
], compile_and_run, ['-finfo-table-map -rtsopts'])
# -finfo-table-map intentionally missing
@@ -602,6 +605,7 @@ test('decodeMyStack_emptyListForMissingFlag',
[ ignore_stdout
, ignore_stderr
, js_broken(22261) # cloneMyStack# not yet implemented
+ , when(ghc_with_ipe(), skip) # IPE builds can populate IPE info even without -finfo-table-map on this module.
], compile_and_run, [''])
# Tests RTS flag parsing. Skipped on JS as it uses a distinct RTS.
@@ -646,7 +650,7 @@ test('T25280', [unless(opsys('linux'),skip),req_process,js_skip], compile_and_ru
test('T25560', [req_c_rts, ignore_stderr], compile_and_run, [''])
test('TestProddableBlockSet', [req_c_rts], multimod_compile_and_run, ['TestProddableBlockSet.c', '-no-hs-main'])
-test('T22859',
+test('T22859',
[js_skip,
# This test is vulnerable to changes in allocation behaviour, so we disable it in some ways
when(arch('wasm32'), skip),
=====================================
testsuite/tests/rts/ipe/all.T
=====================================
@@ -8,7 +8,7 @@ test('ipeMap', [extra_files(['ipe_lib.c', 'ipe_lib.h']), c_src, omit_ghci], comp
test('ipeEventLog',
[ c_src,
extra_files(['ipe_lib.c', 'ipe_lib.h']),
- extra_run_opts('+RTS -va -RTS'),
+ extra_run_opts('+RTS -va -DI -RTS'),
grep_errmsg('table_name_'),
only_ways(debug_ways),
normalise_errmsg_fun(noCapabilityOutputFilter),
@@ -24,7 +24,7 @@ test('ipeEventLog',
test('ipeEventLog_fromMap',
[ c_src,
extra_files(['ipe_lib.c', 'ipe_lib.h']),
- extra_run_opts('+RTS -va -RTS'),
+ extra_run_opts('+RTS -va -DI -RTS'),
grep_errmsg('table_name_'),
only_ways(debug_ways),
normalise_errmsg_fun(noCapabilityOutputFilter),
@@ -34,4 +34,3 @@ test('ipeEventLog_fromMap',
when(opsys('darwin'), fragile(0))
],
compile_and_run, ['ipe_lib.c'])
-
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c784f00a47871cdda7f6fd49728a8c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4c784f00a47871cdda7f6fd49728a8c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] rts: avoid Cmm loop to initialize Array#/SmallArray#
by Marge Bot (＠marge-bot) 22 Jan '26
by Marge Bot (＠marge-bot) 22 Jan '26
22 Jan '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
cdb74049 by Cheng Shao at 2026-01-22T14:52:36-05:00
rts: avoid Cmm loop to initialize Array#/SmallArray#
Previously, `newArray#`/`newSmallArray#` called an RTS C function to
allocate the `Array#`/`SmallArray#`, then used a Cmm loop to
initialize the elements. Cmm doesn't have native for-loop so the code
is a bit awkward, and it's less efficient than a C loop, since the C
compiler can effectively vectorize the loop with optimizations.
So this patch moves the loop that initializes the elements to the C
side. `allocateMutArrPtrs`/`allocateSmallMutArrPtrs` now takes a new
`init` argument and initializes the elements if `init` is non-NULL.
- - - - -
7 changed files:
- rts/AllocArray.c
- rts/AllocArray.h
- rts/ClosureTable.c
- rts/Heap.c
- rts/PrimOps.cmm
- rts/Threads.c
- rts/Weak.c
Changes:
=====================================
rts/AllocArray.c
=====================================
@@ -5,6 +5,7 @@
StgMutArrPtrs *allocateMutArrPtrs (Capability *cap,
StgWord nelements,
+ StgClosure *init,
CostCentreStack *ccs USED_IF_PROFILING)
{
/* All sizes in words */
@@ -25,6 +26,12 @@ StgMutArrPtrs *allocateMutArrPtrs (Capability *cap,
arr->ptrs = nelements;
arr->size = arrsize;
+ if (init != NULL) {
+ for (StgWord i = 0; i < nelements; ++i) {
+ arr->payload[i] = init;
+ }
+ }
+
/* Initialize the card array. Note that memset needs sizes in bytes. */
memset(&(arr->payload[nelements]), 0, mutArrPtrsCards(nelements));
@@ -33,6 +40,7 @@ StgMutArrPtrs *allocateMutArrPtrs (Capability *cap,
StgSmallMutArrPtrs *allocateSmallMutArrPtrs (Capability *cap,
StgWord nelements,
+ StgClosure *init,
CostCentreStack *ccs
USED_IF_PROFILING)
{
@@ -47,6 +55,13 @@ StgSmallMutArrPtrs *allocateSmallMutArrPtrs (Capability *cap,
/* No write barrier needed since this is a new allocation. */
SET_HDR(arr, &stg_SMALL_MUT_ARR_PTRS_DIRTY_info, ccs);
arr->ptrs = nelements;
+
+ if (init != NULL) {
+ for (StgWord i = 0; i < nelements; ++i) {
+ arr->payload[i] = init;
+ }
+ }
+
return arr;
}
=====================================
rts/AllocArray.h
=====================================
@@ -21,16 +21,19 @@
*/
/* Allocate a StgMutArrPtrs for a given number of elements. It is allocated in
- * the DIRTY state.
+ * the DIRTY state. If init is non-NULL, initialize payload elements to init.
*/
StgMutArrPtrs *allocateMutArrPtrs (Capability *cap,
StgWord nelements,
+ StgClosure *init,
CostCentreStack *ccs);
-/* Allocate a StgSmallMutArrPtrs for a given number of elements.
+/* Allocate a StgSmallMutArrPtrs for a given number of elements. If init is
+ * non-NULL, initialize payload elements to init.
*/
StgSmallMutArrPtrs *allocateSmallMutArrPtrs (Capability *cap,
StgWord nelements,
+ StgClosure *init,
CostCentreStack *ccs);
/* Allocate a StgArrBytes for a given number of bytes.
=====================================
rts/ClosureTable.c
=====================================
@@ -46,7 +46,7 @@ bool enlargeClosureTable(Capability *cap, ClosureTable *t, int newcapacity)
ASSERT(newcapacity > oldcapacity);
StgMutArrPtrs *newarr;
- newarr = allocateMutArrPtrs(cap, newcapacity, CCS_SYSTEM_OR_NULL);
+ newarr = allocateMutArrPtrs(cap, newcapacity, NULL, CCS_SYSTEM_OR_NULL);
if (RTS_UNLIKELY(newarr == NULL)) return false;
StgArrBytes *newfree;
@@ -276,4 +276,3 @@ static bool isCompactClosureTable(ClosureTable *t)
}
return isCompact;
}
-
=====================================
rts/Heap.c
=====================================
@@ -279,7 +279,7 @@ StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure) {
StgClosure **ptrs = (StgClosure **) stgMallocBytes(sizeof(StgClosure *) * size, "heap_view_closurePtrs");
StgWord nptrs = collect_pointers(closure, ptrs);
- StgMutArrPtrs *arr = allocateMutArrPtrs(cap, nptrs, cap->r.rCCCS);
+ StgMutArrPtrs *arr = allocateMutArrPtrs(cap, nptrs, NULL, cap->r.rCCCS);
if (RTS_UNLIKELY(arr == NULL)) goto end;
SET_INFO((StgClosure *) arr, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info);
=====================================
rts/PrimOps.cmm
=====================================
@@ -386,24 +386,11 @@ stg_newArrayzh ( W_ n /* words */, gcptr init )
again: MAYBE_GC(again);
- ("ptr" arr) = ccall allocateMutArrPtrs(MyCapability() "ptr", n, CCCS);
+ ("ptr" arr) = ccall allocateMutArrPtrs(MyCapability() "ptr", n, init "ptr", CCCS);
if (arr == NULL) (likely: False) {
jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
- // Initialise all elements of the array with the value init
- W_ p;
- p = arr + SIZEOF_StgMutArrPtrs;
- // Avoid the shift for `WDS(n)` in the inner loop
- W_ limit;
- limit = arr + SIZEOF_StgMutArrPtrs + WDS(n);
- for:
- if (p < limit) (likely: True) {
- W_[p] = init;
- p = p + WDS(1);
- goto for;
- }
-
return (arr);
}
@@ -496,24 +483,11 @@ stg_newSmallArrayzh ( W_ n /* words */, gcptr init )
again: MAYBE_GC(again);
- ("ptr" arr) = ccall allocateSmallMutArrPtrs(MyCapability() "ptr", n, CCCS);
+ ("ptr" arr) = ccall allocateSmallMutArrPtrs(MyCapability() "ptr", n, init "ptr", CCCS);
if (arr == NULL) (likely: False) {
jump stg_raisezh(HsIface_heapOverflow_closure(W_[ghc_hs_iface]));
}
- // Initialise all elements of the array with the value init
- W_ p;
- p = arr + SIZEOF_StgSmallMutArrPtrs;
- // Avoid the shift for `WDS(n)` in the inner loop
- W_ limit;
- limit = arr + SIZEOF_StgSmallMutArrPtrs + WDS(n);
- for:
- if (p < limit) (likely: True) {
- W_[p] = init;
- p = p + WDS(1);
- goto for;
- }
-
return (arr);
}
=====================================
rts/Threads.c
=====================================
@@ -894,7 +894,7 @@ StgMutArrPtrs *listThreads(Capability *cap)
}
// Allocate a suitably-sized array...
- StgMutArrPtrs *arr = allocateMutArrPtrs(cap, n_threads, cap->r.rCCCS);
+ StgMutArrPtrs *arr = allocateMutArrPtrs(cap, n_threads, NULL, cap->r.rCCCS);
if (RTS_UNLIKELY(arr == NULL)) goto end;
// Populate it...
=====================================
rts/Weak.c
=====================================
@@ -146,7 +146,7 @@ scheduleFinalizers(Capability *cap, StgWeak *list)
debugTrace(DEBUG_weak, "weak: batching %d finalizers", n);
- StgMutArrPtrs *arr = allocateMutArrPtrs(cap, n, CCS_SYSTEM_OR_NULL);
+ StgMutArrPtrs *arr = allocateMutArrPtrs(cap, n, NULL, CCS_SYSTEM_OR_NULL);
if (RTS_UNLIKELY(arr == NULL)) exitHeapOverflow();
// No write barrier needed here; this array is only going to referred to by this core.
SET_INFO((StgClosure *) arr, &stg_MUT_ARR_PTRS_FROZEN_CLEAN_info);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdb74049456a5e58c0923bccb08fc8e…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cdb74049456a5e58c0923bccb08fc8e…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
22 Jan '26
Cheng Shao pushed new branch wip/remove-libffi-make at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/remove-libffi-make
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/labelThread-export] 87 commits: Add missing InVar->OutVar lookup in SetLevels
by Teo Camarasu (＠teo) 22 Jan '26
by Teo Camarasu (＠teo) 22 Jan '26
22 Jan '26
Teo Camarasu pushed to branch wip/labelThread-export at Glasgow Haskell Compiler / GHC
Commits:
52d00c05 by Simon Peyton Jones at 2026-01-07T10:24:21-05:00
Add missing InVar->OutVar lookup in SetLevels
As #26681 showed, the SetLevels pass was failing to map an InVar to
an OutVar. Very silly! I'm amazed it hasn't broken before now.
I have improved the type singatures (to mention InVar and OutVar)
so it's more obvious what needs to happen.
- - - - -
ab0a5594 by Cheng Shao at 2026-01-07T10:25:04-05:00
hadrian: drop deprecated pkgHashSplitObjs code path
This patch drops deprecated `pkgHashSplitObjs` code path from hadrian,
since GHC itself has removed split objs support many versions ago and
this code path is unused.
- - - - -
bb3a2ba1 by Cheng Shao at 2026-01-07T10:25:44-05:00
hadrian: remove linting/assertion in quick-validate flavour
The `quick-validate` flavour is meant for testing ghc and passing the
testsuite locally with similar settings to `validate` but faster. This
patch removes the linting/assertion overhead in `quick-validate` to
improve developer experience. I also took the chance to simplify
redundant logic of rts/library way definition in `validate` flavour.
- - - - -
7971f5dd by Cheng Shao at 2026-01-07T10:26:26-05:00
deriveConstants: clean up unused constants
This patch cleans up unused constants from `deriveConstants`, they are
not used by C/Cmm code in the RTS, nor compiler-generated code.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
4df96993 by Cheng Shao at 2026-01-07T10:27:08-05:00
hadrian: pass -fno-omit-frame-pointer with +debug_info
This patch adds `-fno-omit-frame-pointer` as C/C++ compilation flag
when compiling with `+debug_info` flavour transformer. It's a sane
default when you care about debugging and reliable backtraces, and
makes debugging/profiling with bpf easier.
- - - - -
8a3900a3 by Aaron Allen at 2026-01-07T10:27:57-05:00
[26705] Include TyCl instances in data fam iface entry
Ensures dependent modules are recompiled when the class instances for a
data family instance change.
resolves #26705
- - - - -
a0b980af by Cheng Shao at 2026-01-07T10:28:38-05:00
hadrian: remove unused Hp2Ps/Hpc builders
This patch removes the Hp2Ps/Hpc builders from hadrian, they are
unused in the build system. Note that the hp2ps/hpc programs are still
built and not affected.
- - - - -
50a58757 by Cheng Shao at 2026-01-07T10:29:20-05:00
hadrian: only install js files to libdir for wasm/js targets
There are certain js files required for wasm/js targets to work, and
previously hadrian would install those js files to libdir
unconditionally on other targets as well. This could be a minor
annoyance for packagers especially when the unused js files contain
shebangs that interfere with the packaging process. This patch makes
hadrian only selectively install the right js files for the right
targets.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
da40e553 by Simon Peyton Jones at 2026-01-07T10:30:00-05:00
Add flavour transformer assertions_stage1
This allows us to enable -DDEBUG assertions in the stage1 compiler
- - - - -
ec3cf767 by Cheng Shao at 2026-01-08T06:24:31-05:00
make: remove unused Makefiles from legacy make build system
This patch removes unused Makefiles from legacy make build system; now
they are never used by hadrian in any way, and they already include
common boilerplate mk files that are long gone in the make build
system removal, hence the housecleaning.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
04ea3f83 by Cheng Shao at 2026-01-08T06:25:13-05:00
compiler: use -O3 as LLVM optimization level for ghc -O2
The GHC driver clamps LLVM optimization level to `-O2` due to LLVM
crashes, but those were historical issues many years ago that are no
longer relevant for LLVM versions we support today. This patch changes
the driver to use `-O3` as LLVM optimization level when compiling with
`-O2`, which is a better default when we're willing to trade
compilation time for faster generated code.
- - - - -
472df471 by Peter Trommler at 2026-01-08T13:28:54-05:00
Use half-word literals in info tables
With this commit info tables are mapped to the same assembler code
on big-endian and little-endian platforms.
Fixes #26579.
- - - - -
393f9c51 by Simon Peyton Jones at 2026-01-08T13:29:35-05:00
Refactor srutOkForBinderSwap
This MR does a small refactor:
* Moves `scrutOkForBinderSwap` and `BinderSwapDecision`
to GHC.Core.Utils
* Inverts the sense of the coercion it returns, which makes
more sense
No effect on behaviour
- - - - -
ad76fb0f by Simon Peyton Jones at 2026-01-08T13:29:36-05:00
Improve case merging
This small MR makes case merging happen a bit more often than
it otherwise could, by getting join points out of the way.
See #26709 and GHC.Core.Utils
Note [Floating join points out of DEFAULT alternatives]
- - - - -
4c9395f5 by Cheng Shao at 2026-01-08T13:30:16-05:00
hadrian: remove broken hsc2hs flag when cross compiling to windows
This patch removes the `--via-asm` hsc2hs flag when cross compiling to
windows. With recent llvm-mingw toolchain, it would fail with:
```
x86_64-w64-mingw32-hsc2hs: Cannot combine instructions: [Quad 8,Long 4,Long 241,Ref ".Ltmp1-.Ltmp0"]
```
The hsc2hs default `--cross-compile` logic is slower but works.
- - - - -
71fdef55 by Simon Peyton Jones at 2026-01-08T13:30:57-05:00
Try harder to keep the substitution empty
Avoid unnecessary cloning of variables in the Simplifier.
Addresses #26724,
See Note [Keeping the substitution empty]
We get some big wins in compile time
Metrics: compile_time/bytes allocated
-------------------------------------
Baseline
Test Metric value New value Change
----------------------------------------------------------------------------
CoOpt_Singletons(normal) ghc/alloc 721,544,088 692,174,216 -4.1% GOOD
LargeRecord(normal) ghc/alloc 1,268,031,157 1,265,168,448 -0.2%
T14766(normal) ghc/alloc 918,218,533 688,432,296 -25.0% GOOD
T15703(normal) ghc/alloc 318,103,629 306,638,016 -3.6% GOOD
T17836(normal) ghc/alloc 419,174,584 418,400,824 -0.2%
T18478(normal) ghc/alloc 471,042,976 470,261,376 -0.2%
T20261(normal) ghc/alloc 573,387,162 563,663,336 -1.7%
T24984(normal) ghc/alloc 87,832,666 87,636,168 -0.2%
T25196(optasm) ghc/alloc 1,103,284,040 1,101,376,992 -0.2%
hard_hole_fits(normal) ghc/alloc 224,981,413 224,608,208 -0.2%
geo. mean -0.3%
minimum -25.0%
maximum +0.1%
Metric Decrease:
CoOpt_Singletons
T14766
T15703
- - - - -
30341168 by Simon Peyton Jones at 2026-01-08T13:31:38-05:00
Add regression test for #24867
- - - - -
1ac1a541 by Julian Ospald at 2026-01-09T02:48:53-05:00
Support statically linking executables properly
Fixes #26434
In detail, this does a number of things:
* Makes GHC aware of 'extra-libraries-static' (this changes the package
database format).
* Adds a switch '-static-external' that will honour 'extra-libraries-static'
to link external system dependencies statically.
* Adds a new field to settings/targets: "ld supports verbatim namespace".
This field is used by '-static-external' to conditionally use '-l:foo.a'
syntax during linking, which is more robust than trying to find the
absolute path to an archive on our own.
* Adds a switch '-fully-static' that is meant as a high-level interface
for e.g. cabal. This also honours 'extra-libraries-static'.
This also attempts to clean up the confusion around library search directories.
At the moment, we have 3 types of directories in the package database
format:
* library-dirs
* library-dirs-static
* dynamic-library-dirs
However, we only have two types of linking: dynamic or static. Given the
existing logic in 'mungeDynLibFields', this patch assumes that
'library-dirs' is really just nothing but a fallback and always
prefers the more specific variants if they exist and are non-empty.
Conceptually, we should be ok with even just one search dirs variant.
Haskell libraries are named differently depending on whether they're
static or dynamic, so GHC can conveniently pick the right one depending
on the linking needs. That means we don't really need to play tricks
with search paths to convince the compiler to do linking as we want it.
For system C libraries, the convention has been anyway to place static and
dynamic libs next to each other, so we need to deal with that issue
anyway and it is outside of our control. But this is out of the scope
of this patch.
This patch is backwards compatible with cabal. Cabal should however
be patched to use the new '-fully-static' switch.
- - - - -
ad3c808d by Julian Ospald at 2026-01-09T02:48:53-05:00
Warn when "-dynamic" is mixed with "-staticlib"
- - - - -
322dd672 by Matthew Pickering at 2026-01-09T02:49:35-05:00
rts: Use INFO_TABLE_CONSTR for stg_dummy_ret_closure
Since the closure type is CONSTR_NOCAF, we need to use INFO_TABLE_CONSTR
to populate the constructor description field (this crashes ghc-debug
when decoding AP_STACK frames sometimes)
Fixes #26745
- - - - -
039bac4c by Ben Gamari at 2026-01-09T20:22:16-05:00
ghc-internal: Move STM utilities out of GHC.Internal.Conc.Sync
This is necessary to avoid an import cycle on Windows when importing
`GHC.Internal.Exception.Context` in `GHC.Internal.Conc.Sync`.
On the road to address #25365.
- - - - -
8c389e8c by Ben Gamari at 2026-01-09T20:22:16-05:00
base: Capture backtrace from throwSTM
Implements core-libraries-committee#297.
Fixes #25365.
- - - - -
e1ce1fc3 by Ben Gamari at 2026-01-09T20:22:16-05:00
base: Annotate rethrown exceptions in catchSTM with WhileHandling
Implements core-libraries-committee#298
- - - - -
c4ebdbdf by Cheng Shao at 2026-01-09T20:23:06-05:00
compiler: make getPrim eagerly evaluate its result
This commit makes `GHC.Utils.Binary.getPrim` eagerly evaluate its
result, to avoid accidental laziness when future patches build other
binary parsers using `getPrim`.
- - - - -
66a0c4f7 by Cheng Shao at 2026-01-09T20:23:06-05:00
compiler: implement fast get/put for Word16/Word32/Word64
Previously, `GHC.Utils.Binary` contains `get`/`put` functions for
`Word16`/`Word32`/`Word64` which always loads and stores them as
big-endian words at a potentially unaligned address. The previous
implementation is based on loads/stores of individual bytes and
concatenating bytes with bitwise operations, which currently cannot be
fused to a single load/store operation by GHC.
This patch implements fast `get`/`put` functions for
`Word16`/`Word32`/`Word64` based on a single memory load/store, with
an additional `byteSwap` operation on little-endian hosts. It is based
on unaligned load/store primops added since GHC 9.10, and we already
require booting with at least 9.10, so it's about time to switch to
this faster path.
- - - - -
641ec3f0 by Simon Peyton Jones at 2026-01-09T20:23:55-05:00
Fix scoping errors in specialisation
Using -fspecialise-aggressively in #26682 showed up a couple of
subtle errors in the type-class specialiser.
* dumpBindUDs failed to call `deleteCallsMentioning`, resulting in a
call that mentioned a dictionary that was not in scope. This call
has been missing since 2009!
commit c43c981705ec33da92a9ce91eb90f2ecf00be9fe
Author: Simon Peyton Jones <simonpj(a)microsoft.com>
Date: Fri Oct 23 16:15:51 2009 +0000
Fixed by re-combining `dumpBindUDs` and `dumpUDs`.
* I think there was another bug involving the quantified type
variables in polymorphic specialisation. In any case I refactored
`specHeader` and `spec_call` so that the former looks for the
extra quantified type variables rather than the latter. This
is quite a worthwhile simplification: less code, easier to grok.
Test case in simplCore/should_compile/T26682,
brilliantly minimised by @sheaf.
- - - - -
2433e91d by Cheng Shao at 2026-01-09T20:24:43-05:00
compiler: change sectionProtection to take SectionType argument
This commit changes `sectionProtection` to only take `SectionType`
argument instead of whole `Section`, since it doesn't need the Cmm
section content anyway, and it can then be called in parts of NCG
where we only have a `SectionType` in scope.
- - - - -
e5926fbe by Cheng Shao at 2026-01-09T20:24:43-05:00
compiler: change isInitOrFiniSection to take SectionType argument
This commit changes `isInitOrFiniSection` to only take `SectionType`
argument instead of whole `Section`, since it doesn't need the Cmm
section content anyway, and it can then be called in parts of NCG
where we only have a `SectionType` in scope. Also marks it as
exported.
- - - - -
244d57d7 by Cheng Shao at 2026-01-09T20:24:43-05:00
compiler: fix split sections on windows
This patch fixes split sections on windows by emitting the right
COMDAT section header in NCG, see added comment for more explanation.
Fix #26696 #26494.
-------------------------
Metric Decrease:
LargeRecord
T9675
size_hello_artifact
size_hello_artifact_gzip
size_hello_unicode
size_hello_unicode_gzip
Metric Increase:
T13035
-------------------------
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
182f3d0f by Cheng Shao at 2026-01-09T20:25:28-05:00
iserv: add comment about -fkeep-cafs
- - - - -
49675b69 by Matthew Craven at 2026-01-09T20:26:14-05:00
Account for "stupid theta" in demand sig for DataCon wrappers
Fixes #26748.
- - - - -
f3c18890 by Samuel Thibault at 2026-01-10T15:48:22+01:00
hurd: Fix getExecutablePath build
3939a8bf93e27 ("GNU/Hurd: Add getExecutablePath support") added using
/proc/self/exe for GNU/Hurd but missed adding the required imports for
the corresponding code.
- - - - -
7f15bd15 by Samuel Thibault at 2026-01-12T07:16:25-05:00
Fix the OS string encoding for GNU/Hurd
Following https://github.com/haskell/cabal/pull/9434/files , and as seen
in the various gnu_HOST_OS usages in the source code, it is expected that
GNU/Hurd is advertised as "gnu", like the autotools do.
- - - - -
1db2f240 by Andrew Lelechenko at 2026-01-12T07:17:06-05:00
Add since annotation for Data.Bifoldable1
Fixes #26432
- - - - -
e038a383 by Sven Tennie at 2026-01-12T07:17:49-05:00
Ignore Windows CI tool directories in Git
Otherwise, we see thousands of changes in `git status` which is very
confusing to work with.
- - - - -
023c301c by sheaf at 2026-01-13T04:57:30-05:00
Don't re-use stack slots for growing registers
This commit avoids re-using a stack slot for a register that has grown
but already had a stack slot.
For example, suppose we have stack slot assigments
%v1 :: FF64 |-> StackSlot 0
%v2 :: FF64 |-> StackSlot 1
Later, we start using %v1 at a larger format (e.g. F64x2) and we need
to spill it again. Then we **must not** use StackSlot 0, as a spill
at format F64x2 would clobber the data in StackSlot 1.
This can cause some fragmentation of the `StackMap`, but that's probably
OK.
Fixes #26668
- - - - -
d0966e64 by fendor at 2026-01-13T04:58:11-05:00
Remove `traceId` from ghc-pkg executable
- - - - -
20d7efec by Simon Peyton Jones at 2026-01-13T12:41:22-05:00
Make SpecContr rules fire a bit later
See #26615 and Note [SpecConstr rule activation]
- - - - -
8bc4eb8c by Andrew Lelechenko at 2026-01-13T12:42:03-05:00
Upgrade mtl submodule to 2.3.2
Fixes #26656
- - - - -
c94aaacd by Cheng Shao at 2026-01-13T12:42:44-05:00
compiler: remove iserv and only use on-demand external interpreter
This patch removes `iserv` from the tree completely. Hadrian would no
longer build or distribute `iserv`, and the GHC driver would use the
on-demand external interpreter by default when invoked with
`-fexternal-interpreter`, without needing to specify `-pgmi ""`. This
has multiple benefits:
- It allows cleanup of a lot of legacy hacks in the hadrian codebase.
- It paves the way for running cross ghc's iserv via cross emulator
(#25523), fixing TH/ghci support for cross targets other than
wasm/js.
- - - - -
c1fe0097 by Peter Trommler at 2026-01-14T03:54:49-05:00
PPC NCG: Fix shift right MO code
The shift amount in shift right [arithmetic] MOs is machine word
width. Therefore remove unnecessary zero- or sign-extending of
shift amount.
It looks harmless to extend the shift amount argument because the
shift right instruction uses only the seven lowest bits (i. e. mod 128).
But now we have a conversion operation from a smaller type to word width
around a memory load at word width. The types are not matching up but
there is no check done in CodeGen. The necessary conversion from word
width down to the smaller width would be translated into a no-op on
PowerPC anyway. So all seems harmless if it was not for a small
optimisation in getRegister'.
In getRegister' a load instruction with the smaller width of the
conversion operation was generated. This loaded the most significant
bits of the word in memory on a big-endian platform. These bits were
zero and hence shift right was used with shift amount zero and not one
as required in test Sized.
Fixes #26519
- - - - -
2dafc65a by Cheng Shao at 2026-01-14T03:55:31-05:00
Tree-wide cleanup of cygwin logic
GHC has not supported cygwin for quite a few years already, and will
not resume support in the forseeable future. The only supported
windows toolchain is clang64/clangarm64 of the msys2 project. This
patch cleans up the unused cygwin logic in the tree.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
66b96e2a by Teo Camarasu at 2026-01-14T03:56:13-05:00
Set default eventlog-flush-interval to 5s
Resolves #26707
- - - - -
d0254579 by Andrew Lelechenko at 2026-01-14T03:56:53-05:00
Document when -maxN RTS option was added
- - - - -
f25e2b12 by Cheng Shao at 2026-01-14T11:10:39-05:00
testsuite: remove obsolete --ci option from the testsuite driver
This patch removes the obsolete `--ci` option from the testsuite
driver: neither the CI scripts nor hadrian ever invokes the testsuite
driver with `--ci`, and the perf notes are always fetched to the
`refs/notes/perf` local reference anyway.
- - - - -
7964763b by Julian Ospald at 2026-01-14T11:11:31-05:00
Fix fetch_cabal
* download cabal if the existing one is of an older version
* fix FreeBSD download url
* fix unpacking on FreeBSD
- - - - -
6b0129c1 by Julian Ospald at 2026-01-14T11:11:31-05:00
Bump toolchain in CI
- - - - -
0f53ccc6 by Julian Ospald at 2026-01-14T11:11:31-05:00
Use libffi-clib
Previously, we would build libffi via hadrian
and bundle it manually with the GHC bindist.
This now moves all that logic out of hadrian
and allows us to have a clean Haskell package
to build and link against and ship it without
extra logic.
This patch still retains the ability to link
against a system libffi.
The main reason of bundling libffi was that on
some platforms (e.g. FreeBSD and Mac), system libffi
is not visible to the C toolchain by default,
so users would require settings in e.g. cabal
to be able to compile anything.
This adds the submodule libffi-clib to the repository.
- - - - -
5e1cd595 by Peng Fan at 2026-01-14T11:12:26-05:00
NCG/LA64: add support for la664 micro architecture
Add '-mla664' flag to LA664, which has some new features:
atomic instructions, dbar hints, etc.
'LA464' is the default so that unrecognized instructions are not
generated.
- - - - -
c56567ec by Simon Peyton Jones at 2026-01-15T23:19:04+00:00
Add evals for strict data-con args in worker-functions
This fixes #26722, by adding an eval in a worker for
arguments of strict data constructors, even if the
function body uses them strictly.
See (WIS1) in Note [Which Ids should be strictified]
I took the opportunity to make substantial improvements in the
documentation for call-by-value functions. See especially
Note [CBV Function Ids: overview] in GHC.Types.Id.Info
Note [Which Ids should be CBV candidates?] ditto
Note [EPT enforcement] in GHC.Stg.EnforceEpt
among others.
- - - - -
9719ce5d by Simon Peyton Jones at 2026-01-15T23:19:04+00:00
Improve `interestingArg`
This function analyses a function's argument to see if it is
interesting enough to deserve an inlining discount. Improvements
for
* LitRubbish arguments
* exprIsExpandable arguments
See Note [Interesting arguments] which is substantially rewritten.
- - - - -
7b616b9f by Cheng Shao at 2026-01-16T06:45:00-05:00
compiler: fix regression when compiling foreign stubs in the rts unit
This patch fixes a regression when compiling foreign stubs in the rts
unit introduced in 05e25647f72bc102061af3f20478aa72bff6ff6e. A simple
revert would fix it, but it's better to implement a proper fix with
comment for better understanding of the underlying problem, see the
added comment for explanation.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
c343ef64 by Sylvain Henry at 2026-01-16T06:45:51-05:00
base: remove GHC.JS.Prim.Internal.Build (#23432)
See accepted CLC proposal https://github.com/haskell/core-libraries-committee/issues/329
- - - - -
29c0aceb by Simon Peyton Jones at 2026-01-16T17:18:11-05:00
Improve newtype unwrapping
Ticket #26746 describes several relatively-minor shortcomings of newtype
unwrapping. This MR addresses them, while also (arguably) simplifying
the code a bit.
See new Note [Solving newtype equalities: overview]
and Note [Decomposing newtype equalities]
and Note [Eager newtype decomposition]
and Note [Even more eager newtype decomposition]
For some reason, on Windows only, runtime allocations decrease for test
T5205 (from 52k to 48k). I have not idea why. No change at all on Linux.
I'm just going to accept the change. (I saw this same effect in another
MR so I think it's a fault in the baseline.)
Metric Decrease:
T5205
- - - - -
8b59e62c by Andreas Klebinger at 2026-01-16T17:18:52-05:00
testsuite: Widen acceptance window for T5205.
Fixes #26782
- - - - -
9e5e0234 by mangoiv at 2026-01-17T06:03:03-05:00
add a new issue template for getting verified
To reduce spam created by new users, we will in future not grant
any rights but reporting issues to new users. That is why we will
have to be able to verify them. The added issue template serves that
purpose.
- - - - -
b18b2c42 by Cheng Shao at 2026-01-17T06:03:44-05:00
llvm: fix split sections for llvm backend
This patch fixes split sections for llvm backend:
- Pass missing `--data-sections`/`--function-sections` flags to
llc/opt.
- Use `@llvm.compiler.used` instead of `@llvm.used` to avoid sections
being unnecessarily retained at link-time.
Fixes #26770.
-------------------------
Metric Decrease:
libdir
size_hello_artifact
size_hello_unicode
-------------------------
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
ebf66f67 by Cheng Shao at 2026-01-17T13:16:50-05:00
Update autoconf scripts
Scripts taken from autoconf a2287c3041a3f2a204eb942e09c015eab00dc7dd
- - - - -
598624b9 by Andreas Klebinger at 2026-01-17T13:17:32-05:00
CString.hs: Update incorrect comment.
Fixes #26322
- - - - -
eea2036b by Cheng Shao at 2026-01-18T10:00:49-05:00
libraries: bump haskeline submodule to 0.8.4.1
This patch bumps the haskeline submodule to 0.8.4.1 which includes an
important fix for an ANSI handling bug on Windows
(https://github.com/haskell/haskeline/pull/126)
- - - - -
87d8f6c2 by Cheng Shao at 2026-01-18T10:01:30-05:00
hadrian: replace default -H32m/-H64m with -O64M to improve mutator productivity
Most hadrian build flavours pass `-H32m`/`-H64m` to GHC as
conventional wisdom to improve mutator productivity and reduce GC
overhead. They were inherited from the legacy Make build system, and
there used to be make flags to instrument a build process with
`-Rghc-timing` option to collect GC stats of each GHC run from stderr.
It's time to revisit whether there are better defaults for
`-H32m`/`-H64m`, and this patch changes it to `-O64M` which indeed
improves mutator productivity based on real statistics. `-O64M` is
more aggressive than `-H64m`; it allows the old generation to grow to
at least 64M before triggering major GC and reduces major GC runs.
The stats of a clean build with `validate` flavour and `-H64m`:
```
h64m.log
matched RTS stat lines: 5499
sum MUT cpu : 2400.808 s
sum GC cpu : 1378.292 s
sum MUT elapsed : 2788.253 s
sum GC elapsed : 1389.233 s
GC/MUT cpu ratio : 0.574 (GC is 57.4% of MUT)
GC/MUT elapsed ratio : 0.498 (GC is 49.8% of MUT)
GC fraction of (MUT+GC) cpu : 36.5%
GC fraction of (MUT+GC) elapsed : 33.3%
per-line GC/MUT cpu ratio: median 0.691, p90 1.777
per-line GC/MUT elapsed ratio: median 0.519, p90 1.081
```
The stats of a clean build with `validate` flavour and `-O64M`:
```
o64m.log
matched RTS stat lines: 5499
sum MUT cpu : 2377.383 s
sum GC cpu : 1127.146 s
sum MUT elapsed : 2758.857 s
sum GC elapsed : 1135.587 s
GC/MUT cpu ratio : 0.474 (GC is 47.4% of MUT)
GC/MUT elapsed ratio : 0.412 (GC is 41.2% of MUT)
GC fraction of (MUT+GC) cpu : 32.2%
GC fraction of (MUT+GC) elapsed : 29.2%
per-line GC/MUT cpu ratio: median 0.489, p90 1.099
per-line GC/MUT elapsed ratio: median 0.367, p90 0.806
```
Mutator time is roughly in the same ballpark, but GC CPU time has
reduced by 18.22%, and mutator productivity has increased from 63.5%
to 67.8%.
- - - - -
8372e13d by Cheng Shao at 2026-01-18T10:02:12-05:00
rts: remove unused .def files from rts/win32
This patch removes unused .def files from `rts/win32`, given we don't
build .dll files for rts/ghc-internal/ghc-prim at all. Even when we
resurrect win32 dll support at some point in the future, these .def
files still contain incorrect symbols anyway and won't be of any use.
- - - - -
f6af485d by Cheng Shao at 2026-01-18T10:03:19-05:00
.gitmodules: use gitlab mirror for the libffi-clib submodule
This patch fixes .gitmodules to use the gitlab mirror for the
libffi-clib submodule, to make it coherent with other submodules that
allow ghc developers to experiment with wip branches in submodules for
ghc patches. Fixes #26783.
- - - - -
41432d25 by Cheng Shao at 2026-01-18T10:05:13-05:00
hadrian: remove the horrible i386 speedHack
When hadrian builds certain rts objects for i386, there's a horrible
speedHack that forces -fno-PIC even for dynamic ways of those objects.
This is not compatible with newer versions of gcc/binutils as well as
clang/lld, and this patch removes it. Fixes #26792.
- - - - -
323eb8f0 by Cheng Shao at 2026-01-18T21:48:19-05:00
hadrian: enable split sections for cross stage0
This patch fixes a minor issue with `splitSectionsArgs` in hadrian:
previously, it's unconditionally disabled for stage0 libraries because
it's not going to be shipped in the final bindists. But it's only true
when not cross compiling. So for now we also need to enable it for
cross stage0 as well.
- - - - -
3fadfefe by Andreas Klebinger at 2026-01-18T21:49:01-05:00
RTS: Document -K behaviour better
- - - - -
30f442a9 by Teo Camarasu at 2026-01-20T13:57:26-05:00
base: don't expose GHC.Num.{BigNat, Integer, Natural}
We no longer expose GHC.Num.{BigNat, Integer, Natural} from base instead users should get these modules from ghc-bignum.
We make this change to insulate end users from changes to GHC's implementation of big numbers.
Implements CLC proposal 359: https://github.com/haskell/core-libraries-committee/issues/359
- - - - -
75a9053d by Teo Camarasu at 2026-01-20T13:58:07-05:00
base: deprecate GHC internals in GHC.Num
Implements CLC proposal: https://github.com/haskell/core-libraries-committee/issues/360
- - - - -
9534b032 by Andreas Klebinger at 2026-01-20T13:58:50-05:00
ghc-experimental: Update Changelog
I tried to reconstruct a high level overview of the changes and when
they were made since we introduced it.
Fixes #26506
Co-authored-by: Teo Camarasu <teofilcamarasu(a)gmail.com>
- - - - -
346f2f5a by Cheng Shao at 2026-01-20T13:59:30-05:00
hadrian: remove RTS options in ghc-in-ghci flavour
This patch removes the RTS options passed to ghc in ghc-in-ghci
flavour, to workaround command line argument handling issue in
hls/hie-boot that results in `-O64M` instead of `+RTS -O64M -RTS`
being passed to ghc. It's not a hadrian bug per se, since ghc's own
ghc-in-ghci multi repl works fine, but we should still make sure HLS
works. Closes #26801.
- - - - -
759fd15a by Andreas Klebinger at 2026-01-21T16:05:28-05:00
Don't build GHC with -Wcompat
Without bumping the boot compiler the warnings it produces are often not
actionable leading to pointless noise.
Fixes #26800
- - - - -
3172db94 by Torsten Schmits at 2026-01-21T16:06:11-05:00
Use the correct field of ModOrigin when formatting error message listing hidden reexports
- - - - -
485c12b2 by Cheng Shao at 2026-01-21T16:06:54-05:00
Revert "hadrian: handle findExecutable "" gracefully"
This reverts commit 1e5752f64a522c4025365856d92f78073a7b3bba. The
underlying issue has been fixed in
https://github.com/haskell/directory/commit/75828696e7145adc09179111a0d631b…
and present since 1.3.9.0, and hadrian directory lower bound is
1.3.9.0, so we can revert our own in house hack now.
- - - - -
5efb58dc by Cheng Shao at 2026-01-21T16:07:36-05:00
rts: fix typo in TICK_ALLOC_RTS
This patch fixes a typo in the `TICK_ALLOC_RTS` macro, the original
`bytes` argument was silently dropped. The Cmm code has its own
version of `TICK_ALLOC_RTS` not affected by this typo, it affected the
C RTS, and went unnoticed because the variable `n` happened to also be
available at its call site. But the number was incorrect. Also fixes
its call site since `WDS()` is not available in C.
- - - - -
c406ea69 by Cheng Shao at 2026-01-21T16:07:36-05:00
rts: remove broken & unused ALLOC_P_TICKY
This patch removes the `ALLOC_P_TICKY` macro from the rts, it's
unused, and its expanded code is already broken.
- - - - -
34a27e20 by Simon Peyton Jones at 2026-01-21T16:08:17-05:00
Make the implicit-parameter class have representational role
This MR addresses #26737, by making the built-in class IP
have a representational role for its second parameter.
See Note [IP: implicit parameter class] in
ghc-internal:GHC.Internal.Classes.IP
In fact, IP is (unfortunately, currently) exposed by
base:GHC.Base, so we ran a quick CLC proposal to
agree the change:
https://github.com/haskell/core-libraries-committee/issues/385
Some (small) compilations get faster because they only need to
load (small) interface file GHC.Internal.Classes.IP.hi,
rather than (large) GHC.Internal.Classes.hi.
Metric Decrease:
T10421
T12150
T12425
T24582
T5837
T5030
- - - - -
ca79475f by Cheng Shao at 2026-01-21T16:09:00-05:00
testsuite: avoid re.sub in favor of simple string replacements
This patch refactors the testsuite driver and avoids the usage of
re.sub in favor of simple string replacements when possible. The
changes are not comprehensive, and there are still a lot of re.sub
usages lingering around the tree, but this already addresses a major
performance bottleneck in the testsuite driver that might has to do
with quadratic or worse slowdown in cpython's regular expression
engine when handling certain regex patterns with large strings.
Especially on i386, and i386 jobs are the bottlenecks of all full-ci
validate pipelines!
Here are the elapsed times of testing x86_64/i386 with -j48 before
this patch:
x86_64: `Build completed in 6m06s`
i386: `Build completed in 1h36m`
And with this patch:
x86_64: `Build completed in 4m55s`
i386: `Build completed in 4m23s`
Fixes #26786.
Co-authored-by: Codex <codex(a)openai.com>
- - - - -
88c93796 by Zubin Duggal at 2026-01-21T16:09:42-05:00
ghc-toolchain: Also configure windres on non-windows platforms.
It may be needed for cross compilation.
Fixes #24588
- - - - -
9788c0ec by Cheng Shao at 2026-01-21T16:10:24-05:00
ghci: print external interpreter trace messages to stderr instead of stdout
This patch makes ghci print external interpreter trace messages to
stderr instead of stdout, which is a much saner choice for diagnostic
information. Closes #26807.
- - - - -
0491f08a by Sylvain Henry at 2026-01-22T03:44:26-05:00
GC: don't use CAS without PARALLEL_GC on
If we're not using the parallel GC, there is no reason to do a costly
CAS. This was flagged as taking time in a perf profile.
- - - - -
211a8f56 by Sylvain Henry at 2026-01-22T03:44:26-05:00
GC: suffix parallel GC with "par" instead of "thr"
Avoid some potential confusion (see discussion in !15351).
- - - - -
77a23cbd by fendor at 2026-01-22T03:45:08-05:00
Remove blanket ignore that covers libraries/
- - - - -
18bf7f5c by Léana Jiang at 2026-01-22T08:58:45-05:00
doc: update Flavour type in hadrian user-settings
- - - - -
3d5a1365 by Cheng Shao at 2026-01-22T08:59:28-05:00
hadrian: add missing notCross predicate for stage0 -O0
There are a few hard-coded hadrian args that pass -O0 when compiling
some heavy modules in stage0, which only makes sense when not
cross-compiling and when cross-compiling we need properly optimized
stage0 packages. So this patch adds the missing `notCross` predicate
in those places.
- - - - -
ee937134 by Matthew Pickering at 2026-01-22T09:00:10-05:00
Fix ghc-experimental GHC.Exception.Backtrace.Experimental module
This module wasn't added to the cabal file so it was never compiled or
included in the library.
- - - - -
1b490f5a by Zubin Duggal at 2026-01-22T09:00:53-05:00
hadrian: Add ghc-{experimental,internal}.cabal to the list of dependencies of the doc target
We need these files to detect the version of these libraries
Fixes #26738
- - - - -
f324373c by Oleg Grenrus at 2026-01-22T18:20:06+00:00
Export labelThread from Control.Concurrent
- - - - -
298 changed files:
- .gitignore
- .gitlab/ci.sh
- .gitlab/generate-ci/gen_ci.hs
- + .gitlab/issue_templates/get-verified.md
- .gitlab/jobs.yaml
- .gitmodules
- CODEOWNERS
- cabal.project-reinstall
- compiler/GHC/Builtin/Names.hs
- compiler/GHC/Cmm.hs
- compiler/GHC/Cmm/Info.hs
- compiler/GHC/Cmm/InitFini.hs
- compiler/GHC/Cmm/Utils.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/CmmToAsm/Config.hs
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/Ppr.hs
- compiler/GHC/CmmToAsm/Reg/Linear.hs
- compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/CmmToC.hs
- compiler/GHC/CmmToLlvm.hs
- compiler/GHC/CmmToLlvm/Base.hs
- compiler/GHC/CmmToLlvm/Data.hs
- compiler/GHC/Core/FamInstEnv.hs
- compiler/GHC/Core/Opt/Arity.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/SetLevels.hs
- compiler/GHC/Core/Opt/Simplify/Env.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Core/Opt/WorkWrap.hs
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/Subst.hs
- compiler/GHC/Core/Tidy.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/Unfold.hs
- compiler/GHC/Core/Unfold/Make.hs
- compiler/GHC/Core/Utils.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Backpack.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Config/CmmToAsm.hs
- compiler/GHC/Driver/Config/Interpreter.hs
- compiler/GHC/Driver/Downsweep.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/Linker/Dynamic.hs
- compiler/GHC/Linker/Executable.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Linker/Unit.hs
- compiler/GHC/Runtime/Interpreter/Init.hs
- compiler/GHC/Settings.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/Stg/EnforceEpt.hs
- compiler/GHC/Stg/Lint.hs
- compiler/GHC/StgToCmm/Closure.hs
- compiler/GHC/StgToCmm/Expr.hs
- compiler/GHC/StgToJS/Linker/Utils.hs
- compiler/GHC/SysTools/Terminal.hs
- compiler/GHC/Tc/Instance/Family.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Types/Id.hs
- compiler/GHC/Types/Id/Info.hs
- compiler/GHC/Types/Id/Make.hs
- compiler/GHC/Unit/Info.hs
- compiler/GHC/Unit/State.hs
- compiler/GHC/Utils/Binary.hs
- compiler/ghc.cabal.in
- config.guess
- config.sub
- configure.ac
- distrib/configure.ac.in
- − docs/Makefile
- − docs/storage-mgt/Makefile
- docs/users_guide/9.16.1-notes.rst
- − docs/users_guide/Makefile
- docs/users_guide/ghci.rst
- docs/users_guide/packages.rst
- docs/users_guide/phases.rst
- docs/users_guide/runtime_control.rst
- docs/users_guide/using-concurrent.rst
- docs/users_guide/using.rst
- docs/users_guide/win32-dlls.rst
- − driver/Makefile
- − driver/ghc/Makefile
- − driver/ghci/Makefile
- driver/ghci/ghci.c
- − driver/haddock/Makefile
- driver/utils/cwrapper.c
- driver/utils/isMinTTY.c
- ghc/Main.hs
- − ghc/Makefile
- hadrian/bindist/cwrappers/cwrapper.c
- hadrian/cfg/default.host.target.in
- hadrian/cfg/default.target.in
- hadrian/doc/flavours.md
- hadrian/doc/user-settings.md
- hadrian/hadrian.cabal
- hadrian/src/Base.hs
- hadrian/src/Builder.hs
- hadrian/src/Flavour.hs
- hadrian/src/Hadrian/Haskell/Hash.hs
- hadrian/src/Hadrian/Utilities.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Packages.hs
- hadrian/src/Rules.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Rules/Docspec.hs
- hadrian/src/Rules/Documentation.hs
- hadrian/src/Rules/Generate.hs
- − hadrian/src/Rules/Libffi.hs
- hadrian/src/Rules/Lint.hs
- hadrian/src/Rules/Program.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Rules/SourceDist.hs
- hadrian/src/Rules/Test.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Builders/Hsc2Hs.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Builders/SplitSections.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Flavours/Benchmark.hs
- hadrian/src/Settings/Flavours/Development.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- hadrian/src/Settings/Flavours/Performance.hs
- hadrian/src/Settings/Flavours/Quick.hs
- hadrian/src/Settings/Flavours/QuickCross.hs
- hadrian/src/Settings/Flavours/Quickest.hs
- hadrian/src/Settings/Flavours/Validate.hs
- hadrian/src/Settings/Packages.hs
- hadrian/src/Settings/Program.hs
- − libffi-tarballs
- − libraries/Makefile
- libraries/base/base.cabal.in
- libraries/base/changelog.md
- libraries/base/src/Control/Concurrent.hs
- libraries/base/src/Data/Array/Byte.hs
- libraries/base/src/Data/Bifoldable1.hs
- libraries/base/src/GHC/Conc.hs
- libraries/base/src/GHC/Conc/Sync.hs
- − libraries/base/src/GHC/JS/Prim/Internal/Build.hs
- libraries/base/src/GHC/Num.hs
- − libraries/base/src/GHC/Num/BigNat.hs
- − libraries/base/src/GHC/Num/Integer.hs
- − libraries/base/src/GHC/Num/Natural.hs
- libraries/base/src/System/CPUTime/Utils.hs
- libraries/base/src/System/Timeout.hs
- libraries/base/tests/IO/T12010/cbits/initWinSock.c
- − libraries/doc/Makefile
- libraries/ghc-bignum/ghc-bignum.cabal
- libraries/ghc-boot/GHC/Unit/Database.hs
- libraries/ghc-experimental/CHANGELOG.md
- libraries/ghc-experimental/ghc-experimental.cabal.in
- libraries/ghc-experimental/src/GHC/Exception/Backtrace/Experimental.hs
- libraries/ghc-experimental/src/GHC/TypeNats/Experimental.hs
- libraries/ghc-internal/cbits/consUtils.c
- libraries/ghc-internal/configure.ac
- libraries/ghc-internal/ghc-internal.buildinfo.in
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/CString.hs
- libraries/ghc-internal/src/GHC/Internal/Classes.hs
- + libraries/ghc-internal/src/GHC/Internal/Classes/IP.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/IO.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/POSIX.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs
- libraries/ghc-internal/src/GHC/Internal/Conc/Sync.hs-boot
- libraries/ghc-internal/src/GHC/Internal/Conc/Windows.hs
- libraries/ghc-internal/src/GHC/Internal/ConsoleHandler.hsc
- libraries/ghc-internal/src/GHC/Internal/Event/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/Event/Windows/Thread.hs
- libraries/ghc-internal/src/GHC/Internal/IO/Handle.hs
- + libraries/ghc-internal/src/GHC/Internal/STM.hs
- libraries/ghc-internal/src/GHC/Internal/System/Environment/ExecutablePath.hsc
- libraries/ghc-platform/src/GHC/Platform/ArchOS.hs
- libraries/ghci/GHCi/Server.hs
- libraries/haskeline
- + libraries/libffi-clib
- libraries/mtl
- − linters/lint-codes/Makefile
- − linters/lint-notes/Makefile
- llvm-passes
- + m4/fp_linker_supports_verbatim.m4
- m4/ghc_select_file_extensions.m4
- m4/prep_target_file.m4
- mk/system-cxx-std-lib-1.0.conf.in
- packages
- − rts/Makefile
- rts/RtsFlags.c
- rts/StgMiscClosures.cmm
- rts/configure.ac
- rts/include/Cmm.h
- − rts/include/Makefile
- rts/include/rts/ghc_ffi.h
- rts/include/stg/Ticky.h
- rts/rts.buildinfo.in
- rts/rts.cabal
- rts/sm/Evac.c
- rts/sm/Evac_thr.c → rts/sm/Evac_par.c
- rts/sm/Scav_thr.c → rts/sm/Scav_par.c
- rts/sm/Storage.c
- − rts/win32/libHSffi.def
- − rts/win32/libHSghc-internal.def
- − rts/win32/libHSghc-prim.def
- + testsuite/driver/_elffile.py
- testsuite/driver/perf_notes.py
- testsuite/driver/runtests.py
- testsuite/driver/testglobals.py
- testsuite/driver/testlib.py
- testsuite/driver/testutil.py
- testsuite/ghc-config/ghc-config.hs
- testsuite/mk/test.mk
- testsuite/tests/deriving/should_fail/T8984.stderr
- testsuite/tests/deriving/should_fail/deriving-via-fail.stderr
- testsuite/tests/deriving/should_fail/deriving-via-fail4.stderr
- testsuite/tests/deriving/should_fail/deriving-via-fail5.stderr
- + testsuite/tests/dmdanal/should_run/T26748.hs
- + testsuite/tests/dmdanal/should_run/T26748.stdout
- testsuite/tests/dmdanal/should_run/all.T
- − testsuite/tests/driver/T24731.hs
- testsuite/tests/driver/all.T
- + testsuite/tests/driver/fully-static/Hello.hs
- + testsuite/tests/driver/fully-static/Makefile
- + testsuite/tests/driver/fully-static/all.T
- + testsuite/tests/driver/fully-static/fully-static.stdout
- + testsuite/tests/driver/fully-static/test/Test.hs
- + testsuite/tests/driver/fully-static/test/test.pkg
- + testsuite/tests/driver/mostly-static/Hello.hs
- + testsuite/tests/driver/mostly-static/Makefile
- + testsuite/tests/driver/mostly-static/all.T
- + testsuite/tests/driver/mostly-static/mostly-static.stdout
- + testsuite/tests/driver/mostly-static/test/test.c
- + testsuite/tests/driver/mostly-static/test/test.h
- + testsuite/tests/driver/mostly-static/test/test.pkg
- + testsuite/tests/driver/recomp26705/M.hs
- + testsuite/tests/driver/recomp26705/M2A.hs
- + testsuite/tests/driver/recomp26705/M2B.hs
- + testsuite/tests/driver/recomp26705/Makefile
- + testsuite/tests/driver/recomp26705/all.T
- + testsuite/tests/driver/recomp26705/recomp26705.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/interface-stability/ghc-experimental-exports.stdout
- testsuite/tests/interface-stability/ghc-experimental-exports.stdout-mingw32
- testsuite/tests/interface-stability/ghc-prim-exports.stdout
- testsuite/tests/interface-stability/ghc-prim-exports.stdout-mingw32
- testsuite/tests/perf/should_run/all.T
- + testsuite/tests/pmcheck/should_compile/T24867.hs
- + testsuite/tests/pmcheck/should_compile/T24867.stderr
- testsuite/tests/pmcheck/should_compile/all.T
- testsuite/tests/rts/linker/rdynamic.hs
- testsuite/tests/simplCore/should_compile/T14003.stderr
- testsuite/tests/simplCore/should_compile/T18013.stderr
- testsuite/tests/simplCore/should_compile/T19672.stderr
- testsuite/tests/simplCore/should_compile/T21763.stderr
- testsuite/tests/simplCore/should_compile/T21763a.stderr
- + testsuite/tests/simplCore/should_compile/T26615.hs
- + testsuite/tests/simplCore/should_compile/T26615.stderr
- + testsuite/tests/simplCore/should_compile/T26615a.hs
- + testsuite/tests/simplCore/should_compile/T26681.hs
- + testsuite/tests/simplCore/should_compile/T26682.hs
- + testsuite/tests/simplCore/should_compile/T26682a.hs
- + testsuite/tests/simplCore/should_compile/T26709.hs
- + testsuite/tests/simplCore/should_compile/T26709.stderr
- + testsuite/tests/simplCore/should_compile/T26722.hs
- + testsuite/tests/simplCore/should_compile/T26722.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/th/TH_implicitParams.stdout
- + testsuite/tests/typecheck/should_compile/T26737.hs
- + testsuite/tests/typecheck/should_compile/T26746.hs
- testsuite/tests/typecheck/should_compile/all.T
- testsuite/tests/typecheck/should_fail/T15801.stderr
- testsuite/tests/typecheck/should_fail/T22924b.stderr
- testsuite/tests/typecheck/should_fail/TcCoercibleFail.hs
- testsuite/tests/typecheck/should_fail/TcCoercibleFail.stderr
- testsuite/tests/typecheck/should_fail/all.T
- utils/deriveConstants/Main.hs
- utils/ghc-pkg/Main.hs
- utils/ghc-toolchain/exe/Main.hs
- utils/ghc-toolchain/src/GHC/Toolchain/Tools/Link.hs
- − utils/iserv/iserv.cabal.in
- − utils/iserv/src/Main.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e74b942dd575b3d20d9b5f61aa3a7a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e74b942dd575b3d20d9b5f61aa3a7a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/26805] Rejig the NeededEvId stuff again!!
by Simon Peyton Jones (＠simonpj) 22 Jan '26
by Simon Peyton Jones (＠simonpj) 22 Jan '26
22 Jan '26
Simon Peyton Jones pushed to branch wip/26805 at Glasgow Haskell Compiler / GHC
Commits:
22f6f55e by Simon Peyton Jones at 2026-01-22T17:42:22+00:00
Rejig the NeededEvId stuff again!!
Fixes #26772 I hope
- - - - -
16 changed files:
- compiler/GHC/Core/TyCo/Rep.hs
- compiler/GHC/Core/TyCo/Subst.hs
- compiler/GHC/Core/TyCo/Tidy.hs
- compiler/GHC/Tc/Gen/Expr.hs
- compiler/GHC/Tc/Solver/Default.hs
- compiler/GHC/Tc/Solver/Equality.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
- compiler/GHC/Tc/Types/Constraint.hs
- compiler/GHC/Tc/Types/Evidence.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Tc/Utils/TcMType.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Zonk/TcType.hs
- compiler/GHC/Tc/Zonk/Type.hs
- compiler/GHC/Utils/Trace.hs
Changes:
=====================================
compiler/GHC/Core/TyCo/Rep.hs
=====================================
@@ -1688,11 +1688,9 @@ holes `HoleCo`, which get filled in later.
-- | A coercion to be filled in by the type-checker. See Note [Coercion holes]
data CoercionHole
- = CoercionHole { ch_co_var :: CoVar
- -- See Note [Coercion holes] wrinkle (COH2)
-
- , ch_ref :: IORef (Maybe CoercionPlusHoles)
- }
+ = CH { ch_co_var :: CoVar -- See Note [Coercion holes] wrinkle (COH2)
+ , ch_ref :: IORef (Maybe CoercionPlusHoles)
+ }
data CoercionPlusHoles
= CPH { cph_co :: Coercion
@@ -1714,7 +1712,7 @@ instance Data.Data CoercionHole where
dataTypeOf _ = mkNoRepType "CoercionHole"
instance Outputable CoercionHole where
- ppr (CoercionHole { ch_co_var = cv }) = braces (ppr cv)
+ ppr (CH { ch_co_var = cv }) = braces (ppr cv)
instance Outputable CoercionPlusHoles where
ppr (CPH { cph_co = co, cph_holes = holes })
@@ -1723,7 +1721,7 @@ instance Outputable CoercionPlusHoles where
, text "cph_holes =" <+> ppr holes ])
instance Uniquable CoercionHole where
- getUnique (CoercionHole { ch_co_var = cv }) = getUnique cv
+ getUnique (CH { ch_co_var = cv }) = getUnique cv
-- | A CoHoleSet stores a set of CoercionHoles that have been used to rewrite
=====================================
compiler/GHC/Core/TyCo/Subst.hs
=====================================
@@ -892,8 +892,7 @@ subst_co subst co
in cos' `seqList` cos'
-- See Note [Substituting in a coercion hole]
- go_hole h@(CoercionHole { ch_co_var = cv })
- = h { ch_co_var = updateVarType go_ty cv }
+ go_hole h@(CH { ch_co_var = cv }) = h { ch_co_var = updateVarType go_ty cv }
-- | Perform a substitution within a 'DVarSet' of free variables,
-- returning the shallow free coercion variables.
=====================================
compiler/GHC/Core/TyCo/Tidy.hs
=====================================
@@ -357,7 +357,7 @@ tidyCo env co
go_cv cv = tidyTyCoVarOcc env cv
- go_hole (CoercionHole cv r) = (CoercionHole $! go_cv cv) r
+ go_hole (CH cv r) = (CH $! go_cv cv) r
-- Tidy even the holes; tidied types should have tidied kinds
tidyCos :: TidyEnv -> [Coercion] -> [Coercion]
=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -199,6 +199,9 @@ tcPolyExprCheck expr res_ty
-> TcM (HsExpr GhcTc)
outer_skolemise (Left ty) thing_inside
= do { (wrap, expr') <- tcSkolemiseExpectedType ty thing_inside
+ ; traceTc "outer_skol" (vcat [ text "wrap" <+> ppr wrap
+ , text "expr'" <+> ppr expr'
+ , text "wrapped" <+> ppr (mkHsWrap wrap expr') ])
; return (mkHsWrap wrap expr') }
outer_skolemise (Right sig) thing_inside
= do { (wrap, expr') <- tcSkolemiseCompleteSig sig thing_inside
=====================================
compiler/GHC/Tc/Solver/Default.hs
=====================================
@@ -272,10 +272,9 @@ unsatisfiableEv_maybe v = (v,) <$> isUnsatisfiableCt_maybe (idType v)
-- solve all the other Wanted constraints, including those nested within
-- deeper implications.
solveImplicationUsingUnsatGiven :: (EvVar, Type) -> Implication -> TcS Implication
-solveImplicationUsingUnsatGiven
- unsat_given@(given_ev,_)
+solveImplicationUsingUnsatGiven unsat_given
impl@(Implic { ic_wanted = wtd, ic_tclvl = tclvl, ic_binds = ev_binds_var
- , ic_need_implic = inner, ic_info = skol_info })
+ , ic_info = skol_info })
| isCoEvBindsVar ev_binds_var
-- We can't use Unsatisfiable evidence in kinds.
-- See Note [Coercion evidence only] in GHC.Tc.Types.Evidence.
@@ -283,9 +282,7 @@ solveImplicationUsingUnsatGiven
| otherwise
= do { wcs <- nestImplicTcS skol_info ev_binds_var tclvl $ go_wc wtd
; setImplicationStatus $
- impl { ic_wanted = wcs
- , ic_need_implic = inner `extendEvNeedSet` given_ev } }
- -- Record that the Given is needed; I'm not certain why
+ impl { ic_wanted = wcs } }
where
go_wc :: WantedConstraints -> TcS WantedConstraints
go_wc wc@(WC { wc_simple = wtds, wc_impl = impls })
=====================================
compiler/GHC/Tc/Solver/Equality.hs
=====================================
@@ -601,7 +601,7 @@ can_eq_nc_forall ev eq_rel s1 s2
-- they are kept alive by `neededEvVars`. Admittedly they are free in `all_co`,
-- but only if we zonk it, which `neededEvVars` does not do (see test T7196).
ev_binds_var <- getTcEvBindsVar
- ; updTcEvBinds ev_binds_var nested_ev_binds_var
+ ; combineTcEvBinds ev_binds_var nested_ev_binds_var
; setWantedEq orig_dest (CPH { cph_co = all_co, cph_holes = emptyCoHoleSet })
-- emptyCoHoleSet: fully solved, so all_co has no holes
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -15,7 +15,7 @@ module GHC.Tc.Solver.Monad (
failTcS, warnTcS, addErrTcS, wrapTcS, ctLocWarnTcS,
runTcSEqualities,
nestTcS, nestImplicTcS, tryShortCutTcS, nestFunDepsTcS,
- setEvBindsTcS, setTcLevelTcS, updTcEvBinds,
+ setEvBindsTcS, setTcLevelTcS,
selectNextWorkItem,
getWorkList,
@@ -58,7 +58,7 @@ module GHC.Tc.Solver.Monad (
getInstEnvs, getFamInstEnvs, -- Getting the environments
getTopEnv, getGblEnv, getLclEnv, setSrcSpan,
getTcEvBindsVar, getTcLevel,
- getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap,
+ getTcEvBindsMap, setTcEvBindsMap, getTcEvBindsState, combineTcEvBinds,
tcLookupClass, tcLookupId, tcLookupTyCon,
-- Inerts
@@ -1140,7 +1140,7 @@ csTraceTcM mk_doc
{-# INLINE csTraceTcM #-} -- see Note [INLINE conditional tracing utilities]
runTcS :: TcS a -- What to run
- -> TcM (a, EvBindMap)
+ -> TcM (a, EvBindsMap)
runTcS tcs
= do { ev_binds_var <- TcM.newTcEvBinds
; res <- runTcSWithEvBinds ev_binds_var tcs
@@ -1222,7 +1222,7 @@ runTcSWithEvBinds' mode ev_binds_var thing_inside
----------------------------
#if defined(DEBUG)
-checkForCyclicBinds :: EvBindMap -> TcM ()
+checkForCyclicBinds :: EvBindsMap -> TcM ()
checkForCyclicBinds ev_binds_map
| null cycles
= return ()
@@ -1380,18 +1380,24 @@ tryShortCutTcS (TcS thing_inside)
, tcs_inerts = new_inert_var
, tcs_worklist = new_wl_var }
- ; TcM.traceTc "tryTcS {" $
+ ; TcM.traceTc "tryShortCutTcS {" $
vcat [ text "old_ev_binds:" <+> ppr old_ev_binds_var
, text "new_ev_binds:" <+> ppr new_ev_binds_var
, ppr old_inerts ]
; solved <- thing_inside nest_env
- ; TcM.traceTc "tryTcS }" (ppr solved)
+ ; TcM.traceTc "tryShortCutTcS }" (ppr solved)
; if not solved
then return False
else do { -- Successfully solved
-- Add the new bindings to the existing ones
- ; TcM.updTcEvBinds old_ev_binds_var new_ev_binds_var
+ ; old_ebvs <- TcM.readTcRef (ebv_binds old_ev_binds_var)
+
+ ; TcM.combineTcEvBinds old_ev_binds_var new_ev_binds_var
+
+ ; final_ebvs <- TcM.readTcRef (ebv_binds old_ev_binds_var)
+ ; TcM.traceTc "update" (text "old" <+> ppr old_ebvs $$
+ text "new" <+> ppr final_ebvs)
-- Update the existing inert set
; new_inerts <- TcM.readTcRef new_inert_var
@@ -1465,21 +1471,21 @@ getTcEvBindsVar = TcS (return . tcs_ev_binds)
getTcLevel :: TcS TcLevel
getTcLevel = wrapTcS TcM.getTcLevel
-getTcEvTyCoVars :: EvBindsVar -> TcS [TcCoercion]
-getTcEvTyCoVars ev_binds_var
- = wrapTcS $ TcM.getTcEvTyCoVars ev_binds_var
+getTcEvBindsState :: EvBindsVar -> TcS EvBindsState
+getTcEvBindsState ev_binds_var
+ = wrapTcS $ TcM.getTcEvBindsState ev_binds_var
-getTcEvBindsMap :: EvBindsVar -> TcS EvBindMap
+getTcEvBindsMap :: EvBindsVar -> TcS EvBindsMap
getTcEvBindsMap ev_binds_var
= wrapTcS $ TcM.getTcEvBindsMap ev_binds_var
-setTcEvBindsMap :: EvBindsVar -> EvBindMap -> TcS ()
+setTcEvBindsMap :: EvBindsVar -> EvBindsMap -> TcS ()
setTcEvBindsMap ev_binds_var binds
= wrapTcS $ TcM.setTcEvBindsMap ev_binds_var binds
-updTcEvBinds :: EvBindsVar -> EvBindsVar -> TcS ()
-updTcEvBinds evb nested_evb
- = wrapTcS $ TcM.updTcEvBinds evb nested_evb
+combineTcEvBinds :: EvBindsVar -> EvBindsVar -> TcS ()
+combineTcEvBinds evb nested_evb
+ = wrapTcS $ TcM.combineTcEvBinds evb nested_evb
getDefaultInfo :: TcS (DefaultEnv, Bool)
getDefaultInfo = wrapTcS TcM.tcGetDefaultTys
@@ -2029,12 +2035,9 @@ setWantedDict dest canonical tm
HoleDest h -> pprPanic "setWantedEq: HoleDest" (ppr h)
fillCoercionHole :: CoercionHole -> CoercionPlusHoles -> TcS ()
-fillCoercionHole hole co_plus_holes@(CPH { cph_co = co })
+fillCoercionHole hole co_plus_holes
= do { ev_binds_var <- getTcEvBindsVar
- ; wrapTcS $ do { -- Record usage of the free vars of this coercion
- TcM.updTcRef (ebv_tcvs ev_binds_var) (co :)
- ; -- Fill the hole
- TcM.fillCoercionHole hole co_plus_holes }
+ ; wrapTcS $ TcM.addTcEvCoBind ev_binds_var hole co_plus_holes
; kickOutAfterFillingCoercionHole hole co_plus_holes }
newTcEvBinds :: TcS EvBindsVar
=====================================
compiler/GHC/Tc/Solver/Solve.hs
=====================================
@@ -33,7 +33,6 @@ import qualified GHC.Tc.Zonk.TcType as TcM
import GHC.Core.Predicate
import GHC.Core.Reduction
import GHC.Core.Coercion
-import GHC.Core.TyCo.FVs( coVarsOfCos )
import GHC.Core.Class( classHasSCs )
import GHC.Types.Id( idType )
@@ -432,12 +431,10 @@ solveImplication imp@(Implic { ic_tclvl = tclvl
, ic_wanted = final_wanted })
; evbinds <- TcS.getTcEvBindsMap ev_binds_var
- ; tcvs <- TcS.getTcEvTyCoVars ev_binds_var
; traceTcS "solveImplication end }" $ vcat
[ text "has_given_eqs =" <+> ppr has_given_eqs
, text "res_implic =" <+> ppr res_implic
- , text "implication evbinds =" <+> ppr (evBindMapBinds evbinds)
- , text "implication tvcs =" <+> ppr tcvs ]
+ , text "evbinds =" <+> ppr evbinds ]
; return res_implic }
@@ -460,30 +457,27 @@ setImplicationStatus :: Implication -> TcS Implication
-- * Prune unnecessary evidence bindings
-- * Prune unnecessary child implications
-- Precondition: the ic_status field is not already IC_Solved
-setImplicationStatus implic@(Implic { ic_status = old_status
- , ic_info = info
- , ic_wanted = wc })
- = assertPpr (not (isSolvedStatus old_status)) (ppr info) $
- -- Precondition: we only set the status if it is not already solved
- do { traceTcS "setImplicationStatus {" (ppr implic)
-
- ; let solved = isSolvedWC wc
- ; new_implic <- neededEvVars implic
- ; bad_telescope <- if solved then checkBadTelescope implic
- else return False
-
- ; let new_status | insolubleWC wc = IC_Insoluble
- | not solved = IC_Unsolved
- | bad_telescope = IC_BadTelescope
- | otherwise = IC_Solved { ics_dead = dead_givens }
- dead_givens = findRedundantGivens new_implic
- new_wc = pruneImplications wc
-
- final_implic = new_implic { ic_status = new_status
- , ic_wanted = new_wc }
-
- ; traceTcS "setImplicationStatus }" (ppr final_implic)
- ; return final_implic }
+setImplicationStatus implic@(Implic { ic_wanted = wc })
+ | insolubleWC wc
+ = do { traceTcS "setImplicationStatus:insoluble {" (ppr implic)
+ ; return (implic { ic_status = IC_Insoluble }) }
+
+ | not (isSolvedWC wc)
+ = -- Precondition: we only set the status if it is not /already/ solved
+ do { traceTcS "setImplicationStatus:in progress {" (ppr implic)
+ ; return (implic { ic_status = IC_Unsolved }) }
+
+ | otherwise -- The Wanteds are all solved
+ = do { traceTcS "setImplicationStatus:solved {" (ppr implic)
+ ; bad_telescope <- checkBadTelescope implic
+ ; if bad_telescope
+ then return (implic { ic_status = IC_BadTelescope })
+ else
+
+ do { solved_status <- computeSolvedStatus implic
+ ; let pruned_wc = pruneImplications wc
+ ; return (implic { ic_status = solved_status
+ , ic_wanted = pruned_wc }) } }
pruneImplications :: WantedConstraints -> WantedConstraints
-- We have now recorded the `ic_need` variables of the child
@@ -502,8 +496,8 @@ pruneImplications wc@(WC { wc_impl = implics })
| otherwise
= True -- Otherwise, keep it
-findRedundantGivens :: Implication -> [EvVar]
-findRedundantGivens (Implic { ic_info = info, ic_need = need, ic_given = givens })
+findRedundantGivens :: SkolemInfoAnon -> NeededEvIds -> [EvVar] -> [EvVar]
+findRedundantGivens info need givens
| not (warnRedundantGivens info) -- Don't report redundant constraints at all
= [] -- See (TRC4) of Note [Tracking redundant constraints]
@@ -520,9 +514,8 @@ findRedundantGivens (Implic { ic_info = info, ic_need = need, ic_given = givens
unused_givens = filterOut is_used givens
- needed_givens_ignoring_default_methods = ens_fvs need
is_used given = is_type_error given
- || given `elemVarSet` needed_givens_ignoring_default_methods
+ || given `elemVarSet` need
|| (in_instance_decl && is_improving (idType given))
minimal_givens = mkMinimalBySCs evVarPred givens -- See (TRC2)
@@ -611,113 +604,105 @@ checkBadTelescope (Implic { ic_info = info
| otherwise
= go (later_skols `extendVarSet` one_skol) earlier_skols
-neededEvVars :: Implication -> TcS Implication
--- Find all the evidence variables that are "needed",
--- /and/ delete dead evidence bindings
+computeSolvedStatus :: Implication -> TcS ImplicStatus
+-- Given a fully-solved implication,
+-- - Figure out the right IC_Solved fields
+-- - Delete unused evidence bindings
--
-- See Note [Tracking redundant constraints]
-- See Note [Delete dead Given evidence bindings]
---
--- - Start from initial_seeds (from nested implications)
---
--- - Add free vars of RHS of all Wanted evidence bindings
--- and coercion variables accumulated in tcvs (all Wanted)
---
--- - Generate 'needed', the needed set of EvVars, by doing transitive
--- closure through Given bindings
--- e.g. Needed {a,b}
--- Given a = sc_sel a2
--- Then a2 is needed too
---
--- - Prune out all Given bindings that are not needed
-
-neededEvVars implic@(Implic { ic_info = info
+computeSolvedStatus (Implic { ic_info = info
, ic_binds = ev_binds_var
- , ic_wanted = WC { wc_impl = implics }
- , ic_need_implic = old_need_implic -- See (TRC1)
- })
- = do { ev_binds <- TcS.getTcEvBindsMap ev_binds_var
- ; used_cos <- TcS.getTcEvTyCoVars ev_binds_var
-
- ; let -- Find the variables needed by `implics`
- new_need_implic@(ENS { ens_dms = dm_seeds, ens_fvs = other_seeds })
- = foldr add_implic old_need_implic implics
- -- Start from old_need_implic! See (TRC1)
-
- -- Get the variables needed by the solved bindings
- -- (It's OK to use a non-deterministic fold here
- -- because add_wanted is commutative.)
- used_covars = coVarsOfCos used_cos
- seeds_w = nonDetStrictFoldEvBindMap add_wanted used_covars ev_binds
-
- need_ignoring_dms = findNeededGivenEvVars ev_binds (other_seeds `unionVarSet` seeds_w)
- need_from_dms = findNeededGivenEvVars ev_binds dm_seeds
- need_full = need_ignoring_dms `unionVarSet` need_from_dms
-
- -- `need`: the Givens from outer scopes that are used in this implication
- -- is_dm_skol: see (TRC5)
- need | is_dm_skol info = ENS { ens_dms = trim ev_binds need_full
- , ens_fvs = emptyVarSet }
- | otherwise = ENS { ens_dms = trim ev_binds need_from_dms
- , ens_fvs = trim ev_binds need_ignoring_dms }
-
- -- Delete dead Given evidence bindings
+ , ic_given = givens
+ , ic_wanted = WC { wc_impl = implics } })
+ = do { ev_binds_state <- TcS.getTcEvBindsState ev_binds_var
+
+ ; let EBS { ebs_binds = ev_binds, ebs_needs = local_needs } = ev_binds_state
+
+ -- Gather the raw needed EvIds, from the
+ -- current evidence bindings `local_needs`, and the `implics`
+ (need_dm, need_non_dm) = foldr add_implic (emptyVarSet, local_needs) implics
+
+ -- Do transitive closure through the evidence bindings
+ -- and delete all EvIds bound by the bindings
+ need_dm1 = findNeededGivenEvVars ev_binds need_dm
+ need_non_dm1 = findNeededGivenEvVars ev_binds need_non_dm
+
+ -- Compute the redundant Givens
+ dead_givens = findRedundantGivens info need_non_dm1 givens
+
+ -- Delete variables bound by ev_binds or by givens
+ need_dm2 = trim_needs need_dm1
+ need_non_dm2 = trim_needs need_non_dm1
+
+ trim_needs :: NeededEvIds -> NeededEvIds
+ trim_needs needs = (needs `varSetMinusEvBindsMap` ev_binds)
+ `delVarSetList` givens
+
+ -- Prune dead Given evidence bindings
-- See Note [Delete dead Given evidence bindings]
- ; let live_ev_binds = filterEvBindMap (needed_ev_bind need_full) ev_binds
- ; TcS.setTcEvBindsMap ev_binds_var live_ev_binds
-
- ; traceTcS "neededEvVars" $
- vcat [ text "old_need_implic:" <+> ppr old_need_implic
- , text "new_need_implic:" <+> ppr new_need_implic
- , text "used_covars:" <+> ppr used_covars
- , text "need_ignoring_dms:" <+> ppr need_ignoring_dms
- , text "need_from_dms:" <+> ppr need_from_dms
- , text "need:" <+> ppr need
+ ; let need_full = need_dm1 `unionVarSet` need_non_dm1
+ pruned_ev_binds = filterEvBindsMap (keep_ev_bind need_full) ev_binds
+ ; TcS.setTcEvBindsMap ev_binds_var pruned_ev_binds
+
+ ; traceTcS "computeSolvedStatus" $
+ vcat [ text "local_needs:" <+> ppr local_needs
+ , text "need_dm:" <+> ppr need_dm
+ , text "need_non_dm:" <+> ppr need_non_dm
+ , text "need_dm1:" <+> ppr need_dm1
+ , text "need_non_dm1:" <+> ppr need_non_dm1
+ , text "need_dm2:" <+> ppr need_dm2
+ , text "need_non_dm2:" <+> ppr need_non_dm2
, text "ev_binds:" <+> ppr ev_binds
- , text "live_ev_binds:" <+> ppr live_ev_binds ]
- ; return (implic { ic_need = need
- , ic_need_implic = new_need_implic }) }
- where
- trim :: EvBindMap -> VarSet -> VarSet
- -- Delete variables bound by Givens or bindings
- trim ev_binds needs = needs `varSetMinusEvBindMap` ev_binds
+ , text "deleted ev_binds:"
+ <+> ppr (filterEvBindsMap (not . keep_ev_bind need_full) ev_binds) ]
- add_implic :: Implication -> EvNeedSet -> EvNeedSet
- add_implic (Implic { ic_given = givens, ic_need = need }) acc
- = (need `delGivensFromEvNeedSet` givens) `unionEvNeedSet` acc
+ ; if is_dm_skol info
+ then return (IC_Solved { ics_dead = dead_givens
+ , ics_dm = need_dm2 `unionVarSet` need_non_dm2
+ , ics_non_dm = emptyVarSet })
- needed_ev_bind needed (EvBind { eb_lhs = ev_var, eb_info = info })
+ else return (IC_Solved { ics_dead = dead_givens
+ , ics_dm = need_dm2
+ , ics_non_dm = need_non_dm2 }) }
+ where
+ add_implic :: Implication -> (NeededEvIds, NeededEvIds) -> (NeededEvIds, NeededEvIds)
+ add_implic (Implic { ic_status = status}) (dm2, non_dm2)
+ | IC_Solved { ics_dm = dm1, ics_non_dm = non_dm1 } <- status
+ = (dm1 `unionVarSet` dm2, non_dm1 `unionVarSet` non_dm2)
+ | otherwise
+ = pprPanic "computeSolvedStatus" (ppr implics)
+
+ keep_ev_bind :: NeededEvIds -> EvBind -> Bool
+ -- False => we can discard this unused Given evidence binding
+ -- We always keep all the Wanted bindings
+ keep_ev_bind needed (EvBind { eb_lhs = ev_var, eb_info = info })
| EvBindGiven{} <- info = ev_var `elemVarSet` needed
| otherwise = True -- Keep all wanted bindings
- add_wanted :: EvBind -> VarSet -> VarSet
- add_wanted (EvBind { eb_info = info, eb_rhs = rhs }) needs
- | EvBindGiven{} <- info = needs -- Add the rhs vars of the Wanted bindings only
- | otherwise = nestedEvIdsOfTerm rhs `unionVarSet` needs
-
is_dm_skol :: SkolemInfoAnon -> Bool
is_dm_skol (MethSkol _ is_dm) = is_dm
is_dm_skol _ = False
-findNeededGivenEvVars :: EvBindMap -> VarSet -> VarSet
+findNeededGivenEvVars :: EvBindsMap -> NeededEvIds -> NeededEvIds
-- Find all the Given evidence needed by seeds,
-- looking transitively through bindings for Givens (only)
findNeededGivenEvVars ev_binds seeds
= transCloVarSet also_needs seeds
where
- also_needs :: VarSet -> VarSet
- also_needs needs = nonDetStrictFoldUniqSet add emptyVarSet needs
- -- It's OK to use a non-deterministic fold here because we immediately
- -- forget about the ordering by creating a set
-
- add :: Var -> VarSet -> VarSet
- add v needs
- | Just ev_bind <- lookupEvBind ev_binds v
- , EvBind { eb_info = EvBindGiven, eb_rhs = rhs } <- ev_bind
- -- Look at Given bindings only
- = nestedEvIdsOfTerm rhs `unionVarSet` needs
- | otherwise
- = needs
+ also_needs :: VarSet -> VarSet
+ also_needs needs = nonDetStrictFoldUniqSet add emptyVarSet needs
+ -- It's OK to use a non-deterministic fold here because we immediately
+ -- forget about the ordering by creating a set
+
+ add :: Var -> VarSet -> VarSet
+ add v needs
+ | Just ev_bind <- lookupEvBind ev_binds v
+ , EvBind { eb_info = EvBindGiven, eb_rhs = rhs } <- ev_bind
+ -- Look at Given bindings only
+ = nestedEvIdsOfTerm rhs `unionVarSet` needs
+ | otherwise
+ = needs
-------------------------------------------------
simplifyDelayedErrors :: Bag DelayedError -> TcS (Bag DelayedError)
@@ -949,7 +934,7 @@ Wrinkles:
and because of the degnerate instance for `Show (T a)`, we don't need the `Eq a`
constraint. But we don't want to report it as redundant!
-(TRC5) Consider this (#25992), where `op2` has a default method
+(TRC5) Default methods. Consider this (#25992), where `op2` has a default method
class C a where { op1, op2 :: a -> a
; op2 = op1 . op1 }
instance C a => C [a] where
@@ -960,10 +945,12 @@ Wrinkles:
$dmop2 = op1 . op1
$fCList :: forall a. C a => C [a]
- $fCList @a (d::C a) = MkC (\(x:a).x) ($dmop2 @a d)
+ $fCList @a (d::C a) = MkC (\(x:a).x)
+ ($dmop2 @[a] ($fCList @a d))
- Notice that `d` gets passed to `$dmop`: it is "needed". But it's only
- /really/ needed if some /other/ method (in this case `op1`) uses it.
+ Notice that `d` gets passed, indirectly to `$dmop`: it appears to be
+ "needed". But it's only /really/ needed if some /other/ method or
+ superclass (in this case `op1`) uses it.
So, rather than one set of "needed Givens" we use `EvNeedSet` to track
a /pair/ of sets:
@@ -1645,10 +1632,12 @@ solveWantedQCI mode ct@(CQuantCan (QCI { qci_ev = ev, qci_tvs = tvs
-- carrying a record of which evidence variables are used
-- See Note [Free vars of EvFun] in GHC.Tc.Types.Evidence
do { setWantedDict dest EvCanonical $
- EvFun { et_tvs = skol_tvs, et_given = given_ev_vars
+ EvFun { et_tvs = skol_tvs
+ , et_given = given_ev_vars
, et_binds = TcEvBinds ev_binds_var
- , et_body = wantedCtEvEvId wanted_ev }
+ , et_body = wantedCtEvEvId wanted_ev }
+ ; traceTcS "solveWantedQCI" (ppr imp')
; return (Right imp') }
}
=====================================
compiler/GHC/Tc/Types/Constraint.hs
=====================================
@@ -65,7 +65,6 @@ module GHC.Tc.Types.Constraint (
ImplicStatus(..), isInsolubleStatus, isSolvedStatus,
UserGiven, getGivensFromImplics,
HasGivenEqs(..), checkImplicationInvariants,
- EvNeedSet(..), emptyEvNeedSet, unionEvNeedSet, extendEvNeedSet, delGivensFromEvNeedSet,
-- CtLocEnv
CtLocEnv(..), setCtLocEnvLoc, setCtLocEnvLvl, getCtLocEnvLoc, getCtLocEnvLvl, ctLocEnvInGeneratedCode,
@@ -1564,45 +1563,9 @@ data Implication
ic_binds :: EvBindsVar, -- Points to the place to fill in the
-- abstraction and bindings.
- -- The ic_need fields keep track of which Given evidence
- -- is used by this implication or its children
- -- See Note [Tracking redundant constraints]
- -- NB: these sets include stuff used by fully-solved nested implications
- -- that have since been discarded
- ic_need :: EvNeedSet, -- All needed Given evidence, from this implication
- -- or outer ones
- -- That is, /after/ deleting the binders of ic_binds,
- -- but /before/ deleting ic_givens
-
- ic_need_implic :: EvNeedSet, -- Union of of the ic_need of all implications in ic_wanted
- -- /including/ any fully-solved implications that have been
- -- discarded by `pruneImplications`. This discarding is why
- -- we need to keep this field in the first place.
-
ic_status :: ImplicStatus
}
-data EvNeedSet = ENS { ens_dms :: VarSet -- Needed only by default methods
- , ens_fvs :: VarSet -- Needed by things /other than/ default methods
- -- See (TRC5) in Note [Tracking redundant constraints]
- }
-
-emptyEvNeedSet :: EvNeedSet
-emptyEvNeedSet = ENS { ens_dms = emptyVarSet, ens_fvs = emptyVarSet }
-
-unionEvNeedSet :: EvNeedSet -> EvNeedSet -> EvNeedSet
-unionEvNeedSet (ENS { ens_dms = dm1, ens_fvs = fv1 })
- (ENS { ens_dms = dm2, ens_fvs = fv2 })
- = ENS { ens_dms = dm1 `unionVarSet` dm2, ens_fvs = fv1 `unionVarSet` fv2 }
-
-extendEvNeedSet :: EvNeedSet -> Var -> EvNeedSet
-extendEvNeedSet ens@(ENS { ens_fvs = fvs }) v = ens { ens_fvs = fvs `extendVarSet` v }
-
-delGivensFromEvNeedSet :: EvNeedSet -> [Var] -> EvNeedSet
-delGivensFromEvNeedSet (ENS { ens_dms = dms, ens_fvs = fvs }) givens
- = ENS { ens_dms = dms `delVarSetList` givens
- , ens_fvs = fvs `delVarSetList` givens }
-
implicationPrototype :: CtLocEnv -> Implication
implicationPrototype ct_loc_env
= Implic { -- These fields must be initialised
@@ -1619,14 +1582,21 @@ implicationPrototype ct_loc_env
, ic_given = []
, ic_wanted = emptyWC
, ic_given_eqs = MaybeGivenEqs
- , ic_status = IC_Unsolved
- , ic_need = emptyEvNeedSet
- , ic_need_implic = emptyEvNeedSet }
+ , ic_status = IC_Unsolved }
data ImplicStatus
= IC_Solved -- All wanteds in the tree are solved, all the way down
- { ics_dead :: [EvVar] } -- Subset of ic_given that are not needed
- -- See Note [Tracking redundant constraints] in GHC.Tc.Solver
+ { ics_dead :: [EvVar] -- Subset of ic_given that are not needed
+
+ , ics_dm :: NeededEvIds -- Enclosing Given EvIds that are needed by
+ -- calls to default methods (typically empty)
+
+ , ics_non_dm :: NeededEvIds -- Enclosing Given EvIds that are needed, other than
+ -- calls to default methods
+ }
+ -- Reporting redundant givens: use ics_non_dm
+ -- Pruning evidence bindings: use ics_dm `union` ics_non_dm
+ -- See Note [Tracking redundant constraints] in GHC.Tc.Solver
| IC_Insoluble -- At least one insoluble Wanted constraint in the tree
@@ -1715,7 +1685,6 @@ instance Outputable Implication where
, ic_given = given, ic_given_eqs = given_eqs
, ic_wanted = wanted, ic_status = status
, ic_binds = binds
- , ic_need = need, ic_need_implic = need_implic
, ic_info = info })
= hang (text "Implic" <+> lbrace)
2 (sep [ text "TcLevel =" <+> ppr tclvl
@@ -1725,21 +1694,17 @@ instance Outputable Implication where
, hang (text "Given =") 2 (pprEvVars given)
, hang (text "Wanted =") 2 (ppr wanted)
, text "Binds =" <+> ppr binds
- , text "need =" <+> ppr need
- , text "need_implic =" <+> ppr need_implic
, pprSkolInfo info ] <+> rbrace)
-instance Outputable EvNeedSet where
- ppr (ENS { ens_dms = dms, ens_fvs = fvs })
- = text "ENS" <> braces (sep [text "ens_dms =" <+> ppr dms
- , text "ens_fvs =" <+> ppr fvs])
-
instance Outputable ImplicStatus where
ppr IC_Insoluble = text "Insoluble"
ppr IC_BadTelescope = text "Bad telescope"
ppr IC_Unsolved = text "Unsolved"
- ppr (IC_Solved { ics_dead = dead })
- = text "Solved" <+> (braces (text "Dead givens =" <+> ppr dead))
+ ppr (IC_Solved { ics_dead = dead, ics_dm = dm, ics_non_dm = non_dm })
+ = text "Solved" <> (braces $
+ vcat [ text "Dead givens =" <+> ppr dead
+ , text "need_dm =" <+> ppr dm
+ , text "need_non_dm =" <+> ppr non_dm ])
checkTelescopeSkol :: SkolemInfoAnon -> Bool
-- See Note [Checking telescopes]
=====================================
compiler/GHC/Tc/Types/Evidence.hs
=====================================
@@ -14,14 +14,15 @@ module GHC.Tc.Types.Evidence (
optSubTypeHsWrapper,
-- * Evidence bindings
- TcEvBinds(..), EvBindsVar(..),
- EvBindMap(..), emptyEvBindMap, extendEvBinds, unionEvBindMap,
+ TcEvBinds(..), EvBindsVar(..), NeededEvIds,
+ EvBindsState(..), emptyEvBindsState, unionEvBindsState, addCoVarsEBS,
+ EvBindsMap(..), emptyEvBindsMap, extendEvBinds, unionEvBindsMap,
lookupEvBind, evBindMapBinds,
- foldEvBindMap, nonDetStrictFoldEvBindMap,
- filterEvBindMap,
- isEmptyEvBindMap,
+ foldEvBindsMap, nonDetStrictFoldEvBindsMap,
+ filterEvBindsMap,
+ isEmptyEvBindsMap,
evBindMapToVarSet,
- varSetMinusEvBindMap,
+ varSetMinusEvBindsMap,
EvBindInfo(..), EvBind(..), emptyTcEvBinds, isEmptyTcEvBinds, mkGivenEvBind, mkWantedEvBind,
evBindVar, isCoEvBindsVar,
@@ -725,12 +726,12 @@ data EvBindsVar
ebv_uniq :: Unique,
-- The Unique is for debug printing only
- ebv_binds :: IORef EvBindMap,
+ ebv_binds :: IORef EvBindsState
-- The main payload: the value-level evidence bindings
-- (dictionaries etc)
-- Some Given, some Wanted
- ebv_tcvs :: IORef [TcCoercion]
+-- ebv_needs :: IORef VarSet
-- When we solve a Wanted by filling in a CoercionHole, it is as
-- if we were adding an evidence binding
-- co_hole := coercion
@@ -745,10 +746,35 @@ data EvBindsVar
| CoEvBindsVar { -- See Note [Coercion evidence only]
-- See above for comments on ebv_uniq, ebv_tcvs
- ebv_uniq :: Unique,
- ebv_tcvs :: IORef [TcCoercion]
+ ebv_uniq :: Unique,
+ ebv_needs :: IORef NeededEvIds
}
+type NeededEvIds = VarSet
+
+data EvBindsState = EBS { ebs_binds :: EvBindsMap
+ , ebs_needs :: NeededEvIds }
+
+emptyEvBindsState :: EvBindsState
+emptyEvBindsState = EBS { ebs_binds = emptyEvBindsMap
+ , ebs_needs = emptyVarSet }
+
+unionEvBindsState :: EvBindsState -> EvBindsState -> EvBindsState
+unionEvBindsState (EBS { ebs_binds = bs1, ebs_needs = n1 })
+ (EBS { ebs_binds = bs2, ebs_needs = n2 })
+ = EBS { ebs_binds = bs1 `unionEvBindsMap` bs2
+ , ebs_needs = n1 `unionVarSet` n2 }
+
+addCoVarsEBS :: VarSet -> EvBindsState -> EvBindsState
+addCoVarsEBS n1 ebs@(EBS { ebs_needs = n2 })
+ = ebs { ebs_needs = n1 `unionVarSet` n2 }
+
+instance Outputable EvBindsState where
+ ppr (EBS { ebs_binds = bs, ebs_needs = needs })
+ = text "EBS" <> (braces $
+ sep [ text "needs =" <+> ppr needs
+ , text "binds =" <+> ppr bs ])
+
instance Data.Data TcEvBinds where
-- Placeholder; we can't traverse into TcEvBinds
toConstr _ = abstractConstr "TcEvBinds"
@@ -778,8 +804,8 @@ isCoEvBindsVar (CoEvBindsVar {}) = True
isCoEvBindsVar (EvBindsVar {}) = False
-----------------
-newtype EvBindMap
- = EvBindMap {
+newtype EvBindsMap
+ = EvBindsMap {
ev_bind_varenv :: DVarEnv EvBind
} -- Map from evidence variables to evidence terms
-- We use @DVarEnv@ here to get deterministic ordering when we
@@ -801,50 +827,50 @@ newtype EvBindMap
-- See Note [Deterministic UniqFM] in GHC.Types.Unique.DFM for explanation why
-- @UniqFM@ can lead to nondeterministic order.
-emptyEvBindMap :: EvBindMap
-emptyEvBindMap = EvBindMap { ev_bind_varenv = emptyDVarEnv }
+emptyEvBindsMap :: EvBindsMap
+emptyEvBindsMap = EvBindsMap { ev_bind_varenv = emptyDVarEnv }
-extendEvBinds :: EvBindMap -> EvBind -> EvBindMap
+extendEvBinds :: EvBindsMap -> EvBind -> EvBindsMap
extendEvBinds bs ev_bind
- = EvBindMap { ev_bind_varenv = extendDVarEnv (ev_bind_varenv bs)
+ = EvBindsMap { ev_bind_varenv = extendDVarEnv (ev_bind_varenv bs)
(eb_lhs ev_bind)
ev_bind }
-- | Union two evidence binding maps
-unionEvBindMap :: EvBindMap -> EvBindMap -> EvBindMap
-unionEvBindMap (EvBindMap env1) (EvBindMap env2) =
- EvBindMap { ev_bind_varenv = plusDVarEnv env1 env2 }
+unionEvBindsMap :: EvBindsMap -> EvBindsMap -> EvBindsMap
+unionEvBindsMap (EvBindsMap env1) (EvBindsMap env2) =
+ EvBindsMap { ev_bind_varenv = plusDVarEnv env1 env2 }
-isEmptyEvBindMap :: EvBindMap -> Bool
-isEmptyEvBindMap (EvBindMap m) = isEmptyDVarEnv m
+isEmptyEvBindsMap :: EvBindsMap -> Bool
+isEmptyEvBindsMap (EvBindsMap m) = isEmptyDVarEnv m
-lookupEvBind :: EvBindMap -> EvVar -> Maybe EvBind
+lookupEvBind :: EvBindsMap -> EvVar -> Maybe EvBind
lookupEvBind bs = lookupDVarEnv (ev_bind_varenv bs)
-evBindMapBinds :: EvBindMap -> Bag EvBind
-evBindMapBinds = foldEvBindMap consBag emptyBag
+evBindMapBinds :: EvBindsMap -> Bag EvBind
+evBindMapBinds = foldEvBindsMap consBag emptyBag
-foldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a
-foldEvBindMap k z bs = foldDVarEnv k z (ev_bind_varenv bs)
+foldEvBindsMap :: (EvBind -> a -> a) -> a -> EvBindsMap -> a
+foldEvBindsMap k z bs = foldDVarEnv k z (ev_bind_varenv bs)
-- See Note [Deterministic UniqFM] to learn about nondeterminism.
-- If you use this please provide a justification why it doesn't introduce
-- nondeterminism.
-nonDetStrictFoldEvBindMap :: (EvBind -> a -> a) -> a -> EvBindMap -> a
-nonDetStrictFoldEvBindMap k z bs = nonDetStrictFoldDVarEnv k z (ev_bind_varenv bs)
+nonDetStrictFoldEvBindsMap :: (EvBind -> a -> a) -> a -> EvBindsMap -> a
+nonDetStrictFoldEvBindsMap k z bs = nonDetStrictFoldDVarEnv k z (ev_bind_varenv bs)
-filterEvBindMap :: (EvBind -> Bool) -> EvBindMap -> EvBindMap
-filterEvBindMap k (EvBindMap { ev_bind_varenv = env })
- = EvBindMap { ev_bind_varenv = filterDVarEnv k env }
+filterEvBindsMap :: (EvBind -> Bool) -> EvBindsMap -> EvBindsMap
+filterEvBindsMap k (EvBindsMap { ev_bind_varenv = env })
+ = EvBindsMap { ev_bind_varenv = filterDVarEnv k env }
-evBindMapToVarSet :: EvBindMap -> VarSet
-evBindMapToVarSet (EvBindMap dve) = unsafeUFMToUniqSet (mapUFM evBindVar (udfmToUfm dve))
+evBindMapToVarSet :: EvBindsMap -> VarSet
+evBindMapToVarSet (EvBindsMap dve) = unsafeUFMToUniqSet (mapUFM evBindVar (udfmToUfm dve))
-varSetMinusEvBindMap :: VarSet -> EvBindMap -> VarSet
-varSetMinusEvBindMap vs (EvBindMap dve) = vs `uniqSetMinusUDFM` dve
+varSetMinusEvBindsMap :: VarSet -> EvBindsMap -> VarSet
+varSetMinusEvBindsMap vs (EvBindsMap dve) = vs `uniqSetMinusUDFM` dve
-instance Outputable EvBindMap where
- ppr (EvBindMap m) = ppr m
+instance Outputable EvBindsMap where
+ ppr (EvBindsMap m) = ppr m
data EvBindInfo
= EvBindGiven { -- See Note [Tracking redundant constraints] in GHC.Tc.Solver
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -104,9 +104,10 @@ module GHC.Tc.Utils.Monad(
-- * Type constraints
newTcEvBinds, newNoTcEvBinds, cloneEvBindsVar,
- addTcEvBind, addTcEvBinds, addTopEvBinds,
- getTcEvBindsMap, setTcEvBindsMap, updTcEvBinds,
- getTcEvTyCoVars, chooseUniqueOccTc,
+ addTcEvCoBind, addTcEvBind, addTopEvBinds,
+ getTcEvBindsMap, getTcEvBindsState,
+ setTcEvBindsMap, combineTcEvBinds,
+ chooseUniqueOccTc,
getConstraintVar, setConstraintVar,
emitConstraints, emitSimple, emitSimples,
emitImplication, emitImplications, ensureReflMultiplicityCo,
@@ -118,6 +119,7 @@ module GHC.Tc.Utils.Monad(
getLclTypeEnv, setLclTypeEnv,
traceTcConstraints,
emitNamedTypeHole, IsExtraConstraint(..), emitAnonTypeHole,
+ fillCoercionHole,
-- * Template Haskell context
recordThUse, recordThNeededRuntimeDeps,
@@ -187,12 +189,13 @@ import GHC.Unit.Module.Warnings
import GHC.Unit.Home.PackageTable
import GHC.Core.UsageEnv
-
import GHC.Core.Coercion ( isReflCo )
import GHC.Core.Multiplicity
import GHC.Core.InstEnv
import GHC.Core.FamInstEnv
import GHC.Core.Type( mkNumLitTy )
+import GHC.Core.TyCo.Rep( CoercionHole(..) )
+import GHC.Core.TyCo.FVs( coVarsOfCo )
import GHC.Core.TyCon ( TyCon )
import GHC.Driver.Env
@@ -230,6 +233,7 @@ import GHC.Types.SafeHaskell
import GHC.Types.Id
import GHC.Types.TypeEnv
import GHC.Types.Var.Env
+import GHC.Types.Var.Set
import GHC.Types.SrcLoc
import GHC.Types.Name.Env
import GHC.Types.Name.Set
@@ -1660,6 +1664,105 @@ tryTcDiscardingErrs' validate recover_invalid recover_error thing_inside
recover_error
}
+{- Note [Constraints and errors]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider this (#12124):
+
+ foo :: Maybe Int
+ foo = return (case Left 3 of
+ Left -> 1 -- Hard error here!
+ _ -> 0)
+
+The call to 'return' will generate a (Monad m) wanted constraint; but
+then there'll be "hard error" (i.e. an exception in the TcM monad), from
+the unsaturated Left constructor pattern.
+
+We'll recover in tcPolyBinds, using recoverM. But then the final
+tcSimplifyTop will see that (Monad m) constraint, with 'm' utterly
+un-filled-in, and will emit a misleading error message.
+
+The underlying problem is that an exception interrupts the constraint
+gathering process. Bottom line: if we have an exception, it's best
+simply to discard any gathered constraints. Hence in 'attemptM' we
+capture the constraints in a fresh variable, and only emit them into
+the surrounding context if we exit normally. If an exception is
+raised, simply discard the collected constraints... we have a hard
+error to report. So this capture-the-emit dance isn't as stupid as it
+looks :-).
+
+However suppose we throw an exception inside an invocation of
+captureConstraints, and discard all the constraints. Some of those
+constraints might be "variable out of scope" Hole constraints, and that
+might have been the actual original cause of the exception! For
+example (#12529):
+ f = p @ Int
+Here 'p' is out of scope, so we get an insoluble Hole constraint. But
+the visible type application fails in the monad (throws an exception).
+We must not discard the out-of-scope error.
+
+It's distressingly delicate though:
+
+* If we discard too /many/ constraints we may fail to report the error
+ that led us to interrupt the constraint gathering process.
+
+ One particular example "variable out of scope" Hole constraints. For
+ example (#12529):
+ f = p @ Int
+ Here 'p' is out of scope, so we get an insoluble Hole constraint. But
+ the visible type application fails in the monad (throws an exception).
+ We must not discard the out-of-scope error.
+
+ Also GHC.Tc.Solver.simplifyAndEmitFlatConstraints may fail having
+ emitted some constraints with skolem-escape problems.
+
+* If we discard too /few/ constraints, we may get the misleading
+ class constraints mentioned above.
+
+ We may /also/ end up taking constraints built at some inner level, and
+ emitting them (via the exception catching in `tryCaptureConstraints`) at some
+ outer level, and then breaking the TcLevel invariants See Note [TcLevel
+ invariants] in GHC.Tc.Utils.TcType
+
+So `dropMisleading` has a horridly ad-hoc structure:
+
+* It keeps only /insoluble/ flat constraints (which are unlikely to very visibly
+ trip up on the TcLevel invariant)
+
+* But it keeps all /implication/ constraints (except the class constraints
+ inside them). The implication constraints are OK because they set the ambient
+ level before attempting to solve any inner constraints.
+
+Ugh! I hate this. But it seems to work.
+
+Other wrinkles
+
+(CERR1) Note that freshly-generated constraints like (Int ~ Bool), or
+ ((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as
+ insoluble. The constraint solver does that. So they'll be discarded.
+ That's probably ok; but see th/5358 as a not-so-good example:
+ t1 :: Int
+ t1 x = x -- Manifestly wrong
+
+ foo = $(...raises exception...)
+ We report the exception, but not the bug in t1. Oh well. Possible
+ solution: make GHC.Tc.Utils.Unify.uType spot manifestly-insoluble constraints.
+
+(CERR2) In #26015 I found that from the constraints
+ [W] alpha ~ Int -- A class constraint
+ [W] F alpha ~# Bool -- An equality constraint
+ we were dropping the first (becuase it's a class constraint) but not the
+ second, and then getting a misleading error message from the second. As
+ #25607 shows, we can get not just one but a zillion bogus messages, which
+ conceal the one genuine error. Boo.
+
+ For now I have added an even more ad-hoc "drop class constraints except
+ equality classes (~) and (~~)"; see `dropMisleading`. That just kicks the can
+ down the road; but this problem seems somewhat rare anyway. The code in
+ `dropMisleading` hasn't changed for years.
+
+It would be great to have a more systematic solution to this entire mess.
+-}
+
{-
************************************************************************
* *
@@ -1854,108 +1957,112 @@ debugTc thing
addTopEvBinds :: Bag EvBind -> TcM a -> TcM a
addTopEvBinds new_ev_binds thing_inside
- =updGblEnv upd_env thing_inside
+ = updGblEnv upd_env thing_inside
where
upd_env tcg_env = tcg_env { tcg_ev_binds = tcg_ev_binds tcg_env
`unionBags` new_ev_binds }
newTcEvBinds :: TcM EvBindsVar
-newTcEvBinds = do { binds_ref <- newTcRef emptyEvBindMap
- ; tcvs_ref <- newTcRef []
+newTcEvBinds = do { binds_ref <- newTcRef emptyEvBindsState
; uniq <- newUnique
; traceTc "newTcEvBinds" (text "unique =" <+> ppr uniq)
; return (EvBindsVar { ebv_binds = binds_ref
- , ebv_tcvs = tcvs_ref
, ebv_uniq = uniq }) }
-- | Creates an EvBindsVar incapable of holding any bindings. It still
--- tracks covar usages (see comments on ebv_tcvs in "GHC.Tc.Types.Evidence"), thus
+-- tracks covar usages (see comments on ebv_needs in "GHC.Tc.Types.Evidence"), thus
-- must be made monadically
newNoTcEvBinds :: TcM EvBindsVar
newNoTcEvBinds
- = do { tcvs_ref <- newTcRef []
+ = do { tcvs_ref <- newTcRef emptyVarSet
; uniq <- newUnique
; traceTc "newNoTcEvBinds" (text "unique =" <+> ppr uniq)
- ; return (CoEvBindsVar { ebv_tcvs = tcvs_ref
- , ebv_uniq = uniq }) }
+ ; return (CoEvBindsVar { ebv_needs = tcvs_ref
+ , ebv_uniq = uniq }) }
cloneEvBindsVar :: EvBindsVar -> TcM EvBindsVar
-- Clone the refs, so that any binding created when
-- solving don't pollute the original
cloneEvBindsVar ebv@(EvBindsVar {})
- = do { binds_ref <- newTcRef emptyEvBindMap
- ; tcvs_ref <- newTcRef []
- ; return (ebv { ebv_binds = binds_ref
- , ebv_tcvs = tcvs_ref }) }
+ = do { binds_ref <- newTcRef emptyEvBindsState
+ ; uniq <- newUnique
+ ; return (ebv { ebv_uniq = uniq
+ , ebv_binds = binds_ref }) }
cloneEvBindsVar ebv@(CoEvBindsVar {})
- = do { tcvs_ref <- newTcRef []
- ; return (ebv { ebv_tcvs = tcvs_ref }) }
+ = do { tcvs_ref <- newTcRef emptyVarSet
+ ; return (ebv { ebv_needs = tcvs_ref }) }
-getTcEvTyCoVars :: EvBindsVar -> TcM [TcCoercion]
-getTcEvTyCoVars ev_binds_var
- = readTcRef (ebv_tcvs ev_binds_var)
+getTcEvBindsMap :: EvBindsVar -> TcM EvBindsMap
+getTcEvBindsMap ebv = do { EBS { ebs_binds = bs } <- getTcEvBindsState ebv
+ ; return bs }
-getTcEvBindsMap :: EvBindsVar -> TcM EvBindMap
-getTcEvBindsMap (EvBindsVar { ebv_binds = ev_ref })
+getTcEvBindsState :: EvBindsVar -> TcM EvBindsState
+getTcEvBindsState (EvBindsVar { ebv_binds = ev_ref })
= readTcRef ev_ref
-getTcEvBindsMap (CoEvBindsVar {})
- = return emptyEvBindMap
-
-setTcEvBindsMap :: EvBindsVar -> EvBindMap -> TcM ()
-setTcEvBindsMap (EvBindsVar { ebv_binds = ev_ref }) binds
- = writeTcRef ev_ref binds
-setTcEvBindsMap v@(CoEvBindsVar {}) ev_binds
- | isEmptyEvBindMap ev_binds
- = return ()
- | otherwise
- = pprPanic "setTcEvBindsMap" (ppr v $$ ppr ev_binds)
-
-updTcEvBinds :: EvBindsVar -> EvBindsVar -> TcM ()
-updTcEvBinds (EvBindsVar { ebv_binds = old_ebv_ref, ebv_tcvs = old_tcv_ref })
- (EvBindsVar { ebv_binds = new_ebv_ref, ebv_tcvs = new_tcv_ref })
+getTcEvBindsState (CoEvBindsVar { ebv_needs = needs_ref })
+ = do { needs <- readTcRef needs_ref
+ ; return (EBS { ebs_binds = emptyEvBindsMap, ebs_needs = needs }) }
+
+setTcEvBindsMap :: EvBindsVar -> EvBindsMap -> TcM ()
+setTcEvBindsMap (EvBindsVar { ebv_binds = ev_ref }) ev_binds
+ = updTcRef ev_ref (\ebs -> ebs { ebs_binds = ev_binds })
+setTcEvBindsMap (CoEvBindsVar {}) ev_binds
+ = assertPpr (isEmptyEvBindsMap ev_binds) (ppr ev_binds) $
+ return ()
+
+combineTcEvBinds :: EvBindsVar -> EvBindsVar -> TcM ()
+combineTcEvBinds (EvBindsVar { ebv_binds = old_ebv_ref })
+ (EvBindsVar { ebv_binds = new_ebv_ref })
= do { new_ebvs <- readTcRef new_ebv_ref
- ; updTcRef old_ebv_ref (`unionEvBindMap` new_ebvs)
- ; new_tcvs <- readTcRef new_tcv_ref
- ; updTcRef old_tcv_ref (new_tcvs ++) }
-updTcEvBinds (EvBindsVar { ebv_tcvs = old_tcv_ref })
- (CoEvBindsVar { ebv_tcvs = new_tcv_ref })
+ ; updTcRef old_ebv_ref (`unionEvBindsState` new_ebvs) }
+combineTcEvBinds (EvBindsVar { ebv_binds = old_tcv_ref })
+ (CoEvBindsVar { ebv_needs = new_tcv_ref })
= do { new_tcvs <- readTcRef new_tcv_ref
- ; updTcRef old_tcv_ref (new_tcvs ++) }
-updTcEvBinds (CoEvBindsVar { ebv_tcvs = old_tcv_ref })
- (CoEvBindsVar { ebv_tcvs = new_tcv_ref })
+ ; updTcRef old_tcv_ref (addCoVarsEBS new_tcvs) }
+combineTcEvBinds (CoEvBindsVar { ebv_needs = old_tcv_ref })
+ (CoEvBindsVar { ebv_needs = new_tcv_ref })
= do { new_tcvs <- readTcRef new_tcv_ref
- ; updTcRef old_tcv_ref (new_tcvs ++) }
-updTcEvBinds old_var new_var
- = pprPanic "updTcEvBinds" (ppr old_var $$ ppr new_var)
+ ; updTcRef old_tcv_ref (unionVarSet new_tcvs) }
+combineTcEvBinds old_var new_var
+ = pprPanic "combineTcEvBinds" (ppr old_var $$ ppr new_var)
-- Terms inside types, no good
+addTcEvCoBind :: EvBindsVar -> CoercionHole -> CoercionPlusHoles -> TcM ()
+addTcEvCoBind ebv hole co_plus_holes@(CPH { cph_co = co })
+ = do { fillCoercionHole hole co_plus_holes
+ -- Record usage of the free vars of this coercion
+ ; let fvs = coVarsOfCo co
+ ; case ebv of
+ EvBindsVar { ebv_binds = bs_ref }
+ -> updTcRef bs_ref (addCoVarsEBS fvs)
+ CoEvBindsVar { ebv_needs = need_ref }
+ -> updTcRef need_ref (unionVarSet fvs) }
+
addTcEvBind :: EvBindsVar -> EvBind -> TcM ()
-- Add a binding to the TcEvBinds by side effect
-addTcEvBind (EvBindsVar { ebv_binds = ev_ref, ebv_uniq = u }) ev_bind
- = do { bnds <- readTcRef ev_ref
- ; let bnds' = extendEvBinds bnds ev_bind
+addTcEvBind (EvBindsVar { ebv_binds = ev_ref, ebv_uniq = u })
+ ev_bind@(EvBind { eb_info = info, eb_rhs = rhs })
+ = do { EBS { ebs_binds = bnds, ebs_needs = needs } <- readTcRef ev_ref
+ ; let bnds' = extendEvBinds bnds ev_bind
+ needs' = case info of
+ EvBindWanted {} -> nestedEvIdsOfTerm rhs
+ `unionVarSet` needs
+ EvBindGiven {} -> needs
+
; traceTc "addTcEvBind" $
vcat [ text "EvBindsVar:" <+> ppr u
, text "ev_bind:" <+> ppr ev_bind
, text "bnds:" <+> ppr bnds
- , text "bnds':" <+> ppr bnds' ]
- ; writeTcRef ev_ref bnds' }
+ , text "bnds':" <+> ppr bnds'
+ , text "needs" <+> ppr needs
+ , text "needs'" <+> ppr needs' ]
+
+ ; writeTcRef ev_ref $
+ EBS { ebs_binds = bnds', ebs_needs = needs' } }
+
addTcEvBind (CoEvBindsVar { ebv_uniq = u }) ev_bind
= pprPanic "addTcEvBind CoEvBindsVar" (ppr ev_bind $$ ppr u)
-addTcEvBinds :: EvBindsVar -> EvBindMap -> TcM ()
--- ^ Add a collection of binding to the TcEvBinds by side effect
-addTcEvBinds _ new_ev_binds
- | isEmptyEvBindMap new_ev_binds
- = return ()
-addTcEvBinds (EvBindsVar { ebv_binds = ev_ref, ebv_uniq = u }) new_ev_binds
- = do { traceTc "addTcEvBinds" $ ppr u $$
- ppr new_ev_binds
- ; old_bnds <- readTcRef ev_ref
- ; writeTcRef ev_ref (old_bnds `unionEvBindMap` new_ev_binds) }
-addTcEvBinds (CoEvBindsVar { ebv_uniq = u }) new_ev_binds
- = pprPanic "addTcEvBinds CoEvBindsVar" (ppr new_ev_binds $$ ppr u)
-
chooseUniqueOccTc :: (OccSet -> OccName) -> TcM OccName
chooseUniqueOccTc fn =
do { env <- getGblEnv
@@ -2137,111 +2244,22 @@ emitNamedTypeHole (name, tv)
where
occ = nameOccName name
-{- Note [Constraints and errors]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider this (#12124):
-
- foo :: Maybe Int
- foo = return (case Left 3 of
- Left -> 1 -- Hard error here!
- _ -> 0)
-
-The call to 'return' will generate a (Monad m) wanted constraint; but
-then there'll be "hard error" (i.e. an exception in the TcM monad), from
-the unsaturated Left constructor pattern.
-
-We'll recover in tcPolyBinds, using recoverM. But then the final
-tcSimplifyTop will see that (Monad m) constraint, with 'm' utterly
-un-filled-in, and will emit a misleading error message.
-
-The underlying problem is that an exception interrupts the constraint
-gathering process. Bottom line: if we have an exception, it's best
-simply to discard any gathered constraints. Hence in 'attemptM' we
-capture the constraints in a fresh variable, and only emit them into
-the surrounding context if we exit normally. If an exception is
-raised, simply discard the collected constraints... we have a hard
-error to report. So this capture-the-emit dance isn't as stupid as it
-looks :-).
-
-However suppose we throw an exception inside an invocation of
-captureConstraints, and discard all the constraints. Some of those
-constraints might be "variable out of scope" Hole constraints, and that
-might have been the actual original cause of the exception! For
-example (#12529):
- f = p @ Int
-Here 'p' is out of scope, so we get an insoluble Hole constraint. But
-the visible type application fails in the monad (throws an exception).
-We must not discard the out-of-scope error.
-
-It's distressingly delicate though:
-
-* If we discard too /many/ constraints we may fail to report the error
- that led us to interrupt the constraint gathering process.
-
- One particular example "variable out of scope" Hole constraints. For
- example (#12529):
- f = p @ Int
- Here 'p' is out of scope, so we get an insoluble Hole constraint. But
- the visible type application fails in the monad (throws an exception).
- We must not discard the out-of-scope error.
-
- Also GHC.Tc.Solver.simplifyAndEmitFlatConstraints may fail having
- emitted some constraints with skolem-escape problems.
-
-* If we discard too /few/ constraints, we may get the misleading
- class constraints mentioned above.
-
- We may /also/ end up taking constraints built at some inner level, and
- emitting them (via the exception catching in `tryCaptureConstraints` at some
- outer level, and then breaking the TcLevel invariants See Note [TcLevel
- invariants] in GHC.Tc.Utils.TcType
-
-So `dropMisleading` has a horridly ad-hoc structure:
-
-* It keeps only /insoluble/ flat constraints (which are unlikely to very visibly
- trip up on the TcLevel invariant
-
-* But it keeps all /implication/ constraints (except the class constraints
- inside them). The implication constraints are OK because they set the ambient
- level before attempting to solve any inner constraints.
-
-Ugh! I hate this. But it seems to work.
-
-Other wrinkles
-
-(CERR1) Note that freshly-generated constraints like (Int ~ Bool), or
- ((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as
- insoluble. The constraint solver does that. So they'll be discarded.
- That's probably ok; but see th/5358 as a not-so-good example:
- t1 :: Int
- t1 x = x -- Manifestly wrong
-
- foo = $(...raises exception...)
- We report the exception, but not the bug in t1. Oh well. Possible
- solution: make GHC.Tc.Utils.Unify.uType spot manifestly-insoluble constraints.
-
-(CERR2) In #26015 I found that from the constraints
- [W] alpha ~ Int -- A class constraint
- [W] F alpha ~# Bool -- An equality constraint
- we were dropping the first (becuase it's a class constraint) but not the
- second, and then getting a misleading error message from the second. As
- #25607 shows, we can get not just one but a zillion bogus messages, which
- conceal the one genuine error. Boo.
+-- | Put a value in a coercion hole
+fillCoercionHole :: CoercionHole -> CoercionPlusHoles -> TcM ()
+fillCoercionHole (CH { ch_ref = ref, ch_co_var = cv }) co
+ = do { when debugIsOn $
+ do { cts <- readTcRef ref
+ ; whenIsJust cts $ \old_co ->
+ pprPanic "Filling a filled coercion hole" (ppr cv $$ ppr co $$ ppr old_co) }
+ ; traceTc "Filling coercion hole" (ppr cv <+> text ":=" <+> ppr co)
+ ; writeTcRef ref (Just co) }
- For now I have added an even more ad-hoc "drop class constraints except
- equality classes (~) and (~~)"; see `dropMisleading`. That just kicks the can
- down the road; but this problem seems somewhat rare anyway. The code in
- `dropMisleading` hasn't changed for years.
-
-It would be great to have a more systematic solution to this entire mess.
-
-************************************************************************
+{- *********************************************************************
* *
Template Haskell context
* *
-************************************************************************
--}
+********************************************************************* -}
recordThUse :: TcM ()
recordThUse = do { env <- getGblEnv; writeTcRef (tcg_th_used env) True }
=====================================
compiler/GHC/Tc/Utils/TcMType.hs
=====================================
@@ -341,31 +341,13 @@ newImplication
(implicationPrototype (mkCtLocEnv env))
{ ic_warn_inaccessible = warn_inaccessible && not in_gen_code }
-{-
-************************************************************************
-* *
- Coercion holes
-* *
-************************************************************************
--}
-
newCoercionHole :: TcPredType -> TcM CoercionHole
-- For the Bool, see (EIK2) in Note [Equalities with heterogeneous kinds]
newCoercionHole pred_ty
= do { co_var <- newEvVar pred_ty
; traceTc "New coercion hole:" (ppr co_var <+> dcolon <+> ppr pred_ty)
; ref <- newMutVar Nothing
- ; return $ CoercionHole { ch_co_var = co_var, ch_ref = ref } }
-
--- | Put a value in a coercion hole
-fillCoercionHole :: CoercionHole -> CoercionPlusHoles -> TcM ()
-fillCoercionHole (CoercionHole { ch_ref = ref, ch_co_var = cv }) co
- = do { when debugIsOn $
- do { cts <- readTcRef ref
- ; whenIsJust cts $ \old_co ->
- pprPanic "Filling a filled coercion hole" (ppr cv $$ ppr co $$ ppr old_co) }
- ; traceTc "Filling coercion hole" (ppr cv <+> text ":=" <+> ppr co)
- ; writeTcRef ref (Just co) }
+ ; return $ CH { ch_co_var = co_var, ch_ref = ref } }
{- **********************************************************************
*
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -418,7 +418,8 @@ Some examples:
-}
tcSkolemiseGeneral
- :: DeepSubsumptionFlag
+ :: HasDebugCallStack
+ => DeepSubsumptionFlag
-> UserTypeCtxt
-> TcType -> TcType -- top_ty and expected_ty
-- Here, top_ty is the type we started to skolemise; used only in SigSkol
@@ -446,15 +447,16 @@ tcSkolemiseGeneral ds_flag ctxt top_ty expected_ty thing_inside
; skol_info <- mkSkolemInfo sig_skol }
; let skol_tvs = map (binderVar . snd) tv_prs
- ; traceTc "tcSkolemiseGeneral" (pprUserTypeCtxt ctxt <+> ppr skol_tvs <+> ppr given)
+ ; traceTc "tcSkolemiseGeneral {" (pprUserTypeCtxt ctxt <+> ppr skol_tvs <+> ppr given)
; (ev_binds, result) <- checkConstraints sig_skol skol_tvs given $
thing_inside tv_prs rho_ty
+ ; traceTc "tcSkolemiseGeneral }" (ppr ev_binds $$ traceCallStackDoc)
; return (wrap <.> mkWpLet ev_binds, result) }
-- The ev_binds returned by checkConstraints is very
-- often empty, in which case mkWpLet is a no-op
-tcSkolemiseCompleteSig :: TcCompleteSig
+tcSkolemiseCompleteSig :: HasDebugCallStack => TcCompleteSig
-> ([ExpPatType] -> TcRhoType -> TcM result)
-> TcM (HsWrapper, result)
-- ^ The wrapper has type: spec_ty ~~> expected_ty
@@ -471,7 +473,7 @@ tcSkolemiseCompleteSig (CSig { sig_bndr = poly_id, sig_ctxt = ctxt, sig_loc = lo
tcExtendNameTyVarEnv (map (fmap binderVar) tv_prs) $
thing_inside (map (mkInvisExpPatType . snd) tv_prs) rho_ty }
-tcSkolemiseExpectedType :: TcSigmaType
+tcSkolemiseExpectedType :: HasDebugCallStack => TcSigmaType
-> ([ExpPatType] -> TcRhoType -> TcM result)
-> TcM (HsWrapper, result)
-- Just like tcSkolemiseCompleteSig, except that we don't have a user-written
@@ -483,14 +485,15 @@ tcSkolemiseExpectedType exp_ty thing_inside
= tcSkolemiseGeneral Shallow GenSigCtxt exp_ty exp_ty $ \tv_prs rho_ty ->
thing_inside (map (mkInvisExpPatType . snd) tv_prs) rho_ty
-tcSkolemise :: DeepSubsumptionFlag -> UserTypeCtxt -> TcSigmaType
+tcSkolemise :: HasDebugCallStack => DeepSubsumptionFlag -> UserTypeCtxt -> TcSigmaType
-> (TcRhoType -> TcM result)
-> TcM (HsWrapper, result)
tcSkolemise ds_flag ctxt expected_ty thing_inside
= tcSkolemiseGeneral ds_flag ctxt expected_ty expected_ty $ \_ rho_ty ->
thing_inside rho_ty
-checkConstraints :: SkolemInfoAnon
+checkConstraints :: HasDebugCallStack
+ => SkolemInfoAnon
-> [TcTyVar] -- Skolems
-> [EvVar] -- Given
-> TcM result
@@ -504,14 +507,16 @@ checkConstraints skol_info skol_tvs given thing_inside
; if implication_needed
then do { (tclvl, wanted, result) <- pushLevelAndCaptureConstraints thing_inside
; (implics, ev_binds) <- buildImplicationFor tclvl skol_info skol_tvs given wanted
- ; traceTc "checkConstraints" (ppr tclvl $$ ppr skol_tvs)
+ ; traceTc "checkConstraints A" (ppr tclvl $$ ppr skol_tvs $$ traceCallStackDoc)
; emitImplications implics
; return (ev_binds, result) }
else -- Fast path. We check every function argument with tcCheckPolyExpr,
-- which uses tcTopSkolemise and hence checkConstraints.
-- So this fast path is well-exercised
- do { res <- thing_inside
+ do { traceTc "checkConstraints B" (ppr skol_tvs $$ ppr given $$ ppr skol_info $$
+ traceCallStackDoc)
+ ; res <- thing_inside
; return (emptyTcEvBinds, res) } }
checkTvConstraints :: SkolemInfo
=====================================
compiler/GHC/Tc/Zonk/TcType.hs
=====================================
@@ -236,7 +236,7 @@ zonkCo :: Coercion -> ZonkM Coercion
, tcm_tycon = zonkTcTyCon }
where
hole :: () -> CoercionHole -> ZonkM Coercion
- hole _ hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
+ hole _ hole@(CH { ch_ref = ref, ch_co_var = cv })
= do { contents <- readTcRef ref
; case contents of
Just (CPH { cph_co = co })
@@ -617,7 +617,7 @@ instance Monoid UnfilledCoercionHoleMonoid where
-- | Is a coercion hole filled in?
isFilledCoercionHole :: CoercionHole -> ZonkM Bool
-isFilledCoercionHole (CoercionHole { ch_ref = ref })
+isFilledCoercionHole (CH { ch_ref = ref })
= isJust <$> readTcRef ref
-- | Retrieve the contents of a coercion hole. Panics if the hole
@@ -631,7 +631,7 @@ unpackCoercionHole hole
-- | Retrieve the contents of a coercion hole, if it is filled
unpackCoercionHole_maybe :: CoercionHole -> ZonkM (Maybe CoercionPlusHoles)
-unpackCoercionHole_maybe (CoercionHole { ch_ref = ref }) = readTcRef ref
+unpackCoercionHole_maybe (CH { ch_ref = ref }) = readTcRef ref
{-
=====================================
compiler/GHC/Tc/Zonk/Type.hs
=====================================
@@ -485,7 +485,7 @@ zonkCoVarOcc cv
_ -> mkCoVarCo <$> (lift $ liftZonkM $ zonkCoVar cv) }
zonkCoHole :: CoercionHole -> ZonkTcM Coercion
-zonkCoHole hole@(CoercionHole { ch_ref = ref, ch_co_var = cv })
+zonkCoHole hole@(CH { ch_ref = ref, ch_co_var = cv })
= do { contents <- readTcRef ref
; case contents of
Just (CPH { cph_co = co })
@@ -1910,8 +1910,9 @@ zonk_tc_ev_binds (EvBinds bs) = zonkEvBinds bs
zonkEvBindsVar :: EvBindsVar -> ZonkBndrTcM (Bag EvBind)
zonkEvBindsVar (EvBindsVar { ebv_binds = ref })
- = do { bs <- readTcRef ref
+ = do { EBS { ebs_binds = bs } <- readTcRef ref
; zonkEvBinds (evBindMapBinds bs) }
+
zonkEvBindsVar (CoEvBindsVar {}) = return emptyBag
zonkEvBinds :: Bag EvBind -> ZonkBndrTcM (Bag EvBind)
=====================================
compiler/GHC/Utils/Trace.hs
=====================================
@@ -11,6 +11,7 @@ module GHC.Utils.Trace
, warnPprTraceM
, pprTraceUserWarning
, trace
+ , traceCallStackDoc
)
where
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22f6f55efff888690adc4d2b8ef394c…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/22f6f55efff888690adc4d2b8ef394c…
You're receiving this email because of your account on gitlab.haskell.org.
1
0