Check for missing codes (commented out)

5 files changed, 141 insertions, 92 deletions

diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs
index b93cbba833..2143d3df4a 100644
--- a/compiler/GHC/Driver/Errors/Ppr.hs
+++ b/compiler/GHC/Driver/Errors/Ppr.hs
@@ -3,7 +3,13 @@
 {-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic {DriverMessage, GhcMessage}
 
-module GHC.Driver.Errors.Ppr where
+module GHC.Driver.Errors.Ppr (
+  -- The most important exports from this module are instances,
+  -- but the following functions are useful.
+
+  allUsedDiagnosticCodes,
+  allRetiredDiagnosticCodes
+  ) where
 
 import GHC.Prelude
 
@@ -98,6 +104,15 @@ instance GhcDiagnostic GhcMessage where
                                   , retiredDiagnosticCodes @DriverMessage
                                   ]
 
+-- | A list of all used diagnostic codes; used for testing
+-- whether or not a given code is registered in this list.
+allUsedDiagnosticCodes :: [GhcDiagnosticCode]
+allUsedDiagnosticCodes = usedDiagnosticCodes @GhcMessage
+
+-- | A list of all retired diagnostic codes; used for testing
+-- whether the set of codes is pairwise distinct.
+allRetiredDiagnosticCodes :: [GhcDiagnosticCode]
+allRetiredDiagnosticCodes = retiredDiagnosticCodes @GhcMessage
 
 instance Diagnostic DriverMessage where
   diagnosticMessage = \case
diff --git a/compiler/GHC/Driver/Errors/Ppr.hs-boot b/compiler/GHC/Driver/Errors/Ppr.hs-boot
new file mode 100644
index 0000000000..8ddd245613
--- /dev/null
+++ b/compiler/GHC/Driver/Errors/Ppr.hs-boot
@@ -0,0 +1,5 @@
+module GHC.Driver.Errors.Ppr where
+
+import GHC.Types.Error.Codes
+
+allUsedDiagnosticCodes :: [GhcDiagnosticCode]
\ No newline at end of file
diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs
index 3069102448..eec75c1ba5 100644
--- a/compiler/GHC/Types/Error.hs
+++ b/compiler/GHC/Types/Error.hs
@@ -68,21 +68,19 @@ module GHC.Types.Error
    , errorsFound
    , errorsOrFatalWarningsFound
 
-   -- * Diagnostic codes
+   -- * Diagnostic code re-exports
    , DiagnosticCode
-   , mkDiagnosticCode
    , GhcDiagnosticCode
-   , prefixGhcDiagnosticCode
    , fromGhcDiagnosticCode
-   , numDigitsInGhcDiagnosticCode
-   , ghcDiagnosticCodeNumber
    )
 where
 
 import GHC.Prelude
 
 import GHC.Driver.Flags
