[Git][ghc/ghc][master] 4 commits: Use structured error representation for module cycle errors (see #18516)

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Jul 4 15:16:18 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
b05613c5 by Adam Gundry at 2024-07-04T11:12:23-04:00
Use structured error representation for module cycle errors (see #18516)

This removes the re-export of cyclicModuleErr from the top-level GHC module.

- - - - -
70389749 by Adam Gundry at 2024-07-04T11:12:23-04:00
Use structured error representation when reloading a nonexistent module

- - - - -
680ade3d by sheaf at 2024-07-04T11:12:23-04:00
Use structured errors for a Backpack instantiation error

- - - - -
97c6d6de by sheaf at 2024-07-04T11:12:23-04:00
Move mkFileSrcSpan to GHC.Unit.Module.Location

- - - - -


16 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/HsToCore.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Unit/Module/Location.hs
- testsuite/tests/backpack/should_fail/bkpfail51.stderr
- testsuite/tests/count-deps/CountDepsParser.stdout
- testsuite/tests/diagnostic-codes/codes.stdout
- testsuite/tests/driver/T20459.stderr
- testsuite/tests/driver/T24196/T24196.stderr
- testsuite/tests/driver/T24275/T24275.stderr
- testsuite/tests/ghc-e/should_fail/T18441fail5.stderr
- testsuite/tests/ghci/scripts/ghci021.stderr


Changes:

=====================================
compiler/GHC.hs
=====================================
@@ -315,11 +315,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,33 @@ 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)))
+    DriverInstantiationNodeInDependencyGeneration node ->
+      mkSimpleDecorated $
+        vcat [ text "Unexpected backpack instantiation in dependency graph while constructing Makefile:"
+             , nest 2 $ ppr node ]
 
   diagnosticReason = \case
     DriverUnknownMessage m
@@ -303,6 +333,10 @@ instance Diagnostic DriverMessage where
       -> WarningWithFlag Opt_WarnUnrecognisedWarningFlags
     DriverDeprecatedFlag {}
       -> WarningWithFlag Opt_WarnDeprecatedFlags
+    DriverModuleGraphCycle {}
+      -> ErrorWithoutFlag
+    DriverInstantiationNodeInDependencyGeneration {}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     DriverUnknownMessage m
@@ -370,5 +404,9 @@ instance Diagnostic DriverMessage where
       -> noHints
     DriverDeprecatedFlag {}
       -> noHints
+    DriverModuleGraphCycle {}
+      -> noHints
+    DriverInstantiationNodeInDependencyGeneration {}
+      -> 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,23 @@ 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
+
+  {- | DriverInstantiationNodeInDependencyGeneration is an error that occurs
+       if the module graph used for dependency generation contains
+       Backpack 'InstantiationNode's. -}
+  DriverInstantiationNodeInDependencyGeneration :: InstantiatedUnit -> DriverMessage
+
 deriving instance Generic DriverMessage
 
 data DriverMessageOpts =


=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -724,9 +724,9 @@ load' mhmi_cache how_much diag_wrapper mHscMessage mod_graph = do
         checkMod m and_then
             | m `Set.member` all_home_mods = and_then
             | otherwise = do
-                    liftIO $ errorMsg logger
-                        (text "no such module:" <+> quotes (ppr (moduleUnit m) <> colon <> ppr (moduleName m)))
-                    return Failed
+                    throwOneError $ mkPlainErrorMsgEnvelope noSrcSpan
+                                  $ GhcDriverMessage
+                                  $ DriverModuleNotFound (moduleName m)
 
     checkHowMuch how_much $ do
 
@@ -1265,9 +1265,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, [])
+          throwOneError $ cyclicModuleErr mss
         Nothing  -> do
           let success_flag = successIf (all isJust res)
           return (success_flag, completed)
@@ -2388,16 +2386,17 @@ multiRootsErr summs@(summ1:_)
     mod = ms_mod summ1
     files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
 
-cyclicModuleErr :: [ModuleGraphNode] -> SDoc
+cyclicModuleErr :: [ModuleGraphNode] -> MsgEnvelope GhcMessage
 -- 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 -> mkPlainErrorMsgEnvelope src_span $
+                    GhcDriverMessage $ DriverModuleGraphCycle path
+        where
+          src_span = maybe noSrcSpan (mkFileSrcSpan . ms_location) (moduleGraphNodeModSum (head path))
   where
     graph :: [Node NodeKey ModuleGraphNode]
     graph =
@@ -2409,26 +2408,6 @@ 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)))
-
-
 cleanCurrentModuleTempFilesMaybe :: MonadIO m => Logger -> TmpFs -> DynFlags -> m ()
 cleanCurrentModuleTempFilesMaybe logger tmpfs dflags =
   if gopt Opt_KeepTmpFiles dflags


=====================================
compiler/GHC/Driver/MakeFile.hs
=====================================
@@ -16,9 +16,9 @@ where
 import GHC.Prelude
 
 import qualified GHC
+import GHC.Driver.Make
 import GHC.Driver.Monad
 import GHC.Driver.DynFlags
-import GHC.Driver.Ppr
 import GHC.Utils.Misc
 import GHC.Driver.Env
 import GHC.Driver.Errors.Types
@@ -210,17 +210,16 @@ 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
+    throwOneError $ cyclicModuleErr nodes
 
-processDeps dflags _ _ _ _ (AcyclicSCC (InstantiationNode _uid node))
+processDeps _ _ _ _ _ (AcyclicSCC (InstantiationNode _uid node))
   =     -- There shouldn't be any backpack instantiations; report them as well
