- ghc-commits - Haskell.org

[Git][ghc/ghc][master] lint-codes: fixup MSYS drive letter on Windows
by Marge Bot (＠marge-bot) 10 Sep '25

10 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 4bfe2269 by sheaf at 2025-09-10T10:45:50-04:00 lint-codes: fixup MSYS drive letter on Windows This change ensures that System.Directory.listDirectory doesn't trip up on an MSYS-style path like '/c/Foo' when trying to list all testsuite stdout/stderr files as required for testing coverage of GHC diagnostic codes in the testsuite. Fixes #25178 - - - - - 1 changed file: - linters/lint-codes/LintCodes/Coverage.hs Changes: ===================================== linters/lint-codes/LintCodes/Coverage.hs ===================================== @@ -10,11 +10,13 @@ module LintCodes.Coverage -- base import Data.Char - ( isAlphaNum, isDigit, isSpace ) + ( isAlphaNum, isDigit, isSpace, toUpper ) import Data.Maybe ( mapMaybe ) import Data.List ( dropWhileEnd ) +import System.Info + ( os ) -- bytestring import qualified Data.ByteString as ByteString @@ -28,7 +30,7 @@ import qualified Data.Set as Set -- directory import System.Directory - ( doesDirectoryExist, listDirectory ) + ( doesDirectoryExist, listDirectory, makeAbsolute ) -- filepath import System.FilePath @@ -63,7 +65,12 @@ getCoveredCodes = do { top <- dropWhileEnd isSpace <$> readProcess "git" ["rev-parse", "--show-toplevel"] "" -- TODO: would be better to avoid using git entirely. - ; let testRoot = top </> "testsuite" </> "tests" + + -- When run inside an MSYS shell, git may return a Unix-style path + -- like /c/Blah. System.Directory doesn't like that, so we make sure + -- to turn that into C:/Blah. See #25178. + ; top' <- fixupMsysDrive top + ; let testRoot = top' </> "testsuite" </> "tests" ; traverseFilesFrom includeFile diagnosticCodesIn testRoot } @@ -158,3 +165,14 @@ traverseFilesFrom include_file parse_contents = go { Left _ -> mempty ; Right txt -> parse_contents txt } } } } + +-- | On Windows, change MSYS-style @/c/Blah@ to @C:/Blah@. See #25178. +fixupMsysDrive :: FilePath -> IO FilePath +fixupMsysDrive fp = do + fixedUp <- + if | os == "mingw32" || os == "win32" + , ('/':drv:'/':rest) <- fp + -> return $ toUpper drv : ':':'/':rest + | otherwise + -> return fp + makeAbsolute fixedUp View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bfe226936f96b0c2b0bb0c80f3f8ca… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bfe226936f96b0c2b0bb0c80f3f8ca… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Deep subsumption: unify mults without tcEqMult
by Marge Bot (＠marge-bot) 10 Sep '25

10 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: dc79593d by sheaf at 2025-09-10T10:45:01-04:00 Deep subsumption: unify mults without tcEqMult As seen in #26332, we may well end up with a non-reflexive multiplicity coercion when doing deep subsumption. We should do the same thing that we do without deep subsumption: unify the multiplicities normally, without requiring that the coercion is reflexive (which is what 'tcEqMult' was doing). Fixes #26332 - - - - - 3 changed files: - compiler/GHC/Tc/Utils/Unify.hs - + testsuite/tests/linear/should_compile/T26332.hs - testsuite/tests/linear/should_compile/all.T Changes: ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -1853,8 +1853,8 @@ where we eta-expanded that (:). But now foldr expects an argument with ->{Many} and gets an argument with ->{m1} or ->{m2}, and Lint complains. -The easiest solution was to use tcEqMult in tc_sub_type_deep, and -insist on equality. This is only in the DeepSubsumption code anyway. +The easiest solution was to unify the multiplicities in tc_sub_type_deep, +insisting on equality. This is only in the DeepSubsumption code anyway. Note [FunTy vs non-FunTy case in tc_sub_type_deep] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2047,10 +2047,7 @@ tc_sub_type_deep pos unify inst_orig ctxt ty_actual ty_expected -- GenSigCtxt: See Note [Setting the argument context] ; res_wrap <- tc_sub_type_deep (Result pos) unify inst_orig ctxt act_res exp_res - -- See Note [Multiplicity in deep subsumption] - ; tcEqMult inst_orig act_mult exp_mult - - ; mkWpFun_FRR pos + ; mkWpFun_FRR unify pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res arg_wrap res_wrap @@ -2058,20 +2055,32 @@ tc_sub_type_deep pos unify inst_orig ctxt ty_actual ty_expected where given_orig = GivenOrigin (SigSkol GenSigCtxt exp_arg []) --- | Like 'mkWpFun', except that it performs representation-polymorphism --- checks on the argument type. +-- | Like 'mkWpFun', except that it performs the necessary +-- representation-polymorphism checks on the argument type in the case that +-- we introduce a lambda abstraction. mkWpFun_FRR - :: Position p + :: (TcType -> TcType -> TcM TcCoercionN) -- ^ how to unify + -> Position p -> FunTyFlag -> Type -> TcType -> Type -- actual FunTy -> FunTyFlag -> Type -> TcType -> Type -- expected FunTy -> HsWrapper -- ^ exp_arg ~> act_arg -> HsWrapper -- ^ act_res ~> exp_res -> TcM HsWrapper -- ^ act_funTy ~> exp_funTy -mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res arg_wrap res_wrap - | needs_eta - -- See Wrinkle [Representation-polymorphism checking during subtyping] - = do { (exp_arg_co, exp_arg_frr) <- hasFixedRuntimeRep (FRRDeepSubsumption True pos) exp_arg - ; (act_arg_co, _act_arg_frr) <- hasFixedRuntimeRep (FRRDeepSubsumption False pos) act_arg +mkWpFun_FRR unify pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res arg_wrap res_wrap + = do { ((exp_arg_co, exp_arg_frr), (act_arg_co, _act_arg_frr)) <- + if needs_frr_checks + -- See Wrinkle [Representation-polymorphism checking during subtyping] + then do { exp_frr_wrap <- hasFixedRuntimeRep (frr_ctxt True ) exp_arg + ; act_frr_wrap <- hasFixedRuntimeRep (frr_ctxt False) act_arg + ; return (exp_frr_wrap, act_frr_wrap) } + else return ((mkNomReflCo exp_arg, exp_arg), (mkNomReflCo act_arg, act_arg)) + + -- Enforce equality of multiplicities (not the more natural sub-multiplicity). + -- See Note [Multiplicity in deep subsumption] + ; act_arg_mult_co <- unify act_mult exp_mult + -- NB: don't use tcEqMult: that would require the evidence for + -- equality to be Refl, but it might well not be (#26332). + ; let exp_arg_fun_co = mkFunCo Nominal exp_af @@ -2080,7 +2089,7 @@ mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res (mkReflCo Nominal exp_res) act_arg_fun_co = mkFunCo Nominal act_af - (mkReflCo Nominal act_mult) + act_arg_mult_co act_arg_co (mkReflCo Nominal act_res) arg_wrap_frr = @@ -2090,24 +2099,16 @@ mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res -- arg_wrap :: exp_arg ~> act_arg -- arg_wrap_frr :: exp_arg_frr ~> act_arg_frr - -- NB: because of the needs_eta guard, we know that mkWpFun will - -- return (WpFun ...); so we might as well just use the WpFun constructor. ; return $ mkWpCastN exp_arg_fun_co <.> - WpFun arg_wrap_frr res_wrap (Scaled exp_mult exp_arg_frr) + mkWpFun arg_wrap_frr res_wrap (Scaled exp_mult exp_arg_frr) exp_res <.> - mkWpCastN act_arg_fun_co } - | otherwise - = return $ - mkWpFun arg_wrap res_wrap (Scaled exp_mult exp_arg) exp_res - -- NB: because of 'needs_eta', this will never actually be a WpFun. - -- mkWpFun will turn it into a WpHole or WpCast, which is why - -- we can skip the hasFixedRuntimeRep checks in this case. - -- See Wrinkle [Representation-polymorphism checking during subtyping] + mkWpCastN act_arg_fun_co + } where - needs_eta :: Bool - needs_eta = + needs_frr_checks :: Bool + needs_frr_checks = not (hole_or_cast arg_wrap) || not (hole_or_cast res_wrap) @@ -2115,6 +2116,12 @@ mkWpFun_FRR pos act_af act_mult act_arg act_res exp_af exp_mult exp_arg exp_res hole_or_cast WpHole = True hole_or_cast (WpCast {}) = True hole_or_cast _ = False + frr_ctxt :: Bool -> FixedRuntimeRepContext + frr_ctxt is_exp_ty = + FRRDeepSubsumption + { frrDSExpected = is_exp_ty + , frrDSPosition = pos + } ----------------------- deeplySkolemise :: SkolemInfo -> TcSigmaType ===================================== testsuite/tests/linear/should_compile/T26332.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE DeepSubsumption #-} +{-# LANGUAGE LinearTypes #-} + +module T26332 where + +import Unsafe.Coerce + +toLinear + :: forall a b p q. + (a %p-> b) %1-> (a %q-> b) +toLinear f = case unsafeEqualityProof @p @q of + UnsafeRefl -> f ===================================== testsuite/tests/linear/should_compile/all.T ===================================== @@ -41,6 +41,7 @@ test('T19400', unless(compiler_debugged(), skip), compile, ['']) test('T20023', normal, compile, ['']) test('T22546', normal, compile, ['']) test('T23025', normal, compile, ['-dlinear-core-lint']) +test('T26332', normal, compile, ['-O -dlinear-core-lint']) test('LinearRecUpd', normal, compile, ['']) test('T23814', normal, compile, ['']) test('LinearLet', normal, compile, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc79593d4606e5cea93e742a9f2def5… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dc79593d4606e5cea93e742a9f2def5… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Add regression test for #26056
by Marge Bot (＠marge-bot) 10 Sep '25

10 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 0959d4bc by Andreas Klebinger at 2025-09-10T10:44:12-04:00 Add regression test for #26056 - - - - - 2 changed files: - + testsuite/tests/profiling/should_compile/T26056.hs - testsuite/tests/profiling/should_compile/all.T Changes: ===================================== testsuite/tests/profiling/should_compile/T26056.hs ===================================== @@ -0,0 +1,21 @@ +module M where + +import GHC.Exts ( Any ) +import Unsafe.Coerce ( unsafeCoerce ) + +data Sigma = MkT Any + +testSubList :: Maybe Bool -> Sigma -> Sigma +testSubList (Just x) final = {-# SCC "y" #-} ( + let x' = seq x () + in case testSubList Nothing final of + MkT w -> {-# SCC "x" #-} + (unsafeCoerce MkT (konst x' myHead (unsafeCoerce w)))) +testSubList Nothing final = final + +myHead :: [a] -> a +myHead (x:_) = x + +konst :: () -> ([a] -> a) -> [a] -> a +konst _ x = x +{-# OPAQUE konst #-} ===================================== testsuite/tests/profiling/should_compile/all.T ===================================== @@ -20,3 +20,4 @@ test('T14931', [test_opts, unless(have_dynamic(), skip)], test('T15108', [test_opts], compile, ['-O -prof -fprof-auto']) test('T19894', [test_opts, extra_files(['T19894'])], multimod_compile, ['Main', '-v0 -O2 -prof -fprof-auto -iT19894']) test('T20938', [test_opts], compile, ['-O -prof']) +test('T26056', [test_opts], compile, ['-O -prof']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0959d4bcdd0a52d270e5aced2cbdf3b… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0959d4bcdd0a52d270e5aced2cbdf3b… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Make rationalTo{Float,Double} inline in phase 0
by Marge Bot (＠marge-bot) 10 Sep '25

10 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 45305ab8 by sheaf at 2025-09-10T10:43:29-04:00 Make rationalTo{Float,Double} inline in phase 0 We hold off on inlining these until phase 0 to allow constant-folding rules to fire. However, once we get to phase 0, we should inline them, e.g. to expose unboxing opportunities. See CLC proposal #356. - - - - - 2 changed files: - libraries/base/changelog.md - libraries/ghc-internal/src/GHC/Internal/Float.hs Changes: ===================================== libraries/base/changelog.md ===================================== @@ -4,6 +4,7 @@ * Remove deprecated, unstable heap representation details from `GHC.Exts` ([CLC proposal #212](https://github.com/haskell/core-libraries-committee/issues/212)) * Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337)) * Fix issues with toRational for types capable to represent infinite and not-a-number values ([CLC proposal #338](https://github.com/haskell/core-libraries-committee/issues/338)) + * Ensure that `rationalToFloat` and `rationalToDouble` always inline in the end. ([CLC proposal #356](https://github.com/haskell/core-libraries-committee/issues/356)) * Modify the implementation of `Data.List.sortOn` to use `(>)` instead of `compare`. ([CLC proposal #332](https://github.com/haskell/core-libraries-committee/issues/332)) * `GHC.Exts.IOPort#` and its related operations have been removed ([CLC #213](https://github.com/haskell/core-libraries-committee/issues/213)) * Add `thenA` and `thenM`. ([CLC proposal #351](https://github.com/haskell/core-libraries-committee/issues/351)) ===================================== libraries/ghc-internal/src/GHC/Internal/Float.hs ===================================== @@ -466,8 +466,8 @@ instance Fractional Float where recip x = 1.0 / x rationalToFloat :: Integer -> Integer -> Float -{-# NOINLINE [0] rationalToFloat #-} --- Re NOINLINE pragma, see Note [realToFrac natural-to-float] +{-# INLINE [0] rationalToFloat #-} +-- Re INLINE pragma, see Note [realToFrac natural-to-float] rationalToFloat n 0 | n == 0 = 0/0 | n < 0 = (-1)/0 @@ -718,8 +718,8 @@ instance Fractional Double where recip x = 1.0 / x rationalToDouble :: Integer -> Integer -> Double -{-# NOINLINE [0] rationalToDouble #-} --- Re NOINLINE pragma, see Note [realToFrac natural-to-float] +{-# INLINE [0] rationalToDouble #-} +-- Re INLINE pragma, see Note [realToFrac natural-to-float] rationalToDouble n 0 | n == 0 = 0/0 | n < 0 = (-1)/0 @@ -1673,7 +1673,11 @@ Now we'd have a BUILTIN constant folding rule for rationalToFloat; but to allow that rule to fire reliably we should delay inlining rationalToFloat until stage 0. (It may get an inlining from CPR analysis.) -Hence the NOINLINE[0] rationalToFloat, and similarly rationalToDouble. +Hence the INLINE[0] rationalToFloat, and similarly for rationalToDouble. +This activation means: + + - we don't inline until phase 0 (solving the above) + - we do inline starting at phase 0 (because we do want it inlining in the end) -} -- Utils View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45305ab8bc002b0e9d482e43552b4f6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/45305ab8bc002b0e9d482e43552b4f6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Fix a scoping error in Specialise
by Marge Bot (＠marge-bot) 10 Sep '25

