Zubin pushed to branch wip/9.10.3-backports at Glasgow Haskell Compiler / GHC Commits: 6e25fe9e by Jens Petersen at 2025-07-24T06:01:42+05:30 9.10 hadrian can build with Cabal-3.12.1 fixes #25605 (cherry picked from commit 07f17b6ed1bb0ba7134ee8dfd992036e97552c94) - - - - - 7d52147f by sheaf at 2025-07-24T06:01:42+05:30 Don't cache solved [W] HasCallStack constraints This commit ensures we do not add solved Wanted constraints that mention HasCallStack or HasExceptionContext constraints to the set of solved Wanted dictionary constraints: caching them is invalid, because re-using such cached dictionaries means using an old call-stack instead of constructing a new one, as was reported in #25529. Fixes #25529. (cherry picked from commit 256ac29c8df4f17a1d50ea243408d506ebf395d6) - - - - - e373cfb5 by Zubin Duggal at 2025-07-24T06:01:42+05:30 In commit "Don't cache solved [W] HasCallStack constraints" (256ac29c8df4f17a1d50ea243408d506ebf395d6), we attempt to use `tryM` to avoid errors when looking up certain known-key names like CallStack while compiling ghc-prim and ghc-internal. Unfortunately, `tryM` doesn't catch module lookup errors. This manifests as a failure to build ghc-prim in `--make` mode on the GHC 9.10 branch. Instead, we explicitly avoid doing lookups when we are compiling ghc-prim or ghc-internal instead of relying on catching the exception. - - - - - a2398ad0 by Zubin Duggal at 2025-07-24T06:01:42+05:30 Prepare 9.10.3 prerelease - - - - - 20 changed files: - compiler/GHC/Core/Predicate.hs - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Types.hs - configure.ac - + docs/users_guide/9.10.3-notes.rst - hadrian/hadrian.cabal - hadrian/src/Context.hs - hadrian/src/Hadrian/Haskell/Cabal/Parse.hs - hadrian/src/Hadrian/Haskell/Cabal/Type.hs - hadrian/src/Rules/BinaryDist.hs - hadrian/src/Rules/CabalReinstall.hs - hadrian/src/Rules/Register.hs - hadrian/src/Rules/Rts.hs - hadrian/src/Settings/Builders/Ghc.hs - testsuite/tests/plugins/plugins10.stdout - testsuite/tests/plugins/static-plugins.stdout - + testsuite/tests/typecheck/should_run/T25529.hs - + testsuite/tests/typecheck/should_run/T25529.stdout - testsuite/tests/typecheck/should_run/all.T Changes: ===================================== compiler/GHC/Core/Predicate.hs ===================================== @@ -27,7 +27,7 @@ module GHC.Core.Predicate ( -- Implicit parameters isIPLikePred, mentionsIP, isIPTyCon, isIPClass, isCallStackTy, isCallStackPred, isCallStackPredTy, - isExceptionContextPred, + isExceptionContextPred, isExceptionContextTy, isIPPred_maybe, -- Evidence variables @@ -39,7 +39,6 @@ import GHC.Prelude import GHC.Core.Type import GHC.Core.Class -import GHC.Core.TyCo.Compare( eqType ) import GHC.Core.TyCon import GHC.Core.TyCon.RecWalk import GHC.Types.Var @@ -292,7 +291,7 @@ isExceptionContextPred cls tys | otherwise = Nothing --- | Is a type a 'CallStack'? +-- | Is a type an 'ExceptionContext'? isExceptionContextTy :: Type -> Bool isExceptionContextTy ty | Just tc <- tyConAppTyCon_maybe ty @@ -338,31 +337,38 @@ isCallStackTy ty isIPLikePred :: Type -> Bool -- Is `pred`, or any of its superclasses, an implicit parameter? -- See Note [Local implicit parameters] -isIPLikePred pred = mentions_ip_pred initIPRecTc Nothing pred - -mentionsIP :: Type -> Class -> [Type] -> Bool --- Is (cls tys) an implicit parameter with key `str_ty`, or --- is any of its superclasses such at thing. +isIPLikePred pred = + mentions_ip_pred initIPRecTc (const True) (const True) pred + +mentionsIP :: (Type -> Bool) -- ^ predicate on the string + -> (Type -> Bool) -- ^ predicate on the type + -> Class + -> [Type] -> Bool +-- ^ @'mentionsIP' str_cond ty_cond cls tys@ returns @True@ if: +-- +-- - @cls tys@ is of the form @IP str ty@, where @str_cond str@ and @ty_cond ty@ +-- are both @True@, +-- - or any superclass of @cls tys@ has this property. +-- -- See Note [Local implicit parameters] -mentionsIP str_ty cls tys = mentions_ip initIPRecTc (Just str_ty) cls tys - -mentions_ip :: RecTcChecker -> Maybe Type -> Class -> [Type] -> Bool -mentions_ip rec_clss mb_str_ty cls tys - | Just (str_ty', _) <- isIPPred_maybe cls tys - = case mb_str_ty of - Nothing -> True - Just str_ty -> str_ty `eqType` str_ty' +mentionsIP = mentions_ip initIPRecTc + +mentions_ip :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Class -> [Type] -> Bool +mentions_ip rec_clss str_cond ty_cond cls tys + | Just (str_ty, ty) <- isIPPred_maybe cls tys + = str_cond str_ty && ty_cond ty | otherwise - = or [ mentions_ip_pred rec_clss mb_str_ty (classMethodInstTy sc_sel_id tys) + = or [ mentions_ip_pred rec_clss str_cond ty_cond (classMethodInstTy sc_sel_id tys) | sc_sel_id <- classSCSelIds cls ] -mentions_ip_pred :: RecTcChecker -> Maybe Type -> Type -> Bool -mentions_ip_pred rec_clss mb_str_ty ty + +mentions_ip_pred :: RecTcChecker -> (Type -> Bool) -> (Type -> Bool) -> Type -> Bool +mentions_ip_pred rec_clss str_cond ty_cond ty | Just (cls, tys) <- getClassPredTys_maybe ty , let tc = classTyCon cls , Just rec_clss' <- if isTupleTyCon tc then Just rec_clss else checkRecTc rec_clss tc - = mentions_ip rec_clss' mb_str_ty cls tys + = mentions_ip rec_clss' str_cond ty_cond cls tys | otherwise = False -- Includes things like (D []) where D is -- a Constraint-ranged family; #7785 @@ -429,7 +435,38 @@ Small worries (Sept 20): * The superclass hunt stops when it encounters the same class again, but in principle we could have the same class, differently instantiated, and the second time it could have an implicit parameter -I'm going to treat these as problems for another day. They are all exotic. -} +I'm going to treat these as problems for another day. They are all exotic. + +Note [Using typesAreApart when calling mentionsIP] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We call 'mentionsIP' in two situations: + + (1) to check that a predicate does not contain any implicit parameters + IP str ty, for a fixed literal str and any type ty, + (2) to check that a predicate does not contain any HasCallStack or + HasExceptionContext constraints. + +In both of these cases, we want to be sure, so we should be conservative: + + For (1), the predicate might contain an implicit parameter IP Str a, where + Str is a type family such as: + + type family MyStr where MyStr = "abc" + + To safeguard against this (niche) situation, instead of doing a simple + type equality check, we use 'typesAreApart'. This allows us to recognise + that 'IP MyStr a' contains an implicit parameter of the form 'IP "abc" ty'. + + For (2), we similarly might have + + type family MyCallStack where MyCallStack = CallStack + + Again, here we use 'typesAreApart'. This allows us to see that + + (?foo :: MyCallStack) + + is indeed a CallStack constraint, hidden under a type family. +-} {- ********************************************************************* * * ===================================== compiler/GHC/Tc/Solver/Dict.hs ===================================== @@ -32,7 +32,7 @@ import GHC.Core.InstEnv ( DFunInstType ) import GHC.Core.Class import GHC.Core.Predicate import GHC.Core.Multiplicity ( scaledThing ) -import GHC.Core.Unify ( ruleMatchTyKiX ) +import GHC.Core.Unify ( ruleMatchTyKiX , typesAreApart ) import GHC.Types.Name import GHC.Types.Name.Set @@ -105,21 +105,25 @@ updInertDicts :: DictCt -> TcS () updInertDicts dict_ct@(DictCt { di_cls = cls, di_ev = ev, di_tys = tys }) = do { traceTcS "Adding inert dict" (ppr dict_ct $$ ppr cls <+> ppr tys) - ; if | isGiven ev, Just (str_ty, _) <- isIPPred_maybe cls tys + ; if | isGiven ev, Just (str_ty, _) <- isIPPred_maybe cls tys -> -- See (SIP1) and (SIP2) in Note [Shadowing of implicit parameters] -- Update /both/ inert_cans /and/ inert_solved_dicts. updInertSet $ \ inerts@(IS { inert_cans = ics, inert_solved_dicts = solved }) -> - inerts { inert_cans = updDicts (filterDicts (not_ip_for str_ty)) ics - , inert_solved_dicts = filterDicts (not_ip_for str_ty) solved } - | otherwise + inerts { inert_cans = updDicts (filterDicts (does_not_mention_ip_for str_ty)) ics + , inert_solved_dicts = filterDicts (does_not_mention_ip_for str_ty) solved } + | otherwise -> return () -- Add the new constraint to the inert set ; updInertCans (updDicts (addDict dict_ct)) } where - not_ip_for :: Type -> DictCt -> Bool - not_ip_for str_ty (DictCt { di_cls = cls, di_tys = tys }) - = not (mentionsIP str_ty cls tys) + -- Does this class constraint or any of its superclasses mention + -- an implicit parameter (?str :: ty) for the given 'str' and any type 'ty'? + does_not_mention_ip_for :: Type -> DictCt -> Bool + does_not_mention_ip_for str_ty (DictCt { di_cls = cls, di_tys = tys }) + = not $ mentionsIP (not . typesAreApart str_ty) (const True) cls tys + -- See Note [Using typesAreApart when calling mentionsIP] + -- in GHC.Core.Predicate canDictCt :: CtEvidence -> Class -> [Type] -> SolverStage DictCt -- Once-only processing of Dict constraints: @@ -201,7 +205,7 @@ in two places: * In `GHC.Tc.Solver.InertSet.solveOneFromTheOther`, be careful when we have (?x :: ty) in the inert set and an identical (?x :: ty) as the work item. -* In `updInertDicts` in this module, when adding [G] (?x :: ty), remove any +* In `updInertDicts`, in this module, when adding [G] (?x :: ty), remove any existing [G] (?x :: ty'), regardless of ty'. * Wrinkle (SIP1): we must be careful of superclasses. Consider @@ -221,7 +225,7 @@ in two places: An important special case is constraint tuples like [G] (% ?x::ty, Eq a %). But it could happen for `class xx => D xx where ...` and the constraint D (?x :: int). This corner (constraint-kinded variables instantiated with - implicit parameter constraints) is not well explorered. + implicit parameter constraints) is not well explored. Example in #14218, and #23761 ===================================== compiler/GHC/Tc/Solver/Monad.hs ===================================== @@ -158,7 +158,7 @@ import GHC.Tc.Types.Origin import GHC.Tc.Types.Constraint import GHC.Tc.Utils.Unify -import GHC.Builtin.Names ( unsatisfiableClassNameKey ) +import GHC.Builtin.Names ( unsatisfiableClassNameKey, callStackTyConName, exceptionContextTyConName ) import GHC.Core.Type import GHC.Core.TyCo.Rep as Rep @@ -168,6 +168,7 @@ import GHC.Core.Predicate import GHC.Core.Reduction import GHC.Core.Class import GHC.Core.TyCon +import GHC.Core.Unify (typesAreApart) import GHC.Types.Name import GHC.Types.TyThing @@ -177,13 +178,13 @@ import GHC.Types.Var.Set import GHC.Types.Unique.Supply import GHC.Types.Unique.Set( elementOfUniqSet ) -import GHC.Unit.Module ( HasModule, getModule, extractModule ) +import GHC.Unit.Module ( HasModule, getModule, extractModule, primUnit, moduleUnit, ghcInternalUnit) import qualified GHC.Rename.Env as TcM import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Logger -import GHC.Utils.Misc (HasDebugCallStack) +import GHC.Utils.Misc (HasDebugCallStack, (<||>)) import GHC.Data.Bag as Bag import GHC.Data.Pair @@ -478,14 +479,92 @@ getSafeOverlapFailures updSolvedDicts :: InstanceWhat -> DictCt -> TcS () -- Conditionally add a new item in the solved set of the monad -- See Note [Solved dictionaries] in GHC.Tc.Solver.InertSet -updSolvedDicts what dict_ct@(DictCt { di_ev = ev }) +updSolvedDicts what dict_ct@(DictCt { di_cls = cls, di_tys = tys, di_ev = ev }) | isWanted ev , instanceReturnsDictCon what - = do { traceTcS "updSolvedDicts:" $ ppr dict_ct + = do { is_callstack <- is_tyConTy isCallStackTy callStackTyConName + ; is_exceptionCtx <- is_tyConTy isExceptionContextTy exceptionContextTyConName + ; let contains_callstack_or_exceptionCtx = + mentionsIP + (const True) + -- NB: the name of the call-stack IP is irrelevant + -- e.g (?foo :: CallStack) counts! + (is_callstack <||> is_exceptionCtx) + cls tys + -- See Note [Don't add HasCallStack constraints to the solved set] + ; unless contains_callstack_or_exceptionCtx $ + do { traceTcS "updSolvedDicts:" $ ppr dict_ct ; updInertSet $ \ ics -> - ics { inert_solved_dicts = addSolvedDict dict_ct (inert_solved_dicts ics) } } + ics { inert_solved_dicts = addSolvedDict dict_ct (inert_solved_dicts ics) } + } } | otherwise = return () + where + + -- Return a predicate that decides whether a type is CallStack + -- or ExceptionContext, accounting for e.g. type family reduction, as + -- per Note [Using typesAreApart when calling mentionsIP]. + -- + -- See Note [Using isCallStackTy in mentionsIP]. + is_tyConTy :: (Type -> Bool) -> Name -> TcS (Type -> Bool) + is_tyConTy is_eq tc_name + = do { mb_tc <- wrapTcS $ do + mod <- tcg_mod <$> TcM.getGblEnv + if moduleUnit mod `elem` [primUnit, ghcInternalUnit] + then return Nothing + else Just <$> TcM.tcLookupTyCon tc_name + ; case mb_tc of + Just tc -> + return $ \ ty -> not (typesAreApart ty (mkTyConTy tc)) + Nothing -> + return is_eq + } + +{- Note [Don't add HasCallStack constraints to the solved set] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We must not add solved Wanted dictionaries that mention HasCallStack constraints +to the solved set, or we might fail to accumulate the proper call stack, as was +reported in #25529. + +Recall that HasCallStack constraints (and the related HasExceptionContext +constraints) are implicit parameter constraints, and are accumulated as per +Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence. + +When we solve a Wanted that contains a HasCallStack constraint, we don't want +to cache the result, because re-using that solution means re-using the call-stack +in a different context! + +See also Note [Shadowing of implicit parameters], which deals with a similar +problem with Given implicit parameter constraints. + +Note [Using isCallStackTy in mentionsIP] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +To implement Note [Don't add HasCallStack constraints to the solved set], +we need to check whether a constraint contains a HasCallStack or HasExceptionContext +constraint. We do this using the 'mentionsIP' function, but as per +Note [Using typesAreApart when calling mentionsIP] we don't want to simply do: + + mentionsIP + (const True) -- (ignore the implicit parameter string) + (isCallStackTy <||> isExceptionContextTy) + +because this does not account for e.g. a type family that reduces to CallStack. +The predicate we want to use instead is: + + \ ty -> not (typesAreApart ty callStackTy && typesAreApart ty exceptionContextTy) + +However, this is made difficult by the fact that CallStack and ExceptionContext +are not wired-in types; they are only known-key. This means we must look them +up using 'tcLookupTyCon'. However, this might fail, e.g. if we are in the middle +of typechecking ghc-internal and these data-types have not been typechecked yet! + +In that case, we simply fall back to the naive 'isCallStackTy'/'isExceptionContextTy' +logic. + +Note that it would be somewhat painful to wire-in ExceptionContext: at the time +of writing (March 2025), this would require wiring in the ExceptionAnnotation +class, as well as SomeExceptionAnnotation, which is a data type with existentials. +-} getSolvedDicts :: TcS (DictMap DictCt) getSolvedDicts = do { ics <- getInertSet; return (inert_solved_dicts ics) } ===================================== compiler/GHC/Tc/Solver/Types.hs ===================================== @@ -166,7 +166,7 @@ Suppose f :: HasCallStack => blah. Then IP "callStack" CallStack See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence -* We cannonicalise such constraints, in GHC.Tc.Solver.Dict.canDictNC, by +* We canonicalise such constraints, in GHC.Tc.Solver.Dict.canDictNC, by pushing the call-site info on the stack, and changing the CtOrigin to record that has been done. Bind: s1 = pushCallStack <site-info> s2 ===================================== configure.ac ===================================== @@ -22,7 +22,7 @@ AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.10.2], [glasgow-ha AC_CONFIG_MACRO_DIRS([m4]) # Set this to YES for a released version, otherwise NO -: ${RELEASE=YES} +: ${RELEASE=NO} # The primary version (e.g. 7.5, 7.4.1) is set in the AC_INIT line # above. If this is not a released version, then we will append the ===================================== docs/users_guide/9.10.3-notes.rst ===================================== @@ -0,0 +1,165 @@ +.. _release-9-10-3: + +Version 9.10.3 +=============== +The significant changes to the various parts of the compiler are listed in the +following sections. See the `migration guide +https://gitlab.haskell.org/ghc/ghc/-/wikis/migration/9.10`_ on the GHC Wiki +for specific guidance on migrating programs to this release. + + +Compiler +~~~~~~~~ + +- Don't cache solved [W] HasCallStack constraints to avoid re-using old + call-stacks instead of constructing new ones. (:ghc-ticket:`25529`) + +- Fix EmptyCase panic in tcMatches when \case{} is checked against a function + type preceded by invisible forall. (:ghc-ticket:`25960`) + +- Fix panic triggered by combination of \case{} and forall t ->. (:ghc-ticket:`25004`) + +- Fix GHC.SysTools.Ar archive member size writing logic that was emitting wrong + archive member sizes in headers. (:ghc-ticket:`26120`, :ghc-ticket:`22586`) + +- Fix multiple bugs in name resolution of subordinate import lists related to + type namespace specifiers and hiding clauses. (:ghc-ticket:`22581`, :ghc-ticket:`25983`, :ghc-ticket:`25984`, :ghc-ticket:`25991`) + +- Use mkTrAppChecked in ds_ev_typeable to avoid false negatives for type + equality involving function types. (:ghc-ticket:`25998`) + +- Fix bytecode generation for ``tagToEnum# <LITERAL>``. (:ghc-ticket:`25975`) + +- Don't report used duplicate record fields as unused. (:ghc-ticket:`24035`) + +- Propagate long distance info to guarded let binds for better pattern-match + checking warnings. (:ghc-ticket:`25749`) + +- Prevent incorrect unpacking optimizations for GADTs with multiple constructors. (:ghc-ticket:`25672`) + +- Introduce a separate argument limit for forced specs via SPEC argument with + warning when limit is exceeded. (:ghc-ticket:`25197`) + +Build system and packaging +~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +- 9.10 hadrian can build with Cabal-3.12.1. (:ghc-ticket:`25605`) + +- GHC settings: always unescape escaped spaces to fix handling of spaces in + executable paths. (:ghc-ticket:`25204`) + +Native code generator backend +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +- x86 NCG: Fix code generation of bswap64 on i386. (:ghc-ticket:`25601`) + +- AArch64 NCG: Fix sub-word arithmetic right shift by zero-extending sub-word + values. (:ghc-ticket:`26061`) + +- NCG: AArch64 - Add -finter-module-far-jumps flag for modules with far jumps + outside the current module. (:ghc-ticket:`24648`) + +LLVM backend +~~~~~~~~~~~~ + +- LLVM: fix typo in padLiveArgs that was incorrectly computing too many padding + registers causing segfaults. (:ghc-ticket:`25770`, :ghc-ticket:`25773`) + +- llvmGen: Fix linkage of built-in arrays to use Appending linkage instead of + Internal. (:ghc-ticket:`25769`) + +- llvmGen: Fix built-in variable predicate to check for `@llvm` rather than + `$llvm`. + +WebAssembly backend +~~~~~~~~~~~~~~~~~~~ + +- wasm: use primitive opcodes for fabs and sqrt operations. + +Runtime system +~~~~~~~~~~~~~~ + +- rts: Implement WEAK EXTERNAL undef redirection by target symbol name. + +- rts: Handle API set symbol versioning conflicts. + +- rts: fix rts_clearMemory logic when sanity checks are enabled. (:ghc-ticket:`26011`) + +- rts/linker: Improve efficiency of proddable blocks structure by using binary + search instead of linked lists for better performance with split sections. (:ghc-ticket:`26009`) + +- rts/linker/PEi386: Don't repeatedly load DLLs by maintaining a hash-set of + loaded DLL names. (:ghc-ticket:`26009`, :ghc-ticket:`26052`) + +- rts/linker: Don't fail due to RTLD_NOW by attempting eager binding first, + then reverting to lazy binding on failure. (:ghc-ticket:`25943`) + +``base`` library +~~~~~~~~~~~~~~~~ + +- base: Expose Backtraces constructor and fields. (:ghc-ticket:`26049`) + +- base: Note strictness changes made in 4.16.0.0. (:ghc-ticket:`25886`) + +- Fix bugs in ``integerRecipMod`` and ``integerPowMod`` return values. (:ghc-ticket:`26017`) + +``ghc`` library +~~~~~~~~~~~~~~~ + +- perf: Replace uses of genericLength with strictGenericLength to reduce time + spent in 'assembleBCOs' and allocations. (:ghc-ticket:`25706`) + +Build tools +~~~~~~~~~~~ + +- configure: Drop probing of ld.gold since `gold` has been dropped from + binutils-2.44. (:ghc-ticket:`25716`) + +- get-win32-tarballs.py: List tarball files to be downloaded if we cannot find + them. (:ghc-ticket:`25929`) + +- hp2ps Utilities.c: include stdlib.h instead of extern malloc and realloc. + +Included libraries +~~~~~~~~~~~~~~~~~~ + +The package database provided with this distribution also contains a number of +packages other than GHC itself. See the changelogs provided with these packages +for further change information. + +.. ghc-package-list:: + + libraries/array/array.cabal: Dependency of ``ghc`` library + libraries/base/base.cabal: Core library + libraries/binary/binary.cabal: Dependency of ``ghc`` library + libraries/bytestring/bytestring.cabal: Dependency of ``ghc`` library + libraries/Cabal/Cabal/Cabal.cabal: Dependency of ``ghc-pkg`` utility + libraries/Cabal/Cabal-syntax/Cabal-syntax.cabal: Dependency of ``ghc-pkg`` utility + libraries/containers/containers/containers.cabal: Dependency of ``ghc`` library + libraries/deepseq/deepseq.cabal: Dependency of ``ghc`` library + libraries/directory/directory.cabal: Dependency of ``ghc`` library + libraries/exceptions/exceptions.cabal: Dependency of ``ghc`` and ``haskeline`` library + libraries/filepath/filepath.cabal: Dependency of ``ghc`` library + compiler/ghc.cabal: The compiler itself + libraries/ghci/ghci.cabal: The REPL interface + libraries/ghc-boot/ghc-boot.cabal: Internal compiler library + libraries/ghc-boot-th/ghc-boot-th.cabal: Internal compiler library + libraries/ghc-compact/ghc-compact.cabal: Core library + libraries/ghc-heap/ghc-heap.cabal: GHC heap-walking library + libraries/ghc-prim/ghc-prim.cabal: Core library + libraries/haskeline/haskeline.cabal: Dependency of ``ghci`` executable + libraries/hpc/hpc.cabal: Dependency of ``hpc`` executable + libraries/integer-gmp/integer-gmp.cabal: Core library + libraries/mtl/mtl.cabal: Dependency of ``Cabal`` library + libraries/parsec/parsec.cabal: Dependency of ``Cabal`` library + libraries/pretty/pretty.cabal: Dependency of ``ghc`` library + libraries/process/process.cabal: Dependency of ``ghc`` library + libraries/stm/stm.cabal: Dependency of ``haskeline`` library + libraries/template-haskell/template-haskell.cabal: Core library + libraries/terminfo/terminfo.cabal: Dependency of ``haskeline`` library + libraries/text/text.cabal: Dependency of ``Cabal`` library + libraries/time/time.cabal: Dependency of ``ghc`` library + libraries/transformers/transformers.cabal: Dependency of ``ghc`` library + libraries/unix/unix.cabal: Dependency of ``ghc`` library + libraries/Win32/Win32.cabal: Dependency of ``ghc`` library + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable \ No newline at end of file ===================================== hadrian/hadrian.cabal ===================================== @@ -152,7 +152,7 @@ executable hadrian , TypeOperators other-extensions: MultiParamTypeClasses , TypeFamilies - build-depends: Cabal >= 3.10 && < 3.11 + build-depends: Cabal (>= 3.10 && < 3.11) || (>= 3.12.1 && < 3.13) , base >= 4.11 && < 5 , bytestring >= 0.10 && < 0.13 , containers >= 0.5 && < 0.8 ===================================== hadrian/src/Context.hs ===================================== @@ -9,7 +9,7 @@ module Context ( contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, pkgSetupConfigDir, pkgHaddockFile, pkgRegisteredLibraryFile, pkgRegisteredLibraryFileName, pkgLibraryFile, pkgGhciLibraryFile, - pkgConfFile, pkgStampFile, resourcePath, objectPath, contextPath, getContextPath, libPath, distDir, + pkgConfFile, pkgStampFile, resourcePath, objectPath, contextPath, getContextPath, libPath, distDir, distDynDir, haddockStatsFilesDir ) where @@ -20,7 +20,8 @@ import Hadrian.Expression import Hadrian.Haskell.Cabal import Oracles.Setting import GHC.Toolchain.Target (Target(..)) -import GHC.Platform.ArchOS +import Hadrian.Oracles.Cabal +import Hadrian.Haskell.Cabal.Type -- | Most targets are built only one way, hence the notion of 'vanillaContext'. vanillaContext :: Stage -> Package -> Context @@ -62,12 +63,15 @@ libPath Context {..} = buildRoot <&> (-/- (stageString stage -/- "lib")) -- -- We preform some renaming to accommodate Cabal's slightly different naming -- conventions (see 'cabalOsString' and 'cabalArchString'). -distDir :: Stage -> Action FilePath -distDir st = do - version <- ghcVersionStage st - targetOs <- cabalOsString . stringEncodeOS . archOS_OS . tgtArchOs <$> targetStage st - targetArch <- cabalArchString . stringEncodeArch . archOS_arch . tgtArchOs <$> targetStage st - return $ targetArch ++ "-" ++ targetOs ++ "-ghc-" ++ version +distDir :: Context -> Action FilePath +distDir c = do + cd <- readContextData c + return (contextLibdir cd) + +distDynDir :: Context -> Action FilePath +distDynDir c = do + cd <- readContextData c + return (contextDynLibdir cd) pkgFileName :: Context -> Package -> String -> String -> Action FilePath pkgFileName context package prefix suffix = do @@ -104,13 +108,12 @@ pkgHaddockFile Context {..} = do -- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@ pkgRegisteredLibraryFile :: Context -> Action FilePath pkgRegisteredLibraryFile context@Context {..} = do - libDir <- libPath context - pkgId <- pkgUnitId stage package fileName <- pkgRegisteredLibraryFileName context - distDir <- distDir stage + distDir <- distDir context + distDynDir <- distDynDir context return $ if Dynamic `wayUnit` way - then libDir -/- distDir -/- fileName - else libDir -/- distDir -/- pkgId -/- fileName + then distDynDir -/- fileName + else distDir -/- fileName -- | Just the final filename portion of pkgRegisteredLibraryFile pkgRegisteredLibraryFileName :: Context -> Action FilePath ===================================== hadrian/src/Hadrian/Haskell/Cabal/Parse.hs ===================================== @@ -254,6 +254,7 @@ resolveContextData context@Context {..} = do pdi <- liftIO $ getHookedBuildInfo [pkgPath package, cPath -/- "build"] let pd' = C.updatePackageDescription pdi (C.localPkgDescr lbi) lbi' = lbi { C.localPkgDescr = pd' } + pkgDbPath <- packageDbPath (PackageDbLoc stage iplace) -- TODO: Get rid of deprecated 'externalPackageDeps' and drop -Wno-deprecations -- See: https://github.com/snowleopard/hadrian/issues/548 @@ -302,6 +303,8 @@ resolveContextData context@Context {..} = do | takeExtension fp `elem` [".cpp", ".cxx", ".c++"]= CppMain | otherwise = CMain + install_dirs = absoluteInstallDirs pd' lbi' (CopyToDb pkgDbPath) + main_src = fmap (first C.display) mainIs cdata = ContextData { dependencies = deps @@ -343,7 +346,10 @@ resolveContextData context@Context {..} = do , depLdOpts = forDeps Installed.ldOptions , buildGhciLib = C.withGHCiLib lbi' , frameworks = C.frameworks buildInfo - , packageDescription = pd' } + , packageDescription = pd' + , contextLibdir = libdir install_dirs + , contextDynLibdir = dynlibdir install_dirs + } in return cdata ===================================== hadrian/src/Hadrian/Haskell/Cabal/Type.hs ===================================== @@ -70,6 +70,10 @@ data ContextData = ContextData , buildGhciLib :: Bool , frameworks :: [String] , packageDescription :: PackageDescription + -- The location where normal library files go + , contextLibdir :: FilePath + -- The location where dynamic libraries go + , contextDynLibdir :: FilePath } deriving (Eq, Generic, Show, Typeable) instance Binary PackageData ===================================== hadrian/src/Rules/BinaryDist.hs ===================================== @@ -146,7 +146,7 @@ bindistRules = do phony "binary-dist-dir" $ do version <- setting ProjectVersion targetPlatform <- setting TargetPlatformFull - distDir <- Context.distDir Stage1 + distDir <- Context.distDir (vanillaContext Stage1 rts) rtsDir <- pkgUnitId Stage1 rts -- let rtsDir = "rts" ===================================== hadrian/src/Rules/CabalReinstall.hs ===================================== @@ -53,13 +53,11 @@ cabalBuildRules = do iserv_targets <- if cross then pure [] else iservBins need (lib_targets ++ (map (\(_, p) -> p) (bin_targets ++ iserv_targets))) - distDir <- Context.distDir Stage1 + distDir <- Context.distDir (vanillaContext Stage1 rts) rtsDir <- pkgUnitId Stage1 rts -- let rtsDir = "rts" - let ghcBuildDir = root -/- stageString Stage1 - rtsIncludeDir = ghcBuildDir -/- "lib" -/- distDir -/- rtsDir - -/- "include" + let rtsIncludeDir = distDir -/- "include" libdir <- liftIO . IO.makeAbsolute =<< stageLibPath Stage1 work_dir <- liftIO $ IO.makeAbsolute $ root -/- "stage-cabal" ===================================== hadrian/src/Rules/Register.hs ===================================== @@ -182,11 +182,12 @@ buildConfFinal rs context@Context {..} _conf = do -- -- so that if any change ends up modifying a library (but not its .conf -- file), we still rebuild things that depend on it. - dir <- (-/-) <$> libPath context <*> distDir stage + dir <- distDir context + dyndir <- distDynDir context pkgid <- pkgUnitId stage package files <- liftIO $ - (++) <$> getDirectoryFilesIO "." [dir -/- "*libHS"++pkgid++"*"] - <*> getDirectoryFilesIO "." [dir -/- pkgid -/- "**"] + (++) <$> getDirectoryFilesIO "." [dyndir -/- "*libHS"++pkgid++"*"] + <*> getDirectoryFilesIO "." [dir -/- "**"] produces files buildConfInplace :: [(Resource, Int)] -> Context -> FilePath -> Action () ===================================== hadrian/src/Rules/Rts.hs ===================================== @@ -154,10 +154,9 @@ needRtsSymLinks :: Stage -> Set.Set Way -> Action () needRtsSymLinks stage rtsWays = forM_ (Set.filter (wayUnit Dynamic) rtsWays) $ \ way -> do let ctx = Context stage rts way Final - libPath <- libPath ctx - distDir <- distDir stage + distDir <- distDynDir ctx rtsLibFile <- takeFileName <$> pkgLibraryFile ctx - need [removeRtsDummyVersion (libPath distDir rtsLibFile)] + need [removeRtsDummyVersion (distDir rtsLibFile)] prefix, versionlessPrefix :: String versionlessPrefix = "libHSrts" ===================================== hadrian/src/Settings/Builders/Ghc.hs ===================================== @@ -99,8 +99,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do originPath <- dropFileName <$> getOutput context <- getContext libPath' <- expr (libPath context) - st <- getStage - distDir <- expr (Context.distDir st) + distPath <- expr (Context.distDynDir context) useSystemFfi <- expr (flag UseSystemFfi) buildPath <- getBuildPath @@ -112,7 +111,6 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do let dynamic = Dynamic `wayUnit` way - distPath = libPath' -/- distDir originToLibsDir = makeRelativeNoSysLink originPath distPath rpath -- Programs will end up in the bin dir ($ORIGIN) and will link to ===================================== testsuite/tests/plugins/plugins10.stdout ===================================== @@ -7,6 +7,8 @@ interfacePlugin: GHC.Internal.Float interfacePlugin: GHC.Prim.Ext interfacePlugin: Language.Haskell.TH.Syntax typeCheckPlugin (rn) +interfacePlugin: GHC.Internal.Stack.Types +interfacePlugin: GHC.Internal.Exception.Context typeCheckPlugin (tc) parsePlugin(a) typeCheckPlugin (rn) ===================================== testsuite/tests/plugins/static-plugins.stdout ===================================== @@ -8,6 +8,8 @@ interfacePlugin: GHC.Internal.System.IO interfacePlugin: GHC.Types interfacePlugin: GHC.Internal.Show typeCheckPlugin (rn) +interfacePlugin: GHC.Internal.Stack.Types +interfacePlugin: GHC.Internal.Exception.Context interfacePlugin: GHC.Internal.TopHandler typeCheckPlugin (tc) interfacePlugin: GHC.CString ===================================== testsuite/tests/typecheck/should_run/T25529.hs ===================================== @@ -0,0 +1,33 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE ImplicitParams #-} + +module Main where + +import GHC.Stack (HasCallStack, CallStack, SrcLoc(srcLocStartLine, srcLocStartCol), callStack, getCallStack) + +main :: IO () +main = + let ?myImplicitParam = () + in run action + +type MyConstraints = (HasCallStack, ?myImplicitParam :: ()) + +action :: MyConstraints => IO () +action = run $ pure () + +-- | Print the current call stack and then run an action. +run :: + MyConstraints => + IO a -> + IO a +run action = do + let prettyCallStack = unlines $ map prettyCallStackEntry $ getCallStack callStack + prettyCallStackEntry (name, loc) = + name + <> ", called at " + <> show (srcLocStartLine loc) + <> ":" + <> show (srcLocStartCol loc) + putStrLn "============================================================" + putStrLn prettyCallStack + action ===================================== testsuite/tests/typecheck/should_run/T25529.stdout ===================================== @@ -0,0 +1,7 @@ +============================================================ +run, called at 11:7 + +============================================================ +run, called at 16:10 +action, called at 11:11 + ===================================== testsuite/tests/typecheck/should_run/all.T ===================================== @@ -170,6 +170,7 @@ test('T22510', normal, compile_and_run, ['']) test('T21973a', [exit_code(1)], compile_and_run, ['']) test('T21973b', normal, compile_and_run, ['']) test('T23761', normal, compile_and_run, ['']) +test('T25529', normal, compile_and_run, ['']) test('T23761b', normal, compile_and_run, ['']) test('T17594e', normal, compile_and_run, ['']) test('T25998', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/72e5c618bd6386ce03018537ad447d7... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/72e5c618bd6386ce03018537ad447d7... You're receiving this email because of your account on gitlab.haskell.org.