[Haskell-cafe] NFData question
Daniel Fischer
daniel.is.fischer at web.de
Fri Sep 4 16:16:23 EDT 2009
Am Freitag 04 September 2009 21:57:27 schrieb Peter Verswyvelen:
> When ones makes an ADT with data constructors that has strict (and
> maybe unpacked) fields,
>
> e.g.
>
> data Vec2 a = Vec2 {-# UNPACK #-} !a {-# UNPACK #-} !a
>
> how does one define an NFData instance?
>
> Like this?
>
> instance NFData a => NFData (Vec2 a) where
> rnf (Vec2 x y) = rnf x `seq` rnf y
Yep.
>
> Or is it enough to just do
> instance NFData a => NFData (Vec2 a)
>
> since Vec2 is fully strict anyway, so that default rnf implementation will
> do?
Not necessarily. It will do if a is a simple type for which whnf == nf, like Int, but
otherwise the components of Vec2 are only forced to whnf by the strictness annotations and
the default implementation of rnf won't do anything more.
module Vec2 where
import Control.Parallel.Strategies
data Vec2 a = Vec2 {-# UNPACK #-} !a {-# UNPACK #-} !a
deriving Show
instance NFData (Vec2 a)
ghci> let v = Vec2 [True,False] [False,True,undefined]
ghci> case v `using` rnf of { Vec2 l1 l2 -> (l1,take 2 l2) }
([True,False],[False,True])
ghci> v
Vec2 [True,False] [False,True,*** Exception: Prelude.undefined
>
> Thanks,
> Peter
More information about the Haskell-Cafe
mailing list