10 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: b6249140 by Simon Peyton Jones at 2025-09-10T10:42:38-04:00 Fix a scoping error in Specialise This small patch fixes #26329, which triggered a scoping error. Test is in T21391, with -fpolymorphic-specialisation enabled - - - - - 1 changed file: - compiler/GHC/Core/Opt/Specialise.hs Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -1205,14 +1205,21 @@ specExpr env (Tick tickish body) ---------------- Applications might generate a call instance -------------------- specExpr env expr@(App {}) = do { let (fun_in, args_in) = collectArgs expr + ; (fun_out, uds_fun) <- specExpr env fun_in ; (args_out, uds_args) <- mapAndCombineSM (specExpr env) args_in - ; let env_args = env `bringFloatedDictsIntoScope` ud_binds uds_args - -- Some dicts may have floated out of args_in; - -- they should be in scope for fireRewriteRules (#21689) - (fun_in', args_out') = fireRewriteRules env_args fun_in args_out - ; (fun_out', uds_fun) <- specExpr env fun_in' + ; let uds_app = uds_fun `thenUDs` uds_args + env_args = zapSubst env `bringFloatedDictsIntoScope` ud_binds uds_app + -- zapSubst: we have now fully applied the substitution + -- bringFloatedDictsIntoScope: some dicts may have floated out of + -- args_in; they should be in scope for fireRewriteRules (#21689) + + -- Try firing rewrite rules + -- See Note [Fire rules in the specialiser] + ; let (fun_out', args_out') = fireRewriteRules env_args fun_out args_out + + -- Make a call record, and return ; let uds_call = mkCallUDs env fun_out' args_out' - ; return (fun_out' `mkApps` args_out', uds_fun `thenUDs` uds_call `thenUDs` uds_args) } + ; return (fun_out' `mkApps` args_out', uds_app `thenUDs` uds_call) } ---------------- Lambda/case require dumping of usage details -------------------- specExpr env e@(Lam {}) @@ -1246,17 +1253,18 @@ specExpr env (Let bind body) -- See Note [Specialisation modulo dictionary selectors] -- Note [ClassOp/DFun selection] -- Note [Fire rules in the specialiser] -fireRewriteRules :: SpecEnv -> InExpr -> [OutExpr] -> (InExpr, [OutExpr]) +fireRewriteRules :: SpecEnv -- Substitution is already zapped + -> OutExpr -> [OutExpr] -> (OutExpr, [OutExpr]) fireRewriteRules env (Var f) args | let rules = getRules (se_rules env) f , Just (rule, expr) <- specLookupRule env f args activeInInitialPhase rules , let rest_args = drop (ruleArity rule) args -- See Note [Extra args in the target] - zapped_subst = Core.zapSubst (se_subst env) - expr' = simpleOptExprWith defaultSimpleOpts zapped_subst expr + zapped_subst = se_subst env -- Just needed for the InScopeSet + expr' = simpleOptExprWith defaultSimpleOpts zapped_subst (mkApps expr rest_args) -- simplOptExpr needed because lookupRule returns -- (\x y. rhs) arg1 arg2 , (fun', args') <- collectArgs expr' - = fireRewriteRules env fun' (args'++rest_args) + = fireRewriteRules env fun' args' fireRewriteRules _ fun args = (fun, args) -------------- @@ -1669,10 +1677,19 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs ; let all_rule_bndrs = poly_qvars ++ rule_bndrs env' = env { se_subst = subst'' } -{- - ; pprTrace "spec_call" (vcat + -- Check for (a) usefulness and (b) not already covered + -- See (SC1) in Note [Specialisations already covered] + ; let all_rules = rules_acc ++ existing_rules + -- all_rules: we look both in the rules_acc (generated by this invocation + -- of specCalls), and in existing_rules (passed in to specCalls) + already_covered = alreadyCovered env' all_rule_bndrs fn + rule_lhs_args is_active all_rules + +{- ; pprTrace "spec_call" (vcat [ text "fun: " <+> ppr fn , text "call info: " <+> ppr _ci + , text "useful: " <+> ppr useful + , text "already_covered:" <+> ppr already_covered , text "poly_qvars: " <+> ppr poly_qvars , text "useful: " <+> ppr useful , text "all_rule_bndrs:" <+> ppr all_rule_bndrs @@ -1681,17 +1698,13 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs , text "dx_binds:" <+> ppr dx_binds , text "spec_args: " <+> ppr spec_args , text "rhs_bndrs" <+> ppr rhs_bndrs - , text "rhs_body" <+> ppr rhs_body ]) $ + , text "rhs_body" <+> ppr rhs_body + , text "subst''" <+> ppr subst'' ]) $ return () -} - -- Check for (a) usefulness and (b) not already covered - -- See (SC1) in Note [Specialisations already covered] - ; let all_rules = rules_acc ++ existing_rules - -- all_rules: we look both in the rules_acc (generated by this invocation - -- of specCalls), and in existing_rules (passed in to specCalls) - ; if not useful -- No useful specialisation - || alreadyCovered env' all_rule_bndrs fn rule_lhs_args is_active all_rules + ; if not useful -- No useful specialisation + || already_covered -- Useful, but done already then return spec_acc else @@ -1702,6 +1715,12 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs -- Run the specialiser on the specialised RHS ; (rhs_body', rhs_uds) <- specExpr env'' rhs_body +{- ; pprTrace "spec_call2" (vcat + [ text "fun:" <+> ppr fn + , text "rhs_body':" <+> ppr rhs_body' ]) $ + return () +-} + -- Make the RHS of the specialised function ; let spec_rhs_bndrs = spec_bndrs ++ inner_rhs_bndrs' (rhs_uds1, inner_dumped_dbs) = dumpUDs spec_rhs_bndrs rhs_uds View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b62491405ae851ae514afe18d51f0fe… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b62491405ae851ae514afe18d51f0fe… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][master] Report solid equality errors before custom errors
by Marge Bot (＠marge-bot) 10 Sep '25

