X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FArray%2FBase.hs;h=6864362d2481d608e9214f12e888d7a973dfa020;hb=6d89a2fe861274e66e6fa0a5cdd48b1161b33b75;hp=e5b6428a7339bf622ef9e932b7c3b403ecf0256f;hpb=c9868755179b300632cd0b7f935c505ea0c6dbfa;p=ghc-base.git

diff --git a/Data/Array/Base.hs b/Data/Array/Base.hs
index e5b6428..6864362 100644
--- a/Data/Array/Base.hs
+++ b/Data/Array/Base.hs
@@ -546,19 +546,22 @@ instance IArray UArray Int where
     {-# INLINE unsafeAccumArray #-}
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
 
-#ifdef __GLASGOW_HASKELL__
 instance IArray UArray Word where
     {-# INLINE unsafeArray #-}
     unsafeArray lu ies = runST (unsafeArrayUArray lu ies 0)
+#ifdef __GLASGOW_HASKELL__
     {-# INLINE unsafeAt #-}
     unsafeAt (UArray _ _ arr#) (I# i#) = W# (indexWordArray# arr# i#)
+#endif
+#ifdef __HUGS__
+    unsafeAt = unsafeAtBArray
+#endif
     {-# INLINE unsafeReplace #-}
     unsafeReplace arr ies = runST (unsafeReplaceUArray arr ies)
     {-# INLINE unsafeAccum #-}
     unsafeAccum f arr ies = runST (unsafeAccumUArray f arr ies)
     {-# INLINE unsafeAccumArray #-}
     unsafeAccumArray f init lu ies = runST (unsafeAccumArrayUArray f init lu ies)
-#endif
 
 instance IArray UArray (Ptr a) where
     {-# INLINE unsafeArray #-}
@@ -798,10 +801,8 @@ instance Ix ix => Eq (UArray ix Char) where
 instance Ix ix => Eq (UArray ix Int) where
     (==) = eqUArray
 
-#ifdef __GLASGOW_HASKELL__
 instance Ix ix => Eq (UArray ix Word) where
     (==) = eqUArray
-#endif
 
 instance Ix ix => Eq (UArray ix (Ptr a)) where
     (==) = eqUArray
@@ -853,10 +854,8 @@ instance Ix ix => Ord (UArray ix Char) where
 instance Ix ix => Ord (UArray ix Int) where
     compare = cmpUArray
 
-#ifdef __GLASGOW_HASKELL__
 instance Ix ix => Ord (UArray ix Word) where
     compare = cmpUArray
-#endif
 
 instance Ix ix => Ord (UArray ix (Ptr a)) where
     compare = cmpUArray
@@ -903,10 +902,8 @@ instance (Ix ix, Show ix) => Show (UArray ix Char) where
 instance (Ix ix, Show ix) => Show (UArray ix Int) where
     showsPrec = showsIArray
 
-#ifdef __GLASGOW_HASKELL__
 instance (Ix ix, Show ix) => Show (UArray ix Word) where
     showsPrec = showsIArray
-#endif
 
 instance (Ix ix, Show ix) => Show (UArray ix Float) where
     showsPrec = showsIArray
@@ -968,6 +965,10 @@ class (HasBounds a, Monad m) => MArray a e m where
     unsafeRead  :: Ix i => a i e -> Int -> m e
     unsafeWrite :: Ix i => a i e -> Int -> e -> m ()
 
+    {-# INLINE newArray #-}
+	-- The INLINE is crucial, because until we know at least which monad 	
+	-- we are in, the code below allocates like crazy.  So inline it,
+	-- in the hope that the context will know the monad.
     newArray (l,u) init = do
         marr <- newArray_ (l,u)
         sequence_ [unsafeWrite marr i init | i <- [0 .. rangeSize (l,u) - 1]]
@@ -1070,16 +1071,9 @@ instance MArray (STArray s) e (ST s) where
     {-# INLINE unsafeWrite #-}
     unsafeWrite = ArrST.unsafeWriteSTArray
 
------------------------------------------------------------------------------
--- Typeable instance for STArray
-
-sTArrayTc :: TyCon
-sTArrayTc = mkTyCon "STArray"
-
-instance (Typeable a, Typeable b, Typeable c) => Typeable (STArray a b c) where
-  typeOf a = mkAppTy sTArrayTc [typeOf ((undefined :: STArray a b c -> a) a),
-				typeOf ((undefined :: STArray a b c -> b) a),
-				typeOf ((undefined :: STArray a b c -> c) a)]
+#ifdef __HUGS__
+INSTANCE_TYPEABLE3(STArray,sTArrayTc,"STArray")
+#endif
 
 -----------------------------------------------------------------------------
 -- Flat unboxed mutable arrays (ST monad)
@@ -1452,6 +1446,11 @@ instance MArray (STUArray s) Int (ST s) where
     unsafeRead = unsafeReadMBArray
     unsafeWrite = unsafeWriteMBArray
 
+instance MArray (STUArray s) Word (ST s) where
+    newArray_ = newMBArray_
+    unsafeRead = unsafeReadMBArray
+    unsafeWrite = unsafeWriteMBArray
+
 instance MArray (STUArray s) (Ptr a) (ST s) where
     newArray_ = newMBArray_
     unsafeRead = unsafeReadMBArray