[Git][ghc/ghc][wip/amg/module-cycle-error] 2 commits: Use structured errors for a Backpack instantiation error
sheaf (@sheaf)
gitlab at gitlab.haskell.org
Mon Jul 1 10:27:31 UTC 2024
sheaf pushed to branch wip/amg/module-cycle-error at Glasgow Haskell Compiler / GHC
Commits:
81527ee1 by sheaf at 2024-07-01T12:21:00+02:00
Use structured errors for a Backpack instantiation error
- - - - -
803bfbfc by sheaf at 2024-07-01T12:21:18+02:00
Move mkFileSrcSpan to GHC.Unit.Module.Location
- - - - -
8 changed files:
- 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
- + compiler/ghc-llvm-version.h
Changes:
=====================================
compiler/GHC/Driver/Errors/Ppr.hs
=====================================
@@ -264,7 +264,10 @@ instance Diagnostic DriverMessage where
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
@@ -332,6 +335,8 @@ instance Diagnostic DriverMessage where
-> WarningWithFlag Opt_WarnDeprecatedFlags
DriverModuleGraphCycle {}
-> ErrorWithoutFlag
+ DriverInstantiationNodeInDependencyGeneration {}
+ -> ErrorWithoutFlag
diagnosticHints = \case
DriverUnknownMessage m
@@ -401,5 +406,7 @@ instance Diagnostic DriverMessage where
-> noHints
DriverModuleGraphCycle {}
-> noHints
+ DriverInstantiationNodeInDependencyGeneration {}
+ -> noHints
diagnosticCode = constructorCode
=====================================
compiler/GHC/Driver/Errors/Types.hs
=====================================
@@ -385,7 +385,7 @@ data DriverMessage where
DriverDeprecatedFlag :: String -> String -> DriverMessage
- {- | DriverModuleGraphCycle is an error that occurs if the module graph
+ {-| DriverModuleGraphCycle is an error that occurs if the module graph
contains cyclic imports.
Test cases:
@@ -397,6 +397,11 @@ data DriverMessage where
-}
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
=====================================
@@ -1264,7 +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
- cyclicModuleErr mss
+ throwOneError $ cyclicModuleErr mss
Nothing -> do
let success_flag = successIf (all isJust res)
return (success_flag, completed)
@@ -2385,16 +2385,15 @@ multiRootsErr summs@(summ1:_)
mod = ms_mod summ1
files = map (expectJust "checkDup" . ml_hs_file . ms_location) summs
-cyclicModuleErr :: [ModuleGraphNode] -> IO a
+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 -> pprPanic "Unexpected non-cycle" (ppr mss)
- Just path -> throwOneError $ mkPlainErrorMsgEnvelope src_span
- $ GhcDriverMessage
- $ DriverModuleGraphCycle path
+ Just path -> mkPlainErrorMsgEnvelope src_span $
+ GhcDriverMessage $ DriverModuleGraphCycle path
where
src_span = maybe noSrcSpan (mkFileSrcSpan . ms_location) (moduleGraphNodeModSum (head path))
where
@@ -2408,13 +2407,6 @@ cyclicModuleErr mss
| ms <- mss
]
-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 ()
cleanCurrentModuleTempFilesMaybe logger tmpfs dflags =
if gopt Opt_KeepTmpFiles dflags
=====================================
compiler/GHC/Driver/MakeFile.hs
=====================================
@@ -19,7 +19,6 @@ 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
@@ -212,14 +211,14 @@ processDeps :: DynFlags
processDeps _ _ _ _ _ (CyclicSCC nodes)
= -- There shouldn't be any cycles; report them
- 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
=====================================
@@ -319,6 +319,7 @@ type family GhcDiagnosticCode c = n | n -> c where
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
=====================================
@@ -7,12 +7,15 @@ module GHC.Unit.Module.Location
, addBootSuffixLocn
, addBootSuffixLocnOut
, removeBootSuffix
+ , mkFileSrcSpan
)
where
import GHC.Prelude
import GHC.Unit.Types
+import GHC.Types.SrcLoc
import GHC.Utils.Outputable
+import GHC.Data.FastString (mkFastString)
-- | Module Location
--
@@ -113,4 +116,8 @@ addBootSuffixLocnOut locn
, ml_hie_file = addBootSuffix (ml_hie_file locn)
}
-
+mkFileSrcSpan :: ModLocation -> SrcSpan
+mkFileSrcSpan mod_loc
+ = case ml_hs_file mod_loc of
+ Just file_path -> mkGeneralSrcSpan (mkFastString file_path)
+ Nothing -> interactiveSrcSpan -- Presumably
=====================================
compiler/ghc-llvm-version.h
=====================================
@@ -0,0 +1,11 @@
+/* compiler/ghc-llvm-version.h. Generated from ghc-llvm-version.h.in by configure. */
+#if !defined(__GHC_LLVM_VERSION_H__)
+#define __GHC_LLVM_VERSION_H__
+
+/* The maximum supported LLVM version number */
+#define sUPPORTED_LLVM_VERSION_MAX (16)
+
+/* The minimum supported LLVM version number */
+#define sUPPORTED_LLVM_VERSION_MIN (13)
+
+#endif /* __GHC_LLVM_VERSION_H__ */
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/407640d39aba1a20bf8aebe64ec63942394ce24c...803bfbfc141ff5a7f17354be69fbb1fcb8272a7c
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/407640d39aba1a20bf8aebe64ec63942394ce24c...803bfbfc141ff5a7f17354be69fbb1fcb8272a7c
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/20240701/936acb73/attachment-0001.html>
More information about the ghc-commits
mailing list