Skip to content

Commit

Permalink
Scale back changes to ShortByteString to pattern synonym only
Browse files Browse the repository at this point in the history
  • Loading branch information
Bodigrim committed Nov 25, 2021
1 parent 7aba6b4 commit ac24f1b
Showing 1 changed file with 7 additions and 23 deletions.
30 changes: 7 additions & 23 deletions Data/ByteString/Short/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,10 +6,6 @@
{-# LANGUAGE Unsafe #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
#if MIN_VERSION_base(4,10,0)
{-# LANGUAGE DerivingStrategies #-}
#endif

{-# OPTIONS_HADDOCK not-home #-}

Expand Down Expand Up @@ -60,19 +56,17 @@ module Data.ByteString.Short.Internal (

#if BYTEARRAY_IN_BASE
import Data.Array.Byte
import Data.Semigroup (Semigroup)
#else
import Data.Typeable (Typeable)
import Data.Semigroup (Semigroup((<>)))
import Control.DeepSeq (NFData(..))
#endif

import Data.ByteString.Internal (ByteString(..), accursedUnutterablePerformIO)
import qualified Data.ByteString.Internal as BS

import Data.Typeable (Typeable)
import Data.Data (Data(..), mkNoRepType)
import Data.Semigroup (Semigroup((<>)))
import Data.Monoid (Monoid(..))
import Data.String (IsString(..))
import Control.DeepSeq (NFData(..))
import qualified Data.List as List (length)
import Foreign.C.String (CString, CStringLen)
import Foreign.C.Types (CSize(..), CInt(..))
Expand Down Expand Up @@ -128,7 +122,7 @@ import qualified Language.Haskell.TH.Syntax as TH
--
#if BYTEARRAY_IN_BASE
newtype ShortByteString = ShortByteString { unShortByteString :: ByteArray }
deriving newtype (Eq, Semigroup, Monoid)
deriving Typeable

pattern SBS :: ByteArray# -> ShortByteString
pattern SBS x = ShortByteString (ByteArray x)
Expand Down Expand Up @@ -165,16 +159,14 @@ instance TH.Lift ShortByteString where
-- the 0--3 trailing bytes undefined. This means we can use word-sized writes,
-- but we have to be careful with reads, see equateBytes and compareBytes below.

#if !BYTEARRAY_IN_BASE

instance Eq ShortByteString where
(==) = equateBytes
#endif

-- | Lexicographic order.
instance Ord ShortByteString where
compare = compareBytes

#if !BYTEARRAY_IN_BASE
instance Semigroup ShortByteString where
(<>) = append

Expand All @@ -185,7 +177,6 @@ instance Monoid ShortByteString where

instance NFData ShortByteString where
rnf SBS{} = ()
#endif

instance Show ShortByteString where
showsPrec p ps r = showsPrec p (unpackChars ps) r
Expand All @@ -196,13 +187,8 @@ instance Read ShortByteString where
-- | @since 0.10.12.0
instance GHC.Exts.IsList ShortByteString where
type Item ShortByteString = Word8
#if BYTEARRAY_IN_BASE
fromList = ShortByteString . GHC.Exts.fromList
toList = GHC.Exts.toList . unShortByteString
#else
fromList = packBytes
toList = unpackBytes
#endif

-- | Beware: 'fromString' truncates multi-byte characters to octets.
-- e.g. "枯朶に烏のとまりけり秋の暮" becomes �6k�nh~�Q��n�
Expand Down Expand Up @@ -430,15 +416,13 @@ unpackAppendBytesStrict !sbs off len = go (off-1) (off-1 + len)
------------------------------------------------------------------------
-- Eq and Ord implementations

#if !BYTEARRAY_IN_BASE
equateBytes :: ShortByteString -> ShortByteString -> Bool
equateBytes sbs1 sbs2 =
let !len1 = length sbs1
!len2 = length sbs2
in len1 == len2
&& 0 == accursedUnutterablePerformIO
(memcmp_ByteArray (asBA sbs1) (asBA sbs2) len1)
#endif

compareBytes :: ShortByteString -> ShortByteString -> Ordering
compareBytes sbs1 sbs2 =
Expand All @@ -453,10 +437,10 @@ compareBytes sbs1 sbs2 =
| len2 < len1 -> GT
| otherwise -> EQ


------------------------------------------------------------------------
-- Appending and concatenation

#if !BYTEARRAY_IN_BASE
append :: ShortByteString -> ShortByteString -> ShortByteString
append src1 src2 =
let !len1 = length src1
Expand All @@ -478,7 +462,7 @@ concat sbss =
let !len = length src
copyByteArray (asBA src) 0 dst off len
copy dst (off + len) sbss
#endif


------------------------------------------------------------------------
-- Exported low level operations
Expand Down

0 comments on commit ac24f1b

Please sign in to comment.