[commit: ghc] ghc-8.0: Add deepseq dependency and a few NFData instances (2c44744)
git at git.haskell.org
git at git.haskell.org
Sun Aug 7 11:59:24 UTC 2016
Repository : ssh://git@git.haskell.org/ghc
On branch : ghc-8.0
Link : http://ghc.haskell.org/trac/ghc/changeset/2c447448b347bb438b18d29f82cd8b8fc2a397b1/ghc
>---------------------------------------------------------------
commit 2c447448b347bb438b18d29f82cd8b8fc2a397b1
Author: Simon Marlow <smarlow at fb.com>
Date: Thu Jul 21 04:32:55 2016 -0700
Add deepseq dependency and a few NFData instances
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
(cherry picked from commit c4f3d91b6b32a27c2e00506de532e90c595de2d1)
>---------------------------------------------------------------
2c447448b347bb438b18d29f82cd8b8fc2a397b1
compiler/basicTypes/Module.hs | 12 +++++++++++-
compiler/basicTypes/Name.hs | 13 +++++++++++++
compiler/basicTypes/OccName.hs | 4 ++++
compiler/basicTypes/SrcLoc.hs | 4 ++++
compiler/ghc.cabal.in | 1 +
compiler/utils/FastString.hs | 5 ++++-
libraries/ghci/GHCi/RemoteTypes.hs | 5 +++++
libraries/ghci/SizedSeq.hs | 4 ++++
utils/haddock | 2 +-
9 files changed, 47 insertions(+), 3 deletions(-)
diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs
index c8504fd..145321e 100644
--- a/compiler/basicTypes/Module.hs
+++ b/compiler/basicTypes/Module.hs
@@ -91,6 +91,7 @@ import Data.Ord
import {-# SOURCE #-} Packages
import GHC.PackageDb (BinaryStringRep(..))
+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, Typeable)
@@ -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.
@@ -400,6 +407,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
diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index 5ae8557..3ac70f3 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -91,6 +91,7 @@ import DynFlags
import FastString
import Outputable
+import Control.DeepSeq
import Data.Data
{-
@@ -133,6 +134,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.
diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs
index e5aa860..09c5fc9 100644
--- a/compiler/basicTypes/OccName.hs
+++ b/compiler/basicTypes/OccName.hs
@@ -112,6 +112,7 @@ import FastStringEnv
import Outputable
import Lexeme
import Binary
+import Control.DeepSeq
import Module
import Data.Char
import Data.Data
@@ -246,6 +247,9 @@ instance Data OccName where
instance HasOccName OccName where
occName = id
+instance NFData OccName where
+ rnf x = x `seq` ()
+
{-
************************************************************************
* *
diff --git a/compiler/basicTypes/SrcLoc.hs b/compiler/basicTypes/SrcLoc.hs
index 524da78..7b1a5eb 100644
--- a/compiler/basicTypes/SrcLoc.hs
+++ b/compiler/basicTypes/SrcLoc.hs
@@ -89,6 +89,7 @@ import FastString
import Data.Foldable ( Foldable )
import Data.Traversable ( Traversable )
#endif
+import Control.DeepSeq
import Data.Bits
import Data.Data
import Data.List
@@ -269,6 +270,9 @@ data SrcSpan =
deriving (Eq, Ord, Typeable, 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>")
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index ca250a8..d6a4944 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -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,
diff --git a/compiler/utils/FastString.hs b/compiler/utils/FastString.hs
index e1ef46a..6e692f2 100644
--- a/compiler/utils/FastString.hs
+++ b/compiler/utils/FastString.hs
@@ -1,6 +1,7 @@
-- (c) The University of Glasgow, 1997-2006
-{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-}
+{-# LANGUAGE BangPatterns, CPP, DeriveDataTypeable, 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
@@ -149,6 +151,7 @@ hashByteString bs
-- -----------------------------------------------------------------------------
newtype FastZString = FastZString ByteString
+ deriving NFData
hPutFZS :: Handle -> FastZString -> IO ()
hPutFZS handle (FastZString bs) = BS.hPut handle bs
diff --git a/libraries/ghci/GHCi/RemoteTypes.hs b/libraries/ghci/GHCi/RemoteTypes.hs
index ea91f19..32156aa 100644
--- a/libraries/ghci/GHCi/RemoteTypes.hs
+++ b/libraries/ghci/GHCi/RemoteTypes.hs
@@ -9,6 +9,7 @@ module GHCi.RemoteTypes
, unsafeForeignRefToRemoteRef, finalizeForeignRef
) where
+import Control.DeepSeq
import Data.Word
import Foreign hiding (newForeignPtr)
import Foreign.Concurrent
@@ -41,6 +42,7 @@ castRemotePtr (RemotePtr a) = RemotePtr a
deriving instance Show (RemotePtr a)
deriving instance Binary (RemotePtr a)
+deriving instance NFData (RemotePtr a)
-- -----------------------------------------------------------------------------
-- HValueRef
@@ -83,6 +85,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
diff --git a/libraries/ghci/SizedSeq.hs b/libraries/ghci/SizedSeq.hs
index e5bb37c..503544a 100644
--- a/libraries/ghci/SizedSeq.hs
+++ b/libraries/ghci/SizedSeq.hs
@@ -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 []
diff --git a/utils/haddock b/utils/haddock
index 6db811a..08aa479 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit 6db811aefb9cba65c8efe3876e850c813f280b6c
+Subproject commit 08aa47916d6bb5a0f65d4da1021e0700b30b4b3b
More information about the ghc-commits
mailing list