Commit f4c9109d authored by Ian Lynagh's avatar Ian Lynagh

Follow Array changes (adding numElements field)

parent 18ad1f84
......@@ -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
......
......@@ -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#, () #) }
......
......@@ -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 {
......
......@@ -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)
......
......@@ -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#) =
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment