diff options
-rw-r--r-- | compiler/GHC/Driver/Errors/Ppr.hs | 17 | ||||
-rw-r--r-- | compiler/GHC/Driver/Errors/Ppr.hs-boot | 5 | ||||
-rw-r--r-- | compiler/GHC/Types/Error.hs | 116 | ||||
-rw-r--r-- | compiler/GHC/Types/Error/Codes.hs | 94 | ||||
-rw-r--r-- | compiler/ghc.cabal.in | 1 |
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 |