Program runs out of memory using GHC 7.6.3

[Matthias Fischmann]

Hi David,

I don't think this is a ghc issue.

I suspect you have too many unevaluated function calls lying around
(this would cause the runtime to run out of *stack* as opposed to
*heap*).  Different versions of ghc perform different optimizations on
your code, and 7.8 knows a way to fix it that 7.6 doesn't know.

This is usually solved by adding strictness: Instead of letting the
unevaluated function calls pile up, you force them (e.g. with `print`
or `Control.DeepSeq.deepseq`).

I would take a closer look at your makeCounts function: you call
traverse the input list, and traverse the entire list (starting from
each element) again in each round.  Either you should find a way to
iterate only once and accumulate all the data you need, or you should
start optimizing there.

hope this helps,
cheers,
matthias


On Sat, Dec 13, 2014 at 02:06:52AM -0700, David Spies wrote:
> Date: Sat, 13 Dec 2014 02:06:52 -0700
> From: David Spies <dnspies at gmail.com>
> To: "ghc-devs at haskell.org" <ghc-devs at haskell.org>
> Subject: Program runs out of memory using GHC 7.6.3
>
> I have a program I submitted for a Kattis problem:
> https://open.kattis.com/problems/digicomp2
> But I got memory limit exceeded.  I downloaded the test data and ran the
> program on my own computer without problems.  Eventually I found out that
> when compiling with GHC 7.6.3 (the version Kattis uses) rather than 7.8.3,
> this program runs out of memory.
> Can someone explain why it only works on the later compiler?  Is there a
> workaround so that I can submit to Kattis?
>
> Thanks,
> David

> module Main(main) where
>
> import           Control.Monad
> import           Data.Array
> import qualified Data.ByteString.Char8 as BS
> import           Data.Int
> import           Data.Maybe
>
> readAsInt :: BS.ByteString -> Int
> readAsInt = fst . fromJust . BS.readInt
>
> readVert :: IO Vert
> readVert = do
>   [s, sl, sr] <- liftM BS.words BS.getLine
>   return $ V (fromBS s) (readAsInt sl) (readAsInt sr)
>
> main::IO()
> main = do
>   [n, m64] <- liftM (map read . words) getLine :: IO [Int64]
>   let m = fromIntegral m64 :: Int
>   verts <- replicateM m readVert
>   let vside = map getSide verts
>   let vpar = concat $ zipWith makeAssoc [1..] verts
>   let parArr = accumArray (flip (:)) [] (1, m) vpar
>   let counts = makeCounts n m $ elems parArr
>   let res = zipWith doFlips counts vside
>   putStrLn $ map toChar res
>
> doFlips :: Int64 -> Side -> Side
> doFlips n
>   | odd n = flipSide
>   | otherwise = id
>
> makeCounts :: Int64 -> Int -> [[(Int, Round)]] -> [Int64]
> makeCounts n m l = tail $ elems res
>   where
>     res = listArray (0, m) $ 0 : n : map makeCount (tail l)
>     makeCount :: [(Int, Round)] -> Int64
>     makeCount = sum . map countFor
>     countFor :: (Int, Round) -> Int64
>     countFor (i, Up) = ((res ! i) + 1) `quot` 2
>     countFor (i, Down) = (res ! i) `quot` 2
>
> fromBS :: BS.ByteString -> Side
> fromBS = fromChar . BS.head
>
> fromChar :: Char -> Side
> fromChar 'L' = L
> fromChar 'R' = R
> fromChar _ = error "Bad char"
>
> toChar :: Side -> Char
> toChar L = 'L'
> toChar R = 'R'
>
> makeAssoc :: Int -> Vert -> [(Int, (Int, Round))]
> makeAssoc n (V L a b) = filtPos [(a, (n, Up)), (b, (n, Down))]
> makeAssoc n (V R a b) = filtPos [(a, (n, Down)), (b, (n, Up))]
>
> filtPos :: [(Int, a)] -> [(Int, a)]
> filtPos = filter ((> 0) . fst)
>
> data Vert = V !Side !Int !Int
>
> getSide :: Vert -> Side
> getSide (V s _ _) = s
>
> data Side = L | R
>
> data Round = Up | Down
>
> flipSide :: Side -> Side
> flipSide L = R
> flipSide R = L


> _______________________________________________
> ghc-devs mailing list
> ghc-devs at haskell.org
> http://www.haskell.org/mailman/listinfo/ghc-devs