GitLab

Matthew Pickering pushed to branch wip/t26088 at Glasgow Haskell Compiler / GHC

Commits:

1ad84037

by Matthew Pickering at 2025-07-08T10:17:54+01: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

5e0405b9

by Matthew Pickering at 2025-07-08T10:17:54+01: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

9 changed files:

compiler/GHC/Rename/Splice.hs
compiler/GHC/Unit/Module/Graph.hs
+ 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

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

testsuite/tests/splice-imports/T26087.stderr

 +./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

 +{-# LANGUAGE ExplicitLevelImports #-}
 +module T26087A where
++
 +import quote T26087B

testsuite/tests/splice-imports/T26087B.hs

 +{-# LANGUAGE ExplicitLevelImports, TemplateHaskell #-}
 +module T26087B where
++
 +import T26087A

testsuite/tests/splice-imports/T26088.stderr

 +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

 +{-# 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

 +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'])