Follow Array changes (adding numElements field)

diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 747ea57..f048b9f 100644 (file)
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -155,10 +155,10 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity origin malloced)
              insns_arr
                 | n_insns > 65535 = panic "linkBCO: >= 64k insns in BCO"
                  | otherwise = mkInstrArray n_insns asm_insns
-             insns_barr = case insns_arr of UArray _lo _hi barr -> barr
+             insns_barr = case insns_arr of UArray _lo _hi _n barr -> barr
 
             bitmap_arr = mkBitmapArray bsize bitmap
-             bitmap_barr = case bitmap_arr of UArray _lo _hi barr -> barr
+             bitmap_barr = case bitmap_arr of UArray _lo _hi _n barr -> barr
 
          let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits final_ptrs 
 

diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
index 521c162..389c9e7 100644 (file)
--- a/compiler/ghci/ByteCodeLink.lhs
+++ b/compiler/ghci/ByteCodeLink.lhs
@@ -117,11 +117,11 @@ linkBCO' ie ce (UnlinkedBCO nm arity insns_barr bitmap literalsSS ptrsSS)
        ptrs_arr <- mkPtrsArray ie ce n_ptrs ptrs
 
         let 
-            ptrs_parr = case ptrs_arr of Array lo hi parr -> parr
+            ptrs_parr = case ptrs_arr of Array _lo _hi _n parr -> parr
 
             literals_arr = listArray (0, n_literals-1) linked_literals
                            :: UArray Int Word
-            literals_barr = case literals_arr of UArray lo hi barr -> barr
+            literals_barr = case literals_arr of UArray _lo _hi _n barr -> barr
 
            (I# arity#)  = arity
 
@@ -153,6 +153,7 @@ newtype IOArray i e = IOArray (STArray RealWorld i e)
 
 instance MArray IOArray e IO where
     getBounds (IOArray marr) = stToIO $ getBounds marr
+    getNumElements (IOArray marr) = stToIO $ getNumElements marr
     newArray lu init = stToIO $ do
         marr <- newArray lu init; return (IOArray marr)
     newArray_ lu = stToIO $ do
@@ -162,7 +163,7 @@ instance MArray IOArray e IO where
 
 -- XXX HACK: we should really have a new writeArray# primop that takes a BCO#.
 writeArrayBCO :: IOArray Int a -> Int -> BCO# -> IO ()
-writeArrayBCO (IOArray (STArray _ _ marr#)) (I# i#) bco# = IO $ \s# ->
+writeArrayBCO (IOArray (STArray _ _ _ marr#)) (I# i#) bco# = IO $ \s# ->
   case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# ->
   (# s#, () #) }
 

diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 1e69a89..97e47f7 100644 (file)
--- 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 {

diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs
index 7126883..4ad6d53 100644 (file)
--- a/compiler/simplCore/SimplMonad.lhs
+++ b/compiler/simplCore/SimplMonad.lhs
@@ -45,9 +45,8 @@ import FastTypes
 
 import GHC.Exts                ( indexArray# )
 
-import GHC.Arr  ( Array(..) )
-
-import Array           ( array, (//) )
+import Data.Array
+import Data.Array.Base (unsafeAt)
 
 infixr 0  `thenSmpl`, `thenSmpl_`
 \end{code}
@@ -469,11 +468,7 @@ isAmongSimpl on_switches           -- Switches mentioned later occur *earlier*
        defined_elems = map mk_assoc_elem tidied_on_switches
     in
     -- (avoid some unboxing, bounds checking, and other horrible things:)
-    case sw_tbl of { Array _ _ stuff ->
-    \ switch ->
-       case (indexArray# stuff (tagOf_SimplSwitch switch)) of
-         (# v #) -> v
-    }
+    \ switch -> unsafeAt sw_tbl $ iBox (tagOf_SimplSwitch switch)
   where
     mk_assoc_elem k@(MaxSimplifierIterations lvl)
        = (iBox (tagOf_SimplSwitch k), SwInt lvl)

diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index ffe10c3..5b9c7f9 100644 (file)
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -78,11 +78,12 @@ import Data.IORef   ( IORef, newIORef, readIORef, writeIORef )
 import System.IO       ( hPutBuf )
 import Data.Maybe      ( isJust )
 
-import GHC.Arr         ( STArray(..), newSTArray )
+import GHC.ST
 import GHC.IOBase      ( IO(..) )
 import GHC.Ptr         ( Ptr(..) )
 
-#define hASH_TBL_SIZE  4091
+#define hASH_TBL_SIZE          4091
+#define hASH_TBL_SIZE_UNBOXED  4091#
 
 
 {-|
@@ -165,8 +166,10 @@ data FastStringTable =
 string_table :: IORef FastStringTable
 string_table = 
  unsafePerformIO $ do
-   (STArray _ _ arr#) <- stToIO (newSTArray (0::Int,hASH_TBL_SIZE) [])
-   newIORef (FastStringTable 0 arr#)
+   tab <- IO $ \s1# -> case newArray# hASH_TBL_SIZE_UNBOXED [] s1# of
+                           (# s2#, arr# #) ->
+                               (# s2#, FastStringTable 0 arr# #)
+   newIORef tab
 
 lookupTbl :: FastStringTable -> Int -> IO [FastString]
 lookupTbl (FastStringTable _ arr#) (I# i#) =