[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
Fri Jun 7 05:15:34 UTC 2024



Adam Gundry pushed to branch wip/amg/module-cycle-error at Glasgow Haskell Compiler / GHC


Commits:
153d4029 by Adam Gundry at 2024-06-07T07:15:22+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.

- - - - -


11 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/count-deps/CountDepsParser.stdout
- 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/count-deps/CountDepsParser.stdout
=====================================
@@ -112,6 +112,7 @@ GHC.Iface.Ext.Fields
 GHC.Iface.Recomp.Binary
 GHC.Iface.Syntax
 GHC.Iface.Type
+GHC.Linker.Static.Utils
 GHC.Parser
 GHC.Parser.Annotation
 GHC.Parser.CharClass
@@ -188,6 +189,7 @@ GHC.Types.SafeHaskell
 GHC.Types.SourceFile
 GHC.Types.SourceText
 GHC.Types.SrcLoc
+GHC.Types.Target
 GHC.Types.Tickish
 GHC.Types.TyThing
 GHC.Types.Unique
@@ -207,9 +209,11 @@ GHC.Unit.Info
 GHC.Unit.Module
 GHC.Unit.Module.Deps
 GHC.Unit.Module.Env
+GHC.Unit.Module.Graph
 GHC.Unit.Module.Imported
 GHC.Unit.Module.Location
 GHC.Unit.Module.ModIface
+GHC.Unit.Module.ModSummary
 GHC.Unit.Module.Warnings
 GHC.Unit.Parser
 GHC.Unit.Ppr


=====================================
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/153d4029b09e5924423b26637b7470075191b2d5

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/153d4029b09e5924423b26637b7470075191b2d5
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/20240607/bf466e51/attachment-0001.html>


More information about the ghc-commits mailing list