-    throwGhcExceptionIO $ ProgramError $
-      showSDoc dflags $
-        vcat [ text "Unexpected backpack instantiation in dependency graph while constructing Makefile:"
-             , nest 2 $ ppr node ]
+    throwOneError $
+      mkPlainErrorMsgEnvelope noSrcSpan $
+      GhcDriverMessage $ DriverInstantiationNodeInDependencyGeneration node
+
 processDeps _dflags _ _ _ _ (AcyclicSCC (LinkNode {})) = return ()
 
 processDeps dflags hsc_env excl_mods root hdl (AcyclicSCC (ModuleNode _ node))


=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -64,7 +64,6 @@ import GHC.Builtin.Names
 import GHC.Builtin.Types.Prim
 import GHC.Builtin.Types
 
-import GHC.Data.FastString
 import GHC.Data.Maybe    ( expectJust )
 import GHC.Data.OrdList
 import GHC.Data.SizedSeq ( sizeSS )
@@ -289,12 +288,6 @@ deSugar hsc_env
         ; return (msgs, Just mod_guts)
         }}}}
 
-mkFileSrcSpan :: ModLocation -> SrcSpan
-mkFileSrcSpan mod_loc
-  = case ml_hs_file mod_loc of
-      Just file_path -> mkGeneralSrcSpan (mkFastString file_path)
-      Nothing        -> interactiveSrcSpan   -- Presumably
-
 dsImpSpecs :: [LTcSpecPrag] -> DsM (OrdList (Id,CoreExpr), [CoreRule])
 dsImpSpecs imp_specs
  = do { spec_prs <- mapMaybeM (dsSpec Nothing) imp_specs


=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -320,6 +320,8 @@ type family GhcDiagnosticCode c = n | n -> c where
   GhcDiagnosticCode "DriverPackageTrustIgnored"                     = 83552
   GhcDiagnosticCode "DriverUnrecognisedFlag"                        = 93741
   GhcDiagnosticCode "DriverDeprecatedFlag"                          = 53692
+  GhcDiagnosticCode "DriverModuleGraphCycle"                        = 92213
+  GhcDiagnosticCode "DriverInstantiationNodeInDependencyGeneration" = 74284
 
   -- Constraint solver diagnostic codes
   GhcDiagnosticCode "BadTelescope"                                  = 97739


=====================================
compiler/GHC/Unit/Module/Location.hs
=====================================
@@ -18,6 +18,7 @@ module GHC.Unit.Module.Location
    , addBootSuffixLocn
    , addBootSuffixLocnOut
    , removeBootSuffix
+   , mkFileSrcSpan
    )
 where
 
@@ -25,7 +26,9 @@ import GHC.Prelude
 
 import GHC.Data.OsPath
 import GHC.Unit.Types
+import GHC.Types.SrcLoc
 import GHC.Utils.Outputable
+import GHC.Data.FastString (mkFastString)
 
 import qualified System.OsString as OsString
 
@@ -128,6 +131,13 @@ addBootSuffixLocnOut locn
          , ml_hie_file_ospath = addBootSuffix (ml_hie_file_ospath locn)
          }
 
+-- | Compute a 'SrcSpan' from a 'ModLocation'.
+mkFileSrcSpan :: ModLocation -> SrcSpan
+mkFileSrcSpan mod_loc
+  = case ml_hs_file mod_loc of
+      Just file_path -> mkGeneralSrcSpan (mkFastString file_path)
+      Nothing        -> interactiveSrcSpan   -- Presumably
+
 -- ----------------------------------------------------------------------------
 -- Helpers for backwards compatibility
 -- ----------------------------------------------------------------------------


=====================================
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
=====================================
@@ -113,6 +113,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
@@ -189,6 +190,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
@@ -208,9 +210,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/diagnostic-codes/codes.stdout
=====================================
@@ -41,6 +41,7 @@
 [GHC-19971] is untested (constructor = DriverBackpackModuleNotFound)
 [GHC-37141] is untested (constructor = DriverCannotLoadInterfaceFile)
 [GHC-29747] is untested (constructor = DriverMissingSafeHaskellMode)
+[GHC-74284] is untested (constructor = DriverInstantiationNodeInDependencyGeneration)
 [GHC-06200] is untested (constructor = BlockedEquality)
 [GHC-81325] is untested (constructor = ExpectingMoreArguments)
 [GHC-78125] is untested (constructor = AmbiguityPreventsSolvingCt)


=====================================
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)
+


=====================================
testsuite/tests/ghc-e/should_fail/T18441fail5.stderr
=====================================
@@ -1,3 +1,4 @@
+<no location info>: error: [GHC-82272]
+    module ‘Abcde’ cannot be found locally
 
-<no location info>: error: no such module: ‘main:Abcde’
 1


=====================================
testsuite/tests/ghci/scripts/ghci021.stderr
=====================================
@@ -1,2 +1,3 @@
+<no location info>: error: [GHC-82272]
+    module ‘ThisDoesNotExist’ cannot be found locally
 
-<no location info>: error: no such module: ‘main:ThisDoesNotExist’



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87cf41111ef6a650e360e4a9b9ac691feecc4973...97c6d6de3fa3a5595a1b62873750c8b2330c3f16

-- 
This project does not include diff previews in email notifications.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/87cf41111ef6a650e360e4a9b9ac691feecc4973...97c6d6de3fa3a5595a1b62873750c8b2330c3f16
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/20240704/8df4b770/attachment-0001.html>


More information about the ghc-commits mailing list