content: {-# LANGUAGE ForeignFunctionInterface, MagicHash, UnboxedTuples #-}
  
  -- From trac #1947
  -- Should fail with heap exhaustion
  -- See notes below with "Infinite loop here".
  
  module Main(main) where
  
  import System.IO.Unsafe
  import System.IO
  import System.Environment
  import System.Exit
  import Foreign.C.Types
  import Data.Char(ord,chr)
  
  
  -- low level imports
  import GHC.Base                 (realWorld#)
  import GHC.IO                   (IO(IO), unIO, unsafePerformIO)
  import GHC.Exts                 (State#,RealWorld)
  
  
  -- FFI replacements for Haskell stuff
  foreign import ccall unsafe "stdio.h getchar" getchar :: IO CInt
  foreign import ccall unsafe "ctype.h iswspace" isspace :: CInt -> CInt
  
  
  skipCAF :: State# RealWorld -> a -> a
  skipCAF _ x = x
  
  
  -- IO Subsystem
  -- Unboxed IO is more efficient, but requires a certain level of
  -- optimisation, so provide a BOXED_IO fallback
  
  data RW_Box = RW_Box (State# RealWorld)
  type RW_Pair a = (RW_Box, a)
  
  fromIO :: IO a -> (RW_Box -> RW_Pair a)
  fromIO a (RW_Box r) = case unIO a r of (# r, x #) -> (RW_Box r, x)
  
  toIO :: (RW_Box -> RW_Pair a) -> IO a
  toIO f = IO $ \r -> case f (RW_Box r) of (RW_Box r, x) -> (# r, x #)
  
  -- IO functions not dependent on the IO primitives
  main :: IO ()
  main = toIO main_generated
  
  typeRealWorld :: RW_Box -> RW_Box
  typeRealWorld x = x
  
  overlay_get_char :: RW_Box -> RW_Pair Int
  overlay_get_char = fromIO $ do
      c <- getchar
      return $ fromIntegral c
  
  system_IO_hPutChar :: Handle -> Int -> RW_Box -> RW_Pair ()
  system_IO_hPutChar h c = fromIO $ hPutChar h (chr c)
  
  overlay_errorIO :: [Int] -> RW_Box -> RW_Pair a
  overlay_errorIO x r = case fromIO (putStrLn ("ERROR: " ++ map chr x)) r of
                             (r, _) -> fromIO exitFailure r
  
  system_Environment_getArgs :: RW_Box -> RW_Pair [[Int]]
  system_Environment_getArgs r = case (fromIO getArgs) r of
                                      (r, s) -> (r, map str_ s)
  
  overlay_supero_wrap x = x
  
  
  -- Primitives
  prelude_seq = seq
  
  prelude_error x = error (map chr x)
  
  aDD_W = (+) :: Int -> Int -> Int
  mUL_W = (*) :: Int -> Int -> Int
  sUB_W = (-) :: Int -> Int -> Int
  eQ_W = (==) :: Int -> Int -> Bool
  nE_W = (/=) :: Int -> Int -> Bool
  gT_W = (>) :: Int -> Int -> Bool
  gE_W = (>=) :: Int -> Int -> Bool
  lT_W = (<) :: Int -> Int -> Bool
  lE_W = (<=) :: Int -> Int -> Bool
  qUOT = quot :: Int -> Int -> Int
  rEM = rem :: Int -> Int -> Int
  nEG_W = negate :: Int -> Int
  yHC_Primitive_primIntAbs = abs :: Int -> Int
  yHC_Primitive_primIntSignum = signum :: Int -> Int
  yHC_Primitive_primIntegerAdd = (+) :: Integer -> Integer -> Integer
  yHC_Primitive_primIntegerEq = (==) :: Integer -> Integer -> Bool
  yHC_Primitive_primIntegerFromInt = toInteger :: Int -> Integer
  yHC_Primitive_primIntegerGe = (>=) :: Integer -> Integer -> Bool
  yHC_Primitive_primIntegerGt = (>) :: Integer -> Integer -> Bool
  yHC_Primitive_primIntegerLe = (<=) :: Integer -> Integer -> Bool
  yHC_Primitive_primIntegerMul = (*) :: Integer -> Integer -> Integer
  yHC_Primitive_primIntegerNe = (/=) :: Integer -> Integer -> Bool
  yHC_Primitive_primIntegerNeg = negate :: Integer -> Integer
  yHC_Primitive_primIntegerQuot = quot :: Integer -> Integer -> Integer
  yHC_Primitive_primIntegerQuotRem = quotRem :: Integer -> Integer -> (Integer, Integer)
  yHC_Primitive_primIntegerRem = rem :: Integer -> Integer -> Integer
  yHC_Primitive_primIntFromInteger = fromInteger :: Integer -> Int
  yHC_Primitive_primIntegerLt = (<) :: Integer -> Integer -> Bool
  yHC_Primitive_primIntegerSub = (-) :: Integer -> Integer -> Integer
  
  aDD_D = (+) :: Double -> Double -> Double
  sUB_D = (-) :: Double -> Double -> Double
  lT_D = (<) :: Double -> Double -> Bool
  lE_D = (<=) :: Double -> Double -> Bool
  gT_D = (>) :: Double -> Double -> Bool
  gE_D = (>=) :: Double -> Double -> Bool
  eQ_D = (==) :: Double -> Double -> Bool
  mUL_D = (*) :: Double -> Double -> Double
  nEG_D = (negate) :: Double -> Double
  nE_D = (/=) :: Double -> Double -> Bool
  sLASH_D = (/) :: Double -> Double -> Double
  yHC_Primitive_primDecodeDouble = decodeFloat :: Double -> (Integer,Int)
  yHC_Primitive_primDoubleACos = acos :: Double -> Double
  yHC_Primitive_primDoubleASin = asin :: Double -> Double
  yHC_Primitive_primDoubleATan = atan :: Double -> Double
  yHC_Primitive_primDoubleAbs = abs :: Double -> Double
  yHC_Primitive_primDoubleCos = cos :: Double -> Double
  yHC_Primitive_primDoubleExp = exp :: Double -> Double
  yHC_Primitive_primDoubleFromInteger = fromInteger :: Integer -> Double
  yHC_Primitive_primDoubleLog = log :: Double -> Double
  yHC_Primitive_primDoublePow = (**) :: Double -> Double -> Double
  yHC_Primitive_primDoubleSignum = signum :: Double -> Double
  yHC_Primitive_primDoubleSin = sin :: Double -> Double
  yHC_Primitive_primDoubleSqrt = sqrt :: Double -> Double
  yHC_Primitive_primDoubleTan = tan :: Double -> Double
  yHC_Primitive_primEncodeDouble = encodeFloat :: Integer -> Int -> Double
  
  
  
  
  -- things which Yhc decides should be hopelessly slow
  prelude_Int_Integral_mod = mod :: Int -> Int -> Int
  prelude_Integer_Integral_div = div :: Integer -> Integer -> Integer
  prelude_Integer_Integral_mod = mod :: Integer -> Integer -> Integer
  prelude_Integer_Num_signum = signum :: Integer -> Integer
  prelude_Integer_Num_abs = abs :: Integer -> Integer
  
  
  int_ x = x :: Int
  chr_ x = ord x
  str_ x = map chr_ x
  
  
  system_IO_stdin = stdin
  system_IO_stdout = stdout
  
  data_Char_isSpace :: Int -> Bool
  data_Char_isSpace c = isspace (toEnum c) /= 0
  
  
  
  type ReadsPrec a = Int -> [Int] -> [(a,[Int])]
  
  
  prelude_Int_Read_readsPrec :: ReadsPrec Int
  prelude_Int_Read_readsPrec p s = [(a, str_ b) | (a,b) <- readsPrec p (map chr s)]
  prelude_Int_Read_readList = undefined
  
  prelude_Integer_Read_readsPrec :: ReadsPrec Integer
  prelude_Integer_Read_readsPrec p s = [(a, str_ b) | (a,b) <- readsPrec p (map chr s)]
  prelude_Integer_Read_readList = undefined
  
  prelude_Double_Read_readsPrec :: ReadsPrec Double
  prelude_Double_Read_readsPrec p s = [(a, str_ b) | (a,b) <- readsPrec p (map chr s)]
  prelude_Double_Read_readList = undefined
  
  prelude_Char_Read_readsPrec :: ReadsPrec Int
  prelude_Char_Read_readsPrec p s = [(chr_ (a :: Char), str_ b) | (a,b) <- readsPrec p (map chr s)]
  
  prelude_Char_Show_showList :: [Int] -> [Int] -> [Int]
  prelude_Char_Show_showList value rest = str_ (show (map chr value)) ++ rest
  
  prelude_Char_Show_showsPrec :: Int -> Int -> [Int] -> [Int]
  prelude_Char_Show_showsPrec prec i rest = str_ (showsPrec prec (chr i) []) ++ rest
  
  prelude_Int_Show_showsPrec :: Int -> Int -> [Int] -> [Int]
  prelude_Int_Show_showsPrec prec i rest = str_ (showsPrec prec i []) ++ rest
  
  prelude_Integer_Show_showsPrec :: Int -> Integer -> [Int] -> [Int]
  prelude_Integer_Show_showsPrec prec i rest = str_ (showsPrec prec i []) ++ rest
  
  prelude_Double_Show_showsPrec :: Int -> Double -> [Int] -> [Int]
  prelude_Double_Show_showsPrec prec i rest = str_ (showsPrec prec i []) ++ rest
  
  
  prelude_'amp'amp27 v1 v2 =
      case (data_Char_isSpace v1) of
          True ->
              case v2 of
                  [] -> True
                  (:) v4 v5 -> prelude_'amp'amp27 v4 v5
          False -> False
  
  prelude_LAMBDA22 v1 v2 =
      case v1 of
          (,) v267 v268 ->
              case v268 of
                  [] -> prelude_LAMBDA24 v267 v2
                  (:) v7 v8 ->
                      let v11 = prelude_'amp'amp27 v7 v8
                      in case v11 of
                             True -> prelude_LAMBDA24 v267 v2
                             False -> prelude__foldr25 v2
  
  prelude_LAMBDA24 v1 v2 = (:) v1 (prelude__foldr25 v2)
  
  prelude_IO_Monad_fail41 v1 =
      overlay_errorIO
        (skipCAF realWorld# (str_ "pattern-match failure in do expression"))
        v1
  
  prelude__foldr25 v1 =
      case v1 of
          [] -> []
          (:) v296 v297 -> prelude_LAMBDA22 v296 v297
  
  f17 uncaf = skipCAF uncaf (str_ "Prelude.read: no parse")
  
  f18 v1 v2 =
      case v1 of
          (,) v176 v177 ->
              case v177 of
                  [] -> f20 v176 v2
                  (:) v7 v8 ->
                      let v11 = prelude_'amp'amp27 v7 v8
                      in case v11 of
                             True -> f20 v176 v2
                             False ->
                                 case v2 of
                                     [] -> prelude_error (f17 realWorld#)
                                     (:) v4 v5 -> f18 v4 v5
  
  f20 v1 v2 =
      case v2 of
          [] -> v1
          (:) v257 v258 ->
              let v9 = prelude_LAMBDA22 v257 v258
              in case v9 of
                     [] -> v1
                     (:) v10 v11 ->
                         prelude_error
                           (skipCAF realWorld# (str_ "Prelude.read: ambiguous parse"))
  
  -- Infinite loop here.  It was originally:
  -- f34 v1 v2 v3 =
  --    let v336 = f34 v1 v2 v3
  --    in v336
  --
  -- But that now (correctly) just makes a non-allocating infinite loop
  -- instead of (incorrectly) eta-reducing to f34 = f34.
  -- So I've changed to an infinite, allocating loop, which makes
  -- the heap get exhausted.
  f34 v1 v2 v3 =
    if abs v2 < 1000 then 
      let v336 = f34 (v1+1) (-v2) v3
      in v336
    else if v2 == 2000 then 0 else v1
  
  f38 v1 v2 =
      case v1 of
          [] -> system_IO_hPutChar system_IO_stdout (chr_ '\n') v2
          (:) v350 v351 ->
              case (system_IO_hPutChar
                      system_IO_stdout
                      v350
                      (typeRealWorld v2)) of
                  ( v7  , v8  ) -> f38 v351 v7
  
  main_generated v1 =
      case (system_Environment_getArgs (typeRealWorld v1)) of
          ( v3  , v4  ) ->
              case v4 of
                  (:) v7 v8 ->
                      case v8 of
                          (:) v9 v12 ->
                              case v12 of
                                  (:) v13 v14 ->
                                      case v14 of
                                          [] ->
                                              case (prelude_Int_Show_showsPrec
                                                      (int_ 0)
                                                      (let v8 =
                                                               case (prelude_Int_Read_readsPrec
                                                                       (int_ 0)
                                                                       v7) of
                                                                   [] -> prelude_error (f17 realWorld#)
                                                                   (:) v12 v14 -> f18 v12 v14
                                                           v10 =
                                                               case (prelude_Int_Read_readsPrec
                                                                       (int_ 0)
                                                                       v9) of
                                                                   [] -> prelude_error (f17 realWorld#)
                                                                   (:) v15 v16 -> f18 v15 v16
                                                           v11 =
                                                               case (prelude_Int_Read_readsPrec
                                                                       (int_ 0)
                                                                       v13) of
                                                                   [] -> prelude_error (f17 realWorld#)
                                                                   (:) v17 v18 -> f18 v17 v18
                                                       in case (lT_W v10 v8) of
                                                              True ->
                                                                  let v7 = f34 v8 v10 v11
                                                                  in v7
                                                              False -> v11)
                                                      (skipCAF realWorld# (str_ ""))) of
                                                  [] ->
                                                      system_IO_hPutChar
                                                        system_IO_stdout
                                                        (chr_ '\n')
                                                        (typeRealWorld v3)
                                                  (:) v11 v12 ->
                                                      case (system_IO_hPutChar
                                                              system_IO_stdout
                                                              v11
                                                              (typeRealWorld (typeRealWorld v3))) of
                                                          ( v7  , v8  ) -> f38 v12 v7
                                          (:) v15 v16 -> prelude_IO_Monad_fail41 v3
                                  [] -> prelude_IO_Monad_fail41 v3
                          [] -> prelude_IO_Monad_fail41 v3
                  [] -> prelude_IO_Monad_fail41 v3
  
  