[CmmSized] adjust

Author: angerman

Data/Text/Array.hs

@@ -78,6 +78,17 @@ import GHC.ST (ST(..), runST)
 import GHC.Word (Word16(..))
 import Prelude hiding (length, read)
 
+#if MIN_VERSION_base(4,16,0)
+import GHC.Base ( extendWord16#, narrowWord16# )
+#else
+import GHC.Prim (Word#)
+extendWord16#, narrowWord16# :: Word# -> Word#
+extendWord16# w = w
+narrowWord16# w = w
+{-# INLINE narrowWord16# #-}
+{-# INLINE extendWord16# #-}
+#endif
+
 -- | Immutable array type.
 --
 -- The 'Array' constructor is exposed since @text-1.1.1.3@
@@ -153,15 +164,15 @@ bytesInArray n = n `shiftL` 1
 unsafeIndex :: Array -> Int -> Word16
 unsafeIndex Array{..} i@(I# i#) =
   CHECK_BOUNDS("unsafeIndex",aLen,i)
-    case indexWord16Array# aBA i# of r# -> (W16# r#)
+    case indexWord16Array# aBA i# of r# -> (W16# (narrowWord16# r#))
 {-# INLINE unsafeIndex #-}
 
 -- | 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{..} i@(I# i#) (W16# e#) = ST $ \s1# ->
   CHECK_BOUNDS("unsafeWrite",maLen,i)
-  case writeWord16Array# maBA i# e# s1# of
+  case writeWord16Array# maBA i# (extendWord16# e#) s1# of
     s2# -> (# s2#, () #)
 {-# INLINE unsafeWrite #-}
 

Data/Text/Internal/Encoding/Utf16.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash, BangPatterns #-}
+{-# LANGUAGE MagicHash, BangPatterns, CPP #-}
 
 -- |
 -- Module      : Data.Text.Internal.Encoding.Utf16
@@ -23,14 +23,22 @@ module Data.Text.Internal.Encoding.Utf16
     , validate2
     ) where
 
-import GHC.Exts
 import GHC.Word (Word16(..))
+#if MIN_VERSION_base(4,16,0)
+import GHC.Exts
+#else
+import GHC.Exts hiding (extendWord16#)
+import GHC.Prim (Word#)
+extendWord16# :: Word# -> Word#
+extendWord16# w = w
+{-# INLINE extendWord16# #-}
+#endif
 
 chr2 :: Word16 -> Word16 -> Char
 chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))
     where
-      !x# = word2Int# a#
-      !y# = word2Int# b#
+      !x# = word2Int# (extendWord16# a#)
+      !y# = word2Int# (extendWord16# b#)
       !upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#
       !lower# = y# -# 0xDC00#
 {-# INLINE chr2 #-}

Data/Text/Internal/Encoding/Utf8.hs

@@ -43,9 +43,18 @@ import Control.Exception (assert)
 import Data.Bits ((.&.))
 import Data.Text.Internal.Unsafe.Char (ord)
 import Data.Text.Internal.Unsafe.Shift (shiftR)
-import GHC.Exts
 import GHC.Word (Word8(..))
 
+#if MIN_VERSION_base(4,16,0)
+import GHC.Exts
+#else
+import GHC.Exts hiding ( extendWord8# )
+import GHC.Prim (Word#)
+extendWord8# :: Word# -> Word#
+extendWord8#  w = w
+{-# INLINE extendWord8# #-}
+#endif
+
 default(Int)
 
 between :: Word8                -- ^ byte to check
@@ -94,18 +103,18 @@ ord4 c =
 chr2 :: Word8 -> Word8 -> Char
 chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))
     where
-      !y1# = word2Int# x1#
-      !y2# = word2Int# x2#
+      !y1# = word2Int# (extendWord8# x1#)
+      !y2# = word2Int# (extendWord8# x2#)
       !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#
       !z2# = y2# -# 0x80#
 {-# INLINE chr2 #-}
 
 chr3 :: Word8 -> Word8 -> Word8 -> Char
 chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))
     where
-      !y1# = word2Int# x1#
-      !y2# = word2Int# x2#
-      !y3# = word2Int# x3#
+      !y1# = word2Int# (extendWord8# x1#)
+      !y2# = word2Int# (extendWord8# x2#)
+      !y3# = word2Int# (extendWord8# x3#)
       !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#
       !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#
       !z3# = y3# -# 0x80#
@@ -115,10 +124,10 @@ chr4             :: Word8 -> Word8 -> Word8 -> Word8 -> Char
 chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =
     C# (chr# (z1# +# z2# +# z3# +# z4#))
     where
-      !y1# = word2Int# x1#
-      !y2# = word2Int# x2#
-      !y3# = word2Int# x3#
-      !y4# = word2Int# x4#
+      !y1# = word2Int# (extendWord8# x1#)
+      !y2# = word2Int# (extendWord8# x2#)
+      !y3# = word2Int# (extendWord8# x3#)
+      !y4# = word2Int# (extendWord8# x4#)
       !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#
       !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#
       !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#

Data/Text/Internal/Unsafe/Char.hs

@@ -36,20 +36,33 @@ import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)
 import GHC.Word (Word8(..), Word16(..), Word32(..))
 import qualified Data.Text.Array as A
 
+#if MIN_VERSION_base(4,16,0)
+import GHC.Exts ( extendWord8#, extendWord16#, extendWord32# )
+#else
+import GHC.Prim (Word#)
+extendWord8#, extendWord16#, extendWord32# :: Word# -> Word#
+extendWord8#  w = w
+extendWord16# w = w
+extendWord32# w = w
+{-# INLINE extendWord8# #-}
+{-# INLINE extendWord16# #-}
+{-# INLINE extendWord32# #-}
+#endif
+
 ord :: Char -> Int
 ord (C# c#) = I# (ord# c#)
 {-# INLINE ord #-}
 
 unsafeChr :: Word16 -> Char
-unsafeChr (W16# w#) = C# (chr# (word2Int# w#))
+unsafeChr (W16# w#) = C# (chr# (word2Int# (extendWord16# w#)))
 {-# INLINE unsafeChr #-}
 
 unsafeChr8 :: Word8 -> Char
-unsafeChr8 (W8# w#) = C# (chr# (word2Int# w#))
+unsafeChr8 (W8# w#) = C# (chr# (word2Int# (extendWord8# w#)))
 {-# INLINE unsafeChr8 #-}
 
 unsafeChr32 :: Word32 -> Char
-unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))
+unsafeChr32 (W32# w#) = C# (chr# (word2Int# (extendWord32# w#)))
 {-# INLINE unsafeChr32 #-}
 
 -- | Write a character into the array at the given offset.  Returns

Data/Text/Internal/Unsafe/Shift.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MagicHash, CPP #-}
 
 -- |
 -- Module      : Data.Text.Internal.Unsafe.Shift
@@ -21,9 +21,25 @@ module Data.Text.Internal.Unsafe.Shift
     ) where
 
 -- import qualified Data.Bits as Bits
-import GHC.Base
 import GHC.Word
 
+#if MIN_VERSION_base(4,16,0)
+import GHC.Base
+#else
+import GHC.Base hiding (extendWord16#, narrowWord16#)
+import GHC.Prim (Word#)
+extendWord16#, extendWord32# :: Word# -> Word#
+narrowWord16#, narrowWord32# :: Word# -> Word#
+extendWord16# w = w
+extendWord32# w = w
+narrowWord16# w = w
+narrowWord32# w = w
+{-# INLINE narrowWord16# #-}
+{-# INLINE extendWord16# #-}
+{-# INLINE narrowWord32# #-}
+{-# INLINE extendWord32# #-}
+#endif
+
 -- | This is a workaround for poor optimisation in GHC 6.8.2.  It
 -- fails to notice constant-width shifts, and adds a test and branch
 -- to every shift.  This imposes about a 10% performance hit.
@@ -36,17 +52,17 @@ class UnsafeShift a where
 
 instance UnsafeShift Word16 where
     {-# INLINE shiftL #-}
-    shiftL (W16# x#) (I# i#) = W16# (narrow16Word# (x# `uncheckedShiftL#` i#))
+    shiftL (W16# x#) (I# i#) = W16# (narrowWord16# ((extendWord16# x#) `uncheckedShiftL#` i#))
 
     {-# INLINE shiftR #-}
-    shiftR (W16# x#) (I# i#) = W16# (x# `uncheckedShiftRL#` i#)
+    shiftR (W16# x#) (I# i#) = W16# (narrowWord16# ((extendWord16# x#) `uncheckedShiftRL#` i#))
 
 instance UnsafeShift Word32 where
     {-# INLINE shiftL #-}
-    shiftL (W32# x#) (I# i#) = W32# (narrow32Word# (x# `uncheckedShiftL#` i#))
+    shiftL (W32# x#) (I# i#) = W32# (narrowWord32# ((extendWord32# x#) `uncheckedShiftL#` i#))
 
     {-# INLINE shiftR #-}
-    shiftR (W32# x#) (I# i#) = W32# (x# `uncheckedShiftRL#` i#)
+    shiftR (W32# x#) (I# i#) = W32# (narrowWord32# ((extendWord32# x#) `uncheckedShiftRL#` i#))
 
 instance UnsafeShift Word64 where
     {-# INLINE shiftL #-}

text.cabal

@@ -160,7 +160,7 @@ library
     base             >= 4.3 && < 5,
     binary           >= 0.5 && < 0.9,
     deepseq          >= 1.1 && < 1.5,
-    ghc-prim         >= 0.2 && < 0.8,
+    ghc-prim         >= 0.2 && < 0.9,
     template-haskell >= 2.5 && < 2.18
 
   if flag(bytestring-builder)