[Git][ghc/ghc][wip/amg/module-cycle-error] Use structured error representation for module cycle errors (see #18516)
Adam Gundry (@adamgundry)
gitlab at gitlab.haskell.org
Thu Jun 6 21:05:49 UTC 2024
Adam Gundry pushed to branch wip/amg/module-cycle-error at Glasgow Haskell Compiler / GHC
Commits:
4bc002ce by Adam Gundry at 2024-06-06T23:05:40+02:00
Use structured error representation for module cycle errors (see #18516)
This removes the re-export of cyclicModuleErr from the top-level GHC module.
- - - - -
10 changed files:
- compiler/GHC.hs
- compiler/GHC/Driver/Errors/Ppr.hs
- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Driver/MakeFile.hs
- compiler/GHC/Types/Error/Codes.hs
- testsuite/tests/backpack/should_fail/bkpfail51.stderr
- testsuite/tests/driver/T20459.stderr
- testsuite/tests/driver/T24196/T24196.stderr
- testsuite/tests/driver/T24275/T24275.stderr
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -285,11 +285,8 @@ module GHC (
parser,
-- * API Annotations
- AnnKeywordId(..),EpaComment(..),
-
- -- * Miscellaneous
- --sessionHscEnv,
- cyclicModuleErr,
+ AnnKeywordId(..),
+ EpaComment(..)
) where
{-
=====================================
compiler/GHC/Driver/Errors/Ppr.hs
=====================================
@@ -20,7 +20,10 @@ import GHC.Types.Error
import GHC.Types.Error.Codes
import GHC.Unit.Types
import GHC.Utils.Outputable
+import GHC.Utils.Panic
import GHC.Unit.Module
+import GHC.Unit.Module.Graph
+import GHC.Unit.Module.ModSummary
import GHC.Unit.State
import GHC.Types.Hint
import GHC.Types.SrcLoc
@@ -238,6 +241,30 @@ instance Diagnostic DriverMessage where
-> mkSimpleDecorated $ text $ "unrecognised warning flag: -" ++ arg
DriverDeprecatedFlag arg msg
-> mkSimpleDecorated $ text $ arg ++ " is deprecated: " ++ msg
+ DriverModuleGraphCycle path
+ -> mkSimpleDecorated $ vcat
+ [ text "Module graph contains a cycle:"
+ , nest 2 (show_path path) ]
+ where
+ show_path :: [ModuleGraphNode] -> SDoc
+ show_path [] = panic "show_path"
+ show_path [m] = ppr_node m <+> text "imports itself"
+ show_path (m1:m2:ms) = vcat ( nest 14 (ppr_node m1)
+ : nest 6 (text "imports" <+> ppr_node m2)
+ : go ms )
+ where
+ go [] = [text "which imports" <+> ppr_node m1]
+ go (m:ms) = (text "which imports" <+> ppr_node m) : go ms
+
+ ppr_node :: ModuleGraphNode -> SDoc
+ ppr_node (ModuleNode _deps m) = text "module" <+> ppr_ms m
+ ppr_node (InstantiationNode _uid u) = text "instantiated unit" <+> ppr u
+ ppr_node (LinkNode uid _) = pprPanic "LinkNode should not be in a cycle" (ppr uid)
+
+ ppr_ms :: ModSummary -> SDoc
+ ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+>
+ (parens (text (msHsFilePath ms)))
+
diagnosticReason = \case
DriverUnknownMessage m
@@ -303,6 +330,8 @@ instance Diagnostic DriverMessage where
-> WarningWithFlag Opt_WarnUnrecognisedWarningFlags
DriverDeprecatedFlag {}
-> WarningWithFlag Opt_WarnDeprecatedFlags
+ DriverModuleGraphCycle {}
+ -> ErrorWithoutFlag
diagnosticHints = \case
DriverUnknownMessage m
@@ -370,5 +399,7 @@ instance Diagnostic DriverMessage where
-> noHints
DriverDeprecatedFlag {}
-> noHints
+ DriverModuleGraphCycle {}
+ -> noHints
diagnosticCode = constructorCode
=====================================
compiler/GHC/Driver/Errors/Types.hs
=====================================
@@ -28,6 +28,7 @@ import GHC.Driver.DynFlags (DynFlags, PackageArg, gopt)
import GHC.Driver.Flags (GeneralFlag (Opt_BuildingCabalPackage))
import GHC.Types.Error
import GHC.Unit.Module
+import GHC.Unit.Module.Graph
import GHC.Unit.State
import GHC.Parser.Errors.Types ( PsMessage(PsHeaderMessage) )
@@ -384,6 +385,18 @@ data DriverMessage where
DriverDeprecatedFlag :: String -> String -> DriverMessage
+ {- | DriverModuleGraphCycle is an error that occurs if the module graph
+ contains cyclic imports.
+
+ Test cases:
+ tests/backpack/should_fail/bkpfail51
+ tests/driver/T20459
+ tests/driver/T24196/T24196
+ tests/driver/T24275/T24275
+
+ -}
+ DriverModuleGraphCycle :: [ModuleGraphNode] -> DriverMessage
+
deriving instance Generic DriverMessage
data DriverMessageOpts =
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1264,9 +1264,7 @@ upsweep n_jobs hsc_env hmi_cache diag_wrapper mHscMessage old_hpt build_plan = d
-- of the upsweep.
case cycle of
Just mss -> do
- let logger = hsc_logger hsc_env
- liftIO $ fatalErrorMsg logger (cyclicModuleErr mss)
- return (Failed, [])
+ cyclicModuleErr mss
Nothing -> do
let success_flag = successIf (all isJust res)
return (success_flag, completed)
@@ -2387,16 +2385,18 @@ multiRootsErr summs@(summ1:_)
mod = ms_mod summ1
files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
-cyclicModuleErr :: [ModuleGraphNode] -> SDoc
+cyclicModuleErr :: [ModuleGraphNode] -> IO a
-- From a strongly connected component we find
-- a single cycle to report
cyclicModuleErr mss
= assert (not (null mss)) $
case findCycle graph of
- Nothing -> text "Unexpected non-cycle" <+> ppr mss
- Just path0 -> vcat
- [ text "Module graph contains a cycle:"
- , nest 2 (show_path path0)]
+ Nothing -> pprPanic "Unexpected non-cycle" (ppr mss)
+ Just path -> throwOneError $ mkPlainErrorMsgEnvelope src_span
+ $ GhcDriverMessage
+ $ DriverModuleGraphCycle path
+ where
+ src_span = maybe noSrcSpan (mkFileSrcSpan . ms_location) (moduleGraphNodeModSum (head path))
where
graph :: [Node NodeKey ModuleGraphNode]
graph =
@@ -2408,24 +2408,11 @@ cyclicModuleErr mss
| ms <- mss
]
- show_path :: [ModuleGraphNode] -> SDoc
- show_path [] = panic "show_path"
- show_path [m] = ppr_node m <+> text "imports itself"
- show_path (m1:m2:ms) = vcat ( nest 14 (ppr_node m1)
- : nest 6 (text "imports" <+> ppr_node m2)
- : go ms )
- where
- go [] = [text "which imports" <+> ppr_node m1]
- go (m:ms) = (text "which imports" <+> ppr_node m) : go ms
-
- ppr_node :: ModuleGraphNode -> SDoc
- ppr_node (ModuleNode _deps m) = text "module" <+> ppr_ms m
- ppr_node (InstantiationNode _uid u) = text "instantiated unit" <+> ppr u
- ppr_node (LinkNode uid _) = pprPanic "LinkNode should not be in a cycle" (ppr uid)
-
- ppr_ms :: ModSummary -> SDoc
- ppr_ms ms = quotes (ppr (moduleName (ms_mod ms))) <+>
- (parens (text (msHsFilePath ms)))
+mkFileSrcSpan :: ModLocation -> SrcSpan
+mkFileSrcSpan mod_loc
+ = case ml_hs_file mod_loc of
+ Just file_path -> mkGeneralSrcSpan (mkFastString file_path)
+ Nothing -> interactiveSrcSpan -- Presumably
cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m ()
=====================================
compiler/GHC/Driver/MakeFile.hs
=====================================
@@ -16,6 +16,7 @@ where
import GHC.Prelude
import qualified GHC
+import GHC.Driver.Make
import GHC.Driver.Monad
import GHC.Driver.DynFlags
import GHC.Driver.Ppr
@@ -209,10 +210,9 @@ processDeps :: DynFlags
--
-- For {-# SOURCE #-} imports the "hi" will be "hi-boot".
-processDeps dflags _ _ _ _ (CyclicSCC nodes)
+processDeps _ _ _ _ _ (CyclicSCC nodes)
= -- There shouldn't be any cycles; report them
- throwGhcExceptionIO $ ProgramError $
- showSDoc dflags $ GHC.cyclicModuleErr nodes
+ cyclicModuleErr nodes
processDeps dflags _ _ _ _ (AcyclicSCC (InstantiationNode _uid node))
= -- There shouldn't be any backpack instantiations; report them as well
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -318,6 +318,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "DriverPackageTrustIgnored" = 83552
GhcDiagnosticCode "DriverUnrecognisedFlag" = 93741
GhcDiagnosticCode "DriverDeprecatedFlag" = 53692
+ GhcDiagnosticCode "DriverModuleGraphCycle" = 92213
-- Constraint solver diagnostic codes
GhcDiagnosticCode "BadTelescope" = 97739
=====================================
testsuite/tests/backpack/should_fail/bkpfail51.stderr
=====================================
@@ -2,7 +2,9 @@
[1 of 2] Compiling H[sig] ( p/H.hsig, nothing )
[2 of 2] Compiling I ( p/I.hs, nothing )
[2 of 2] Processing q
-Module graph contains a cycle:
- instantiated unit p[H=A]
- imports module ‘A’ (q/A.hsig)
- which imports instantiated unit p[H=A]
+<no location info>: error: [GHC-92213]
+ Module graph contains a cycle:
+ instantiated unit p[H=<A>]
+ imports module ‘A’ (q/A.hsig)
+ which imports instantiated unit p[H=<A>]
+
=====================================
testsuite/tests/driver/T20459.stderr
=====================================
@@ -1,2 +1,4 @@
-Module graph contains a cycle:
- module ‘T20459A’ (./T20459A.hs) imports itself
+./T20459A.hs: error: [GHC-92213]
+ Module graph contains a cycle:
+ module ‘T20459A’ (./T20459A.hs) imports itself
+
=====================================
testsuite/tests/driver/T24196/T24196.stderr
=====================================
@@ -1,4 +1,6 @@
-Module graph contains a cycle:
- module ‘T24196A’ (./T24196A.hs-boot)
- imports module ‘T24196B’ (T24196B.hs)
- which imports module ‘T24196A’ (./T24196A.hs-boot)
+./T24196A.hs-boot: error: [GHC-92213]
+ Module graph contains a cycle:
+ module ‘T24196A’ (./T24196A.hs-boot)
+ imports module ‘T24196B’ (T24196B.hs)
+ which imports module ‘T24196A’ (./T24196A.hs-boot)
+
=====================================
testsuite/tests/driver/T24275/T24275.stderr
=====================================
@@ -1,4 +1,6 @@
-Module graph contains a cycle:
- module ‘T24275A’ (./T24275A.hs-boot)
- imports module ‘T24275B’ (T24275B.hs)
- which imports module ‘T24275A’ (./T24275A.hs-boot)
+./T24275A.hs-boot: error: [GHC-92213]
+ Module graph contains a cycle:
+ module ‘T24275A’ (./T24275A.hs-boot)
+ imports module ‘T24275B’ (T24275B.hs)
+ which imports module ‘T24275A’ (./T24275A.hs-boot)
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bc002ce5df8aca903ed0c5c8988fdb217f0f8ac
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/4bc002ce5df8aca903ed0c5c8988fdb217f0f8ac
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240606/3584d630/attachment-0001.html>
More information about the ghc-commits
mailing list