10 Sep '25

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: ba210d98 by Simon Peyton Jones at 2025-09-08T16:26:36+01:00 Report solid equality errors before custom errors This MR fixes #26255 by * Reporting solid equality errors like Int ~ Bool before "custom type errors". See comments in `report1` in `reportWanteds` * Suppressing errors that arise from superclasses of Wanteds. See (SCE1) in Note [Suppressing confusing errors] More details in #26255. - - - - - 15 changed files: - compiler/GHC/Core/Type.hs - compiler/GHC/Core/Unify.hs - compiler/GHC/HsToCore/Pmc/Solver.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Types/Constraint.hs - compiler/GHC/Tc/Utils/TcType.hs - testsuite/tests/typecheck/should_fail/T18851.hs - + testsuite/tests/typecheck/should_fail/T26255a.hs - + testsuite/tests/typecheck/should_fail/T26255a.stderr - + testsuite/tests/typecheck/should_fail/T26255b.hs - + testsuite/tests/typecheck/should_fail/T26255b.stderr - + testsuite/tests/typecheck/should_fail/T26255c.hs - + testsuite/tests/typecheck/should_fail/T26255c.stderr - testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr - testsuite/tests/typecheck/should_fail/all.T Changes: ===================================== compiler/GHC/Core/Type.hs ===================================== @@ -132,7 +132,7 @@ module GHC.Core.Type ( kindBoxedRepLevity_maybe, mightBeLiftedType, mightBeUnliftedType, definitelyLiftedType, definitelyUnliftedType, - isAlgType, isDataFamilyAppType, + isAlgType, isDataFamilyApp, isSatTyFamApp, isPrimitiveType, isStrictType, isTerminatingType, isLevityTy, isLevityVar, isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy, @@ -2292,6 +2292,21 @@ isFamFreeTy (ForAllTy _ ty) = isFamFreeTy ty isFamFreeTy (CastTy ty _) = isFamFreeTy ty isFamFreeTy (CoercionTy _) = False -- Not sure about this +-- | Check whether a type is a data family type +isDataFamilyApp :: Type -> Bool +isDataFamilyApp ty = case tyConAppTyCon_maybe ty of + Just tc -> isDataFamilyTyCon tc + _ -> False + +isSatTyFamApp :: Type -> Maybe (TyCon, [Type]) +-- Return the argument if we have a saturated type family application +-- Why saturated? See (ATF4) in Note [Apartness and type families] +isSatTyFamApp (TyConApp tc tys) + | isTypeFamilyTyCon tc + && not (tys `lengthExceeds` tyConArity tc) -- Not over-saturated + = Just (tc, tys) +isSatTyFamApp _ = Nothing + buildSynTyCon :: Name -> [KnotTied TyConBinder] -> Kind -- ^ /result/ kind -> [Role] -> KnotTied Type -> TyCon -- This function is here because here is where we have @@ -2459,12 +2474,6 @@ isAlgType ty isAlgTyCon tc _other -> False --- | Check whether a type is a data family type -isDataFamilyAppType :: Type -> Bool -isDataFamilyAppType ty = case tyConAppTyCon_maybe ty of - Just tc -> isDataFamilyTyCon tc - _ -> False - -- | Computes whether an argument (or let right hand side) should -- be computed strictly or lazily, based only on its type. -- Currently, it's just 'isUnliftedType'. ===================================== compiler/GHC/Core/Unify.hs ===================================== @@ -1741,8 +1741,8 @@ unify_ty env ty1 ty2 kco where mb_tc_app1 = splitTyConApp_maybe ty1 mb_tc_app2 = splitTyConApp_maybe ty2 - mb_sat_fam_app1 = isSatFamApp ty1 - mb_sat_fam_app2 = isSatFamApp ty2 + mb_sat_fam_app1 = isSatTyFamApp ty1 + mb_sat_fam_app2 = isSatTyFamApp ty2 unify_ty _ _ _ _ = surelyApart @@ -1801,16 +1801,6 @@ unify_tys env orig_xs orig_ys -- Possibly different saturations of a polykinded tycon -- See Note [Polykinded tycon applications] ---------------------------------- -isSatFamApp :: Type -> Maybe (TyCon, [Type]) --- Return the argument if we have a saturated type family application --- Why saturated? See (ATF4) in Note [Apartness and type families] -isSatFamApp (TyConApp tc tys) - | isTypeFamilyTyCon tc - && not (tys `lengthExceeds` tyConArity tc) -- Not over-saturated - = Just (tc, tys) -isSatFamApp _ = Nothing - --------------------------------- uVarOrFam :: UMEnv -> CanEqLHS -> InType -> OutCoercion -> UM () -- Invariants: (a) If ty1 is a TyFamLHS, then ty2 is NOT a TyVarTy @@ -1927,7 +1917,7 @@ uVarOrFam env ty1 ty2 kco | otherwise -> maybeApart MARTypeFamily -- Check for equality F tys1 ~ F tys2 - | Just (tc2, tys2) <- isSatFamApp ty2 + | Just (tc2, tys2) <- isSatTyFamApp ty2 , tc1 == tc2 = go_fam_fam substs tc1 tys1 tys2 kco ===================================== compiler/GHC/HsToCore/Pmc/Solver.hs ===================================== @@ -363,7 +363,7 @@ pmTopNormaliseType (TySt _ inert) typ = {-# SCC "pmTopNormaliseType" #-} do eq_src_ty ty tys = maybe ty id (find is_closed_or_data_family tys) is_closed_or_data_family :: Type -> Bool - is_closed_or_data_family ty = pmIsClosedType ty || isDataFamilyAppType ty + is_closed_or_data_family ty = pmIsClosedType ty || isDataFamilyApp ty -- For efficiency, represent both lists as difference lists. -- comb performs the concatenation, for both lists. ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -439,10 +439,9 @@ reportBadTelescope _ _ skol_info skols -- See Note [Constraints to ignore]. ignoreConstraint :: Ct -> Bool ignoreConstraint ct - | AssocFamPatOrigin <- ctOrigin ct - = True - | otherwise - = False + = case ctOrigin ct of + AssocFamPatOrigin -> True -- See (CIG1) + _ -> False -- | Makes an error item from a constraint, calculating whether or not -- the item should be suppressed. See Note [Wanteds rewrite Wanteds] @@ -538,15 +537,15 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics ; when (null simples) $ reportMultiplicityCoercionErrs ctxt_for_insols mult_co_errs -- See Note [Suppressing confusing errors] - ; let (suppressed_items, items0) = partition suppress tidy_items + ; let (suppressed_items, reportable_items) = partition suppressItem tidy_items ; traceTc "reportWanteds suppressed:" (ppr suppressed_items) - ; (ctxt1, items1) <- tryReporters ctxt_for_insols report1 items0 + ; (ctxt1, items1) <- tryReporters ctxt_for_insols report1 reportable_items -- Now all the other constraints. We suppress errors here if -- any of the first batch failed, or if the enclosing context -- says to suppress ; let ctxt2 = ctxt1 { cec_suppress = cec_suppress ctxt || cec_suppress ctxt1 } - ; (ctxt3, leftovers) <- tryReporters ctxt2 report2 items1 + ; (_, leftovers) <- tryReporters ctxt2 report2 items1 ; massertPpr (null leftovers) (text "The following unsolved Wanted constraints \ \have not been reported to the user:" @@ -557,12 +556,16 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics -- wanted insoluble here; but do suppress inner insolubles -- if there's a *given* insoluble here (= inaccessible code) - -- Only now, if there are no errors, do we report suppressed ones - -- See Note [Suppressing confusing errors] - -- We don't need to update the context further because of the - -- whenNoErrs guard - ; whenNoErrs $ - do { (_, more_leftovers) <- tryReporters ctxt3 report3 suppressed_items + -- If there are no other errors to report, report suppressed errors. + -- See Note [Suppressing confusing errors]. NB: with -fdefer-type-errors + -- we might have reported warnings only from `reportable_items`, but we + -- still want to suppress the `suppressed_items`. + ; when (null reportable_items) $ + do { (_, more_leftovers) <- tryReporters ctxt_for_insols (report1++report2) + suppressed_items + -- ctxt_for_insols: the suppressed errors can be Int~Bool, which + -- will have made the incoming `ctxt` be True; don't make that + -- suppress the Int~Bool error! ; massertPpr (null more_leftovers) (ppr more_leftovers) } } where env = cec_tidy ctxt @@ -585,29 +588,42 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics DE_Multiplicity mult_co loc -> (es1, es2, es3, (mult_co, loc):es4) - -- See Note [Suppressing confusing errors] - suppress :: ErrorItem -> Bool - suppress item - | Wanted <- ei_flavour item - = is_ww_fundep_item item - | otherwise - = False - -- report1: ones that should *not* be suppressed by -- an insoluble somewhere else in the tree -- It's crucial that anything that is considered insoluble -- (see GHC.Tc.Utils.insolublWantedCt) is caught here, otherwise -- we might suppress its error message, and proceed on past -- type checking to get a Lint error later - report1 = [ ("custom_error", is_user_type_error, True, mkUserTypeErrorReporter) - -- (Handles TypeError and Unsatisfiable) + report1 = [ -- We put implicit lifting errors first, because are solid errors + -- See "Implicit lifting" in GHC.Tc.Gen.Splice + -- Note [Lifecycle of an untyped splice, and PendingRnSplice] + ("implicit lifting", is_implicit_lifting, True, mkImplicitLiftingReporter) - , ("implicit lifting", is_implicit_lifting, True, mkImplicitLiftingReporter) + -- Next, solid equality errors , given_eq_spec , ("insoluble2", utterly_wrong, True, mkGroupReporter mkEqErr) , ("skolem eq1", very_wrong, True, mkSkolReporter) , ("FixedRuntimeRep", is_FRR, True, mkGroupReporter mkFRRErr) , ("skolem eq2", skolem_eq, True, mkSkolReporter) + + -- Next, custom type errors + -- See Note [Custom type errors in constraints] in GHC.Tc.Types.Constraint + -- + -- Put custom type errors /after/ solid equality errors. In #26255 we + -- had a custom error (T <= F alpha) which was suppressing a far more + -- informative (K Int ~ [K alpha]). That mismatch between K and [] is + -- definitely wrong; and if it was fixed we'd know alpha:=Int, and hence + -- perhaps be able to solve T <= F alpha, by reducing F Int. + -- + -- But put custom type errors /before/ "non-tv eq", because if we have + -- () ~ TypeError blah + -- we want to report it as a custom error, /not/ as a mis-match + -- between TypeError and ()! Also see the Assert example + -- in Note [Custom type errors in constraints] + , ("custom_error", is_user_type_error, True, mkUserTypeErrorReporter) + -- (Handles TypeError and Unsatisfiable) + + -- "non-tv-eq": equalities (ty1 ~ ty2) where ty1 is not a tyvar , ("non-tv eq", non_tv_eq, True, mkSkolReporter) -- The only remaining equalities are alpha ~ ty, @@ -617,6 +633,7 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics -- See Note [Equalities with heterogeneous kinds] in GHC.Tc.Solver.Equality , ("Homo eqs", is_homo_equality, True, mkGroupReporter mkEqErr) , ("Other eqs", is_equality, True, mkGroupReporter mkEqErr) + ] -- report2: we suppress these if there are insolubles elsewhere in the tree @@ -625,11 +642,6 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics , ("Dicts", is_dict, False, mkGroupReporter mkDictErr) , ("Quantified", is_qc, False, mkGroupReporter mkQCErr) ] - -- report3: suppressed errors should be reported as categorized by either report1 - -- or report2. Keep this in sync with the suppress function above - report3 = [ ("wanted/wanted fundeps", is_ww_fundep, True, mkGroupReporter mkEqErr) - ] - -- rigid_nom_eq, rigid_nom_tv_eq, is_dict, is_equality, is_ip, is_FRR, is_irred :: ErrorItem -> Pred -> Bool @@ -690,10 +702,6 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics is_qc _ (ForAllPred {}) = True is_qc _ _ = False - -- See situation (1) of Note [Suppressing confusing errors] - is_ww_fundep item _ = is_ww_fundep_item item - is_ww_fundep_item = isWantedWantedFunDepOrigin . errorItemOrigin - given_eq_spec -- See Note [Given errors] | has_gadt_match_here = ("insoluble1a", is_given_eq, True, mkGivenErrorReporter) @@ -719,6 +727,16 @@ reportWanteds ctxt tc_lvl wc@(WC { wc_simple = simples, wc_impl = implics = has_gadt_match implics --------------- +suppressItem :: ErrorItem -> Bool + -- See Note [Suppressing confusing errors] +suppressItem item + | Wanted <- ei_flavour item + , let orig = errorItemOrigin item + = isWantedSuperclassOrigin orig -- See (SCE1) + || isWantedWantedFunDepOrigin orig -- See (SCE2) + | otherwise + = False + isSkolemTy :: TcLevel -> Type -> Bool -- The type is a skolem tyvar isSkolemTy tc_lvl ty @@ -741,9 +759,25 @@ isTyFun_maybe ty = case tcSplitTyConApp_maybe ty of Certain errors we might encounter are potentially confusing to users. If there are any other errors to report, at all, we want to suppress these. -Which errors (only 1 case right now): - -1) Errors which arise from the interaction of two Wanted fun-dep constraints. +Which errors are suppressed? + +(SCE1) Superclasses of Wanteds. These are generated only in case they trigger functional + dependencies. If such a constraint is unsolved, then its "parent" constraint must + also be unsolved, and is much more informative to the user. Example (#26255): + class (MinVersion <= F era) => Era era where { ... } + f :: forall era. EraFamily era -> IO () + f = ..blah... -- [W] Era era + Here we have simply omitted "Era era =>" from f's type. But we'll end up with + /two/ Wanted constraints: + [W] d1 : Era era + [W] d2 : MinVersion <= F era -- Superclass of d1 + We definitely want to report d1 and not d2! Happily it's easy to filter out those + superclass-Wanteds, becuase their Origin betrays them. + + See test T18851 for an example of how it is (just, barely) possible for the /only/ + errors to be superclass-of-Wanted constraints. + +(SCE2) Errors which arise from the interaction of two Wanted fun-dep constraints. Example: class C a b | a -> b where @@ -786,7 +820,7 @@ they will remain unfilled, and might have been used to rewrite another constrain Currently, the constraints to ignore are: -1) Constraints generated in order to unify associated type instance parameters +(CIG1) Constraints generated in order to unify associated type instance parameters with class parameters. Here are two illustrative examples: class C (a :: k) where @@ -814,6 +848,9 @@ Currently, the constraints to ignore are: If there is any trouble, checkValidFamInst bleats, aborting compilation. +(Note: Aug 25: this seems a rather tricky corner; + c.f. Note [Suppressing confusing errors]) + Note [Implementation of Unsatisfiable constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The Unsatisfiable constraint was introduced in GHC proposal #433 (https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0433-u…) ===================================== compiler/GHC/Tc/Types/Constraint.hs ===================================== @@ -903,75 +903,6 @@ isWantedCt = isWanted . ctEvidence isGivenCt :: Ct -> Bool isGivenCt = isGiven . ctEvidence -{- Note [Custom type errors in constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -When GHC reports a type-error about an unsolved-constraint, we check -to see if the constraint contains any custom-type errors, and if so -we report them. Here are some examples of constraints containing type -errors: - -TypeError msg -- The actual constraint is a type error - -TypError msg ~ Int -- Some type was supposed to be Int, but ended up - -- being a type error instead - -Eq (TypeError msg) -- A class constraint is stuck due to a type error - -F (TypeError msg) ~ a -- A type function failed to evaluate due to a type err - -It is also possible to have constraints where the type error is nested deeper, -for example see #11990, and also: - -Eq (F (TypeError msg)) -- Here the type error is nested under a type-function - -- call, which failed to evaluate because of it, - -- and so the `Eq` constraint was unsolved. - -- This may happen when one function calls another - -- and the called function produced a custom type error. --} - --- | A constraint is considered to be a custom type error, if it contains --- custom type errors anywhere in it. --- See Note [Custom type errors in constraints] -getUserTypeErrorMsg :: PredType -> Maybe ErrorMsgType -getUserTypeErrorMsg pred = msum $ userTypeError_maybe pred - : map getUserTypeErrorMsg (subTys pred) - where - -- Richard thinks this function is very broken. What is subTys - -- supposed to be doing? Why are exactly-saturated tyconapps special? - -- What stops this from accidentally ripping apart a call to TypeError? - subTys t = case splitAppTys t of - (t,[]) -> - case splitTyConApp_maybe t of - Nothing -> [] - Just (_,ts) -> ts - (t,ts) -> t : ts - --- | Is this an user error message type, i.e. either the form @TypeError err@ or --- @Unsatisfiable err@? -isTopLevelUserTypeError :: PredType -> Bool -isTopLevelUserTypeError pred = - isJust (userTypeError_maybe pred) || isJust (isUnsatisfiableCt_maybe pred) - --- | Does this constraint contain an user error message? --- --- That is, the type is either of the form @Unsatisfiable err@, or it contains --- a type of the form @TypeError msg@, either at the top level or nested inside --- the type. -containsUserTypeError :: PredType -> Bool -containsUserTypeError pred = - isJust (getUserTypeErrorMsg pred) || isJust (isUnsatisfiableCt_maybe pred) - --- | Is this type an unsatisfiable constraint? --- If so, return the error message. -isUnsatisfiableCt_maybe :: Type -> Maybe ErrorMsgType -isUnsatisfiableCt_maybe t - | Just (tc, [msg]) <- splitTyConApp_maybe t - , tc `hasKey` unsatisfiableClassNameKey - = Just msg - | otherwise - = Nothing - isPendingScDict :: Ct -> Bool isPendingScDict (CDictCan dict_ct) = isPendingScDictCt dict_ct isPendingScDict _ = False @@ -1413,6 +1344,93 @@ variable masquerading as expression holes IS treated as truly insoluble, so that it trumps other errors during error reporting. Yuk! +-} + +{- ********************************************************************* +* * + Custom type errors: Unsatisfiable and TypeError +* * +********************************************************************* -} + +{- Note [Custom type errors in constraints] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When GHC reports a type-error about an unsolved-constraint, we check +to see if the constraint contains any custom-type errors, and if so +we report them. Here are some examples of constraints containing type +errors: + + TypeError msg -- The actual constraint is a type error + + TypError msg ~ Int -- Some type was supposed to be Int, but ended up + -- being a type error instead + + Eq (TypeError msg) -- A class constraint is stuck due to a type error + + F (TypeError msg) ~ a -- A type function failed to evaluate due to a type err + +It is also possible to have constraints where the type error is nested deeper, +for example see #11990, and also: + + Eq (F (TypeError msg)) -- Here the type error is nested under a type-function + -- call, which failed to evaluate because of it, + -- and so the `Eq` constraint was unsolved. + -- This may happen when one function calls another + -- and the called function produced a custom type error. + +A good use-case is described in "Detecting the undetectable" + https://blog.csongor.co.uk/report-stuck-families/ +which features + type family Assert (err :: Constraint) (break :: Type -> Type) (a :: k) :: k where + Assert _ Dummy _ = Any + Assert _ _ k = k +and an unsolved constraint like + Assert (TypeError ...) (F ty1) ty1 ~ ty2 +that reports that (F ty1) remains stuck. +-} + +-- | A constraint is considered to be a custom type error, if it contains +-- custom type errors anywhere in it. +-- See Note [Custom type errors in constraints] +getUserTypeErrorMsg :: PredType -> Maybe ErrorMsgType +getUserTypeErrorMsg pred = msum $ userTypeError_maybe pred + : map getUserTypeErrorMsg (subTys pred) + where + -- Richard thinks this function is very broken. What is subTys + -- supposed to be doing? Why are exactly-saturated tyconapps special? + -- What stops this from accidentally ripping apart a call to TypeError? + subTys t = case splitAppTys t of + (t,[]) -> + case splitTyConApp_maybe t of + Nothing -> [] + Just (_,ts) -> ts + (t,ts) -> t : ts + +-- | Is this an user error message type, i.e. either the form @TypeError err@ or +-- @Unsatisfiable err@? +isTopLevelUserTypeError :: PredType -> Bool +isTopLevelUserTypeError pred = + isJust (userTypeError_maybe pred) || isJust (isUnsatisfiableCt_maybe pred) + +-- | Does this constraint contain an user error message? +-- +-- That is, the type is either of the form @Unsatisfiable err@, or it contains +-- a type of the form @TypeError msg@, either at the top level or nested inside +-- the type. +containsUserTypeError :: PredType -> Bool +containsUserTypeError pred = + isJust (getUserTypeErrorMsg pred) || isJust (isUnsatisfiableCt_maybe pred) + +-- | Is this type an unsatisfiable constraint? +-- If so, return the error message. +isUnsatisfiableCt_maybe :: Type -> Maybe ErrorMsgType +isUnsatisfiableCt_maybe t + | Just (tc, [msg]) <- splitTyConApp_maybe t + , tc `hasKey` unsatisfiableClassNameKey + = Just msg + | otherwise + = Nothing + +{- ************************************************************************ * * Implication constraints ===================================== compiler/GHC/Tc/Utils/TcType.hs ===================================== @@ -2090,6 +2090,7 @@ isRigidTy ty | Just (tc,_) <- tcSplitTyConApp_maybe ty = isGenerativeTyCon tc Nominal | Just {} <- tcSplitAppTy_maybe ty = True | isForAllTy ty = True + | Just {} <- isLitTy ty = True | otherwise = False {- ===================================== testsuite/tests/typecheck/should_fail/T18851.hs ===================================== @@ -33,3 +33,14 @@ f = show (undefined :: c) -- blows up at run time once type checks g :: String g = f @A @B + +{- +[W] Show c, Num int, C int A, C int B, C int c +Superclasses + C_FD int ~ A + C_FD int ~ B + C_FD int ~ c +--> + C_FD int ~ B + B ~ A +-} ===================================== testsuite/tests/typecheck/should_fail/T26255a.hs ===================================== @@ -0,0 +1,47 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T26255a where + +import Data.Proxy +import GHC.TypeLits + +type MinVersion = 1 + +class + ( KnownNat (ProtVerLow era) + , MinVersion <= ProtVerLow era + , KnownSymbol (EraName era) + ) => + Era era + where + type EraName era = (r :: Symbol) | r -> era + + type ProtVerLow era :: Nat + + eraName :: Proxy era -> String + eraName _ = symbolVal (Proxy :: Proxy (EraName era)) + +data FooEra + +instance Era FooEra where + type EraName FooEra = "Foo" + type ProtVerLow FooEra = 1 + +data BarEra + +instance Era BarEra where + type EraName BarEra = "Bar" + type ProtVerLow BarEra = 2 + +fromEraName :: (Era era, EraName era ~ name) => Proxy (name :: Symbol) -> Proxy era +fromEraName _ = Proxy + +noCompileErrorMessage :: IO () +noCompileErrorMessage = putStrLn $ eraName $ fromEraName (Proxy :: Proxy "Bar") + +brokenCompileErrorMessage1 :: IO () +brokenCompileErrorMessage1 = putStrLn $ eraName $ fromEraName (Proxy :: Proxy "Blah") + ===================================== testsuite/tests/typecheck/should_fail/T26255a.stderr ===================================== @@ -0,0 +1,10 @@ +T26255a.hs:46:51: error: [GHC-18872] + • Couldn't match type ‘EraName era0’ with ‘"Blah"’ + arising from a use of ‘fromEraName’ + The type variable ‘era0’ is ambiguous + • In the second argument of ‘($)’, namely + ‘fromEraName (Proxy :: Proxy "Blah")’ + In the second argument of ‘($)’, namely + ‘eraName $ fromEraName (Proxy :: Proxy "Blah")’ + In the expression: + putStrLn $ eraName $ fromEraName (Proxy :: Proxy "Blah") ===================================== testsuite/tests/typecheck/should_fail/T26255b.hs ===================================== @@ -0,0 +1,46 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T26255b where + +import Data.Proxy +import GHC.TypeLits + +type MinVersion = 1 + +class + ( KnownNat (ProtVerLow era) + , MinVersion <= ProtVerLow era + , KnownSymbol (EraName era) + ) => + Era era + where + type EraName era = (r :: Symbol) | r -> era + + type ProtVerLow era :: Nat + + eraName :: Proxy era -> String + eraName _ = symbolVal (Proxy :: Proxy (EraName era)) + +data FooEra + +instance Era FooEra where + type EraName FooEra = "Foo" + type ProtVerLow FooEra = 1 + +data BarEra + +instance Era BarEra where + type EraName BarEra = "Bar" + type ProtVerLow BarEra = 2 + +fromEraName :: (Era era, EraName era ~ name) => Proxy (name :: Symbol) -> Proxy era +fromEraName _ = Proxy + +noCompileErrorMessage :: IO () +noCompileErrorMessage = putStrLn $ eraName $ fromEraName (Proxy :: Proxy "Bar") + +brokenCompileErrorMessage2 :: IO () +brokenCompileErrorMessage2 = putStrLn $ eraName $ head $ fromEraName (Proxy :: Proxy "Bar") ===================================== testsuite/tests/typecheck/should_fail/T26255b.stderr ===================================== @@ -0,0 +1,9 @@ +T26255b.hs:46:58: error: [GHC-83865] + • Couldn't match expected type: [Proxy era0] + with actual type: Proxy BarEra + • In the second argument of ‘($)’, namely + ‘fromEraName (Proxy :: Proxy "Bar")’ + In the second argument of ‘($)’, namely + ‘head $ fromEraName (Proxy :: Proxy "Bar")’ + In the second argument of ‘($)’, namely + ‘eraName $ head $ fromEraName (Proxy :: Proxy "Bar")’ ===================================== testsuite/tests/typecheck/should_fail/T26255c.hs ===================================== @@ -0,0 +1,30 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableSuperClasses #-} + +module T26255c where + +import Data.Kind +import Data.Proxy +import GHC.TypeLits + +type MinVersion = 1 + +class + ( KnownNat (ProtVerLow era) + , MinVersion <= ProtVerLow era + ) => + Era era + where + type ProtVerLow era :: Nat + +newtype EraFamily era = EraFamily Int + +class Era era => NewEra era where + eraFamilySize :: EraFamily era -> Int + +printEraFamilySize :: EraFamily era -> IO () +printEraFamilySize = print . eraFamilySize ===================================== testsuite/tests/typecheck/should_fail/T26255c.stderr ===================================== @@ -0,0 +1,11 @@ +T26255c.hs:30:30: error: [GHC-39999] + • No instance for ‘NewEra era’ + arising from a use of ‘eraFamilySize’ + Possible fix: + add (NewEra era) to the context of + the type signature for: + printEraFamilySize :: forall {k} (era :: k). EraFamily era -> IO () + • In the second argument of ‘(.)’, namely ‘eraFamilySize’ + In the expression: print . eraFamilySize + In an equation for ‘printEraFamilySize’: + printEraFamilySize = print . eraFamilySize ===================================== testsuite/tests/typecheck/should_fail/UnliftedNewtypesFamilyKindFail2.stderr ===================================== @@ -1,3 +1,7 @@ +UnliftedNewtypesFamilyKindFail2.hs:12:1: error: [GHC-83865] + • Expected a type, but ‘F 5’ has kind ‘5’ + • In the newtype family instance declaration for ‘F’ + UnliftedNewtypesFamilyKindFail2.hs:12:20: error: [GHC-83865] • Expected a type, but ‘5’ has kind ===================================== testsuite/tests/typecheck/should_fail/all.T ===================================== @@ -742,3 +742,5 @@ test('T25004', normal, compile_fail, ['']) test('T25004k', normal, compile_fail, ['']) test('T26004', normal, compile_fail, ['']) test('T26318', normal, compile_fail, ['']) +test('T26255a', normal, compile_fail, ['']) +test('T26255b', normal, compile_fail, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba210d981b0812aea604f884d3c0aad… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ba210d981b0812aea604f884d3c0aad… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/9.10.3-backports] Prepare 9.10.3 final
by Zubin (＠wz1000) 10 Sep '25

