Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 8b731e3c by Matthew Pickering at 2025-07-21T13:36:43-04:00 level imports: Fix infinite loop with cyclic module imports I didn't anticipate that downsweep would run before we checked for cyclic imports. Therefore we need to use the reachability function which handles cyclic graphs. Fixes #26087 - - - - - d751a9f1 by Pierre Thierry at 2025-07-21T13:37:28-04:00 Fix documentation about deriving from generics - - - - - bca43b91 by Zubin Duggal at 2025-07-22T09:01:16-04:00 haddock: Don't warn about missing link destinations for derived names. Fixes #26114 - - - - - 22ec4499 by Matthew Pickering at 2025-07-22T09:01:17-04:00 template haskell: use a precise condition when implicitly lifting Implicit lifting corrects a level error by replacing references to `x` with `$(lift x)`, therefore you can use a level `n` binding at level `n + 1`, if it can be lifted. Therefore, we now have a precise check that the use level is 1 more than the bind level. Before this bug was not observable as you only had 0 and 1 contexts but it is easily evident when using explicit level imports. Fixes #26088 - - - - - 6f29b57e by Andreas Klebinger at 2025-07-22T09:01:18-04:00 Add since tag and more docs for do-clever-arg-eta-expansion Fixes #26113 - - - - - 7f86eda9 by Andreas Klebinger at 2025-07-22T09:01:18-04:00 Add since tag for -fexpose-overloaded-unfoldings Fixes #26112 - - - - - 16 changed files: - compiler/GHC/Rename/Splice.hs - compiler/GHC/Unit/Module/Graph.hs - docs/users_guide/using-optimisation.rst - libraries/base/src/GHC/Generics.hs - testsuite/tests/haddock/haddock_testsuite/Makefile - + testsuite/tests/haddock/haddock_testsuite/T26114.hs - + testsuite/tests/haddock/haddock_testsuite/T26114.stdout - testsuite/tests/haddock/haddock_testsuite/all.T - + testsuite/tests/splice-imports/T26087.stderr - + testsuite/tests/splice-imports/T26087A.hs - + testsuite/tests/splice-imports/T26087B.hs - + testsuite/tests/splice-imports/T26088.stderr - + testsuite/tests/splice-imports/T26088A.hs - + testsuite/tests/splice-imports/T26088B.hs - testsuite/tests/splice-imports/all.T - utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs Changes: ===================================== compiler/GHC/Rename/Splice.hs ===================================== @@ -35,6 +35,7 @@ import GHC.Rename.Pat ( rnPat ) import GHC.Types.Error import GHC.Types.Basic ( TopLevelFlag, isTopLevel, maxPrec ) import GHC.Types.SourceText ( SourceText(..) ) +import GHC.Types.ThLevelIndex import GHC.Utils.Outputable import GHC.Unit.Module import GHC.Types.SrcLoc @@ -1001,7 +1002,7 @@ checkCrossLevelLifting dflags reason top_lvl is_local allow_lifting bind_lvl use , xopt LangExt.ImplicitStagePersistence dflags = when (isExternalName name) (keepAlive name) >> return (HsVar noExtField name_var) -- 4. Name is in a bracket, and lifting is allowed | Brack _ pending <- use_lvl - , any (use_lvl_idx >=) (Set.toList bind_lvl) + , any (\bind_idx -> use_lvl_idx == incThLevelIndex bind_idx) (Set.toList bind_lvl) , allow_lifting = do let mgre = case reason of ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -866,7 +866,7 @@ mkTransZeroDeps = first graphReachability {- module graph is acyclic -} . module -- | Transitive dependencies, but with the stage that each module is required at. mkStageDeps :: [ModuleGraphNode] -> (ReachabilityIndex StageSummaryNode, (NodeKey, ModuleStage) -> Maybe StageSummaryNode) -mkStageDeps = first graphReachability . moduleGraphNodesStages +mkStageDeps = first cyclicGraphReachability . moduleGraphNodesStages type ZeroSummaryNode = Node Int ZeroScopeKey ===================================== docs/users_guide/using-optimisation.rst ===================================== @@ -547,16 +547,24 @@ as such you shouldn't need to set any of them explicitly. A flag Eta-expand let-bindings to increase their arity. .. ghc-flag:: -fdo-clever-arg-eta-expansion - :shortdesc: Enable sophisticated argument eta-expansion. Implied by :ghc-flag:`-O2`. + :shortdesc: Enable sophisticated argument eta-expansion. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-do-clever-arg-eta-expansion :category: :default: off + :since: 9.10.1 Eta-expand arguments to increase their arity to avoid allocating unnecessary thunks for them. + For example in code like `foo = f (g x)` this flag will determine which analysis + is used to decide the arity of `g x`, with the goal of avoiding a thunk for `g x` + in cases where `g` is a function with an arity higher than one. + + Enabling the flag enables a more sophisticated analysis, resulting in better + runtime but longer compile time. + .. ghc-flag:: -feager-blackholing :shortdesc: Turn on :ref:`eager blackholing <parallel-compile-options>` :type: dynamic @@ -617,6 +625,7 @@ as such you shouldn't need to set any of them explicitly. A flag :category: :default: off + :since: 9.12.1 This experimental flag is a slightly less heavy weight alternative to :ghc-flag:`-fexpose-all-unfoldings`. ===================================== libraries/base/src/GHC/Generics.hs ===================================== @@ -392,9 +392,14 @@ module GHC.Generics ( -- instance (Encode a) => Encode (Tree a) -- @ -- --- The generic default is being used. In the future, it will hopefully be --- possible to use @deriving Encode@ as well, but GHC does not yet support --- that syntax for this situation. +-- The generic default is being used. Alternatively the @DeriveAnyClass@ language extension can be +-- used to derive Encode: +-- +-- @ +-- {-# LANGUAGE DeriveAnyClass #-} +-- data Tree a = Leaf a | Node (Tree a) (Tree a) +-- deriving (Generic, Encode) +-- @ -- -- Having @Encode@ as a class has the advantage that we can define -- non-generic special cases, which is particularly useful for abstract ===================================== testsuite/tests/haddock/haddock_testsuite/Makefile ===================================== @@ -76,3 +76,7 @@ hypsrcTest: .PHONY: haddockForeignTest haddockForeignTest: '$(HADDOCK)' A.hs B.hs F.hs arith.c + +.PHONY: T26114 +T26114: + '$(HADDOCK)' T26114.hs ===================================== testsuite/tests/haddock/haddock_testsuite/T26114.hs ===================================== @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeFamilies #-} + +-- | Module +module T26114 where + +-- | C1 +class C1 t where + type C2 t + +-- | A +data A = A + +instance C1 A where + type C2 A = B + +-- | B +data B = B + +instance C1 B where + type C2 B = C + +-- | C +data C = C ===================================== testsuite/tests/haddock/haddock_testsuite/T26114.stdout ===================================== @@ -0,0 +1,3 @@ +[1 of 1] Compiling T26114 ( T26114.hs, nothing ) +Haddock coverage: + 100% ( 5 / 5) in 'T26114' ===================================== testsuite/tests/haddock/haddock_testsuite/all.T ===================================== @@ -24,3 +24,8 @@ test('haddockForeignTest', [ignore_stdout, ignore_stderr, req_haddock, extra_files(['./haddock-th-foreign-repro/A.hs', './haddock-th-foreign-repro/B.hs', './haddock-th-foreign-repro/F.hs', './haddock-th-foreign-repro/arith.c'])], makefile_test, ['haddockForeignTest']) + +test('T26114', + [ignore_stderr, req_haddock, extra_files(['T26114.hs'])], + makefile_test, + ['T26114']) ===================================== testsuite/tests/splice-imports/T26087.stderr ===================================== @@ -0,0 +1,6 @@ +./T26087B.hs: error: [GHC-92213] + Module graph contains a cycle: + module ‘main:T26087B’ (./T26087B.hs) + imports module ‘main:T26087A’ (T26087A.hs) + which imports module ‘main:T26087B’ (./T26087B.hs) + ===================================== testsuite/tests/splice-imports/T26087A.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE ExplicitLevelImports #-} +module T26087A where + +import quote T26087B ===================================== testsuite/tests/splice-imports/T26087B.hs ===================================== @@ -0,0 +1,4 @@ +{-# LANGUAGE ExplicitLevelImports, TemplateHaskell #-} +module T26087B where + +import T26087A ===================================== testsuite/tests/splice-imports/T26088.stderr ===================================== @@ -0,0 +1,6 @@ +T26088A.hs:8:8: error: [GHC-28914] + • Level error: ‘a’ is bound at level -1 but used at level 1 + • Available from the imports: + • imported from ‘T26088B’ at -1 at T26088A.hs:4:1-21 + • In the Template Haskell quotation: [| a |] + ===================================== testsuite/tests/splice-imports/T26088A.hs ===================================== @@ -0,0 +1,8 @@ +{-# LANGUAGE ExplicitLevelImports, TemplateHaskell #-} +module T26088A where + +import splice T26088B +import Language.Haskell.TH.Syntax + +x :: Q Exp +x = [| a |] ===================================== testsuite/tests/splice-imports/T26088B.hs ===================================== @@ -0,0 +1,3 @@ +module T26088B where + +a = () ===================================== testsuite/tests/splice-imports/all.T ===================================== @@ -46,3 +46,5 @@ test('SI35', compile_and_run, ['-package ghc']) test('SI36', [extra_files(["SI36_A.hs", "SI36_B1.hs", "SI36_B2.hs", "SI36_B3.hs", "SI36_C1.hs", "SI36_C2.hs", "SI36_C3.hs"])], multimod_compile_fail, ['SI36', '-v0']) +test('T26087', [], multimod_compile_fail, ['T26087A', '']) +test('T26088', [], multimod_compile_fail, ['T26088A', '-v0']) ===================================== utils/haddock/haddock-api/src/Haddock/Interface/Rename.hs ===================================== @@ -110,6 +110,7 @@ renameInterface ignoreSet renamingEnv expInfo warnings hoogle iface = do && isExternalName name && not (isBuiltInSyntax name) && not (isTyVarName name) + && not (isDerivedOccName $ nameOccName name) && Exact name /= eqTyCon_RDR -- Must not be in the set of ignored symbols for the module or the -- unqualified ignored symbols View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9480fe9608d86bdb706e2043cb7ccaf... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/9480fe9608d86bdb706e2043cb7ccaf... You're receiving this email because of your account on gitlab.haskell.org.