Add deepseq dependency and a few NFData instances
authorSimon Marlow <smarlow@fb.com>
Thu, 21 Jul 2016 11:32:55 +0000 (04:32 -0700)
committerSimon Marlow <marlowsd@gmail.com>
Fri, 22 Jul 2016 12:56:41 +0000 (13:56 +0100)
I needed to rnf a data structure (CompiledByteCode) but we don't have
any good deepseq infrastructure in the compiler yet.  There are bits and
pieces, but nothing consistent, so this is a start.

We already had a dependency on deepseq indirectly via other packages
(e.g. containers).

Includes an update to the haddock submodule, to remove orphan NFData
instances in there.

Test Plan: validate

Reviewers: austin, bgamari, erikd, hvr

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2418

compiler/basicTypes/Module.hs
compiler/basicTypes/Name.hs
compiler/basicTypes/OccName.hs
compiler/basicTypes/SrcLoc.hs
compiler/ghc.cabal.in
compiler/utils/FastString.hs
libraries/ghci/GHCi/RemoteTypes.hs
libraries/ghci/SizedSeq.hs
utils/haddock

index 59ed840..b6b19d2 100644 (file)
@@ -92,6 +92,7 @@ import Data.Ord
 import {-# SOURCE #-} Packages
 import GHC.PackageDb (BinaryStringRep(..), DbModuleRep(..), DbModule(..))
 
+import Control.DeepSeq
 import Data.Coerce
 import Data.Data
 import Data.Map (Map)
@@ -266,6 +267,9 @@ instance Data ModuleName where
   gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNoRepType "ModuleName"
 
+instance NFData ModuleName where
+  rnf x = x `seq` ()
+
 stableModuleNameCmp :: ModuleName -> ModuleName -> Ordering
 -- ^ Compares module names lexically, rather than by their 'Unique's
 stableModuleNameCmp n1 n2 = moduleNameFS n1 `compare` moduleNameFS n2
@@ -319,7 +323,7 @@ moduleNameColons = dots_to_colons . moduleNameString
 -- | A Module is a pair of a 'UnitId' and a 'ModuleName'.
 data Module = Module {
    moduleUnitId :: !UnitId,  -- pkg-1.0
-   moduleName      :: !ModuleName  -- A.B.C
+   moduleName :: !ModuleName  -- A.B.C
   }
   deriving (Eq, Ord)
 
@@ -339,6 +343,9 @@ instance Data Module where
   gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNoRepType "Module"
 
+instance NFData Module where
+  rnf x = x `seq` ()
+
 -- | This gives a stable ordering, as opposed to the Ord instance which
 -- gives an ordering based on the 'Unique's of the components, which may
 -- not be stable from run to run of the compiler.
@@ -404,6 +411,9 @@ instance Data UnitId where
   gunfold _ _  = error "gunfold"
   dataTypeOf _ = mkNoRepType "UnitId"
 
+instance NFData UnitId where
+  rnf x = x `seq` ()
+
 stableUnitIdCmp :: UnitId -> UnitId -> Ordering
 -- ^ Compares package ids lexically, rather than by their 'Unique's
 stableUnitIdCmp p1 p2 = unitIdFS p1 `compare` unitIdFS p2
index b0411b9..d1b05f3 100644 (file)
@@ -90,6 +90,7 @@ import DynFlags
 import FastString
 import Outputable
 
+import Control.DeepSeq
 import Data.Data
 
 {-
@@ -131,6 +132,18 @@ instance Outputable NameSort where
   ppr  Internal       = text "internal"
   ppr  System         = text "system"
 
+instance NFData Name where
+  rnf Name{..} = rnf n_sort
+
+instance NFData NameSort where
+  rnf (External m) = rnf m
+  rnf (WiredIn m t b) = rnf m `seq` t `seq` b `seq` ()
+    -- XXX this is a *lie*, we're not going to rnf the TyThing, but
+    -- since the TyThings for WiredIn Names are all static they can't
+    -- be hiding space leaks or errors.
+  rnf Internal = ()
+  rnf System = ()
+
 -- | BuiltInSyntax is for things like @(:)@, @[]@ and tuples,
 -- which have special syntactic forms.  They aren't in scope
 -- as such.
index 8dfeb7f..3b8943f 100644 (file)
@@ -116,6 +116,7 @@ import FastStringEnv
 import Outputable
 import Lexeme
 import Binary
+import Control.DeepSeq
 import Data.List (mapAccumL)
 import Data.Char
 import Data.Data
@@ -249,6 +250,9 @@ instance Data OccName where
 instance HasOccName OccName where
   occName = id
 
+instance NFData OccName where
+  rnf x = x `seq` ()
+
 {-
 ************************************************************************
 *                                                                      *
index a5df956..9c48eee 100644 (file)
@@ -84,6 +84,7 @@ import Util
 import Outputable
 import FastString
 
+import Control.DeepSeq
 import Data.Bits
 import Data.Data
 import Data.List
@@ -238,6 +239,9 @@ data SrcSpan =
   deriving (Eq, Ord, Show) -- Show is used by Lexer.x, because we
                            -- derive Show for Token
 
+instance NFData SrcSpan where
+  rnf x = x `seq` ()
+
 -- | Built-in "bad" 'SrcSpan's for common sources of location uncertainty
 noSrcSpan, wiredInSrcSpan, interactiveSrcSpan :: SrcSpan
 noSrcSpan          = UnhelpfulSpan (fsLit "<no location info>")
index 3042d1d..3d75dae 100644 (file)
@@ -45,6 +45,7 @@ Library
     Exposed: False
 
     Build-Depends: base       >= 4   && < 5,
+                   deepseq    >= 1.4 && < 1.5,
                    directory  >= 1   && < 1.3,
                    process    >= 1   && < 1.5,
                    bytestring >= 0.9 && < 0.11,
index 651719a..1496a86 100644 (file)
@@ -1,6 +1,7 @@
 -- (c) The University of Glasgow, 1997-2006
 
-{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples,
+    GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -O -funbox-strict-fields #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
@@ -97,6 +98,7 @@ import FastFunctions
 import Panic
 import Util
 
+import Control.DeepSeq
 import Control.Monad
 import Data.ByteString (ByteString)
 import qualified Data.ByteString          as BS
@@ -145,6 +147,7 @@ hashByteString bs
 -- -----------------------------------------------------------------------------
 
 newtype FastZString = FastZString ByteString
+  deriving NFData
 
 hPutFZS :: Handle -> FastZString -> IO ()
 hPutFZS handle (FastZString bs) = BS.hPut handle bs
index 5bc0136..3b4dee7 100644 (file)
@@ -17,6 +17,7 @@ module GHCi.RemoteTypes
   , unsafeForeignRefToRemoteRef, finalizeForeignRef
   ) where
 
+import Control.DeepSeq
 import Data.Word
 import Foreign hiding (newForeignPtr)
 import Foreign.Concurrent
@@ -49,6 +50,7 @@ castRemotePtr (RemotePtr a) = RemotePtr a
 
 deriving instance Show (RemotePtr a)
 deriving instance Binary (RemotePtr a)
+deriving instance NFData (RemotePtr a)
 
 -- -----------------------------------------------------------------------------
 -- HValueRef
@@ -91,6 +93,9 @@ freeRemoteRef (RemoteRef w) =
 -- | An HValueRef with a finalizer
 newtype ForeignRef a = ForeignRef (ForeignPtr ())
 
+instance NFData (ForeignRef a) where
+  rnf x = x `seq` ()
+
 type ForeignHValue = ForeignRef HValue
 
 -- | Create a 'ForeignRef' from a 'RemoteRef'.  The finalizer
index e5bb37c..503544a 100644 (file)
@@ -8,6 +8,7 @@ module SizedSeq
   , sizeSS
   ) where
 
+import Control.DeepSeq
 import Data.Binary
 import Data.List
 import GHC.Generics
@@ -26,6 +27,9 @@ instance Traversable SizedSeq where
 
 instance Binary a => Binary (SizedSeq a)
 
+instance NFData a => NFData (SizedSeq a) where
+  rnf (SizedSeq _ xs) = rnf xs
+
 emptySS :: SizedSeq a
 emptySS = SizedSeq 0 []
 
index cdc81a1..a3309e7 160000 (submodule)
@@ -1 +1 @@
-Subproject commit cdc81a1b73bd4d1b330a32870d4369e1a2af3610
+Subproject commit a3309e797c42dae9bccdeb17ce52fcababbaff8a