Preparatory work to facilitate utf8 transition

.github/workflows/windows_and_macOS.yml

@@ -30,8 +30,13 @@ jobs:
       with:
         path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }}
         key: ${{ runner.os }}-${{ matrix.ghc }}
+    # We rebuild tests several times to avoid intermittent failures on Windows
+    # https://github.com/haskell/actions/issues/36
     - name: Test
-      run: cabal test
+      run: |
+        bld() { cabal build pkg:text:tests; }
+        bld || bld || bld
+        cabal test
     - name: Haddock
       run: cabal haddock
     - name: SDist

src/Data/Text.hs

@@ -205,7 +205,9 @@ import Prelude (Char, Bool(..), Int, Maybe(..), String,
 import Control.DeepSeq (NFData(rnf))
 #if defined(ASSERTS)
 import Control.Exception (assert)
+import GHC.Stack (HasCallStack)
 #endif
+import Data.Bits (shiftL)
 import Data.Char (isSpace)
 import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,
                   Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))
@@ -231,7 +233,6 @@ import Data.Text.Internal.Unsafe.Char (unsafeChr)
 import qualified Data.Text.Internal.Functions as F
 import qualified Data.Text.Internal.Encoding.Utf16 as U16
 import Data.Text.Internal.Search (indices)
-import Data.Text.Internal.Unsafe.Shift (UnsafeShift(..))
 #if defined(__HADDOCK__)
 import Data.ByteString (ByteString)
 import qualified Data.Text.Lazy as L
@@ -597,7 +598,11 @@ isSingleton = S.isSingleton . stream
 
 -- | /O(n)/ Returns the number of characters in a 'Text'.
 -- Subject to fusion.
