Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 264d1cca by Adam Gundry at 2026-03-18T14:59:20-04:00 ghci: Mention active language edition in startup banner Per GHC proposal 632, this makes the GHCi startup banner include the active language edition, plus an indication of whether this was the default (as opposed to being explicitly selected via an option such as `-XGHC2024`). For example: ``` $ ghci GHCi, version 9.14.1: https://www.haskell.org/ghc/ :? for help Using default language edition: GHC2024 ghci> ``` Fixes #26037. - - - - - 29e6623e by sheaf at 2026-03-18T14:59:26-04:00 Improve incomplete record selector warnings This commit stops GHC from emitting spurious incomplete record selector warnings for bare selectors/projections such as .fld There are two places we currently emit incomplete record selector warnings: 1. In the desugarer, when we see a record selector or an occurrence of 'getField'. Here, we can use pattern matching information to ensure we don't give false positives. 2. In the typechecker, which might sometimes give false positives but can emit warnings in cases that the pattern match checker would otherwise miss. This is explained in Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc. Now, we obviously don't want to emit the same error twice, and generally we prefer (1), as those messages contain fewer false positives. So we suppress (2) when we are sure we are going to emit (1); the logic for doing so is in GHC.Tc.Instance.Class.warnIncompleteRecSel, and works by looking at the CtOrigin. Now, the issue was that this logic handled explicit record selectors as well as overloaded record field selectors such as "x.r" (which turns into a simple GetFieldOrigin CtOrigin), but it didn't properly handle record projectors like ".fld" or ".fld1.fld2" (which result in other CtOrigins such as 'RecordFieldProjectionOrigin'). To solve this problem, we re-use the 'isHasFieldOrigin' introduced in fbdc623a (slightly adjusted). On the way, we also had to update the desugarer with special handling for the 'ExpandedThingTc' case in 'ds_app', to make sure that 'ds_app_var' sees all the type arguments to 'getField' in order for it to indeed emit warnings like in (1). Fixes #26686 - - - - - 4562ceff by Cheng Shao at 2026-03-18T14:59:28-04:00 rts: opportunistically grow the MutableByteArray# in-place in resizeMutableByteArray# Following !15234, this patch improves `resizeMutableByteArray#` memory efficiency by growing the `MutableByteArray#` in-place if possible, addressing an old todo comment here. Also adds a new test case `resizeMutableByteArrayInPlace` that stresses this behavior. - - - - - 607a3f73 by Sylvain Henry at 2026-03-18T14:59:35-04:00 Core: add constant-folding rules for Addr# eq/ne (#18032) - - - - - c5fc7cb6 by Matthew Pickering at 2026-03-18T14:59:37-04:00 Use OsPath rather than FilePath in Downsweep cache This gets us one step closure to uniformly using `OsPath` in the compiler. - - - - - c257675b by Cheng Shao at 2026-03-18T14:59:37-04:00 hadrian: fix ghc-in-ghci flavour stage0 shared libraries This patch fixes missing stage0 shared libraries in hadrian ghc-in-ghci flavour, which was accidentally dropped in 669d09f950a6e88b903d9fd8a7571531774d4d5d and resulted in a regression in HLS support on linux/macos. Fixes #27057. - - - - - 19 changed files: - compiler/GHC/Core/Opt/ConstantFold.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/HsToCore/Expr.hs - compiler/GHC/HsToCore/Pmc.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Instance/Class.hs - compiler/GHC/Tc/Types/Origin.hs - ghc/GHCi/UI.hs - ghc/Main.hs - hadrian/src/Settings/Flavours/GhcInGhci.hs - rts/PrimOps.cmm - + testsuite/tests/overloadedrecflds/should_compile/T26686.hs - + testsuite/tests/overloadedrecflds/should_compile/T26686.stderr - testsuite/tests/overloadedrecflds/should_compile/all.T - testsuite/tests/rts/all.T - + testsuite/tests/rts/resizeMutableByteArrayInPlace.hs - + testsuite/tests/simplCore/should_compile/T18032.hs - + testsuite/tests/simplCore/should_compile/T18032.stderr - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core/Opt/ConstantFold.hs ===================================== @@ -847,6 +847,14 @@ primOpRules nm = \case -- Misc + -- See Note [Constant folding for Addr# equality] + AddrEqOp -> mkPrimOpRule nm 2 [ equalArgs >> (trueValInt <$> getPlatform) + , match_litAddr_eq True + ] + AddrNeOp -> mkPrimOpRule nm 2 [ equalArgs >> (falseValInt <$> getPlatform) + , match_litAddr_eq False + ] + AddrAddOp -> mkPrimOpRule nm 2 [ rightIdentityPlatform zeroi ] SparkOp -> mkPrimOpRule nm 4 [ sparkRule ] @@ -969,6 +977,39 @@ cmpOp platform cmp = go -------------------------- +-- Note [Constant folding for Addr# equality] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- We constant-fold (eqAddr# "foo"# "bar"#) when both arguments are string +-- literals with *different* byte content. Because the bytes differ, the two +-- literals cannot reside at the same address, so the result is definitely +-- False (or True for neAddr#). +-- +-- We use exprIsLiteral_maybe (via isLiteral) rather than binaryLit/cmpOp, +-- because string literals are frequently floated out to the top level as CAF +-- bindings. That turns them into variables, and we must look through those +-- variable unfoldings to recover the underlying LitString. +-- +-- When both literals have the *same* byte content we do NOT fold to True. +-- Two distinct literal occurrences in the source may end up at different +-- addresses in the object file (the linker is not required to merge them), +-- so pointer equality is not guaranteed by equal content alone. The +-- equalArgs already handles the case where both arguments are the *same* +-- expression (provably the same pointer). + +match_litAddr_eq :: Bool -- ^ True <=> eqAddr# (fold different-content to False) + -- False <=> neAddr# (fold different-content to True) + -> RuleM CoreExpr +-- See Note [Constant folding for Addr# equality] +match_litAddr_eq is_eq = do + platform <- getPlatform + [e1, e2] <- getArgs + LitString s1 <- isLiteral e1 + LitString s2 <- isLiteral e2 + guard (s1 /= s2) + return $ if is_eq then falseValInt platform else trueValInt platform + +-------------------------- + negOp :: RuleOpts -> Literal -> Maybe CoreExpr -- Negate negOp env = \case (LitFloat 0.0) -> Nothing -- can't represent -0.0 as a Rational ===================================== compiler/GHC/Driver/Downsweep.hs ===================================== @@ -56,7 +56,7 @@ import GHC.Data.Graph.Directed import GHC.Data.FastString import GHC.Data.Maybe ( expectJust ) import qualified GHC.Data.Maybe as M -import GHC.Data.OsPath ( unsafeEncodeUtf ) +import GHC.Data.OsPath ( OsPath, unsafeEncodeUtf ) import GHC.Data.StringBuffer import GHC.Data.Graph.Directed.Reachability import qualified GHC.LanguageExtensions as LangExt @@ -216,9 +216,9 @@ downsweep hsc_env diag_wrapper msg old_summaries excl_mods allow_dup_roots = do -- file was used in. -- Reuse these if we can because the most expensive part of downsweep is -- reading the headers. - old_summary_map :: M.Map (UnitId, FilePath) ModSummary + old_summary_map :: M.Map (UnitId, OsPath) ModSummary old_summary_map = - M.fromList [((ms_unitid ms, msHsFilePath ms), ms) | ms <- old_summaries] + M.fromList [((ms_unitid ms, msHsFileOsPath ms), ms) | ms <- old_summaries] -- Dependencies arising on a unit (backpack and module linking deps) unitModuleNodes :: [ModuleGraphNode] -> UnitId -> HomeUnitEnv -> [Either (Messages DriverMessage) ModuleGraphNode] @@ -384,7 +384,7 @@ data DownsweepMode = DownsweepUseCompile | DownsweepUseFixed -- This function will start at the given roots, and traverse downwards to find -- all the dependencies, all the way to the leaf units. downsweepFromRootNodes :: HscEnv - -> M.Map (UnitId, FilePath) ModSummary + -> M.Map (UnitId, OsPath) ModSummary -> [ModuleName] -> Bool -> DownsweepMode -- ^ Whether to create fixed or compile nodes for dependencies @@ -442,7 +442,7 @@ type DownsweepM a = ReaderT DownsweepEnv IO a data DownsweepEnv = DownsweepEnv { downsweep_hsc_env :: HscEnv , _downsweep_mode :: DownsweepMode - , _downsweep_old_summaries :: M.Map (UnitId, FilePath) ModSummary + , _downsweep_old_summaries :: M.Map (UnitId, OsPath) ModSummary , _downsweep_excl_mods :: [ModuleName] } @@ -715,7 +715,7 @@ linkNodes summaries uid hue = getRootSummary :: [ModuleName] -> - M.Map (UnitId, FilePath) ModSummary -> + M.Map (UnitId, OsPath) ModSummary -> HscEnv -> Target -> IO (Either DriverMessages ModSummary) @@ -1183,7 +1183,7 @@ mkRootMap summaries = Map.fromListWith (flip (++)) summariseFile :: HscEnv -> HomeUnit - -> M.Map (UnitId, FilePath) ModSummary -- old summaries + -> M.Map (UnitId, OsPath) ModSummary -- old summaries -> FilePath -- source file name -> Maybe Phase -- start phase -> Maybe (StringBuffer,UTCTime) @@ -1192,7 +1192,7 @@ summariseFile summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf -- we can use a cached summary if one is available and the -- source file hasn't changed, - | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn) old_summaries + | Just old_summary <- M.lookup (homeUnitId home_unit, src_fn_os) old_summaries = do let location = ms_location $ old_summary @@ -1213,6 +1213,7 @@ summariseFile hsc_env' home_unit old_summaries src_fn mb_phase maybe_buf where -- change the main active unit so all operations happen relative to the given unit hsc_env = hscSetActiveHomeUnit home_unit hsc_env' + src_fn_os = unsafeEncodeUtf src_fn -- src_fn does not necessarily exist on the filesystem, so we need to -- check what kind of target we are dealing with get_src_hash = case maybe_buf of @@ -1302,7 +1303,7 @@ data SummariseResult = -- --make mode. summariseModule :: HscEnv -> HomeUnit - -> M.Map (UnitId, FilePath) ModSummary + -> M.Map (UnitId, OsPath) ModSummary -> IsBootInterface -> Located ModuleName -> PkgQual @@ -1382,7 +1383,7 @@ summariseModuleDispatch k hsc_env' home_unit is_boot (L _ wanted_mod) mb_pkg exc -- for it and potentially compile it. summariseModuleWithSource :: HomeUnit - -> M.Map (UnitId, FilePath) ModSummary + -> M.Map (UnitId, OsPath) ModSummary -- ^ Map of old summaries -> IsBootInterface -- True <=> a {-# SOURCE #-} import -> Maybe (StringBuffer, UTCTime) @@ -1411,7 +1412,7 @@ summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env lo where dflags = hsc_dflags hsc_env new_summary_cache_check loc mod src_fn h - | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn)) old_summary_map = + | Just old_summary <- Map.lookup ((toUnitId (moduleUnit mod), src_fn_os)) old_summary_map = -- check the hash on the source file, and -- return the cached summary if it hasn't changed. If the @@ -1422,6 +1423,8 @@ summariseModuleWithSource home_unit old_summary_map is_boot maybe_buf hsc_env lo Nothing -> checkSummaryHash hsc_env (new_summary loc mod src_fn) old_summary loc h | otherwise = new_summary loc mod src_fn h + where + src_fn_os = unsafeEncodeUtf src_fn new_summary :: ModLocation -> Module ===================================== compiler/GHC/HsToCore/Expr.hs ===================================== @@ -721,6 +721,15 @@ ds_app (XExpr (ConLikeTc con)) _hs_args core_args ds_app (XExpr (HsRecSelTc (FieldOcc { foLabel = L _ sel_id }))) _hs_args core_args = ds_app_rec_sel sel_id sel_id core_args +ds_app (XExpr (ExpandedThingTc _orig e)) hs_args core_args + = ds_app e hs_args core_args + -- NB: this is important for the 'getField' case of 'ds_app_var', which needs + -- to see all type arguments to 'getField' at once, while for record field + -- projections such as (.fld) we may get: + -- + -- XExpr (ExpandedThingTc (.fld) (getField @Symbol @LiftedRep @LiftedRep "fld")) + -- `HsAppType` rec_ty `HsAppType` fld + ds_app (HsVar _ lfun) hs_args core_args = ds_app_var lfun hs_args core_args @@ -736,8 +745,10 @@ ds_app_var (L loc fun_id) hs_args core_args ----------------------- -- Deal with getField applications. General form: -- getField - -- @GHC.Types.Symbol {k} - -- @"sel" x_ty + -- @Symbol {k} + -- @LiftedRep {r_rep} + -- @LiftedRep {a_rep} + -- @"sel" fld -- @T r_ty -- @Int a_ty -- ($dHasField :: HasField "sel" T Int) dict ===================================== compiler/GHC/HsToCore/Pmc.hs ===================================== @@ -375,6 +375,10 @@ Finally, there are two more items addressing -XOverloadedRecordDot: the (IRS6) warning in the typechecker for a `HasField` constraint that arises from a record-dot HsGetField occurrence. Happily, this is easy to do by looking at its `CtOrigin`. Tested in T24891. + + The same applies for record field projection operators such as (.fld) and + (.fld1.fld2), which have different 'CtOrigin's. The 'isHasFieldOrigin' + function catches those as well. Tested in T26686. -} pmcRecSel :: Id -- ^ Id of the selector ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -97,6 +97,7 @@ import Data.Ord ( comparing ) import Data.Either ( partitionEithers ) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import qualified Data.Semigroup as Semi {- ************************************************************************ @@ -2714,15 +2715,34 @@ hasFieldInfo_maybe rdr_env fam_inst_envs item -- (HF2e) It's a custom HasField constraint, not the one from GHC.Records. | Just (tc, _) <- splitTyConApp_maybe (errorItemPred item) - , getOccString tc == "HasField" - , isHasFieldOrigin (errorItemOrigin item) - = return $ Just $ CustomHasField tc + = do { rebindable_syntax <- xoptM LangExt.RebindableSyntax + ; return $ + if want_custom_hasfield_msg tc rebindable_syntax + then Just $ CustomHasField tc + else Nothing + } | otherwise = return Nothing where + orig = errorItemOrigin item + + want_custom_hasfield_msg tc rebindable_syntax + | getOccString tc == "HasField" + = Semi.getAny $ foldMapCtOrigin (Semi.Any . is_has_field) orig + | otherwise + = False + where + -- Handle custom 'getField'/'setField' with RebindableSyntax. + is_has_field (OccurrenceOf n) + | rebindable_syntax + , getOccString n `elem` ["getField", "setField"] + = True + is_has_field o + = isHasFieldOrigin o + get_parent_nm :: Name -> TcM (Maybe (Either PatSyn TyCon)) get_parent_nm nm = do { fld_id <- tcLookupId nm @@ -2762,22 +2782,6 @@ hasField_maybe pred = -- NB: we deliberately don't handle rebound 'HasField' (with -XRebindableSyntax), -- as GHC only has built-in instances for the built-in 'HasField' class. --- | Does this constraint arise from GHC internal mechanisms that desugar to --- usage of the 'HasField' typeclass (e.g. OverloadedRecordDot, etc)? --- --- Just used heuristically to decide whether to print an informative message to --- the user (see (H2e) in Note [Error messages for unsolved HasField constraints]). -isHasFieldOrigin :: CtOrigin -> Bool -isHasFieldOrigin = \case - OccurrenceOf n -> - -- A heuristic... - getOccString n `elem` ["getField", "setField"] - OccurrenceOfRecSel {} -> True - RecordUpdOrigin {} -> True - RecordFieldProjectionOrigin {} -> True - GetFieldOrigin {} -> True - _ -> False - ----------------------- -- relevantBindings looks at the value environment and finds values whose -- types mention any of the offending type variables. It has to be ===================================== compiler/GHC/Tc/Instance/Class.hs ===================================== @@ -20,7 +20,7 @@ import GHC.Tc.Instance.Typeable import GHC.Tc.Utils.TcMType import GHC.Tc.Types.Evidence import GHC.Tc.Types.CtLoc -import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, CtOrigin(GetFieldOrigin) ) +import GHC.Tc.Types.Origin ( InstanceWhat (..), SafeOverlapping, isHasFieldOrigin ) import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcLookupDataFamInst, FamInstEnvs ) import GHC.Rename.Env( addUsedGRE, addUsedDataCons, DeprecationWarnings (..) ) @@ -1275,8 +1275,8 @@ warnIncompleteRecSel :: DynFlags -> Id -> CtLoc -> TcM () -- Warn about incomplete record selectors -- See (IRS6) in Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc warnIncompleteRecSel dflags sel_id ct_loc - | not (isGetFieldOrigin (ctLocOrigin ct_loc)) - -- isGetFieldOrigin: see (IRS7) in + | not $ isHasFieldOrigin (ctLocOrigin ct_loc) + -- isHasFieldOrigin: see (IRS7) in -- Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc , RecSelId { sel_cons = RSI { rsi_undef = fallible_cons } } <- idDetails sel_id , not (null fallible_cons) @@ -1288,11 +1288,6 @@ warnIncompleteRecSel dflags sel_id ct_loc where maxCons = maxUncoveredPatterns dflags - -- GHC.Tc.Gen.App.tcInstFun arranges that the CtOrigin of (r.x) is GetFieldOrigin, - -- despite the expansion to (getField @"x" r) - isGetFieldOrigin (GetFieldOrigin {}) = True - isGetFieldOrigin _ = False - lookupHasFieldLabel :: FamInstEnvs -> GlobalRdrEnv -> [Type] -> Maybe ( Name -- Name of the record selector ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -16,7 +16,8 @@ module GHC.Tc.Types.Origin ( CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin, invisibleOrigin_maybe, isVisibleOrigin, toInvisibleOrigin, pprCtOrigin, pprCtOriginBriefly, isGivenOrigin, - defaultReprEqOrigins, isWantedSuperclassOrigin, + foldMapCtOrigin, + defaultReprEqOrigins, isWantedSuperclassOrigin, isHasFieldOrigin, ClsInstOrQC(..), NakedScFlag(..), NonLinearPatternReason(..), HsImplicitLiftSplice(..), StandaloneDeriv, @@ -52,6 +53,8 @@ import GHC.Tc.Utils.TcType import GHC.Hs +import GHC.Builtin.Names (getFieldName) + import GHC.Core.DataCon import GHC.Core.ConLike import GHC.Core.TyCon @@ -79,6 +82,8 @@ import GHC.Types.Unique.Supply import qualified Data.Kind as Hs import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (isNothing) +import qualified Data.Semigroup as Semi +import GHC.Generics {- ********************************************************************* * * @@ -993,6 +998,95 @@ pprNonLinearPatternReason PatternSynonymReason = parens (text "pattern synonyms pprNonLinearPatternReason ViewPatternReason = parens (text "view patterns aren't linear") pprNonLinearPatternReason OtherPatternReason = empty + +{- ********************************************************************* +* * + Recursing through CtOrigin +* * +********************************************************************* -} + +-- | Fold over a 'CtOrigin', looking through all recursive +-- occurrences of 'CtOrigin' within 'CtOrigin'. +foldMapCtOrigin :: forall m. Semigroup m => (CtOrigin -> m) -> CtOrigin -> m +foldMapCtOrigin f = go + where + go :: CtOrigin -> m + go orig = + case orig of + KindEqOrigin _ _ o _ -> recur o + CycleBreakerOrigin o -> recur o + WantedSuperclassOrigin _ o -> recur o + DefaultReprEqOrigin _ _ o -> recur o + ScOrigin cls_or_qc _sc_flag -> + case cls_or_qc of + IsQC _ o -> recur o + IsClsInst -> f orig + + -- Explicit pattern match on remaining constructors, in order to get + -- better pattern-match warnings when constructors are changed or + -- added/removed. This isn't entirely fool-proof, as someone may still + -- change the type of one of the fields and hide a 'CtOrigin' inside. + -- + -- This approach was chosen instead of using 'syb'/'GHC.Generics', + -- because those would require deriving 'Data.Data'/'Generic' on + -- a huge number of datatypes. + GivenOrigin {} -> f orig + GivenSCOrigin {} -> f orig + OccurrenceOf {} -> f orig + OccurrenceOfRecSel {} -> f orig + AppOrigin {} -> f orig + SpecPragOrigin {} -> f orig + TypeEqOrigin {}-> f orig + IPOccOrigin {} -> f orig + OverLabelOrigin {} -> f orig + LiteralOrigin {} -> f orig + QualLiteralOrigin {} -> f orig + NegateOrigin {} -> f orig + ArithSeqOrigin {} -> f orig + AssocFamPatOrigin {} -> f orig + SectionOrigin {} -> f orig + GetFieldOrigin {} -> f orig + RecordFieldProjectionOrigin {} -> f orig + TupleOrigin {} -> f orig + ExprSigOrigin {} -> f orig + PatSigOrigin {} -> f orig + PatOrigin {} -> f orig + ProvCtxtOrigin {} -> f orig + RecordUpdOrigin {} -> f orig + ViewPatOrigin {} -> f orig + DerivOrigin {} -> f orig + DerivOriginDC {} -> f orig + DerivOriginCoerce {} -> f orig + DefaultOrigin {} -> f orig + DoOrigin {} -> f orig + DoPatOrigin {} -> f orig + MCompOrigin {} -> f orig + MCompPatOrigin {} -> f orig + ProcOrigin {} -> f orig + ArrowCmdOrigin {} -> f orig + AnnOrigin {} -> f orig + FunDepOrigin {} -> f orig + ExprHoleOrigin {} -> f orig + TypeHoleOrigin {} -> f orig + PatCheckOrigin {} -> f orig + ListOrigin {} -> f orig + IfThenElseOrigin {} -> f orig + BracketOrigin {} -> f orig + StaticOrigin {} -> f orig + ImpedanceMatching {} -> f orig + Shouldn'tHappenOrigin {} -> f orig + InstProvidedOrigin {} -> f orig + NonLinearPatternOrigin {} -> f orig + OmittedFieldOrigin {} -> f orig + UsageEnvironmentOf {} -> f orig + FRROrigin {} -> f orig + InstanceSigOrigin {} -> f orig + AmbiguityCheckOrigin {} -> f orig + ImplicitLiftOrigin {} -> f orig + + where + recur o = f orig Semi.<> go o + {- ********************************************************************* * * Defaulting of representational equalities @@ -1004,21 +1098,10 @@ pprNonLinearPatternReason OtherPatternReason = empty -- That is, this function extracts all occurrences of the 'DefaultReprEqOrigin' -- constructor from within a 'CtOrigin'. defaultReprEqOrigins :: CtOrigin -> [(CtOrigin, (TcType, TcType))] -defaultReprEqOrigins = go +defaultReprEqOrigins = foldMapCtOrigin go where go = \case - DefaultReprEqOrigin l r o -> (o, (l, r)) : go o - - -- Handle recursive occurrences of 'CtOrigin' within 'CtOrigin'. - -- TODO: use syb to derive this, so that the following never goes out of date. - ScOrigin cls_or_qc _ -> - case cls_or_qc of - IsClsInst -> [] - IsQC _ o -> go o - KindEqOrigin _ _ o _ -> go o - CycleBreakerOrigin o -> go o - WantedSuperclassOrigin _ o -> go o - + DefaultReprEqOrigin l r o -> [(o, (l, r))] _ -> [] {- ********************************************************************* @@ -1046,6 +1129,37 @@ isPushCallStackOrigin_maybe orig = Just orig_fs where orig_fs = mkFastString (showSDocUnsafe (pprCtOriginBriefly orig)) +{- ********************************************************************* +* * + HasField and CtOrigin +* * +********************************************************************* -} + +-- | Does this constraint arise from GHC internal mechanisms that desugar to +-- usage of the 'HasField' typeclass (e.g. OverloadedRecordDot, etc)? +-- +-- Used in two places: +-- +-- - When reporting an unsolved 'HasField' constraint, to decide whether to +-- print an informative message to the user. +-- See (H2e) in Note [Error messages for unsolved HasField constraints] +-- in GHC.Tc.Errors. +-- - To avoid emitting a poor "incomplete record selector" warning directly +-- in typechecker, in cases when the desugarer will be able to emit a better +-- error message, due to having better pattern match checking information. +-- See (IRS7) in Note [Detecting incomplete record selectors] +-- in GHC.HsToCore.Pmc +isHasFieldOrigin :: CtOrigin -> Bool +isHasFieldOrigin = Semi.getAny . foldMapCtOrigin (Semi.Any . go) + where + go = \case + OccurrenceOf n -> n == getFieldName + OccurrenceOfRecSel {} -> True + RecordFieldProjectionOrigin {} -> True + GetFieldOrigin {} -> True + RecordUpdOrigin {} -> True + _ -> False + {- ************************************************************************ * * ===================================== ghc/GHCi/UI.hs ===================================== @@ -23,7 +23,8 @@ module GHCi.UI ( GhciSettings(..), defaultGhciSettings, ghciCommands, - ghciWelcomeMsg + ghciWelcomeMsg, + languageEditionMsg ) where -- GHCi @@ -199,6 +200,10 @@ versionString = "GHCi, version " ++ cProjectVersion ghciWelcomeMsg :: String ghciWelcomeMsg = versionString ++ ": https://www.haskell.org/ghc/ :? for help" +languageEditionMsg :: Maybe Language -> String +languageEditionMsg Nothing = "Using default language edition: " ++ show defaultLanguage +languageEditionMsg (Just lang) = "Using language edition: " ++ show lang + ghciCommands :: [Command] ghciCommands = map mkCmd [ -- Hugs users are accustomed to :e, so make sure it doesn't overlap ===================================== ghc/Main.hs ===================================== @@ -37,7 +37,7 @@ import GHC.Platform import GHC.Platform.Host #if defined(HAVE_INTERNAL_INTERPRETER) -import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings ) +import GHCi.UI ( interactiveUI, ghciWelcomeMsg, defaultGhciSettings, languageEditionMsg ) #endif import GHC.Runtime.Loader ( loadFrontendPlugin, initializeSessionPlugins ) @@ -334,7 +334,9 @@ showBanner _postLoadMode dflags = do #if defined(HAVE_INTERNAL_INTERPRETER) -- Show the GHCi banner - when (isInteractiveMode _postLoadMode && verb >= 1) $ putStrLn ghciWelcomeMsg + when (isInteractiveMode _postLoadMode && verb >= 1) $ + do putStrLn ghciWelcomeMsg + putStrLn $ languageEditionMsg (language dflags) #endif -- Display details of the configuration in verbose mode ===================================== hadrian/src/Settings/Flavours/GhcInGhci.hs ===================================== @@ -1,14 +1,22 @@ module Settings.Flavours.GhcInGhci (ghcInGhciFlavour) where +import qualified Data.Set as Set import Expression import Flavour +import Oracles.Flag import {-# SOURCE #-} Settings.Default -- Please update doc/flavours.md when changing this file. ghcInGhciFlavour :: Flavour ghcInGhciFlavour = disableProfiledLibs $ defaultFlavour { name = "ghc-in-ghci" - , extraArgs = ghciArgs + , extraArgs = ghciArgs + , libraryWays = + Set.fromList + <$> mconcat + [ pure [vanilla] + , platformSupportsSharedLibs ? pure [dynamic] + ] } ghciArgs :: Args ===================================== rts/PrimOps.cmm ===================================== @@ -200,6 +200,26 @@ stg_isMutableByteArrayWeaklyPinnedzh ( gcptr mba ) * used to as the LDV profiler will essentially ignore arrays anyways. */ +/* Note [Resizing arrays in-place] + * ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + * We try to shrink or grow bd->free when resizing a MutableByteArray in-place, + * to reclaim or use slop space at the end of the current block and avoid + * unnecessary fragmentation/allocation. + * + * But we must guarantee that: + * + * 1. mba is already at the end of current block (check bd->free). + * Otherwise we can't move closures that come after it anyway. + * 2. It's a nursery block that belongs to the current Capability, + * so check rCurrentAlloc (used by allocateMightFail) or + * pinned_object_block (used by allocatePinned). There's also no + * point if it's an older generation block, the mutator won't + * allocate into those blocks anyway. + * + * If check fails, fall back to the conservative code path: just zero the slop + * and return when shrinking, or allocate a new array when growing. + */ + // shrink size of MutableByteArray in-place stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size ) // MutableByteArray# s -> Int# -> State# s -> State# s @@ -212,20 +232,7 @@ stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size ) old_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(old_size); new_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(new_size); - // Try to shrink bd->free as well, to reclaim slop space at the end - // of current block and avoid unnecessary fragmentation. But we - // must guarantee that: - // - // 1. mba is already at the end of current block (check bd->free). - // Otherwise we can't move closures that come after it anyway. - // 2. It's a nursery block that belongs to the current Capability, - // so check rCurrentAlloc (used by allocateMightFail) or - // pinned_object_block (used by allocatePinned). There's also no - // point if it's an older generation block, the mutator won't - // allocate into those blocks anyway. - // - // If check fails, fall back to the conservative code path: just - // zero the slop and return. + // See Note [Resizing arrays in-place] bd = Bdescr(mba); if (bdescr_free(bd) != mba + WDS(old_wds) || (bd != StgRegTable_rCurrentAlloc(BaseReg) && bd != Capability_pinned_object_block(MyCapability()))) { @@ -258,20 +265,33 @@ stg_shrinkMutableByteArrayzh ( gcptr mba, W_ new_size ) stg_resizzeMutableByteArrayzh ( gcptr mba, W_ new_size ) // MutableByteArray# s -> Int# -> State# s -> (# State# s,MutableByteArray# s #) { + W_ old_size, old_wds, new_wds, new_free; + W_ bd; + ASSERT(new_size `ge` 0); - if (new_size <= StgArrBytes_bytes(mba)) { + old_size = StgArrBytes_bytes(mba); + if (new_size <= old_size) { call stg_shrinkMutableByteArrayzh(mba, new_size); return (mba); + } + + bd = Bdescr(mba); + old_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(old_size); + new_wds = BYTES_TO_WDS(SIZEOF_StgArrBytes) + ROUNDUP_BYTES_TO_WDS(new_size); + new_free = mba + WDS(new_wds); + + // See Note [Resizing arrays in-place] + // we also need to check that we don't grow past the end of current block. + if (bdescr_free(bd) == mba + WDS(old_wds) && + (bd == StgRegTable_rCurrentAlloc(BaseReg) || bd == Capability_pinned_object_block(MyCapability())) && + new_free <= bdescr_start(bd) + (TO_W_(bdescr_blocks(bd)) * BLOCK_SIZE)) { + bdescr_free(bd) = new_free; + StgArrBytes_bytes(mba) = new_size; + return (mba); } else { (P_ new_mba) = call stg_newByteArrayzh(new_size); - // maybe at some point in the future we may be able to grow the - // MBA in-place w/o copying if we know the space after the - // current MBA is still available, as often we want to grow the - // MBA shortly after we allocated the original MBA. So maybe no - // further allocations have occurred by then. - // copy over old content prim %memcpy(BYTE_ARR_CTS(new_mba), BYTE_ARR_CTS(mba), StgArrBytes_bytes(mba), SIZEOF_W); ===================================== testsuite/tests/overloadedrecflds/should_compile/T26686.hs ===================================== @@ -0,0 +1,37 @@ +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE GADTs #-} + +{-# OPTIONS_GHC -Wincomplete-record-selectors #-} + +module T26686 where + +import Data.Kind + +data A +data B + +data G = G { f2 :: Int } + +data T x where + TA :: { ta :: G } -> T x + TB :: { tb :: G } -> T B + +data H a = H { f1 :: T a } + +test1_ok :: T A -> G +test1_ok = (.ta) +test2_ok :: T A -> Int +test2_ok = (.ta.f2) +test3_ok :: H A -> G +test3_ok = (.f1.ta) +test4_ok :: H A -> Int +test4_ok = (.f1.ta.f2) + +test1_bad :: T x -> G +test1_bad = (.ta) +test2_bad :: T x -> Int +test2_bad = (.ta.f2) +test3_bad :: H x -> G +test3_bad = (.f1.ta) +test4_bad :: H x -> Int +test4_bad = (.f1.ta.f2) ===================================== testsuite/tests/overloadedrecflds/should_compile/T26686.stderr ===================================== @@ -0,0 +1,16 @@ +T26686.hs:31:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)] + Selecting the record field ‘ta’ may fail for the following constructors: + TB + +T26686.hs:33:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)] + Selecting the record field ‘ta’ may fail for the following constructors: + TB + +T26686.hs:35:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)] + Selecting the record field ‘ta’ may fail for the following constructors: + TB + +T26686.hs:37:13: warning: [GHC-17335] [-Wincomplete-record-selectors (in -Wall)] + Selecting the record field ‘ta’ may fail for the following constructors: + TB + ===================================== testsuite/tests/overloadedrecflds/should_compile/all.T ===================================== @@ -30,6 +30,7 @@ test('T21720', req_th, compile, ['']) test('T21898', normal, compile, ['']) test('T22160', [extra_files(['T22160_A.hs', 'T22160_B.hs', 'T22160_C.hs'])] , multimod_compile, ['T22160_A T22160_B T22160_C T22160', '-v0']) +test('T26686', normal, compile, ['']) test('DupFldFixity3', normal, compile, ['']) test('overloadedrecflds10' , [extra_files(['OverloadedRecFlds10_A.hs', 'OverloadedRecFlds10_B.hs', 'OverloadedRecFlds10_C.hs'])] ===================================== testsuite/tests/rts/all.T ===================================== @@ -669,3 +669,5 @@ test('TimeoutQueue', test('ClosureTable', [req_c, only_ways(['normal', 'debug']), extra_files(['ClosureTable_c.c'])], compile_and_run, ['-debug -O0 ClosureTable_c.c -I{top}/../rts -I{top}/../rts/include']) + +test('resizeMutableByteArrayInPlace', [req_cmm, extra_ways(['optasm', 'sanity']), only_ways(['optasm', 'sanity'])], compile_and_run, ['']) ===================================== testsuite/tests/rts/resizeMutableByteArrayInPlace.hs ===================================== @@ -0,0 +1,24 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +import Control.Monad +import GHC.Exts +import GHC.IO + +-- Given newByteArray#/newPinnedByteArray#, iterate given number of +-- rounds: first allocate a MutableByteArray# using the first size, +-- then resize to the new size, then resize back +{-# INLINE testResize #-} +testResize :: (Int# -> State# RealWorld -> (# State# RealWorld, MutableByteArray# RealWorld #)) -> Int -> Int -> Int -> IO () +testResize alloc# rounds (I# sz0#) (I# sz1#) = + replicateM_ rounds $ IO $ \s0 -> case alloc# sz0# s0 of + (# s1, mba0# #) -> case resizeMutableByteArray# mba0# sz1# s1 of + (# s2, mba1# #) -> case resizeMutableByteArray# mba1# sz0# s2 of + (# s3, _ #) -> (# s3, () #) + +main :: IO () +main = do + testResize newByteArray# 100000 8 64 + testResize newByteArray# 100000 64 8 + testResize newPinnedByteArray# 100000 8 64 + testResize newPinnedByteArray# 100000 64 8 ===================================== testsuite/tests/simplCore/should_compile/T18032.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE MagicHash #-} +module T18032 where + +import GHC.Exts + +-- Different byte content: eqAddr# must be False (0), neAddr# must be True (1) +a = I# (eqAddr# "foo"# "bar"#) +b = I# (neAddr# "foo"# "bar"#) + +-- Same variable on both sides: eqAddr# must be True (1), neAddr# must be False (0) +c = let s = "baz"# in I# (eqAddr# s s) +d = let s = "baz"# in I# (neAddr# s s) ===================================== testsuite/tests/simplCore/should_compile/T18032.stderr ===================================== @@ -0,0 +1,15 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core + = {terms: 10, types: 4, coercions: 0, joins: 0/0} + +a = I# 0# + +b = I# 1# + +c = b + +d = a + + + ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -593,3 +593,4 @@ test('T26722', [grep_errmsg(r'SPEC')], compile, ['-O -dno-typeable-binds']) test('T26805', [grep_errmsg(r'fromInteger')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques']) test('T26826', normal, compile, ['-O']) test('T26903', [grep_errmsg(r'reverse')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques -dsuppress-all']) +test('T18032', normal, compile, ['-O -dsuppress-all -dsuppress-uniques -dno-typeable-binds -ddump-simpl']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1caa8a26ddbef36c30cf9003c9c12d... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1caa8a26ddbef36c30cf9003c9c12d... You're receiving this email because of your account on gitlab.haskell.org.