10 Sep '25

Zubin pushed to branch wip/9.10.3-backports at Glasgow Haskell Compiler / GHC Commits: 3f4d7d38 by Zubin Duggal at 2025-09-10T20:00:24+05:30 Prepare 9.10.3 final - - - - - 4 changed files: - .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py - .gitlab/rel_eng/upload.sh - configure.ac - docs/users_guide/9.10.3-notes.rst Changes: ===================================== .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py ===================================== @@ -129,7 +129,7 @@ def fetch_artifacts(release: str, pipeline_id: int, for f in doc_files: subprocess.run(['tar', '-xf', f, '-C', dest]) logging.info(f'extracted docs {f} to {dest}') - index_path = destdir / 'docs' / 'index.html' + index_path = destdir / 'index.html' index_path.replace(dest / 'index.html') pdfs = list(destdir.glob('*.pdf')) for f in pdfs: ===================================== .gitlab/rel_eng/upload.sh ===================================== @@ -1,5 +1,4 @@ -#!/usr/bin/env nix-shell -#! nix-shell -i bash -p moreutils lzip zip lftp gnupg +#!/usr/bin/bash set -Eeuo pipefail @@ -41,7 +40,7 @@ set -Eeuo pipefail : ${ver:=$(ls ghc-*.tar.* | sed -ne 's/ghc-$[0-9]\+\.[0-9]\+\.[0-9]\+\(\.[0-9]\+$\?\).\+/\1/p' | head -n1)} if [ -z "$ver" ]; then echo "Failed to infer \$ver"; exit 1; fi -host="gitlab-storage.haskell.org" +host="gitlab.haskell.org:2222" usage() { echo "Usage: [rel_name=<name>] ver=7.10.3-rc2 $0 <action>" ===================================== configure.ac ===================================== @@ -13,7 +13,7 @@ dnl # see what flags are available. (Better yet, read the documentation!) # -AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.10.2], [glasgow-haskell-bugs(a)haskell.org] [ghc-AC_PACKAGE_VERSION]) +AC_INIT([The Glorious Glasgow Haskell Compilation System], [9.10.3], [glasgow-haskell-bugs(a)haskell.org] [ghc-AC_PACKAGE_VERSION]) # Version on master must be X.Y (not X.Y.Z) for ProjectVersionMunged variable # to be useful (cf #19058). However, the version must have three components # (X.Y.Z) on stable branches (e.g. ghc-9.2) to ensure that pre-releases are @@ -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=NO} +: ${RELEASE=YES} # 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 ===================================== @@ -22,9 +22,6 @@ Compiler - 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`) @@ -40,6 +37,9 @@ Compiler - Introduce a separate argument limit for forced specs via SPEC argument with warning when limit is exceeded. (:ghc-ticket:`25197`) +- Fix compiler crash in the renamer with certain programs referencing out of + scope record fields (:ghc-ticket:`25056`) + Build system and packaging ~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -79,6 +79,8 @@ WebAssembly backend Runtime system ~~~~~~~~~~~~~~ +- rts: Fix a segfault involving STM (:ghc-ticket:`26205`). + - rts: Implement WEAK EXTERNAL undef redirection by target symbol name. - rts: Handle API set symbol versioning conflicts. @@ -97,12 +99,12 @@ Runtime system ``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`) +- Fix incorrect results for ``naturalAndNot`` (:ghc-ticket:`26230`) + ``ghc`` library ~~~~~~~~~~~~~~~ @@ -112,9 +114,6 @@ Runtime system 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`) @@ -162,4 +161,4 @@ for further change information. 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 + libraries/xhtml/xhtml.cabal: Dependency of ``haddock`` executable View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f4d7d38b9661435bdde981451ac50c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3f4d7d38b9661435bdde981451ac50c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/ghc-toolchain-js-no-llvm] ghc-toolchain: skip llvm program detection for unsupported targets
by Cheng Shao (＠TerrorJack) 10 Sep '25

10 Sep '25

Cheng Shao pushed to branch wip/ghc-toolchain-js-no-llvm at Glasgow Haskell Compiler / GHC Commits: 59110415 by Cheng Shao at 2025-09-10T16:28:01+02:00 ghc-toolchain: skip llvm program detection for unsupported targets This patch skips llvm program detection for wasm/js targets in ghc-toolchain; these targets are based on LLVM related toolchains like wasi-sdk/emscripten, but they don't support the LLVM backend in GHC and doesn't invoke llc/opt/llvm-as programs anyway, so we need to skip these. Otherwise in some build environments ghc-toolchain may find llc/opt/llvm-as programs for unsupported targets and configure --enable-strict-ghc-toolchain-check may fail. - - - - - 1 changed file: - utils/ghc-toolchain/exe/Main.hs Changes: ===================================== utils/ghc-toolchain/exe/Main.hs ===================================== @@ -419,7 +419,17 @@ ldOverrideWhitelist a = OSMinGW32 -> True _ -> False - +-- | Some targets like wasm32/js are based on LLVM related toolchains +-- like wasi-sdk/emscripten, but these targets don't really support +-- the LLVM backend and doesn't invoke llc/opt/llvm-as programs +-- anyway, so we need to skip these. Otherwise in some build +-- environments ghc-toolchain may find llc/opt/llvm-as programs for +-- unsupported targets and configure +-- --enable-strict-ghc-toolchain-check may fail. +excludeNoLLVMTarget :: ArchOS -> M (Maybe a) -> M (Maybe a) +excludeNoLLVMTarget archOS m + | archOS_arch archOS `elem` [ArchWasm32, ArchJavaScript] = pure Nothing + | otherwise = m mkTarget :: Opts -> M Target mkTarget opts = do @@ -458,9 +468,9 @@ mkTarget opts = do throwE "Neither a object-merging tool (e.g. ld -r) nor an ar that supports -L is available" -- LLVM toolchain - llc <- optional $ findProgram "llc" (optLlc opts) ["llc"] - opt <- optional $ findProgram "opt" (optOpt opts) ["opt"] - llvmAs <- optional $ findProgram "llvm assembler" (optLlvmAs opts) ["clang"] + llc <- excludeNoLLVMTarget archOs $ optional $ findProgram "llc" (optLlc opts) ["llc"] + opt <- excludeNoLLVMTarget archOs $ optional $ findProgram "opt" (optOpt opts) ["opt"] + llvmAs <- excludeNoLLVMTarget archOs $ optional $ findProgram "llvm assembler" (optLlvmAs opts) ["clang"] -- Windows-specific utilities windres <- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59110415fbab937a625c640634a4186… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59110415fbab937a625c640634a4186… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/ghc-toolchain-js-no-llvm
by Cheng Shao (＠TerrorJack) 10 Sep '25

10 Sep '25

Cheng Shao pushed new branch wip/ghc-toolchain-js-no-llvm at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/ghc-toolchain-js-no-llvm You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/26264] compiler: Attempt to systematize Unique tags by introducing an ADT for each different tag
by Zubin (＠wz1000) 10 Sep '25

