Hi Dom, I can confirm that your example compiles (with minimal adjustments) under GHC 7.6.2 RC1. You can get it here:
http://www.haskell.org/ghc/dist/7.6.2-rc1/ Roman * Dominic Steinitz <[email protected]> [2013-01-01 20:30:10+0000] > Thanks - I'll probably wait for the next release. > > On 1 Jan 2013, at 19:48, Simon Peyton-Jones <[email protected]> wrote: > > > I think the patch did get into 7.6.2 (which is about to be released) though. > > > > I don't think there's a workaround, except by not using External Core, or > > not using Integer literals (use Ints?). Sorry. > > > > Simon > > > > | -----Original Message----- > > | From: [email protected] > > [mailto:glasgow-haskell-users- > > | [email protected]] On Behalf Of Dominic Steinitz > > | Sent: 26 December 2012 18:14 > > | To: [email protected] > > | Subject: Is there a workaround for this bug? > > | > > | 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 > > | > > | > > | _______________________________________________ > > | Glasgow-haskell-users mailing list > > | [email protected] > > | http://www.haskell.org/mailman/listinfo/glasgow-haskell-users > > > _______________________________________________ > Glasgow-haskell-users mailing list > [email protected] > http://www.haskell.org/mailman/listinfo/glasgow-haskell-users _______________________________________________ Glasgow-haskell-users mailing list [email protected] http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
