Commit c4f3d91b authored by Simon Marlow's avatar Simon Marlow Committed by Simon Marlow

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
parent bfef2eb1
......@@ -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
......
......@@ -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.
......
......@@ -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` ()
{-
************************************************************************
* *
......
......@@ -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>")
......
......@@ -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,
......
-- (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
......
......@@ -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
......
......@@ -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 []
......
Subproject commit cdc81a1b73bd4d1b330a32870d4369e1a2af3610
Subproject commit a3309e797c42dae9bccdeb17ce52fcababbaff8a
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment