summaryrefslogtreecommitdiff
path: root/compiler/GHC
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC')
-rw-r--r--compiler/GHC/Data/EnumSet.hs3
-rw-r--r--compiler/GHC/Driver/Flags.hs4
-rw-r--r--compiler/GHC/Hs/Doc.hs30
-rw-r--r--compiler/GHC/Hs/DocString.hs18
-rw-r--r--compiler/GHC/Types/Avail.hs10
-rw-r--r--compiler/GHC/Types/FieldLabel.hs7
-rw-r--r--compiler/GHC/Types/Name.hs-boot2
-rw-r--r--compiler/GHC/Types/SrcLoc.hs2
-rw-r--r--compiler/GHC/Types/Unique/Map.hs4
-rw-r--r--compiler/GHC/Unit/Module/ModIface.hs4
10 files changed, 73 insertions, 11 deletions
diff --git a/compiler/GHC/Data/EnumSet.hs b/compiler/GHC/Data/EnumSet.hs
index d364dc05d7..de462e2337 100644
--- a/compiler/GHC/Data/EnumSet.hs
+++ b/compiler/GHC/Data/EnumSet.hs
@@ -15,11 +15,12 @@ module GHC.Data.EnumSet
import GHC.Prelude
import GHC.Utils.Binary
+import Control.DeepSeq
import qualified Data.IntSet as IntSet
newtype EnumSet a = EnumSet IntSet.IntSet
- deriving (Semigroup, Monoid)
+ deriving (Semigroup, Monoid, NFData)
member :: Enum a => a -> EnumSet a -> Bool
member x (EnumSet s) = IntSet.member (fromEnum x) s
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index f45397d887..ed77b81ebd 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -26,6 +26,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Binary
import GHC.Data.EnumSet as EnumSet
+import Control.DeepSeq
import Control.Monad (guard)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (fromMaybe,mapMaybe)
@@ -40,6 +41,9 @@ instance Binary Language where
put_ bh = put_ bh . fromEnum
get bh = toEnum <$> get bh
+instance NFData Language where
+ rnf x = x `seq` ()
+
-- | Debugging flags
data DumpFlag
-- See Note [Updating flag description in the User's Guide]
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)
diff --git a/compiler/GHC/Types/Avail.hs b/compiler/GHC/Types/Avail.hs
index ab57c6f1a1..346cf4236c 100644
--- a/compiler/GHC/Types/Avail.hs
+++ b/compiler/GHC/Types/Avail.hs
@@ -50,6 +50,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Utils.Constants (debugIsOn)
+import Control.DeepSeq
import Data.Data ( Data )
import Data.Either ( partitionEithers )
import Data.Functor.Classes ( liftCompare )
@@ -272,6 +273,10 @@ instance Outputable GreName where
ppr (NormalGreName n) = ppr n
ppr (FieldGreName fl) = ppr fl
+instance NFData GreName where
+ rnf (NormalGreName n) = rnf n
+ rnf (FieldGreName f) = rnf f
+
instance HasOccName GreName where
occName (NormalGreName n) = occName n
occName (FieldGreName fl) = occName fl
@@ -385,6 +390,10 @@ instance Binary AvailInfo where
ac <- get bh
return (AvailTC ab ac)
+instance NFData AvailInfo where
+ rnf (Avail n) = rnf n
+ rnf (AvailTC a b) = rnf a `seq` rnf b
+
instance Binary GreName where
put_ bh (NormalGreName aa) = do
putByte bh 0
@@ -399,3 +408,4 @@ instance Binary GreName where
return (NormalGreName aa)
_ -> do ab <- get bh
return (FieldGreName ab)
+
diff --git a/compiler/GHC/Types/FieldLabel.hs b/compiler/GHC/Types/FieldLabel.hs
index 2c654926ae..89bfd4afee 100644
--- a/compiler/GHC/Types/FieldLabel.hs
+++ b/compiler/GHC/Types/FieldLabel.hs
@@ -95,6 +95,7 @@ import GHC.Utils.Binary
import Language.Haskell.Syntax.Basic (FieldLabelString(..))
+import Control.DeepSeq
import Data.Bool
import Data.Data
@@ -129,6 +130,8 @@ instance Outputable FieldLabelString where
instance Uniquable FieldLabelString where
getUnique (FieldLabelString fs) = getUnique fs
+instance NFData FieldLabel where
+ rnf (FieldLabel a b c d) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d
-- | Flag to indicate whether the DuplicateRecordFields extension is enabled.
data DuplicateRecordFields
@@ -144,6 +147,8 @@ instance Outputable DuplicateRecordFields where
ppr DuplicateRecordFields = text "+dup"
ppr NoDuplicateRecordFields = text "-dup"
+instance NFData DuplicateRecordFields where
+ rnf x = x `seq` ()
-- | Flag to indicate whether the FieldSelectors extension is enabled.
data FieldSelectors
@@ -159,6 +164,8 @@ instance Outputable FieldSelectors where
ppr FieldSelectors = text "+sel"
ppr NoFieldSelectors = text "-sel"
+instance NFData FieldSelectors where
+ rnf x = x `seq` ()
-- | We need the @Binary Name@ constraint here even though there is an instance
-- defined in "GHC.Types.Name", because the we have a SOURCE import, so the
diff --git a/compiler/GHC/Types/Name.hs-boot b/compiler/GHC/Types/Name.hs-boot
index ebc2efd34c..e7e4cf2c7b 100644
--- a/compiler/GHC/Types/Name.hs-boot
+++ b/compiler/GHC/Types/Name.hs-boot
@@ -8,6 +8,7 @@ import {-# SOURCE #-} GHC.Types.Name.Occurrence
import GHC.Types.Unique
import GHC.Utils.Outputable
import Data.Data (Data)
+import Control.DeepSeq (NFData)
data Name
@@ -15,6 +16,7 @@ instance Eq Name
instance Data Name
instance Uniquable Name
instance Outputable Name
+instance NFData Name
class NamedThing a where
getOccName :: a -> OccName
diff --git a/compiler/GHC/Types/SrcLoc.hs b/compiler/GHC/Types/SrcLoc.hs
index 30ff00deed..a78716a61e 100644
--- a/compiler/GHC/Types/SrcLoc.hs
+++ b/compiler/GHC/Types/SrcLoc.hs
@@ -738,6 +738,8 @@ pprUserRealSpan show_path (RealSrcSpan' src_path sline scol eline ecol)
-- | We attach SrcSpans to lots of things, so let's have a datatype for it.
data GenLocated l e = L l e
deriving (Eq, Ord, Show, Data, Functor, Foldable, Traversable)
+instance (NFData l, NFData e) => NFData (GenLocated l e) where
+ rnf (L l e) = rnf l `seq` rnf e
type Located = GenLocated SrcSpan
type RealLocated = GenLocated RealSrcSpan
diff --git a/compiler/GHC/Types/Unique/Map.hs b/compiler/GHC/Types/Unique/Map.hs
index b889ba2bbd..4f79792811 100644
--- a/compiler/GHC/Types/Unique/Map.hs
+++ b/compiler/GHC/Types/Unique/Map.hs
@@ -59,6 +59,7 @@ import Data.Semigroup as Semi ( Semigroup(..) )
import Data.Coerce
import Data.Maybe
import Data.Data
+import Control.DeepSeq
-- | Maps indexed by 'Uniquable' keys
newtype UniqMap k a = UniqMap { getUniqMap :: UniqFM k (k, a) }
@@ -78,6 +79,9 @@ instance (Outputable k, Outputable a) => Outputable (UniqMap k a) where
[ ppr k <+> text "->" <+> ppr v
| (k, v) <- nonDetEltsUFM m ]
+instance (NFData k, NFData a) => NFData (UniqMap k a) where
+ rnf (UniqMap fm) = seqEltsUFM rnf fm
+
liftC :: (a -> a -> a) -> (k, a) -> (k, a) -> (k, a)
liftC f (_, v) (k', v') = (k', f v v')
diff --git a/compiler/GHC/Unit/Module/ModIface.hs b/compiler/GHC/Unit/Module/ModIface.hs
index 1d5280f4fa..d46160a1a6 100644
--- a/compiler/GHC/Unit/Module/ModIface.hs
+++ b/compiler/GHC/Unit/Module/ModIface.hs
@@ -240,7 +240,7 @@ data ModIface_ (phase :: ModIfacePhase)
-- See Note [Trust Own Package] in GHC.Rename.Names
mi_complete_matches :: ![IfaceCompleteMatch],
- mi_docs :: Maybe Docs,
+ mi_docs :: !(Maybe Docs),
-- ^ Docstrings and related data for use by haddock, the ghci
-- @:doc@ command, and other tools.
--
@@ -554,7 +554,7 @@ instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclE
f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) =
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` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq`
- rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` f21 `seq` f22 `seq` f23 `seq` rnf f24
+ rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` rnf f21 `seq` f22 `seq` f23 `seq` rnf f24
`seq` ()
View Lorry Controller Status