diff options
Diffstat (limited to 'compiler/GHC/Unit')
| -rw-r--r-- | compiler/GHC/Unit/Module/ModGuts.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Unit/Module/ModIface.hs | 41 | ||||
| -rw-r--r-- | compiler/GHC/Unit/Module/Warnings.hs | 47 |
3 files changed, 45 insertions, 49 deletions
diff --git a/compiler/GHC/Unit/Module/ModGuts.hs b/compiler/GHC/Unit/Module/ModGuts.hs index 4fc683d844..d54e836d71 100644 --- a/compiler/GHC/Unit/Module/ModGuts.hs +++ b/compiler/GHC/Unit/Module/ModGuts.hs @@ -72,7 +72,7 @@ data ModGuts mg_foreign :: !ForeignStubs, -- ^ Foreign exports declared in this module mg_foreign_files :: ![(ForeignSrcLang, FilePath)], -- ^ Files to be compiled with the C compiler - mg_warns :: !Warnings, -- ^ Warnings declared in the module + mg_warns :: !(Warnings GhcRn), -- ^ Warnings declared in the module mg_anns :: [Annotation], -- ^ Annotations declared in this module mg_complete_matches :: [CompleteMatch], -- ^ Complete Matches mg_hpc_info :: !HpcInfo, -- ^ Coverage tick boxes in the module @@ -97,9 +97,7 @@ data ModGuts -- See Note [Trust Own Package] -- in "GHC.Rename.Names" - mg_doc_hdr :: !(Maybe HsDocString), -- ^ Module header. - mg_decl_docs :: !DeclDocMap, -- ^ Docs on declarations. - mg_arg_docs :: !ArgDocMap -- ^ Docs on arguments. + mg_docs :: !(Maybe Docs) -- ^ Documentation. } mg_mnwib :: ModGuts -> ModuleNameWithIsBoot diff --git a/compiler/GHC/Unit/Module/ModIface.hs b/compiler/GHC/Unit/Module/ModIface.hs index db7c4ce362..5a3cfe71c9 100644 --- a/compiler/GHC/Unit/Module/ModIface.hs +++ b/compiler/GHC/Unit/Module/ModIface.hs @@ -109,7 +109,7 @@ data ModIfaceBackend = ModIfaceBackend -- other fields and are not put into the interface file. -- Not really produced by the backend but there is no need to create them -- any earlier. - , mi_warn_fn :: !(OccName -> Maybe WarningTxt) + , mi_warn_fn :: !(OccName -> Maybe (WarningTxt GhcRn)) -- ^ Cached lookup for 'mi_warns' , mi_fix_fn :: !(OccName -> Maybe Fixity) -- ^ Cached lookup for 'mi_fixities' @@ -184,7 +184,7 @@ data ModIface_ (phase :: ModIfacePhase) -- ^ Fixities -- NOT STRICT! we read this field lazily from the interface file - mi_warns :: Warnings, + mi_warns :: (Warnings GhcRn), -- ^ Warnings -- NOT STRICT! we read this field lazily from the interface file @@ -235,14 +235,11 @@ data ModIface_ (phase :: ModIfacePhase) -- See Note [Trust Own Package] in GHC.Rename.Names mi_complete_matches :: ![IfaceCompleteMatch], - mi_doc_hdr :: Maybe HsDocString, - -- ^ Module header. - - mi_decl_docs :: DeclDocMap, - -- ^ Docs on declarations. - - mi_arg_docs :: ArgDocMap, - -- ^ Docs on arguments. + mi_docs :: Maybe Docs, + -- ^ Docstrings and related data for use by haddock, the ghci + -- @:doc@ command, and other tools. + -- + -- @Just _@ @<=>@ the module was built with @-haddock@. mi_final_exts :: !(IfaceBackendExts phase), -- ^ Either `()` or `ModIfaceBackend` for @@ -359,9 +356,7 @@ instance Binary ModIface where mi_trust = trust, mi_trust_pkg = trust_pkg, mi_complete_matches = complete_matches, - mi_doc_hdr = doc_hdr, - mi_decl_docs = decl_docs, - mi_arg_docs = arg_docs, + mi_docs = docs, mi_ext_fields = _ext_fields, -- Don't `put_` this in the instance so we -- can deal with it's pointer in the header -- when we write the actual file @@ -405,9 +400,7 @@ instance Binary ModIface where put_ bh trust put_ bh trust_pkg put_ bh complete_matches - lazyPut bh doc_hdr - lazyPut bh decl_docs - lazyPut bh arg_docs + lazyPutMaybe bh docs get bh = do mod <- get bh @@ -438,9 +431,7 @@ instance Binary ModIface where trust <- get bh trust_pkg <- get bh complete_matches <- get bh - doc_hdr <- lazyGet bh - decl_docs <- lazyGet bh - arg_docs <- lazyGet bh + docs <- lazyGetMaybe bh return (ModIface { mi_module = mod, mi_sig_of = sig_of, @@ -464,9 +455,7 @@ instance Binary ModIface where mi_trust_pkg = trust_pkg, -- And build the cached values mi_complete_matches = complete_matches, - mi_doc_hdr = doc_hdr, - mi_decl_docs = decl_docs, - mi_arg_docs = arg_docs, + mi_docs = docs, mi_ext_fields = emptyExtensibleFields, -- placeholder because this is dealt -- with specially when the file is read mi_final_exts = ModIfaceBackend { @@ -510,9 +499,7 @@ emptyPartialModIface mod mi_trust = noIfaceTrustInfo, mi_trust_pkg = False, mi_complete_matches = [], - mi_doc_hdr = Nothing, - mi_decl_docs = emptyDeclDocMap, - mi_arg_docs = emptyArgDocMap, + mi_docs = Nothing, mi_final_exts = (), mi_ext_fields = emptyExtensibleFields } @@ -554,11 +541,11 @@ emptyIfaceHashCache _occ = Nothing -- avoid major space leaks. instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24 f25) = + f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23) = rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` f9 `seq` rnf f10 `seq` rnf f11 `seq` f12 `seq` rnf f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` f17 `seq` rnf f18 `seq` rnf f19 `seq` f20 `seq` f21 `seq` f22 `seq` rnf f23 - `seq` rnf f24 `seq` f25 `seq` () + `seq` () instance NFData (ModIfaceBackend) where rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) diff --git a/compiler/GHC/Unit/Module/Warnings.hs b/compiler/GHC/Unit/Module/Warnings.hs index d8847be72c..6936702b2a 100644 --- a/compiler/GHC/Unit/Module/Warnings.hs +++ b/compiler/GHC/Unit/Module/Warnings.hs @@ -1,4 +1,8 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE StandaloneDeriving #-} -- | Warnings for a module module GHC.Unit.Module.Warnings @@ -16,25 +20,31 @@ import GHC.Prelude import GHC.Types.SourceText import GHC.Types.Name.Occurrence import GHC.Types.SrcLoc +import GHC.Hs.Doc +import GHC.Hs.Extension import GHC.Utils.Outputable import GHC.Utils.Binary +import Language.Haskell.Syntax.Extension + import Data.Data -- | Warning Text -- -- reason/explanation from a WARNING or DEPRECATED pragma -data WarningTxt +data WarningTxt pass = WarningTxt (Located SourceText) - [Located StringLiteral] + [Located (WithHsDocIdentifiers StringLiteral pass)] | DeprecatedTxt (Located SourceText) - [Located StringLiteral] - deriving (Eq, Data) + [Located (WithHsDocIdentifiers StringLiteral pass)] + +deriving instance Eq (IdP pass) => Eq (WarningTxt pass) +deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass) -instance Outputable WarningTxt where +instance Outputable (WarningTxt pass) where ppr (WarningTxt lsrc ws) = case unLoc lsrc of NoSourceText -> pp_ws ws @@ -45,7 +55,7 @@ instance Outputable WarningTxt where NoSourceText -> pp_ws ds SourceText src -> text src <+> pp_ws ds <+> text "#-}" -instance Binary WarningTxt where +instance Binary (WarningTxt GhcRn) where put_ bh (WarningTxt s w) = do putByte bh 0 put_ bh s @@ -66,7 +76,7 @@ instance Binary WarningTxt where return (DeprecatedTxt s d) -pp_ws :: [Located StringLiteral] -> SDoc +pp_ws :: [Located (WithHsDocIdentifiers StringLiteral pass)] -> SDoc pp_ws [l] = ppr $ unLoc l pp_ws ws = text "[" @@ -74,19 +84,19 @@ pp_ws ws <+> text "]" -pprWarningTxtForMsg :: WarningTxt -> SDoc +pprWarningTxtForMsg :: WarningTxt p -> SDoc pprWarningTxtForMsg (WarningTxt _ ws) - = doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ws)) + = doubleQuotes (vcat (map (ftext . sl_fs . hsDocString . unLoc) ws)) pprWarningTxtForMsg (DeprecatedTxt _ ds) = text "Deprecated:" <+> - doubleQuotes (vcat (map (ftext . sl_fs . unLoc) ds)) + doubleQuotes (vcat (map (ftext . sl_fs . hsDocString . unLoc) ds)) -- | Warning information for a module -data Warnings +data Warnings pass = NoWarnings -- ^ Nothing deprecated - | WarnAll WarningTxt -- ^ Whole module deprecated - | WarnSome [(OccName,WarningTxt)] -- ^ Some specific things deprecated + | WarnAll (WarningTxt pass) -- ^ Whole module deprecated + | WarnSome [(OccName,WarningTxt pass)] -- ^ Some specific things deprecated -- Only an OccName is needed because -- (1) a deprecation always applies to a binding @@ -108,9 +118,10 @@ data Warnings -- -- this is in contrast with fixity declarations, where we need to map -- a Name to its fixity declaration. - deriving( Eq ) -instance Binary Warnings where +deriving instance Eq (IdP pass) => Eq (Warnings pass) + +instance Binary (Warnings GhcRn) where put_ bh NoWarnings = putByte bh 0 put_ bh (WarnAll t) = do putByte bh 1 @@ -129,15 +140,15 @@ instance Binary Warnings where return (WarnSome aa) -- | Constructs the cache for the 'mi_warn_fn' field of a 'ModIface' -mkIfaceWarnCache :: Warnings -> OccName -> Maybe WarningTxt +mkIfaceWarnCache :: Warnings p -> OccName -> Maybe (WarningTxt p) mkIfaceWarnCache NoWarnings = \_ -> Nothing mkIfaceWarnCache (WarnAll t) = \_ -> Just t mkIfaceWarnCache (WarnSome pairs) = lookupOccEnv (mkOccEnv pairs) -emptyIfaceWarnCache :: OccName -> Maybe WarningTxt +emptyIfaceWarnCache :: OccName -> Maybe (WarningTxt p) emptyIfaceWarnCache _ = Nothing -plusWarns :: Warnings -> Warnings -> Warnings +plusWarns :: Warnings p -> Warnings p -> Warnings p plusWarns d NoWarnings = d plusWarns NoWarnings d = d plusWarns _ (WarnAll t) = WarnAll t |