10 Sep '25

Zubin pushed to branch wip/26264 at Glasgow Haskell Compiler / GHC Commits: 1e4cba38 by Zubin Duggal at 2025-09-10T18:42:28+05:30 compiler: Attempt to systematize Unique tags by introducing an ADT for each different tag Fixes #26264 - - - - - 32 changed files: - compiler/GHC/Builtin/Uniques.hs - compiler/GHC/Cmm/Info.hs - compiler/GHC/Cmm/Info/Build.hs - compiler/GHC/Cmm/Pipeline.hs - compiler/GHC/Cmm/UniqueRenamer.hs - compiler/GHC/CmmToLlvm/Base.hs - compiler/GHC/Core/Opt/Monad.hs - compiler/GHC/Core/Opt/Pipeline.hs - compiler/GHC/Core/Opt/Simplify/Monad.hs - compiler/GHC/CoreToStg/Prep.hs - compiler/GHC/Driver/CodeOutput.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/HsToCore/Foreign/JavaScript.hs - compiler/GHC/HsToCore/Monad.hs - compiler/GHC/Iface/Binary.hs - compiler/GHC/Iface/Rename.hs - compiler/GHC/JS/JStg/Monad.hs - compiler/GHC/Platform/Reg.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Stg/EnforceEpt.hs - compiler/GHC/Stg/Pipeline.hs - compiler/GHC/StgToCmm/ExtCode.hs - compiler/GHC/StgToCmm/Monad.hs - compiler/GHC/StgToJS/CodeGen.hs - compiler/GHC/StgToJS/Ids.hs - compiler/GHC/Tc/Types.hs - compiler/GHC/Tc/Types/Origin.hs - compiler/GHC/Tc/Utils/Monad.hs - compiler/GHC/Types/Name/Cache.hs - compiler/GHC/Types/Unique.hs - compiler/GHC/Types/Unique/DSM.hs - compiler/GHC/Types/Unique/Supply.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e4cba3810df56f34a53992ee89e226… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1e4cba3810df56f34a53992ee89e226… You're receiving this email because of your account on gitlab.haskell.org.

1 0