From f4c9109d7f1deb6f79c2c141f69ec24b7022776b Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Fri, 10 Aug 2007 14:16:14 +0000 Subject: [PATCH] Follow Array changes (adding numElements field) --- compiler/ghci/ByteCodeAsm.lhs | 4 ++-- compiler/ghci/ByteCodeLink.lhs | 7 ++++--- compiler/ghci/RtClosureInspect.hs | 17 +++++++++-------- compiler/simplCore/SimplMonad.lhs | 11 +++-------- compiler/utils/FastString.lhs | 11 +++++++---- 5 files changed, 25 insertions(+), 25 deletions(-) diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs index 747ea57..f048b9f 100644 --- 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 --- 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 --- 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 --- 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 --- 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#) = -- 1.7.10.4