-length :: Text -> Int
+length ::
+#if defined(ASSERTS)
+  HasCallStack =>
+#endif
+  Text -> Int
 length t = S.length (stream t)
 {-# INLINE [1] length #-}
 -- length needs to be phased after the compareN/length rules otherwise
@@ -697,7 +702,11 @@ intersperse c t = unstream (S.intersperse (safe c) (stream t))
 -- "reversed"
 --
 -- Subject to fusion (fuses with its argument).
-reverse :: Text -> Text
+reverse ::
+#if defined(ASSERTS)
+  HasCallStack =>
+#endif
+  Text -> Text
 reverse t = S.reverse (stream t)
 {-# INLINE reverse #-}
 
@@ -1737,7 +1746,11 @@ isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
 --
 -- In (unlikely) bad cases, this function's time complexity degrades
 -- towards /O(n*m)/.
-isInfixOf :: Text -> Text -> Bool
+isInfixOf ::
+#if defined(ASSERTS)
+  HasCallStack =>
+#endif
+  Text -> Text -> Bool
 isInfixOf needle haystack
     | null needle        = True
     | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack

src/Data/Text/Array.hs

@@ -42,12 +42,12 @@ module Data.Text.Array
 
 #if defined(ASSERTS)
 import Control.Exception (assert)
-import GHC.Base (sizeofByteArray#, sizeofMutableByteArray#)
+import GHC.Base (sizeofByteArray#, getSizeofMutableByteArray#)
+import GHC.Stack (HasCallStack)
 #endif
 import Control.Monad.ST.Unsafe (unsafeIOToST)
-import Data.Bits ((.&.), xor)
+import Data.Bits ((.&.), xor, shiftL, shiftR)
 import Data.Text.Internal.Unsafe (inlinePerformIO)
-import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
 import Foreign.C.Types (CInt(CInt), CSize(CSize))
 import GHC.Base (ByteArray#, MutableByteArray#, Int(..),
                  indexWord16Array#, newByteArray#,
@@ -95,7 +95,11 @@ bytesInArray n = n `shiftL` 1
 
 -- | Unchecked read of an immutable array.  May return garbage or
 -- crash on an out-of-bounds access.
-unsafeIndex :: Array -> Int -> Word16
+unsafeIndex ::
+#if defined(ASSERTS)
+  HasCallStack =>
+#endif
+  Array -> Int -> Word16
 unsafeIndex a@Array{..} i@(I# i#) =
 #if defined(ASSERTS)
   let word16len = I# (sizeofByteArray# aBA) `quot` 2 in
@@ -106,16 +110,35 @@ unsafeIndex a@Array{..} i@(I# i#) =
   case indexWord16Array# aBA i# of r# -> (W16# r#)
 {-# INLINE unsafeIndex #-}
 
+#if defined(ASSERTS)
+-- sizeofMutableByteArray# is deprecated, because it is unsafe in the presence of
+-- shrinkMutableByteArray# and resizeMutableByteArray#.
+getSizeofMArray :: MArray s -> ST s Int
+getSizeofMArray ma@MArray{..} = ST $ \s0# ->
+  case getSizeofMutableByteArray# maBA s0# of
+    (# s1#, word8len# #) -> (# s1#, I# word8len# #)
+
+checkBoundsM :: HasCallStack => MArray s -> Int -> Int -> ST s ()
+checkBoundsM ma i elSize = do
+  len <- getSizeofMArray ma
+  if i < 0 || i + elSize > len
+    then error ("bounds error, offset " ++ show i ++ ", length " ++ show len)
+    else return ()
+#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 ma@MArray{..} i@(I# i#) (W16# e#) = ST $ \s1# ->
+unsafeWrite ::
+#if defined(ASSERTS)
+  HasCallStack =>
+#endif
+  MArray s -> Int -> Word16 -> ST s ()
+unsafeWrite ma@MArray{..} i@(I# i#) (W16# e#) =
 #if defined(ASSERTS)
-  let word16len = I# (sizeofMutableByteArray# maBA) `quot` 2 in
-  if i < 0 || i >= word16len then error ("Data.Text.Array.unsafeWrite: bounds error, offset " ++ show i ++ ", length " ++ show word16len) else
+  checkBoundsM ma (i * 2) 2 >>
 #endif
-  case writeWord16Array# maBA i# e# s1# of
-    s2# -> (# s2#, () #)
+  (ST $ \s1# -> case writeWord16Array# maBA i# e# s1# of
+    s2# -> (# s2#, () #))
 {-# INLINE unsafeWrite #-}
 
 -- | Convert an immutable array to a list.
@@ -151,14 +174,16 @@ copyM :: MArray s               -- ^ Destination
       -> ST s ()
 copyM dest didx src sidx count
     | count <= 0 = return ()
-    | otherwise =
+    | otherwise = do
 #if defined(ASSERTS)
-    assert (sidx + count <= I# (sizeofMutableByteArray# (maBA src))  `quot` 2) .
-    assert (didx + count <= I# (sizeofMutableByteArray# (maBA dest)) `quot` 2) .
+    srcLen  <- getSizeofMArray src
+    destLen <- getSizeofMArray dest
+    assert (sidx + count <= srcLen `quot` 2) .
+      assert (didx + count <= destLen `quot` 2) .
 #endif
-    unsafeIOToST $ memcpyM (maBA dest) (fromIntegral didx)
-                           (maBA src) (fromIntegral sidx)
-                           (fromIntegral count)
+      unsafeIOToST $ memcpyM (maBA dest) (intToCSize didx)
+                             (maBA src) (intToCSize sidx)
+                             (intToCSize count)
 {-# INLINE copyM #-}
 
 -- | Copy some elements of an immutable array.
@@ -172,9 +197,9 @@ copyI :: MArray s               -- ^ Destination
 copyI dest i0 src j0 top
     | i0 >= top = return ()
     | otherwise = unsafeIOToST $
-                  memcpyI (maBA dest) (fromIntegral i0)
-                          (aBA src) (fromIntegral j0)
-                          (fromIntegral (top-i0))
+                  memcpyI (maBA dest) (intToCSize i0)
+                          (aBA src) (intToCSize j0)
+                          (intToCSize (top-i0))
 {-# INLINE copyI #-}
 
 -- | Compare portions of two arrays for equality.  No bounds checking
@@ -186,11 +211,14 @@ equal :: Array                  -- ^ First
       -> Int                    -- ^ Count
       -> Bool
 equal arrA offA arrB offB count = inlinePerformIO $ do
-  i <- memcmp (aBA arrA) (fromIntegral offA)
-                     (aBA arrB) (fromIntegral offB) (fromIntegral count)
+  i <- memcmp (aBA arrA) (intToCSize offA)
+                     (aBA arrB) (intToCSize offB) (intToCSize count)
   return $! i == 0
 {-# INLINE equal #-}
 
+intToCSize :: Int -> CSize
+intToCSize = fromIntegral
+
 foreign import ccall unsafe "_hs_text_memcpy" memcpyI
     :: MutableByteArray# s -> CSize -> ByteArray# -> CSize -> CSize -> IO ()