X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghci%2FRtClosureInspect.hs;h=97e47f7b1d8af02775fc6669839f55f68866cda4;hp=1e69a8997917c7395118f69bc1bd5be478aed111;hb=f4c9109d7f1deb6f79c2c141f69ec24b7022776b;hpb=18ad1f84fc1d5d2695a64f503b4905fc5d5059e3

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 1e69a89..97e47f7 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -163,8 +163,8 @@ getClosureData a =
      (# iptr, ptrs, nptrs #) -> do
            itbl <- peek (Ptr iptr)
            let tipe = readCType (BCI.tipe itbl)
-               elems = BCI.ptrs itbl 
-               ptrsList = Array 0 ((fromIntegral elems) - 1) ptrs
+               elems = fromIntegral (BCI.ptrs itbl)
+               ptrsList = Array 0 (elems - 1) elems ptrs
                nptrs_data = [W# (indexWordArray# nptrs i)
                               | I# i <- [0.. fromIntegral (BCI.nptrs itbl)] ]
            ASSERT(fromIntegral elems >= 0) return ()
@@ -206,9 +206,9 @@ isFullyEvaluated a = do
     otherwise -> return False
   where amapM f = sequence . amap' f
 
-amap' f (Array i0 i arr#) = map (\(I# i#) -> case indexArray# arr# i# of
-                                   (# e #) -> f e)
-                                [0 .. i - i0]
+amap' f (Array i0 i _ arr#) = map g [0 .. i - i0]
+    where g (I# i#) = case indexArray# arr# i# of
+                          (# e #) -> f e
 
 -- TODO: Fix it. Probably the otherwise case is failing, trace/debug it
 {-
@@ -727,9 +727,10 @@ mapMif_ pred f (x:xx) = (if pred x then f x else return x) : mapMif_ pred f xx
 unlessM condM acc = condM >>= \c -> unless c acc
 
 -- Strict application of f at index i
-appArr f a@(Array _ _ ptrs#) i@(I# i#) = ASSERT (i < length(elems a))
-                                  case indexArray# ptrs# i# of 
-                                       (# e #) -> f e
+appArr f a@(Array _ _ _ ptrs#) i@(I# i#)
+ = ASSERT (i < length(elems a))
+   case indexArray# ptrs# i# of
+       (# e #) -> f e
 
 zonkTerm :: Term -> TcM Term
 zonkTerm = foldTerm idTermFoldM {