why-doesnt-this-stack-overflow.mkd

context

$ ghc -V
The Glorious Glasgow Haskell Compilation System, version 7.6.2

stack overflowing program

import Control.Monad
bignum = 100 * 1000 * 1000
main = replicateM bignum (return ())

This will quickly crash with a stack overflow, as expected due to replicateM keeping around the resulting [()],

$ /usr/bin/time -v ./test | wc -l
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize -RTS' to increase it.
Command exited with non-zero status 2
	Command being timed: "./test"
	User time (seconds): 0.12
	System time (seconds): 0.01
	Percent of CPU this job got: 97%
	Elapsed (wall clock) time (h:mm:ss or m:ss): 0:00.14
	Average shared text size (kbytes): 0
	Average unshared data size (kbytes): 0
	Average stack size (kbytes): 0
	Average total size (kbytes): 0
	Maximum resident set size (kbytes): 30760
	Average resident set size (kbytes): 0
	Major (requiring I/O) page faults: 0
	Minor (reclaiming a frame) page faults: 7797
	Voluntary context switches: 1
	Involuntary context switches: 29
	Swaps: 0
	File system inputs: 0
	File system outputs: 0
	Socket messages sent: 0
	Socket messages received: 0
	Signals delivered: 0
	Page size (bytes): 4096
	Exit status: 2
0

This produces the following cleaned up (ghc-core -dsuppress-coercions -dsuppress-idinfo and some hand editing) Core,

main2 :: Int#
      -> State# RealWorld
      -> (# State# RealWorld, [()] #)
main2 = \ m_a1ps eta_B1 ->
    case <=# m_a1ps 1 of _ {
      False ->
        case main2 (-# m_a1ps 1) eta_B1 of _ {
          (# ipv_X1qa, ipv1_X1qc #) -> (# ipv_X1qa, : () ipv1_X1qc #)
        }
      True -> (# eta_B1, lvl_r1qL #)

main1 :: State# RealWorld -> (# State# RealWorld, [()] #)
main1 = \ eta_B1 -> main2 100000000 eta_B1

main :: IO [()]
main = main1 `cast` ...

working program

import Control.Monad
bignum = 100 * 1000 * 1000
main = replicateM bignum (putStrLn "hi")

This strangely does not stack overflow and on my machine actually runs to completion albeit with high memory usage,

$ /usr/bin/time -v ./test | wc -l
	Command being timed: "./test"
	User time (seconds): 54.56
	System time (seconds): 3.07
	Percent of CPU this job got: 98%
	Elapsed (wall clock) time (h:mm:ss or m:ss): 0:58.60
	Average shared text size (kbytes): 0
	Average unshared data size (kbytes): 0
	Average stack size (kbytes): 0
	Average total size (kbytes): 0
	Maximum resident set size (kbytes): 5950676
	Average resident set size (kbytes): 0
	Major (requiring I/O) page faults: 0
	Minor (reclaiming a frame) page faults: 1487810
	Voluntary context switches: 1
	Involuntary context switches: 17868
	Swaps: 0
	File system inputs: 0
	File system outputs: 0
	Socket messages sent: 0
	Socket messages received: 0
	Signals delivered: 0
	Page size (bytes): 4096
	Exit status: 0
100000000

It produces the following Core,

main2 :: Int#
      -> State# RealWorld
      -> (# State# RealWorld, [()] #)
main2 = \ m_a1yV eta_B1 ->
    case <=# m_a1yV 1 of _ {
      False ->
        case Handle.Text.hPutStr2 Handle.FD.stdout lvl_r1AD True eta_B1 of _ {
          (# ipv_a1zg, ipv1_a1zh #) ->
            case main2 (-# m_a1yV 1) ipv_a1zg of _ {
              (# ipv2_X1zD, ipv3_X1zF #) -> (# ipv2_X1zD, : ipv1_a1zh ipv3_X1zF #)
            }
        };
      True ->
        case Handle.Text.hPutStr2 Handle.FD.stdout lvl_r1AD True eta_B1 of _ {
          (# ipv_a1zg, ipv1_a1zh #) -> (# ipv_a1zg, : ipv1_a1zh [] #)
        }
    }

main1 :: State# RealWorld -> (# State# RealWorld, [()] #)
main1 = \ eta_B1 -> main2 100000000 eta_B1

main :: IO [()]
main = main1 `cast` ...