projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
18ad1f8
)
Follow Array changes (adding numElements field)
author
Ian Lynagh
<igloo@earth.li>
Fri, 10 Aug 2007 14:16:14 +0000
(14:16 +0000)
committer
Ian Lynagh
<igloo@earth.li>
Fri, 10 Aug 2007 14:16:14 +0000
(14:16 +0000)
compiler/ghci/ByteCodeAsm.lhs
patch
|
blob
|
history
compiler/ghci/ByteCodeLink.lhs
patch
|
blob
|
history
compiler/ghci/RtClosureInspect.hs
patch
|
blob
|
history
compiler/simplCore/SimplMonad.lhs
patch
|
blob
|
history
compiler/utils/FastString.lhs
patch
|
blob
|
history
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_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_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
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_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_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
(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
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
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 ()
-- 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#, () #) }
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)
(# 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 ()
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
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
{-
-- 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
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 {
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.Exts ( indexArray# )
-import GHC.Arr ( Array(..) )
-
-import Array ( array, (//) )
+import Data.Array
+import Data.Array.Base (unsafeAt)
infixr 0 `thenSmpl`, `thenSmpl_`
\end{code}
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:)
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)
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 System.IO ( hPutBuf )
import Data.Maybe ( isJust )
-import GHC.Arr ( STArray(..), newSTArray )
+import GHC.ST
import GHC.IOBase ( IO(..) )
import GHC.Ptr ( Ptr(..) )
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
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#) =
lookupTbl :: FastStringTable -> Int -> IO [FastString]
lookupTbl (FastStringTable _ arr#) (I# i#) =