Bryan O'Sullivan avatar Bryan O'Sullivan committed 6f2e782

Simplify the internal array code

There was no value (but also no performance penalty) to it being
based around a typeclass, so I ripped that out, along with Hugs
support that I'd never really compile-tested.

Comments (0)

Files changed (6)

 import qualified Data.Text.Array as A
 import qualified Data.List as L
 import Data.Monoid (Monoid(..))
-import Data.Word (Word16)
 import Data.String (IsString(..))
 import qualified Data.Text.Fusion as S
 import qualified Data.Text.Fusion.Common as S
     unstream (S.append (stream t1) (stream t2)) = append t1 t2
  #-}
 
-copy :: forall s. A.MArray s Word16 -> Int -> A.Array Word16 -> Int -> Int
+copy :: forall s. A.MArray s -> Int -> A.Array -> Int -> Int
      -> ST s ()
 copy dest i0 src j0 top = go i0 j0
   where

Data/Text/Array.hs

-{-# LANGUAGE BangPatterns, CPP, ExistentialQuantification, MagicHash,
-             Rank2Types, ScopedTypeVariables, UnboxedTuples #-}
+{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}
 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
 -- |
 -- Module      : Data.Text.Array
     (
     -- * Types
       IArray(..)
-    , Elt(..)
     , Array
     , MArray
 
     -- * Functions
+    , copy
     , empty
-    , new
-    , unsafeNew
-    , unsafeFreeze
     , run
     , run2
     , toList
-    , copy
     , unsafeCopy
+    , unsafeFreeze
+    , unsafeIndex
+    , unsafeNew
+    , unsafeWrite
     ) where
 
 #if 0
 #define CHECK_BOUNDS(_func_,_len_,_k_)
 #endif
 
-#if defined(__GLASGOW_HASKELL__)
 #include "MachDeps.h"
 
+import Control.Exception (assert)
+import Data.Text.UnsafeShift (shiftL)
 import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
                  indexWord16Array#, newByteArray#,
                  readWord16Array#, unsafeCoerce#,
-                 writeWord16Array#, (*#))
-import GHC.Prim (Int#)
+                 writeWord16Array#)
 import GHC.ST (ST(..), runST)
 import GHC.Word (Word16(..))
-
-#elif defined(__HUGS__)
-
-import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,
-                       newMutableByteArray, readMutableByteArray,
-                       unsafeFreezeMutableByteArray, writeMutableByteArray)
-import Foreign.Storable (Storable, sizeOf)
-import Hugs.ST (ST(..), runST)
-
-#else
-# error not implemented for this compiler
-#endif
-
-import Control.Exception (assert)
-import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)
 import Prelude hiding (length, read)
 
-#include "Typeable.h"
-
 -- | Immutable array type.
