diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs --- a/compiler/GHC/Core/Opt/Arity.hs +++ b/compiler/GHC/Core/Opt/Arity.hs @@ -791,7 +791,7 @@ andArityType env at1 (AT [] div2) = andWithTail env div2 at1 andWithTail :: ArityEnv -> Divergence -> ArityType -> ArityType -andWithTail env div1 at2@(AT lams2 _) +andWithTail env div1 at2 | isDeadEndDiv div1 -- case x of { T -> error; F -> \y.e } = at2 -- Note [ABot branches: max arity wins] @@ -799,7 +799,7 @@ = AT [] topDiv | otherwise -- case x of { T -> plusInt ; F -> \y.e } - = AT lams2 topDiv -- We know div1 = topDiv + = takeWhileOneShot at2 -- We know div1 = topDiv -- See Note [Combining case branches: andWithTail] @@ -2004,8 +2004,11 @@ , let (subst', tv') = substVarBndr subst tv = go (n-1) res_ty subst' (tv' : rev_bs) (e `App` varToCoreExpr tv') | Just (mult, arg_ty, res_ty) <- splitFunTy_maybe ty + -- The varToCoreExpr is important: `tv` might be a coercion variable , let (subst', b) = freshEtaId n subst (Scaled mult arg_ty) - = go (n-1) res_ty subst' (b : rev_bs) (e `App` Var b) + = go (n-1) res_ty subst' (b : rev_bs) (e `App` varToCoreExpr b) + -- The varToCoreExpr is important: `b` might be a coercion variable + | otherwise = pprPanic "etaBodyForJoinPoint" $ int need_args $$ ppr body $$ ppr (exprType body) diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs --- a/compiler/GHC/Core/Opt/OccurAnal.hs +++ b/compiler/GHC/Core/Opt/OccurAnal.hs @@ -1725,7 +1725,7 @@ -> CoreExpr -- RHS -> (UsageDetails, CoreExpr) occAnalRhs env is_rec mb_join_arity rhs - = case occAnalLamOrRhs env bndrs body of { (body_usage, bndrs', body') -> + = case occAnalLamOrRhs env1 bndrs body of { (body_usage, bndrs', body') -> let final_bndrs | isRec is_rec = bndrs' | otherwise = markJoinOneShots mb_join_arity bndrs' -- For a /non-recursive/ join point we can mark all @@ -1737,6 +1737,7 @@ in (rhs_usage, mkLams final_bndrs body') } where (bndrs, body) = collectBinders rhs + env1 = addInScope env bndrs occAnalUnfolding :: OccEnv -> RecFlag @@ -2005,7 +2006,7 @@ occAnal env expr@(Lam _ _) = -- See Note [Occurrence analysis for lambda binders] - case occAnalLamOrRhs env bndrs body of { (usage, tagged_bndrs, body') -> + case occAnalLamOrRhs env1 bndrs body of { (usage, tagged_bndrs, body') -> let expr' = mkLams tagged_bndrs body' usage1 = markAllNonTail usage @@ -2015,6 +2016,7 @@ (final_usage, expr') } where (bndrs, body) = collectBinders expr + env1 = addInScope env bndrs occAnal env (Case scrut bndr ty alts) = case occAnal (scrutCtxt env alts) scrut of { (scrut_usage, scrut') -> @@ -2284,12 +2286,13 @@ -- See Note [The binder-swap substitution] -- If x :-> (y, co) is in the env, - -- then please replace x by (y |> sym mco) - -- Invariant of course: idType x = exprType (y |> sym mco) - , occ_bs_env :: VarEnv (OutId, MCoercion) - , occ_bs_rng :: VarSet -- Vars free in the range of occ_bs_env + -- then please replace x by (y |> mco) + -- Invariant of course: idType x = exprType (y |> mco) + , occ_bs_env :: !(IdEnv (OutId, MCoercion)) -- Domain is Global and Local Ids -- Range is just Local Ids + , occ_bs_rng :: !VarSet + -- Vars (TyVars and Ids) free in the range of occ_bs_env } @@ -2578,25 +2581,29 @@ (BS3) We need care when shadowing. Suppose [x :-> b] is in occ_bs_env, and we encounter: - - \x. blah - Here we want to delete the x-binding from occ_bs_env + (i) \x. blah + Here we want to delete the x-binding from occ_bs_env - - \b. blah - This is harder: we really want to delete all bindings that - have 'b' free in the range. That is a bit tiresome to implement, - so we compromise. We keep occ_bs_rng, which is the set of - free vars of rng(occc_bs_env). If a binder shadows any of these - variables, we discard all of occ_bs_env. Safe, if a bit - brutal. NB, however: the simplifer de-shadows the code, so the - next time around this won't happen. + (ii) \b. blah + This is harder: we really want to delete all bindings that + have 'b' free in the range. That is a bit tiresome to implement, + so we compromise. We keep occ_bs_rng, which is the set of + free vars of rng(occc_bs_env). If a binder shadows any of these + variables, we discard all of occ_bs_env. Safe, if a bit + brutal. NB, however: the simplifer de-shadows the code, so the + next time around this won't happen. These checks are implemented in addInScope. + (i) is needed only for Ids, but (ii) is needed for tyvars too (#22623) + because if occ_bs_env has [x :-> ...a...] where `a` is a tyvar, we + must not replace `x` by `...a...` under /\a. ...x..., or similarly + under a case pattern match that binds `a`. - The occurrence analyser itself does /not/ do cloning. It could, in - principle, but it'd make it a bit more complicated and there is no - great benefit. The simplifer uses cloning to get a no-shadowing - situation, the care-when-shadowing behaviour above isn't needed for - long. + An alternative would be for the occurrence analyser to do cloning as + it goes. In principle it could do so, but it'd make it a bit more + complicated and there is no great benefit. The simplifer uses + cloning to get a no-shadowing situation, the care-when-shadowing + behaviour above isn't needed for long. (BS4) The domain of occ_bs_env can include GlobaIds. Eg case M.foo of b { alts } diff --git a/compiler/GHC/Core/Unify.hs b/compiler/GHC/Core/Unify.hs --- a/compiler/GHC/Core/Unify.hs +++ b/compiler/GHC/Core/Unify.hs @@ -1114,20 +1114,11 @@ ; unless (um_inj_tf env) $ -- See (end of) Note [Specification of unification] don'tBeSoSure MARTypeFamily $ unify_tys env noninj_tys1 noninj_tys2 } - | Just (tc1, _) <- mb_tc_app1 - , not (isGenerativeTyCon tc1 Nominal) - -- E.g. unify_ty (F ty1) b = MaybeApart - -- because the (F ty1) behaves like a variable - -- NB: if unifying, we have already dealt - -- with the 'ty2 = variable' case - = maybeApart MARTypeFamily + | isTyFamApp mb_tc_app1 -- A (not-over-saturated) type-family application + = maybeApart MARTypeFamily -- behaves like a type variable; might match - | Just (tc2, _) <- mb_tc_app2 - , not (isGenerativeTyCon tc2 Nominal) - , um_unif env - -- E.g. unify_ty [a] (F ty2) = MaybeApart, when unifying (only) - -- because the (F ty2) behaves like a variable - -- NB: we have already dealt with the 'ty1 = variable' case + | isTyFamApp mb_tc_app2 -- A (not-over-saturated) type-family application + , um_unif env -- behaves like a type variable; might unify = maybeApart MARTypeFamily where @@ -1215,6 +1206,17 @@ go _ _ = surelyApart -- Possibly different saturations of a polykinded tycon -- See Note [Polykinded tycon applications] + +isTyFamApp :: Maybe (TyCon, [Type]) -> Bool +-- True if we have a saturated or under-saturated type family application +-- If it is /over/ saturated then we return False. E.g. +-- unify_ty (F a b) (c d) where F has arity 1 +-- we definitely want to decompose that type application! (#22647) +isTyFamApp (Just (tc, tys)) + = not (isGenerativeTyCon tc Nominal) -- Type family-ish + && not (tys `lengthExceeds` tyConArity tc) -- Not over-saturated +isTyFamApp Nothing + = False --------------------------------- uVar :: UMEnv diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -3727,7 +3727,7 @@ -- *after* we see the close paren. field :: { Located FastString } - : VARID { sL1 $1 $! getVARID $1 } + : varid { reLocN $ fmap (occNameFS . rdrNameOcc) $1 } qvarid :: { LocatedN RdrName } : varid { $1 } diff --git a/compiler/cbits/keepCAFsForGHCi.c b/compiler/cbits/keepCAFsForGHCi.c new file mode 100644 --- /dev/null +++ b/compiler/cbits/keepCAFsForGHCi.c @@ -0,0 +1,35 @@ +#include +#include + +// Note [keepCAFsForGHCi] +// ~~~~~~~~~~~~~~~~~~~~~~ +// This file is only included in the dynamic library. +// It contains an __attribute__((constructor)) function (run prior to main()) +// which sets the keepCAFs flag in the RTS, before any Haskell code is run. +// This is required so that GHCi can use dynamic libraries instead of HSxyz.o +// files. +// +// For static builds we have to guarantee that the linker loads this object file +// to ensure the constructor gets run and not discarded. If the object is part of +// an archive and not otherwise referenced the linker would ignore the object. +// To avoid this: +// * When initializing a GHC session in initGhcMonad we assert keeping cafs has been +// enabled by calling keepCAFsForGHCi. +// * This causes the GHC module from the ghc package to carry a reference to this object +// file. +// * Which in turn ensures the linker doesn't discard this object file, causing +// the constructor to be run, allowing the assertion to succeed in the first place +// as keepCAFs will have been set already during initialization of constructors. + + + +bool keepCAFsForGHCi(void) __attribute__((constructor)); + +bool keepCAFsForGHCi(void) +{ + bool was_set = keepCAFs; + setKeepCAFs(); + return was_set; +} + + diff --git a/ghc-lib-parser.cabal b/ghc-lib-parser.cabal --- a/ghc-lib-parser.cabal +++ b/ghc-lib-parser.cabal @@ -1,7 +1,7 @@ cabal-version: 2.0 build-type: Simple name: ghc-lib-parser -version: 9.2.5.20221107 +version: 9.2.6.20230211 license: BSD3 license-file: LICENSE category: Development @@ -50,7 +50,10 @@ source-repository head type: git location: git@github.com:digital-asset/ghc-lib.git - +flag threaded-rts + default: True + manual: True + description: Pass -DTHREADED_RTS to the C toolchain library default-language: Haskell2010 exposed: False @@ -59,9 +62,13 @@ ghc-lib/stage0/lib ghc-lib/stage0/compiler/build compiler - ghc-options: -fobject-code -package=ghc-boot-th -optc-DTHREADED_RTS - cc-options: -DTHREADED_RTS - cpp-options: -DTHREADED_RTS + if flag(threaded-rts) + ghc-options: -fobject-code -package=ghc-boot-th -optc-DTHREADED_RTS + cc-options: -DTHREADED_RTS + cpp-options: -DTHREADED_RTS + else + ghc-options: -fobject-code -package=ghc-boot-th + cpp-options: if !os(windows) build-depends: unix else @@ -125,6 +132,7 @@ libraries/ghc-heap/cbits/HeapPrim.cmm compiler/cbits/genSym.c compiler/cbits/cutils.c + compiler/cbits/keepCAFsForGHCi.c hs-source-dirs: ghc-lib/stage0/libraries/ghc-boot/build ghc-lib/stage0/compiler/build diff --git a/ghc-lib/stage0/lib/GhclibDerivedConstants.h b/ghc-lib/stage0/lib/GhclibDerivedConstants.h --- a/ghc-lib/stage0/lib/GhclibDerivedConstants.h +++ b/ghc-lib/stage0/lib/GhclibDerivedConstants.h @@ -68,29 +68,29 @@ #define OFFSET_stgGCEnter1 -16 #define OFFSET_stgGCFun -8 #define OFFSET_Capability_r 24 -#define OFFSET_Capability_lock 1216 +#define OFFSET_Capability_lock 1224 #define OFFSET_Capability_no 944 #define REP_Capability_no b32 #define Capability_no(__ptr__) REP_Capability_no[__ptr__+OFFSET_Capability_no] #define OFFSET_Capability_mut_lists 1016 #define REP_Capability_mut_lists b64 #define Capability_mut_lists(__ptr__) REP_Capability_mut_lists[__ptr__+OFFSET_Capability_mut_lists] -#define OFFSET_Capability_context_switch 1184 +#define OFFSET_Capability_context_switch 1192 #define REP_Capability_context_switch b32 #define Capability_context_switch(__ptr__) REP_Capability_context_switch[__ptr__+OFFSET_Capability_context_switch] -#define OFFSET_Capability_interrupt 1188 +#define OFFSET_Capability_interrupt 1196 #define REP_Capability_interrupt b32 #define Capability_interrupt(__ptr__) REP_Capability_interrupt[__ptr__+OFFSET_Capability_interrupt] -#define OFFSET_Capability_sparks 1320 +#define OFFSET_Capability_sparks 1328 #define REP_Capability_sparks b64 #define Capability_sparks(__ptr__) REP_Capability_sparks[__ptr__+OFFSET_Capability_sparks] -#define OFFSET_Capability_total_allocated 1192 +#define OFFSET_Capability_total_allocated 1200 #define REP_Capability_total_allocated b64 #define Capability_total_allocated(__ptr__) REP_Capability_total_allocated[__ptr__+OFFSET_Capability_total_allocated] -#define OFFSET_Capability_weak_ptr_list_hd 1168 +#define OFFSET_Capability_weak_ptr_list_hd 1176 #define REP_Capability_weak_ptr_list_hd b64 #define Capability_weak_ptr_list_hd(__ptr__) REP_Capability_weak_ptr_list_hd[__ptr__+OFFSET_Capability_weak_ptr_list_hd] -#define OFFSET_Capability_weak_ptr_list_tl 1176 +#define OFFSET_Capability_weak_ptr_list_tl 1184 #define REP_Capability_weak_ptr_list_tl b64 #define Capability_weak_ptr_list_tl(__ptr__) REP_Capability_weak_ptr_list_tl[__ptr__+OFFSET_Capability_weak_ptr_list_tl] #define OFFSET_bdescr_start 0 diff --git a/ghc-lib/stage0/lib/settings b/ghc-lib/stage0/lib/settings --- a/ghc-lib/stage0/lib/settings +++ b/ghc-lib/stage0/lib/settings @@ -2,7 +2,7 @@ ,("C compiler command", "cc") ,("C compiler flags", "--target=x86_64-apple-darwin ") ,("C++ compiler flags", "--target=x86_64-apple-darwin ") -,("C compiler link flags", "--target=x86_64-apple-darwin ") +,("C compiler link flags", "--target=x86_64-apple-darwin -Wl,-no_fixup_chains") ,("C compiler supports -no-pie", "NO") ,("Haskell CPP command", "cc") ,("Haskell CPP flags", "-E -undef -traditional -Wno-invalid-pp-token -Wno-unicode -Wno-trigraphs") diff --git a/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs b/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs --- a/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs +++ b/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs @@ -3,19 +3,19 @@ import Prelude -- See Note [Why do we import Prelude here?] cProjectGitCommitId :: String -cProjectGitCommitId = "74ca6191fa0dbbe8cee3dc53741b8d59fbf16b09" +cProjectGitCommitId = "5383016c78fe4b2555e0aae9248bea5b42f67a78" cProjectVersion :: String -cProjectVersion = "9.2.5" +cProjectVersion = "9.2.6" cProjectVersionInt :: String cProjectVersionInt = "902" cProjectPatchLevel :: String -cProjectPatchLevel = "5" +cProjectPatchLevel = "6" cProjectPatchLevel1 :: String -cProjectPatchLevel1 = "5" +cProjectPatchLevel1 = "6" cProjectPatchLevel2 :: String cProjectPatchLevel2 = "" diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -462,7 +462,7 @@ #define MIN_VERSION_ghc_heap(major1,major2,minor) (\ (major1) < 9 || \ (major1) == 9 && (major2) < 2 || \ - (major1) == 9 && (major2) == 2 && (minor) <= 5) + (major1) == 9 && (major2) == 2 && (minor) <= 6) #endif /* MIN_VERSION_ghc_heap */ #if MIN_VERSION_ghc_heap(8,11,0) instance Binary Heap.StgTSOProfInfo