Alan Zimmerman pushed to branch wip/az/epa-tidy-locatedxxx-22 at Glasgow Haskell Compiler / GHC Commits: ced53ce6 by mangoiv at 2026-08-29T07:15:24-04:00 nightlies: output yaml to file only Previously we would just output the metadata to stdout which risks that it's clobbered by incidental debugt output. We now output to file only. Fixes #27511 - - - - - 578bd185 by Andreas Klebinger at 2026-08-29T07:16:05-04:00 Specialise: Stop looping on recursive dictionaries in interestingDict interestingDict now doesn't look through loopbreaker unfoldings. Doing so would cause infinite loops on certain dictionaries. Fixes #27705. - - - - - ee1c879e by Alan Zimmerman at 2026-08-31T12:31:49+01:00 EPA Fix HsCmdDo exact print with comments Exact printing of HsCmdDo was ignoring the location for the do statements, and this is an annotation that can have comments in it. Update it so we print the statements as a unit, including any comments. Also add the result of auditing that we capture comments in all needed places, noting that the remaining Anno SrcSpan instances are benign. - - - - - 11 changed files: - .gitlab-ci.yml - .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py - + changelog.d/T27705 - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Hs/Doc.hs - compiler/GHC/Hs/Extension/Pass.hs - + testsuite/tests/simplCore/should_run/T27705.hs - + testsuite/tests/simplCore/should_run/T27705.stdout - + testsuite/tests/simplCore/should_run/T27705_Inst.hs - testsuite/tests/simplCore/should_run/all.T - utils/check-exact/ExactPrint.hs Changes: ===================================== .gitlab-ci.yml ===================================== @@ -1300,7 +1300,7 @@ ghcup-metadata-nightly: artifacts: false - job: project-version script: - - nix shell -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" > "metadata_test.yaml" + - nix shell -f .gitlab/rel_eng -c ghcup-metadata --metadata ghcup-0.0.7.yaml --date="$(date -d $CI_PIPELINE_CREATED_AT +%Y-%m-%d)" --pipeline-id="$CI_PIPELINE_ID" --version="$ProjectVersion" metadata_test.yaml rules: - if: $NIGHTLY ===================================== .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py ===================================== @@ -324,6 +324,7 @@ def main() -> None: # TODO: We could work out the --version from the project-version CI job. parser.add_argument('--version', required=True, type=str, help='Version of the GHC compiler') parser.add_argument('--date', required=True, type=str, help='Date of the compiler release') + parser.add_argument('output_path', nargs='?', type=Path, help='Path to write the output to, if not set, dump to stdout') args = parser.parse_args() project = gl.projects.get(1, lazy=True) @@ -352,13 +353,14 @@ def main() -> None: with open(args.metadata, 'r') as file: ghcup_metadata = yaml.safe_load(file) if args.version in ghcup_metadata['ghcupDownloads']['GHC']: - # if there are days without a commit, then the nightly metadata - # is up to date by default, no need to fail, no need to upload anything - print("Refusing to override existing version in metadata, exiting") - sys.exit() + eprint("GHCUp nightly run produced the same metadata as last night") setNightlyTags(ghcup_metadata) ghcup_metadata['ghcupDownloads']['GHC'][args.version] = new_yaml - print(yaml.dump(ghcup_metadata)) + if args.output_path: + with open(args.output_path, 'w') as ofile: + yaml.dump(ghcup_metadata, ofile) + else: + print(yaml.dump(ghcup_metadata)) ===================================== changelog.d/T27705 ===================================== @@ -0,0 +1,5 @@ +section: compiler +synopsis: Fixed an issue that caused the specializer to sometimes loop on recursive dictionary superclasses. +issues: #27705 +mrs: !16559 + ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -3120,8 +3120,8 @@ interestingDict :: SpecEnv -> CoreExpr -> Bool -- This is a subtle and important function -- See Note [Interesting dictionary arguments] interestingDict env (Var v) -- See (ID3) and (ID5) + -- (ID6.a) Might fail for loop breaker dicts but that seems fine. | Just rhs <- maybeUnfoldingTemplate (idUnfolding v) - -- Might fail for loop breaker dicts but that seems fine. = interestingDict env rhs interestingDict env arg -- Main Plan: use exprIsConApp_maybe @@ -3136,9 +3136,9 @@ interestingDict env arg -- Main Plan: use exprIsConApp_maybe , isIPClass cls -- See (ID5) -> False - -- Otherwise we are unwrapping a unary type class + -- Shouldn't happen. | otherwise - -> exprIsHNF arg -- See (ID7) + -> pprTraceDebug "shouldn't happen anymore" (ppr arg) $ exprIsHNF arg -- See (ID7) | Just (_, _, data_con, _tys, args) <- exprIsConApp_maybe in_scope_env arg , Just cls <- tyConClass_maybe (dataConTyCon data_con) @@ -3152,7 +3152,8 @@ interestingDict env arg -- Main Plan: use exprIsConApp_maybe where arg_ty = exprType arg definitely_not_ip_like = not (couldBeIPLike arg_ty) - in_scope_env = ISE (substInScopeSet $ se_subst env) realIdUnfolding + -- idUnfolding rather than realIdUnfolding: See (ID6.a) + in_scope_env = ISE (substInScopeSet $ se_subst env) idUnfolding {- Note [Ticks on applications] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -3268,11 +3269,27 @@ case we can clearly specialise. But there are wrinkles: (Remember: a constraint tuple is just a class with N superclasses and no methods.) See discussion on #26831. -(ID7) A unary (single-method) class is currently represented by (meth |> co). We - will unwrap the cast (see (ID5)) and then want to reply "yes" if the method - has any struture. We rather arbitrarily use `exprIsHNF` for this. (We plan a - new story for unary classes, see #23109, and this special case will become - irrelevant.) +(ID6.a) If we deal with a recursive dictionary as in #27705 we want to avoid + infinite recursion while recursing into superclasses. + + For example we might have: + + class D1 a => D2 a + class D2 a => D1 a + + The primary concern is that we want to avoid looping on recursive instances. + We can achieve this by simply not looking through loop breakers by using idUnfolding + rather than realIdUnfolding. + + It's possible that this prevents specialization of edge cases that have loop breakers + in their recursive loop. But even if we can find a dictionary like this the simplifier + won't look through loopbreaker dictionaries either killing any potential benefit. + So while we could handle this case via a already-seen set or fuel we simply don't bother + for now. + +(ID7) A unary (single-method) class is currently handled by the same path as regular dicts + since they are represented by faking a regular Dictionary. + See Note [Unary class magic] for the details. (ID8) Sadly, if `exprIsConApp_maybe` says Nothing, we still want to treat a non-trivial argument as interesting. In T19695 we have this: ===================================== compiler/GHC/Hs/Doc.hs ===================================== @@ -58,6 +58,7 @@ import Language.Haskell.Syntax.Doc import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Module.Name +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine type instance Anno (WithHsDocIdentifiers (HsDocString (GhcPass pass)) (GhcPass pass)) = SrcSpan deriving instance (Data pass, Data (LIdP pass), Data a) => Data (WithHsDocIdentifiers a pass) ===================================== compiler/GHC/Hs/Extension/Pass.hs ===================================== @@ -46,6 +46,7 @@ type instance XRec (GhcPass p) a = XRecGhc a -- but pass-independent, source location type XRecGhc a = GenLocated (Anno a) a +-- Exact print annotations ignore LHsDoc, so bare SrcSpan is fine type instance Anno (HsDocString (GhcPass _)) = SrcSpan type instance Anno HsDocStringChunk = SrcSpan ===================================== testsuite/tests/simplCore/should_run/T27705.hs ===================================== @@ -0,0 +1,9 @@ +module Main where + +import T27705_Inst + +-- The dictionaries (D1/D2) are mutually recursive. We have to watch +-- out for the specializer looping on them. This was first detected in #22802 +-- but no test was added, which caused it to break again #27705 :( +main :: IO () +main = print (b (3 :: Int)) ===================================== testsuite/tests/simplCore/should_run/T27705.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/simplCore/should_run/T27705_Inst.hs ===================================== @@ -0,0 +1,13 @@ +{-# LANGUAGE UndecidableInstances, UndecidableSuperClasses, FlexibleInstances #-} +module T27705_Inst where + +-- The two dictionaries are mutually recursive, and we have to ensure the specialiser +-- doesn't loop when it's peaking through their unfoldings. +class D2 a => D1 a +class D1 a => D2 a +instance D2 Int => D1 Int +instance D1 Int => D2 Int + +{-# NOINLINE b #-} +b :: D1 a => a -> Int +b _ = 42 ===================================== testsuite/tests/simplCore/should_run/all.T ===================================== @@ -123,3 +123,5 @@ test('T24359b', normal, compile_and_run, ['-O']) test('T23429', normal, compile_and_run, ['-O']) test('T27071', normal, compile_and_run, ['-O -fworker-wrapper-cbv']) test('T27005', [], multimod_compile_and_run, ['T27005', '-O']) +test('T27705', [extra_hc_opts('+RTS -M500M -RTS')], multimod_compile_and_run, + ['T27705', '-O2 -fexpose-all-unfoldings']) ===================================== utils/check-exact/ExactPrint.hs ===================================== @@ -3397,13 +3397,13 @@ instance ExactPrint (HsCmd GhcPs) where e' <- markAnnotated e return (HsCmdLet (tkLet', tkIn') binds' e') - exact (HsCmdDo (an0,loc) (L l es)) = do + exact (HsCmdDo (an0,loc) es) = do debugM $ "HsCmdDo" loc' <- printStringAtAA loc "do" (an1,es') <- markAnnList' an0 $ do - ee <- mapM markAnnotated es + ee <- markAnnotated es return ee - return (HsCmdDo (an1,loc') (L l es')) + return (HsCmdDo (an1,loc') es') -- --------------------------------------------------------------------- @@ -4462,10 +4462,10 @@ instance ExactPrint [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsCmd GhcPs)))] whe Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do debugM $ "LocatedL [ExprLStmt: snocView" ls' <- markAnnotated ls - initStmts' <- markAnnotated initStmts + initStmts' <- mapM markAnnotated initStmts return (initStmts' ++ [ls']) _ -> do - stmts' <- markAnnotated stmts + stmts' <- mapM markAnnotated stmts return stmts' instance ExactPrint [Located HsDocStringChunk] where View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9c6b1d38e91dc92fdfb0aee06b9403... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e9c6b1d38e91dc92fdfb0aee06b9403... You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications: https://gitlab.haskell.org/-/profile/notifications | Help: https://gitlab.haskell.org/help