diff options
Diffstat (limited to 'compiler/GHC/Hs')
| -rw-r--r-- | compiler/GHC/Hs/Doc.hs | 30 | ||||
| -rw-r--r-- | compiler/GHC/Hs/DocString.hs | 18 |
2 files changed, 40 insertions, 8 deletions
diff --git a/compiler/GHC/Hs/Doc.hs b/compiler/GHC/Hs/Doc.hs index 948341f89f..38271e3681 100644 --- a/compiler/GHC/Hs/Doc.hs +++ b/compiler/GHC/Hs/Doc.hs @@ -38,6 +38,7 @@ import GHC.Types.Avail import GHC.Types.Name.Set import GHC.Driver.Flags +import Control.DeepSeq import Data.Data import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap @@ -74,6 +75,8 @@ data WithHsDocIdentifiers a pass = WithHsDocIdentifiers deriving instance (Data pass, Data (IdP pass), Data a) => Data (WithHsDocIdentifiers a pass) deriving instance (Eq (IdP pass), Eq a) => Eq (WithHsDocIdentifiers a pass) +instance (NFData (IdP pass), NFData a) => NFData (WithHsDocIdentifiers a pass) where + rnf (WithHsDocIdentifiers d i) = rnf d `seq` rnf i -- | For compatibility with the existing @-ddump-parsed' output, we only show -- the docstring. @@ -118,19 +121,19 @@ type LHsDoc pass = Located (HsDoc pass) -- | A simplified version of 'HsImpExp.IE'. data DocStructureItem - = DsiSectionHeading Int (HsDoc GhcRn) - | DsiDocChunk (HsDoc GhcRn) - | DsiNamedChunkRef String - | DsiExports Avails + = DsiSectionHeading !Int !(HsDoc GhcRn) + | DsiDocChunk !(HsDoc GhcRn) + | DsiNamedChunkRef !(String) + | DsiExports !Avails | DsiModExport - (NonEmpty ModuleName) -- ^ We might re-export avails from multiple + !(NonEmpty ModuleName) -- ^ We might re-export avails from multiple -- modules with a single export declaration. E.g. -- when we have -- -- > module M (module X) where -- > import R0 as X -- > import R1 as X - Avails + !Avails instance Binary DocStructureItem where put_ bh = \case @@ -179,6 +182,15 @@ instance Outputable DocStructureItem where DsiModExport mod_names avails -> text "re-exported module(s):" <+> ppr mod_names $$ nest 2 (ppr avails) +instance NFData DocStructureItem where + rnf = \case + DsiSectionHeading level doc -> rnf level `seq` rnf doc + DsiDocChunk doc -> rnf doc + DsiNamedChunkRef name -> rnf name + DsiExports avails -> rnf avails + DsiModExport mod_names avails -> rnf mod_names `seq` rnf avails + + type DocStructure = [DocStructureItem] data Docs = Docs @@ -203,6 +215,12 @@ data Docs = Docs -- ^ The full set of language extensions used in the module. } +instance NFData Docs where + rnf (Docs mod_hdr decls args structure named_chunks haddock_opts language extentions) + = rnf mod_hdr `seq` rnf decls `seq` rnf args `seq` rnf structure `seq` rnf named_chunks + `seq` rnf haddock_opts `seq` rnf language `seq` rnf extentions + `seq` () + instance Binary Docs where put_ bh docs = do put_ bh (docs_mod_hdr docs) diff --git a/compiler/GHC/Hs/DocString.hs b/compiler/GHC/Hs/DocString.hs index c96165d178..8e42c4a8d8 100644 --- a/compiler/GHC/Hs/DocString.hs +++ b/compiler/GHC/Hs/DocString.hs @@ -1,5 +1,7 @@ -- | An exactprintable structure for docstrings {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module GHC.Hs.DocString ( LHsDocString @@ -27,6 +29,7 @@ import GHC.Utils.Binary import GHC.Utils.Encoding import GHC.Utils.Outputable as Outputable hiding ((<>)) import GHC.Types.SrcLoc +import Control.DeepSeq import Data.ByteString (ByteString) import qualified Data.ByteString as BS @@ -59,6 +62,11 @@ data HsDocString instance Outputable HsDocString where ppr = text . renderHsDocString +instance NFData HsDocString where + rnf (MultiLineDocString a b) = rnf a `seq` rnf b + rnf (NestedDocString a b) = rnf a `seq` rnf b + rnf (GeneratedDocString a) = rnf a + -- | Annotate a pretty printed thing with its doc -- The docstring comes after if is 'HsDocStringPrevious' -- Otherwise it comes before. @@ -101,6 +109,12 @@ data HsDocStringDecorator instance Outputable HsDocStringDecorator where ppr = text . printDecorator +instance NFData HsDocStringDecorator where + rnf HsDocStringNext = () + rnf HsDocStringPrevious = () + rnf (HsDocStringNamed x) = rnf x + rnf (HsDocStringGroup x) = rnf x + printDecorator :: HsDocStringDecorator -> String printDecorator HsDocStringNext = "|" printDecorator HsDocStringPrevious = "^" @@ -126,7 +140,8 @@ type LHsDocStringChunk = Located HsDocStringChunk -- | A contiguous chunk of documentation newtype HsDocStringChunk = HsDocStringChunk ByteString - deriving (Eq,Ord,Data, Show) + deriving stock (Eq,Ord,Data, Show) + deriving newtype (NFData) instance Binary HsDocStringChunk where put_ bh (HsDocStringChunk bs) = put_ bh bs @@ -135,7 +150,6 @@ instance Binary HsDocStringChunk where instance Outputable HsDocStringChunk where ppr = text . unpackHDSC - mkHsDocStringChunk :: String -> HsDocStringChunk mkHsDocStringChunk s = HsDocStringChunk (utf8EncodeByteString s) |