[Haskell-cafe] Derving NFData via Generics from a type that has a vector doesn't work. (was trying to understand out of memory exceptions)
Anatoly Yakovenko
aeyakovenko at gmail.com
Tue Apr 16 21:07:24 CEST 2013
-- ok, something in deriving NFData using Generics in a type that has a
Vector in it.
{-# LANGUAGE DeriveGeneric #-}
import Control.DeepSeq
import System.IO
import GHC.Generics (Generic)
import qualified Data.Vector as V
import qualified Data.ByteString.Lazy.Char8 as BL
scanl' :: NFData a => (a -> b -> a) -> a -> [b] -> [a]
scanl' f q ls = q : (case ls of
[] -> []
x:xs -> let q' = f q x
in q' `deepseq` scanl' f q' xs)
-- this runs without blowing up
-- main = print $ last $ scanl' (+) (0::Int) [0..]
data Simple = Simple (V.Vector Double)
deriving (Show, Generic)
instance NFData Simple
--this blows up
main = do
let initial = Simple $ V.fromList (take 100 $ repeat 0)
sumvs (Simple a) (Simple b) = Simple $ V.zipWith (+) a b
print $ last $ scanl' sumvs initial $ repeat $ initial
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20130416/908cf6bf/attachment.htm>
More information about the Haskell-Cafe
mailing list