+-- import {-# SOURCE #-} GHC.Driver.Errors.Ppr ( allUsedDiagnosticCodes )
 
+import GHC.Types.Error.Codes
 import GHC.Data.Bag
 import GHC.IO (catchException)
 import GHC.Utils.Outputable as Outputable
@@ -91,12 +89,11 @@ import GHC.Types.SrcLoc as SrcLoc
 import GHC.Data.FastString (unpackFS)
 import GHC.Data.StringBuffer (atLine, hGetStringBuffer, len, lexemeToString)
 import GHC.Utils.Json
-import GHC.Utils.Panic.Plain
+import GHC.Utils.Panic
 
 import Data.Bifunctor
 import Data.Foldable    ( fold )
 import GHC.Types.Hint
-import Text.Printf      ( printf )
 import qualified Data.List.NonEmpty as NE
 import Data.List ( intercalate )
 
@@ -246,6 +243,27 @@ class Diagnostic a where
   -- to make defining this easier.
   diagnosticCode    :: a -> Maybe DiagnosticCode
 
+-- | Make defining 'diagnosticCode' easier within GHC. Example usage:
+--
+-- @
+--   instance Diagnostic MyMessage where
+--     diagnosticCode = fromGhcDiagnosticCode $ \case
+--       ...
+-- @
+--
+-- In a DEBUG compiler, this function also checks whether the code
+-- is listed in allUsedDiagnosticCodes, to make sure that list isn't
+-- missing anything.
+fromGhcDiagnosticCode :: (a -> Maybe GhcDiagnosticCode) -> a -> Maybe DiagnosticCode
+fromGhcDiagnosticCode mk_ghc_dc =
+  fmap (prefixGhcDiagnosticCode . check_code) . mk_ghc_dc
+  where
+    check_code :: GhcDiagnosticCode -> GhcDiagnosticCode
+    check_code ghc_code =
+{-      assertPpr (ghc_code `elem` allUsedDiagnosticCodes)
+                (text "Unknown diagnostic code:" <+> ppr ghc_code) $ -}
+      ghc_code
+
 -- | A class identifying diagnostic message types within GHC.
 -- This class does /not/ include plugin diagnostics, but every type
 -- within GHC that implements 'Diagnostic' should also implement this
@@ -663,87 +681,3 @@ getErrorMessages (Messages xs) = fst $ partitionBag isIntrinsicErrorMessage xs
 -- warnings, and the second the errors.
 partitionMessages :: Diagnostic e => Messages e -> (Messages e, Messages e)
 partitionMessages (Messages xs) = bimap Messages Messages (partitionBag isWarningMessage xs)
-
-----------------------------------------------------------------
---                                                            --
--- Diagnostic Codes                                           --
---                                                            --
-----------------------------------------------------------------
-
-{- Note [Diagnostic codes]
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-"RAE": Write note.
-Talk about difference between DiagnosticCode and GhcDiagnosticCode.
-Talk about aspirations to remove Maybe.
--}
-
--- | A diagnostic code (called an "error code" in its specification
--- at "RAE": TODO) has a prefix and a suffix. Briefly, the prefix is
--- an alphanumeric string assigned by the Haskell Foundation (in order
--- to keep codes from different tools distinct). The suffix is a string
--- of digits uniquely identifying a diagnostic.
---
--- To make a 'DiagnosticCode' from a 'GhcDiagnosticCode', see 'prefixGhcDiagnosticCode'.
---
--- See also Note [Diagnostic codes]
-data DiagnosticCode = MkDiagnosticCode SDoc SDoc
-
-mkDiagnosticCode :: SDoc   -- ^ prefix of diagnostic code; must be assiged by Haskell Foundation
-                 -> SDoc   -- ^ suffix of diagnostic code; must be a string of digits
-                 -> DiagnosticCode
-mkDiagnosticCode = MkDiagnosticCode
-
-instance Outputable DiagnosticCode where
-  ppr (MkDiagnosticCode prefix suffix) = brackets $ prefix <> char '-' <> suffix
-
--- | Convert the GHC-specific 'GhcDiagnosticCode' to a tool-agnostic
--- 'DiagnosticCode' by adding the @GHC-@ prefix.
-prefixGhcDiagnosticCode :: GhcDiagnosticCode -> DiagnosticCode
-prefixGhcDiagnosticCode (MkGhcDiagnosticCode n)
-  = MkDiagnosticCode (text ghcDiagnosticCodePrefix) (text ppr_n)
-  where
-    ppr_n = printf format_string n
-    format_string = "%0" ++ show numDigitsInGhcDiagnosticCode ++ "d"
-
--- | Make defining 'diagnosticCode' easier within GHC. Example usage:
---
--- @
---   instance Diagnostic MyMessage where
---     diagnosticCode = fromGhcDiagnosticCode $ \case
---       ...
--- @
-fromGhcDiagnosticCode :: (a -> Maybe GhcDiagnosticCode) -> a -> Maybe DiagnosticCode
-fromGhcDiagnosticCode mk_ghc_dc = fmap prefixGhcDiagnosticCode . mk_ghc_dc
-
--- | The code used within GHC to label a diagnostic. See Note [Diagnostic codes].
-newtype GhcDiagnosticCode = MkGhcDiagnosticCode Int
-  deriving (Eq, Ord)
-
--- | Make it easy to write code without using the constructor
-instance Num GhcDiagnosticCode where
-  fromInteger = MkGhcDiagnosticCode . fromInteger
-
-  (+) = panic "adding GhcDiagnosticCodes"
-  (-) = panic "subtracting GhcDiagnosticCodes"
-  (*) = panic "multiplying GhcDiagnosticCodes"
-  abs = panic "abs GhcDiagnosticCode"
-  negate = panic "negate GhcDiagnosticCode"
-  signum = panic "signum GhcDiagnosticCode"
-
--- | Extract the diagnostic code number from a 'GhcDiagnosticCode'
-ghcDiagnosticCodeNumber :: GhcDiagnosticCode -> Int
-ghcDiagnosticCodeNumber (MkGhcDiagnosticCode n) = n
-
--- | The Haskell-Foundation-assigned prefix for GHC's diagnostic codes.
-ghcDiagnosticCodePrefix :: String
-ghcDiagnosticCodePrefix = "GHC"
-
--- | The minimum number of digits of a diagnostic code. Codes are prefixed
--- with 0s to print this many digits.
-numDigitsInGhcDiagnosticCode :: Int
-numDigitsInGhcDiagnosticCode = 5
-
--- This instance outputs the full diagnostic code, including its "GHC-"
--- prefix, and wraps it in brackets for visual distinction.
-instance Outputable GhcDiagnosticCode where
-  ppr = ppr . prefixGhcDiagnosticCode
diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs
new file mode 100644
index 0000000000..8a41181e14
--- /dev/null
+++ b/compiler/GHC/Types/Error/Codes.hs
@@ -0,0 +1,94 @@
+-- Defines types for diagnostic codes.
+-- Separate from GHC.Types.Error to avoid a (worse)
+-- module loop with GHC.Driver.Errors.Ppr
+
+module GHC.Types.Error.Codes (
+
+     -- * Diagnostic codes
+     DiagnosticCode
+   , mkDiagnosticCode
+   , GhcDiagnosticCode
+   , prefixGhcDiagnosticCode
+   , numDigitsInGhcDiagnosticCode
+   , ghcDiagnosticCodeNumber
+  ) where
+
+import GHC.Prelude
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+
+import Text.Printf
+
+----------------------------------------------------------------
+--                                                            --
+-- Diagnostic Codes                                           --
+--                                                            --
+----------------------------------------------------------------
+
+{- Note [Diagnostic codes]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+"RAE": Write note.
+Talk about difference between DiagnosticCode and GhcDiagnosticCode.
+Talk about aspirations to remove Maybe.
+-}
+
+-- | A diagnostic code (called an "error code" in its specification
+-- at "RAE": TODO) has a prefix and a suffix. Briefly, the prefix is
+-- an alphanumeric string assigned by the Haskell Foundation (in order
+-- to keep codes from different tools distinct). The suffix is a string
+-- of digits uniquely identifying a diagnostic.
+--
+-- To make a 'DiagnosticCode' from a 'GhcDiagnosticCode', see 'prefixGhcDiagnosticCode'.
+--
+-- See also Note [Diagnostic codes]
+data DiagnosticCode = MkDiagnosticCode SDoc SDoc
+
+mkDiagnosticCode :: SDoc   -- ^ prefix of diagnostic code; must be assiged by Haskell Foundation
+                 -> SDoc   -- ^ suffix of diagnostic code; must be a string of digits
+                 -> DiagnosticCode
+mkDiagnosticCode = MkDiagnosticCode
+
+instance Outputable DiagnosticCode where
+  ppr (MkDiagnosticCode prefix suffix) = brackets $ prefix <> char '-' <> suffix
+
+-- | Convert the GHC-specific 'GhcDiagnosticCode' to a tool-agnostic
+-- 'DiagnosticCode' by adding the @GHC-@ prefix.
+prefixGhcDiagnosticCode :: GhcDiagnosticCode -> DiagnosticCode
+prefixGhcDiagnosticCode (MkGhcDiagnosticCode n)
+  = MkDiagnosticCode (text ghcDiagnosticCodePrefix) (text ppr_n)
+  where
+    ppr_n = printf format_string n
+    format_string = "%0" ++ show numDigitsInGhcDiagnosticCode ++ "d"
+
+-- | The code used within GHC to label a diagnostic. See Note [Diagnostic codes].
+newtype GhcDiagnosticCode = MkGhcDiagnosticCode Int
+  deriving (Eq, Ord)
+
+-- | Make it easy to write code without using the constructor
+instance Num GhcDiagnosticCode where
+  fromInteger = MkGhcDiagnosticCode . fromInteger
+
+  (+) = panic "adding GhcDiagnosticCodes"
+  (-) = panic "subtracting GhcDiagnosticCodes"
+  (*) = panic "multiplying GhcDiagnosticCodes"
+  abs = panic "abs GhcDiagnosticCode"
+  negate = panic "negate GhcDiagnosticCode"
+  signum = panic "signum GhcDiagnosticCode"
+
+-- | Extract the diagnostic code number from a 'GhcDiagnosticCode'
+ghcDiagnosticCodeNumber :: GhcDiagnosticCode -> Int
+ghcDiagnosticCodeNumber (MkGhcDiagnosticCode n) = n
+
+-- | The Haskell-Foundation-assigned prefix for GHC's diagnostic codes.
+ghcDiagnosticCodePrefix :: String
+ghcDiagnosticCodePrefix = "GHC"
+
+-- | The minimum number of digits of a diagnostic code. Codes are prefixed
+-- with 0s to print this many digits.
+numDigitsInGhcDiagnosticCode :: Int
+numDigitsInGhcDiagnosticCode = 5
+
+-- This instance outputs the full diagnostic code, including its "GHC-"
+-- prefix, and wraps it in brackets for visual distinction.
+instance Outputable GhcDiagnosticCode where
+  ppr = ppr . prefixGhcDiagnosticCode
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 36c05ac38e..19f648f3f7 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -699,6 +699,7 @@ Library
         GHC.Types.Cpr
         GHC.Types.Demand
         GHC.Types.Error
+        GHC.Types.Error.Codes
         GHC.Types.FieldLabel
         GHC.Types.Fixity
         GHC.Types.Fixity.Env