-data Array e = Array
-    {-# UNPACK #-} !Int -- length (in units of e, not bytes)
-#if defined(__GLASGOW_HASKELL__)
+data Array = Array
+    {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
     ByteArray#
-#elif defined(__HUGS__)
-    !ByteArray
-#endif
-
-INSTANCE_TYPEABLE1(Array,arrayTc,"Array")
 
 -- | Mutable array type, for use in the ST monad.
-data MArray s e = MArray
-    {-# UNPACK #-} !Int -- length (in units of e, not bytes)
-#if defined(__GLASGOW_HASKELL__)
+data MArray s = MArray
+    {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)
     (MutableByteArray# s)
-#elif defined(__HUGS__)
-    !(MutableByteArray s)
-#endif
-
-INSTANCE_TYPEABLE2(MArray,mArrayTc,"MArray")
 
 -- | Operations supported by all arrays.
 class IArray a where
     -- | Return the length of an array.
     length :: a -> Int
 
-instance IArray (Array e) where
+instance IArray Array where
     length (Array len _ba) = len
     {-# INLINE length #-}
 
-instance (Elt e, Show e) => Show (Array e) where
-    show = show . toList
-
-instance IArray (MArray s e) where
+instance IArray (MArray s) where
     length (MArray len _ba) = len
     {-# INLINE length #-}
 
-check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b
-check func ary i f
-    | i >= 0 && i < length ary = f ary i
-    | otherwise = error ("Data.Array.Flat." ++ func ++ ": index out of bounds")
-{-# INLINE check #-}
-
--- | Operations supported by all elements that can be stored in
--- arrays.
-class Elt e where
-    -- | Indicate how many bytes would be used for an array of the
-    -- given size.
-    bytesInArray :: Int -> e -> Int
-    -- | Unchecked read of an immutable array.  May return garbage or
-    -- crash on an out-of-bounds access.
-    unsafeIndex :: Array e -> Int -> e
-    -- | Unchecked read of a mutable array.  May return garbage or
-    -- crash on an out-of-bounds access.
-    unsafeRead :: MArray s e -> Int -> ST s e
-    -- | Unchecked write of a mutable array.  May return garbage or
-    -- crash on an out-of-bounds access.
-    unsafeWrite :: MArray s e -> Int -> e -> ST s ()
-
-    -- | Read an immutable array. An invalid index results in a
-    -- runtime error.
-    index :: Array e -> Int -> e
-    index ary i = check "index" ary i unsafeIndex
-    {-# INLINE index #-}
-
-    -- | Read a mutable array. An invalid index results in a runtime
-    -- error.
-    read :: Array e -> Int -> ST s e
-    read ary i = check "read" ary i read
-    {-# INLINE read #-}
-
-    -- | Write a mutable array. An invalid index results in a runtime
-    -- error.
-    write :: Array e -> Int -> ST s e
-    write ary i = check "write" ary i write
-    {-# INLINE write #-}
-
 -- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!
-unsafeFreeze :: MArray s e -> ST s (Array e)
-
-#if defined(__GLASGOW_HASKELL__)
-
-wORD16_SCALE :: Int# -> Int#
-wORD16_SCALE n# = scale# *# n# where !(I# scale#) = SIZEOF_WORD16
+unsafeFreeze :: MArray s -> ST s (Array)
 
 -- | Create an uninitialized mutable array.
-unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)
+unsafeNew :: forall s. Int -> ST s (MArray s)
 unsafeNew n = assert (n >= 0) . ST $ \s1# ->
-   case bytesInArray n (undefined :: e) of
+   case bytesInArray n of
      len@(I# len#) ->
 #if defined(BOUNDS_CHECKING)
          if len < 0 then error (show ("unsafeNew",len)) else
                                  (# s#, Array len (unsafeCoerce# mba#) #)
 {-# INLINE unsafeFreeze #-}
 
--- | Create a mutable array, with its elements initialized with the
--- given value.
-new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)
+-- | Indicate how many bytes would be used for an array of the given
+-- size.
+bytesInArray :: Int -> Int
+bytesInArray n = n `shiftL` 1
+{-# INLINE bytesInArray #-}
 
-#elif defined(__HUGS__)
+-- | Unchecked read of an immutable array.  May return garbage or
+-- crash on an out-of-bounds access.
+unsafeIndex :: Array -> Int -> Word16
+unsafeIndex (Array len ba#) i@(I# i#) =
+  CHECK_BOUNDS("unsafeIndex",len,i)
+    case indexWord16Array# ba# i# of r# -> (W16# r#)
+{-# INLINE unsafeIndex #-}
 
-unsafeIndexArray :: Storable e => Array e -> Int -> e
-unsafeIndexArray (Array off len arr) i =
-    assert (i >= 0 && i < len) $ readByteArray arr (off + i)
+-- | Unchecked read of a mutable array.  May return garbage or
+-- crash on an out-of-bounds access.
+unsafeRead :: MArray s -> Int -> ST s Word16
+unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
+  CHECK_BOUNDS("unsafeRead",len,i)
+  case readWord16Array# mba# i# s# of
+    (# s2#, r# #) -> (# s2#, W16# r# #)
+{-# INLINE unsafeRead #-}
 
-unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e
-unsafeReadMArray (MArray _len marr) i =
-    assert (i >= 0 && i < len) $ readMutableByteArray marr
-
-unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()
-unsafeWriteMArray (MArray len marr) i =
-    assert (i >= 0 && i < len) $ writeMutableByteArray marr
-
--- | Create an uninitialized mutable array.
-unsafeNew :: (Storable e) => Int -> ST s (MArray s e)
-unsafeNew n = new undefined
-  where new :: (Storable e) => e -> ST s (MArray s e)
-        new unused = do
-          marr <- newMutableByteArray (n * sizeOf unused)
-          return (MArray n marr)
-
-unsafeFreeze (MArray len mba) = do
-  ba <- unsafeFreezeMutableByteArray mba
-  return (Array 0 len ba)
-
--- | Create a mutable array, with its elements initialized with the
--- given value.
-new :: (Storable e) => Int -> e -> ST s (MArray s e)
-#endif
-
-new len initVal = do
-  marr <- unsafeNew len
-  sequence_ [unsafeWrite marr i initVal | i <- [0..len-1]]
-  return marr
-
-instance Elt Word16 where
-#if defined(__GLASGOW_HASKELL__)
-
-    bytesInArray (I# i#) _ = I# (wORD16_SCALE i#)
-    {-# INLINE bytesInArray #-}
-
-    unsafeIndex (Array len ba#) i@(I# i#) =
-      CHECK_BOUNDS("unsafeIndex",len,i)
-        case indexWord16Array# ba# i# of r# -> (W16# r#)
-    {-# INLINE unsafeIndex #-}
-
-    unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->
-      CHECK_BOUNDS("unsafeRead",len,i)
-      case readWord16Array# mba# i# s# of
-        (# s2#, r# #) -> (# s2#, W16# r# #)
-    {-# INLINE unsafeRead #-}
-
-    unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->
-      CHECK_BOUNDS("unsafeWrite",len,i)
-      case writeWord16Array# marr# i# e# s1# of
-        s2# -> (# s2#, () #)
-    {-# INLINE unsafeWrite #-}
-
-#elif defined(__HUGS__)
-
-    bytesInArray n w = sizeOf w * n
-    unsafeIndex = unsafeIndexArray
-    unsafeRead = unsafeReadMArray
-    unsafeWrite = unsafeWriteMArray
-
-#endif
+-- | Unchecked write of a mutable array.  May return garbage or crash
+-- on an out-of-bounds access.
+unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()
+unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->
+  CHECK_BOUNDS("unsafeWrite",len,i)
+  case writeWord16Array# marr# i# e# s1# of
+    s2# -> (# s2#, () #)
+{-# INLINE unsafeWrite #-}
 
 -- | Convert an immutable array to a list.
-toList :: Elt e => Array e -> [e]
+toList :: Array -> [Word16]
 toList a = loop 0
     where loop i | i < len   = unsafeIndex a i : loop (i+1)
                  | otherwise = []
           len = length a
 
 -- | An empty immutable array.
-empty :: Elt e => Array e
+empty :: Array
 empty = runST (unsafeNew 0 >>= unsafeFreeze)
 
 -- | Run an action in the ST monad and return an immutable array of
 -- its result.
-run :: Elt e => (forall s. ST s (MArray s e)) -> Array e
+run :: (forall s. ST s (MArray s)) -> Array
 run k = runST (k >>= unsafeFreeze)
 
 -- | Run an action in the ST monad and return an immutable array of
 -- its result paired with whatever else the action returns.
-run2 :: Elt e => (forall s. ST s (MArray s e, a)) -> (Array e, a)
+run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)
 run2 k = runST (do
                  (marr,b) <- k
                  arr <- unsafeFreeze marr
 
 -- | Copy an array in its entirety. The destination array must be at
 -- least as big as the source.
-copy :: Elt e => MArray s e     -- ^ source array
-     -> MArray s e              -- ^ destination array
+copy :: MArray s     -- ^ source array
+     -> MArray s     -- ^ destination array
      -> ST s ()
 copy src dest
     | length dest >= length src = copy_loop 0
 {-# INLINE copy #-}
 
 -- | Unsafely copy the elements of an array.
-unsafeCopy :: Elt e =>
-              MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()
+unsafeCopy :: MArray s -> Int -> MArray s -> Int -> Int -> ST s ()
 unsafeCopy src sidx dest didx count =
     assert (sidx + count <= length src) .
     assert (didx + count <= length dest) $

Data/Text/IO/Internal.hs

 getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =
   case bufferElems buf of
     -- buffer empty: read some more
-    0 -> readTextDevice handle_ buf
+    0 -> {-# SCC "readTextDevice" #-} readTextDevice handle_ buf
 
     -- if the buffer has a single '\r' in it and we're doing newline
     -- translation: read some more
                  return buf
 
     -- buffer has some chars in it already: just return it
-    _otherwise -> return buf
+    _otherwise -> {-# SCC "otherwise" #-} return buf
 
 -- | Read a single chunk of strict text from a buffer. Used by both
 -- the strict and lazy implementations of hGetContents.

Data/Text/Internal.hs

 import Control.Exception (assert)
 import qualified Data.Text.Array as A
 import Data.Typeable (Typeable)
-import Data.Word (Word16)
 
 -- | A space efficient, packed, unboxed Unicode text type.
 data Text = Text
-    {-# UNPACK #-} !(A.Array Word16) -- payload
+    {-# UNPACK #-} !A.Array          -- payload
     {-# UNPACK #-} !Int              -- offset
     {-# UNPACK #-} !Int              -- length
     deriving (Typeable)
 
 -- | Smart constructor.
-text :: A.Array Word16 -> Int -> Int -> Text
+text :: A.Array -> Int -> Int -> Text
 text arr off len =
     assert (len >= 0) .
     assert (off >= 0) .
 
 -- | Construct a 'Text' without invisibly pinning its byte array in
 -- memory if its length has dwindled to zero.
-textP :: A.Array Word16 -> Int -> Int -> Text
+textP :: A.Array -> Int -> Int -> Text
 textP arr off len | len == 0  = empty
                   | otherwise = text arr off len
 {-# INLINE textP #-}

Data/Text/Lazy/Builder.hs

 import Data.Text.Lazy.Internal (smallChunkSize)
 import Data.Text.Unsafe (inlineInterleaveST)
 import Data.Text.UnsafeShift (shiftR)
-import Data.Word (Word16)
 import Prelude hiding (map, putChar)
 
 import qualified Data.String as String
 ------------------------------------------------------------------------
 
 -- Our internal buffer type
-data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s Word16)
+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)
                        {-# UNPACK #-} !Int  -- offset
                        {-# UNPACK #-} !Int  -- used units
                        {-# UNPACK #-} !Int  -- length left
 
 -- | Ensure that @n@ many elements are available, and then use @f@ to
 -- write some elements into the memory.
-writeN :: Int -> (forall s. A.MArray s Word16 -> Int -> ST s ()) -> Builder
+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder
 writeN n f = ensureFree n `append'` withBuffer (writeNBuffer n f)
 {-# INLINE [0] writeN #-}
 
-writeNBuffer :: Int -> (A.MArray s Word16 -> Int -> ST s ()) -> (Buffer s)
+writeNBuffer :: Int -> (A.MArray s -> Int -> ST s ()) -> (Buffer s)
              -> ST s (Buffer s)
 writeNBuffer n f (Buffer p o u l) = do
     f p (o+u)
 {-# INLINE newBuffer #-}
 
 -- | Unsafely copy the elements of an array.
-unsafeCopy :: A.Elt e =>
-              A.Array e -> Int -> A.MArray s e -> Int -> Int -> ST s ()
+unsafeCopy :: A.Array -> Int -> A.MArray s -> Int -> Int -> ST s ()
 unsafeCopy src sidx dest didx count =
     assert (sidx + count <= A.length src) .
     assert (didx + count <= A.length dest) $
 
 -- Write a character to the array, starting at the specified offset
 -- @i@.  Returns the number of elements written.
-unsafeWrite :: A.MArray s Word16 -> Int -> Char -> ST s Int
+unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int
 unsafeWrite marr i c
     | n < 0x10000 = do
         assert (i >= 0) . assert (i < A.length marr) $
 
 {-# RULES
 
-"append/writeN" forall a b (f::forall s. A.MArray s Word16 -> Int -> ST s ())
-                           (g::forall s. A.MArray s Word16 -> Int -> ST s ()) ws.
+"append/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())
+                           (g::forall s. A.MArray s -> Int -> ST s ()) ws.
         append (writeN a f) (append (writeN b g) ws) =
             append (writeN (a+b) (\marr o -> f marr o >> g marr (o+a))) ws
 
-"writeN/writeN" forall a b (f::forall s. A.MArray s Word16 -> Int -> ST s ())
-                           (g::forall s. A.MArray s Word16 -> Int -> ST s ()).
+"writeN/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())
+                           (g::forall s. A.MArray s -> Int -> ST s ()).
         append (writeN a f) (writeN b g) =
             writeN (a+b) (\marr o -> f marr o >> g marr (o+a))
 

Data/Text/UnsafeChar.hs

 unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))
 {-# INLINE unsafeChr32 #-}
 
-unsafeWrite :: A.MArray s Word16 -> Int -> Char -> ST s Int
+unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int
 unsafeWrite marr i c
     | n < 0x10000 = do
         assert (i >= 0) . assert (i < A.length marr) $
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.