Is there a workaround for this bug?

26 Dec 2012

      AFAICT this bug fix http://hackage.haskell.org/trac/ghc/ticket/7239 did not make it into 7.6.1. Also I am happily working on the Haskell Platform with 7.4.1 and I'd rather avoid upgrading if possible.

Is there a workaround? I've attached my code below along with the error message (which is the same as in the above bug report). I'm rather hoping I won't have to build HEAD.

Thanks, Dominic.

bash-3.2$ ghc -fext-core --make Test.hs
[1 of 1] Compiling Main             ( Test.hs, Test.o )
ghc: panic! (the 'impossible' happened)
 (GHC version 7.4.1 for x86_64-apple-darwin):
	MkExternalCore died: make_lit

{-# LANGUAGE FlexibleContexts #-}

{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing -fno-warn-type-defaults #-}

import Data.Array.Repa as Repa
import Data.Array.Repa.Eval
import Control.Monad

r, sigma, k, t, xMax, deltaX, deltaT :: Double
m, n :: Int
r = 0.05
sigma = 0.2
k = 50.0
t = 3.0
m = 80
xMax = 150
deltaX = xMax / (fromIntegral m)
n = 800
deltaT = t / (fromIntegral n)

data PointedArrayU a = PointedArrayU Int (Array U DIM1 a)
 deriving Show

f :: PointedArrayU Double -> Double
f (PointedArrayU j _x) | j == 0 = 0.0
f (PointedArrayU j _x) | j == m = xMax - k
f (PointedArrayU j  x)          = a * x! (Z :. j-1) +
                                 b * x! (Z :. j) +
                                 c * x! (Z :. j+1)
 where
   a = deltaT * (sigma^2 * (fromIntegral j)^2 - r * (fromIntegral j)) / 2
   b = 1 - deltaT * (r  + sigma^2 * (fromIntegral j)^2)
   c = deltaT * (sigma^2 * (fromIntegral j)^2 + r * (fromIntegral j)) / 2

priceAtT :: PointedArrayU Double
priceAtT = PointedArrayU 0 (fromListUnboxed (Z :. m+1) 
                          [ max 0 (deltaX * (fromIntegral j) - k) | j <- [0..m] ])

coBindU :: (Source U a, Source U b, Target U b, Monad m) =>
          PointedArrayU a -> (PointedArrayU a -> b) -> m (PointedArrayU  b)
coBindU (PointedArrayU i a) f = computeP newArr >>= return . PointedArrayU i
 where
     newArr = traverse a id g
       where
         g _get (Z :. j) = f $ PointedArrayU j a

testN :: Int -> IO (PointedArrayU Double)
testN n =  h priceAtT
          where
          h = foldr (>=>) return
              (take n $ Prelude.zipWith flip (repeat coBindU) (repeat f))

main :: IO ()
main = do r <- testN n
         putStrLn $ show r

Is there a workaround for this bug?

Dominic Steinitz