packages feed

bytestring-short (empty) → 0.0.1.0

raw patch · 8 files changed

+949/−0 lines, 8 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, bytestring-short, deepseq

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Kei HIBINO++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Kei HIBINO nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bytestring-short.cabal view
@@ -0,0 +1,68 @@+name:                bytestring-short+version:             0.0.1.0+synopsis:            Backport copy of ShortByteString+description:         Backport copy of ShortByteString+license:             BSD3+license-file:        LICENSE+author:              Kei Hibino+maintainer:          Kei Hibino <ex8k.hibino@gmail.com>+copyright:           Copyright (c) Don Stewart          2005-2009,+                               (c) Duncan Coutts        2006-2013,+                               (c) David Roundy         2003-2005,+                               (c) Kei Hibino           2015.+category:            Text+build-type:          Simple+-- extra-source-files:+cabal-version:       >=1.10++library+  exposed-modules:+                       Data.ByteString.Short+                       Data.ByteString.Short.Internal+  -- other-modules:++  other-extensions:+                       DeriveDataTypeable+                       CPP+                       BangPatterns+                       RankNTypes+                       ForeignFunctionInterface+                       MagicHash+                       UnboxedTuples+                       UnliftedFFITypes+                       Unsafe++  build-depends:         base >=4.2 && <5+                       , bytestring >=0.9.1 && <0.10.4+                       , deepseq >=1.1+  hs-source-dirs:      src+  default-language:    Haskell2010++  ghc-options:+                       -Wall++  default-language: Haskell98++  c-sources:         cbits/short_fpstring.c+  include-dirs:      include+  includes:          short_fpstring.h+  install-includes:  short_fpstring.h++test-suite prop-compiled+  type:             exitcode-stdio-1.0+  main-is:          Properties.hs+  hs-source-dirs:   tests+  build-depends:    base <5, bytestring-short, bytestring,+                    QuickCheck >=2+  default-language: Haskell98+  c-sources:        cbits/short_fpstring.c+  include-dirs:     include+++source-repository head+  type:       git+  location:   https://github.com/khibino/haskell-bytestring-short++source-repository head+  type:       mercurial+  location:   https://bitbucket.org/khibino/haskell-bytestring-short
+ cbits/short_fpstring.c view
@@ -0,0 +1,40 @@+/*+ * Copyright (c) 2003 David Roundy+ * Copyright (c) 2005-6 Don Stewart+ *+ * All rights reserved.+ *+ * Redistribution and use in source and binary forms, with or without+ * modification, are permitted provided that the following conditions+ * are met:+ * 1. Redistributions of source code must retain the above copyright+ *    notice, this list of conditions and the following disclaimer.+ * 2. Redistributions in binary form must reproduce the above copyright+ *    notice, this list of conditions and the following disclaimer in the+ *    documentation and/or other materials provided with the distribution.+ * 3. Neither the names of the authors or the names of any contributors+ *    may be used to endorse or promote products derived from this software+ *    without specific prior written permission.+ *+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+ * SUCH DAMAGE.+ */++#include "short_fpstring.h"++/* This wrapper is here so that we can copy a sub-range of a ByteArray#.+   We cannot construct a pointer to the interior of an unpinned ByteArray#,+   except by doing an unsafe ffi call, and adjusting the pointer C-side. */+void * short_fps_memcpy_offsets(void       *dst, unsigned long dst_off,+				const void *src, unsigned long src_off, size_t n) {+    return memcpy(dst + dst_off, src + src_off, n);+}
+ include/short_fpstring.h view
@@ -0,0 +1,5 @@++#include <string.h>++void * short_fps_memcpy_offsets(void       *dst, unsigned long dst_off,+				const void *src, unsigned long src_off, size_t n);
+ src/Data/ByteString/Short.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 701+{-# LANGUAGE Trustworthy #-}+#endif++-- |+-- Module      : Data.ByteString.Short+-- Copyright   : (c) Duncan Coutts 2012-2013+-- License     : BSD-style+--+-- Maintainer  : duncan@community.haskell.org+-- Stability   : stable+-- Portability : ghc only+-- +-- A compact representation suitable for storing short byte strings in memory.+--+-- In typical use cases it can be imported alongside "Data.ByteString", e.g.+--+-- > import qualified Data.ByteString       as B+-- > import qualified Data.ByteString.Short as B+-- >          (ShortByteString, toShort, fromShort)+--+-- Other 'ShortByteString' operations clash with "Data.ByteString" or "Prelude"+-- functions however, so they should be imported @qualified@ with a different+-- alias e.g.+--+-- > import qualified Data.ByteString.Short as B.Short+--+module Data.ByteString.Short (++    -- * The @ShortByteString@ type++    ShortByteString,++    -- ** Memory overhead+    -- | With GHC, the memory overheads are as follows, expressed in words and+    -- in bytes (words are 4 and 8 bytes on 32 or 64bit machines respectively).+    --+    -- * 'ByteString' unshared: 9 words; 36 or 72 bytes.+    --+    -- * 'ByteString' shared substring: 5 words; 20 or 40 bytes.+    --+    -- * 'ShortByteString': 4 words; 16 or 32 bytes.+    --+    -- For the string data itself, both 'ShortByteString' and 'ByteString' use+    -- one byte per element, rounded up to the nearest word. For example,+    -- including the overheads, a length 10 'ShortByteString' would take+    -- @16 + 12 = 28@ bytes on a 32bit platform and @32 + 16 = 48@ bytes on a+    -- 64bit platform.+    --+    -- These overheads can all be reduced by 1 word (4 or 8 bytes) when the+    -- 'ShortByteString' or 'ByteString' is unpacked into another constructor.+    --+    -- For example:+    --+    -- > data ThingId = ThingId {-# UNPACK #-} !Int+    -- >                        {-# UNPACK #-} !ShortByteString+    --+    -- This will take @1 + 1 + 3@ words (the @ThingId@ constructor ++    -- unpacked @Int@ + unpacked @ShortByteString@), plus the words for the+    -- string data.+    +    -- ** Heap fragmentation+    -- | With GHC, the 'ByteString' representation uses /pinned/ memory,+    -- meaning it cannot be moved by the GC. This is usually the right thing to+    -- do for larger strings, but for small strings using pinned memory can+    -- lead to heap fragmentation which wastes space. The 'ShortByteString'+    -- type (and the @Text@ type from the @text@ package) use /unpinned/ memory+    -- so they do not contribute to heap fragmentation. In addition, with GHC,+    -- small unpinned strings are allocated in the same way as normal heap+    -- allocations, rather than in a separate pinned area.++    -- * Conversions+    toShort,+    fromShort,+    pack,+    unpack,++    -- * Other operations+    empty, null, length, index,+  ) where++import Data.ByteString.Short.Internal+import Prelude ()+
+ src/Data/ByteString/Short/Internal.hs view
@@ -0,0 +1,589 @@+{-# LANGUAGE DeriveDataTypeable, CPP, BangPatterns, RankNTypes,+             ForeignFunctionInterface, MagicHash, UnboxedTuples,+             UnliftedFFITypes #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+#if __GLASGOW_HASKELL__ >= 703+{-# LANGUAGE Unsafe #-}+#endif+{-# OPTIONS_HADDOCK hide #-}++-- |+-- Module      : Data.ByteString.Short.Internal+-- Copyright   : (c) Duncan Coutts 2012-2013+-- License     : BSD-style+--+-- Maintainer  : duncan@community.haskell.org+-- Stability   : stable+-- Portability : ghc only+--+-- Internal representation of ShortByteString+--+module Data.ByteString.Short.Internal (++    -- * The @ShortByteString@ type and representation+    ShortByteString(..),++    -- * Conversions+    toShort,+    fromShort,+    pack,+    unpack,++    -- * Other operations+    empty, null, length, index, unsafeIndex,++    -- * Low level operations+    createFromPtr, copyToPtr+  ) where++import Data.ByteString.Internal (ByteString(..), inlinePerformIO)++import Data.Typeable    (Typeable)+import Data.Data        (Data(..), mkNoRepType)+import Data.Monoid      (Monoid(..))+import Data.String      (IsString(..))+import Control.DeepSeq  (NFData(..))+import qualified Data.List as List (length)+#if MIN_VERSION_base(4,7,0)+import Foreign.C.Types  (CSize(..), CInt(..))+#elif MIN_VERSION_base(4,4,0)+import Foreign.C.Types  (CSize(..), CInt(..), CLong(..))+#else+import Foreign.C.Types  (CSize, CInt, CLong)+#endif+import Foreign.Ptr+import Foreign.ForeignPtr (touchForeignPtr)+#if MIN_VERSION_base(4,5,0)+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+#else+import Foreign.ForeignPtr (unsafeForeignPtrToPtr)+#endif++#if MIN_VERSION_base(4,5,0)+import qualified GHC.Exts+#endif+import GHC.Exts ( Int(I#), Int#, Ptr(Ptr), Addr#, Char(C#)+                , State#, RealWorld+                , ByteArray#, MutableByteArray#+                , newByteArray#+#if MIN_VERSION_base(4,6,0)+                , newPinnedByteArray#+                , byteArrayContents#+                , unsafeCoerce#+#endif+#if MIN_VERSION_base(4,3,0)+                , sizeofByteArray#+#endif+                , indexWord8Array#, indexCharArray#+                , writeWord8Array#, writeCharArray#+                , unsafeFreezeByteArray# )+import GHC.IO+#if MIN_VERSION_base(4,6,0)+import GHC.ForeignPtr (ForeignPtr(ForeignPtr), ForeignPtrContents(PlainPtr))+#else+import GHC.ForeignPtr (mallocPlainForeignPtrBytes)+#endif+import GHC.ST         (ST(ST), runST)+import GHC.Word++import Prelude ( Eq(..), Ord(..), Ordering(..), Read(..), Show(..)+               , ($), error, (++)+               , Bool(..), (&&), otherwise+               , (+), (-), fromIntegral+               , return )+++-- | A compact representation of a 'Word8' vector.+--+-- It has a lower memory overhead than a 'ByteString' and and does not+-- contribute to heap fragmentation. It can be converted to or from a+-- 'ByteString' (at the cost of copying the string data). It supports very few+-- other operations.+--+-- It is suitable for use as an internal representation for code that needs+-- to keep many short strings in memory, but it /should not/ be used as an+-- interchange type. That is, it should not generally be used in public APIs.+-- The 'ByteString' type is usually more suitable for use in interfaces; it is+-- more flexible and it supports a wide range of operations.+--+data ShortByteString = SBS ByteArray#+#if !(MIN_VERSION_base(4,3,0))+                           Int  -- ^ Prior to ghc-7.0.x, 'ByteArray#'s reported+                                -- their length rounded up to the nearest word.+                                -- This means we have to store the true length+                                -- separately, wasting a word.+#define LEN(x) (x)+#else+#define _len   /* empty */+#define LEN(x) /* empty */+#endif+    deriving Typeable++-- The ByteArray# representation is always word sized and aligned but with a+-- known byte length. Our representation choice for ShortByteString is to leave+-- 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.+++instance Eq ShortByteString where+    (==)    = equateBytes++instance Ord ShortByteString where+    compare = compareBytes++instance Monoid ShortByteString where+    mempty  = empty+    mappend = append+    mconcat = concat++instance NFData ShortByteString++instance Show ShortByteString where+    showsPrec p ps r = showsPrec p (unpackChars ps) r++instance Read ShortByteString where+    readsPrec p str = [ (packChars x, y) | (x, y) <- readsPrec p str ]++instance IsString ShortByteString where+    fromString = packChars++instance Data ShortByteString where+  gfoldl f z txt = z packBytes `f` (unpackBytes txt)+  toConstr _     = error "Data.ByteString.Short.ShortByteString.toConstr"+  gunfold _ _    = error "Data.ByteString.Short.ShortByteString.gunfold"+#if MIN_VERSION_base(4,2,0)+  dataTypeOf _   = mkNoRepType "Data.ByteString.Short.ShortByteString"+#else+  dataTypeOf _   = mkNorepType "Data.ByteString.Short.ShortByteString"+#endif++------------------------------------------------------------------------+-- Simple operations++-- | /O(1)/. The empty 'ShortByteString'.+empty :: ShortByteString+empty = create 0 (\_ -> return ())++-- | /O(1)/ The length of a 'ShortByteString'.+length :: ShortByteString -> Int+#if MIN_VERSION_base(4,3,0)+length (SBS barr#) = I# (sizeofByteArray# barr#)+#else+length (SBS _ len) = len+#endif++-- | /O(1)/ Test whether a 'ShortByteString' is empty.+null :: ShortByteString -> Bool+null sbs = length sbs == 0++-- | /O(1)/ 'ShortByteString' index (subscript) operator, starting from 0.+index :: ShortByteString -> Int -> Word8+index sbs i+  | i >= 0 && i < length sbs = unsafeIndex sbs i+  | otherwise                = indexError sbs i++unsafeIndex :: ShortByteString -> Int -> Word8+unsafeIndex sbs = indexWord8Array (asBA sbs)++indexError :: ShortByteString -> Int -> a+indexError sbs i =+  error $ "Data.ByteString.Short.index: error in array index; " ++ show i+       ++ " not in range [0.." ++ show (length sbs) ++ ")"+++------------------------------------------------------------------------+-- Internal utils++asBA :: ShortByteString -> BA+asBA (SBS ba# _len) = BA# ba#++create :: Int -> (forall s. MBA s -> ST s ()) -> ShortByteString+create len fill =+    runST (do+      mba <- newByteArray len+      fill mba+      BA# ba# <- unsafeFreezeByteArray mba+      return (SBS ba# LEN(len)))+{-# INLINE create #-}++------------------------------------------------------------------------+-- Conversion to and from ByteString++-- | /O(n)/. Convert a 'ByteString' into a 'ShortByteString'.+--+-- This makes a copy, so does not retain the input string.+--+toShort :: ByteString -> ShortByteString+toShort !bs = unsafeDupablePerformIO (toShortIO bs)++toShortIO :: ByteString -> IO ShortByteString+toShortIO (PS fptr off len) = do+    mba <- stToIO (newByteArray len)+    let ptr = unsafeForeignPtrToPtr fptr+    stToIO (copyAddrToByteArray (ptr `plusPtr` off) mba 0 len)+    touchForeignPtr fptr+    BA# ba# <- stToIO (unsafeFreezeByteArray mba)+    return (SBS ba# LEN(len))+++-- | /O(n)/. Convert a 'ShortByteString' into a 'ByteString'.+--+fromShort :: ShortByteString -> ByteString+fromShort !sbs = unsafeDupablePerformIO (fromShortIO sbs)++fromShortIO :: ShortByteString -> IO ByteString+fromShortIO sbs = do+#if MIN_VERSION_base(4,6,0)+    let len = length sbs+    mba@(MBA# mba#) <- stToIO (newPinnedByteArray len)+    stToIO (copyByteArray (asBA sbs) 0 mba 0 len)+    let fp = ForeignPtr (byteArrayContents# (unsafeCoerce# mba#))+                        (PlainPtr mba#)+    return (PS fp 0 len)+#else+    -- Before base 4.6 ForeignPtrContents is not exported from GHC.ForeignPtr+    -- so we cannot get direct access to the mbarr#+    let len = length sbs+    fptr <- mallocPlainForeignPtrBytes len+    let ptr = unsafeForeignPtrToPtr fptr+    stToIO (copyByteArrayToAddr (asBA sbs) 0 ptr len)+    touchForeignPtr fptr+    return (PS fptr 0 len)+#endif+++------------------------------------------------------------------------+-- Packing and unpacking from lists++-- | /O(n)/. Convert a list into a 'ShortByteString'+pack :: [Word8] -> ShortByteString+pack = packBytes++-- | /O(n)/. Convert a 'ShortByteString' into a list.+unpack :: ShortByteString -> [Word8]+unpack = unpackBytes++packChars :: [Char] -> ShortByteString+packChars cs = packLenChars (List.length cs) cs++packBytes :: [Word8] -> ShortByteString+packBytes cs = packLenBytes (List.length cs) cs++packLenChars :: Int -> [Char] -> ShortByteString+packLenChars len cs0 =+    create len (\mba -> go mba 0 cs0)+  where+    go :: MBA s -> Int -> [Char] -> ST s ()+    go !_   !_ []     = return ()+    go !mba !i (c:cs) = do+      writeCharArray mba i c+      go mba (i+1) cs++packLenBytes :: Int -> [Word8] -> ShortByteString+packLenBytes len ws0 =+    create len (\mba -> go mba 0 ws0)+  where+    go :: MBA s -> Int -> [Word8] -> ST s ()+    go !_   !_ []     = return ()+    go !mba !i (w:ws) = do+      writeWord8Array mba i w+      go mba (i+1) ws++-- Unpacking bytestrings into lists effeciently is a tradeoff: on the one hand+-- we would like to write a tight loop that just blats the list into memory, on+-- the other hand we want it to be unpacked lazily so we don't end up with a+-- massive list data structure in memory.+--+-- Our strategy is to combine both: we will unpack lazily in reasonable sized+-- chunks, where each chunk is unpacked strictly.+--+-- unpackChars does the lazy loop, while unpackAppendBytes and+-- unpackAppendChars do the chunks strictly.++unpackChars :: ShortByteString -> [Char]+unpackChars bs = unpackAppendCharsLazy bs []++unpackBytes :: ShortByteString -> [Word8]+unpackBytes bs = unpackAppendBytesLazy bs []++-- Why 100 bytes you ask? Because on a 64bit machine the list we allocate+-- takes just shy of 4k which seems like a reasonable amount.+-- (5 words per list element, 8 bytes per word, 100 elements = 4000 bytes)++unpackAppendCharsLazy :: ShortByteString -> [Char] -> [Char]+unpackAppendCharsLazy sbs cs0 =+    go 0 (length sbs) cs0+  where+    sz = 100++    go off len cs+      | len <= sz = unpackAppendCharsStrict sbs off len cs+      | otherwise = unpackAppendCharsStrict sbs off sz  remainder+                      where remainder = go (off+sz) (len-sz) cs++unpackAppendBytesLazy :: ShortByteString -> [Word8] -> [Word8]+unpackAppendBytesLazy sbs ws0 =+    go 0 (length sbs) ws0+  where+    sz = 100++    go off len ws+      | len <= sz = unpackAppendBytesStrict sbs off len ws+      | otherwise = unpackAppendBytesStrict sbs off sz  remainder+                      where remainder = go (off+sz) (len-sz) ws++-- For these unpack functions, since we're unpacking the whole list strictly we+-- build up the result list in an accumulator. This means we have to build up+-- the list starting at the end. So our traversal starts at the end of the+-- buffer and loops down until we hit the sentinal:++unpackAppendCharsStrict :: ShortByteString -> Int -> Int -> [Char] -> [Char]+unpackAppendCharsStrict !sbs off len cs =+    go (off-1) (off-1 + len) cs+  where+    go !sentinal !i !acc+      | i == sentinal = acc+      | otherwise     = let !c = indexCharArray (asBA sbs) i+                        in go sentinal (i-1) (c:acc)++unpackAppendBytesStrict :: ShortByteString -> Int -> Int -> [Word8] -> [Word8]+unpackAppendBytesStrict !sbs off len ws =+    go (off-1) (off-1 + len) ws+  where+    go !sentinal !i !acc+      | i == sentinal = acc+      | otherwise     = let !w = indexWord8Array (asBA sbs) i+                         in go sentinal (i-1) (w:acc)+++------------------------------------------------------------------------+-- Eq and Ord implementations++equateBytes :: ShortByteString -> ShortByteString -> Bool+equateBytes sbs1 sbs2 =+    let !len1 = length sbs1+        !len2 = length sbs2+     in len1 == len2+     && 0 == inlinePerformIO (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len1)++compareBytes :: ShortByteString -> ShortByteString -> Ordering+compareBytes sbs1 sbs2 =+    let !len1 = length sbs1+        !len2 = length sbs2+        !len  = min len1 len2+     in case inlinePerformIO (memcmp_ByteArray (asBA sbs1) (asBA sbs2) len) of+          i | i    < 0    -> LT+            | i    > 0    -> GT+            | len2 > len1 -> LT+            | len2 < len1 -> GT+            | otherwise   -> EQ+++------------------------------------------------------------------------+-- Appending and concatenation++append :: ShortByteString -> ShortByteString -> ShortByteString+append src1 src2 =+  let !len1 = length src1+      !len2 = length src2+   in create (len1 + len2) $ \dst -> do+        copyByteArray (asBA src1) 0 dst 0    len1+        copyByteArray (asBA src2) 0 dst len1 len2++concat :: [ShortByteString] -> ShortByteString+concat sbss =+    create (totalLen 0 sbss) (\dst -> copy dst 0 sbss)+  where+    totalLen !acc []          = acc+    totalLen !acc (sbs: sbss) = totalLen (acc + length sbs) sbss++    copy :: MBA s -> Int -> [ShortByteString] -> ST s ()+    copy !_   !_   []                           = return ()+    copy !dst !off (src : sbss) = do+      let !len = length src+      copyByteArray (asBA src) 0 dst off len+      copy dst (off + len) sbss+++------------------------------------------------------------------------+-- Exported low level operations++copyToPtr :: ShortByteString  -- ^ source data+          -> Int              -- ^ offset into source+          -> Ptr a            -- ^ destination+          -> Int              -- ^ number of bytes to copy+          -> IO ()+copyToPtr src off dst len =+    stToIO $+      copyByteArrayToAddr (asBA src) off dst len++createFromPtr :: Ptr a   -- ^ source data+              -> Int     -- ^ number of bytes to copy+              -> IO ShortByteString+createFromPtr !ptr len =+    stToIO $ do+      mba <- newByteArray len+      copyAddrToByteArray ptr mba 0 len+      BA# ba# <- unsafeFreezeByteArray mba+      return (SBS ba# LEN(len))+++------------------------------------------------------------------------+-- Primop wrappers++data BA    = BA# ByteArray#+data MBA s = MBA# (MutableByteArray# s)++indexCharArray :: BA -> Int -> Char+indexCharArray (BA# ba#) (I# i#) = C# (indexCharArray# ba# i#)++indexWord8Array :: BA -> Int -> Word8+indexWord8Array (BA# ba#) (I# i#) = W8# (indexWord8Array# ba# i#)++newByteArray :: Int -> ST s (MBA s)+newByteArray (I# len#) =+    ST $ \s -> case newByteArray# len# s of+                 (# s, mba# #) -> (# s, MBA# mba# #)++#if MIN_VERSION_base(4,6,0)+newPinnedByteArray :: Int -> ST s (MBA s)+newPinnedByteArray (I# len#) =+    ST $ \s -> case newPinnedByteArray# len# s of+                 (# s, mba# #) -> (# s, MBA# mba# #)+#endif++unsafeFreezeByteArray :: MBA s -> ST s BA+unsafeFreezeByteArray (MBA# mba#) =+    ST $ \s -> case unsafeFreezeByteArray# mba# s of+                 (# s, ba# #) -> (# s, BA# ba# #)++writeCharArray :: MBA s -> Int -> Char -> ST s ()+writeCharArray (MBA# mba#) (I# i#) (C# c#) =+  ST $ \s -> case writeCharArray# mba# i# c# s of+               s -> (# s, () #)++writeWord8Array :: MBA s -> Int -> Word8 -> ST s ()+writeWord8Array (MBA# mba#) (I# i#) (W8# w#) =+  ST $ \s -> case writeWord8Array# mba# i# w# s of+               s -> (# s, () #)++copyAddrToByteArray :: Ptr a -> MBA RealWorld -> Int -> Int -> ST RealWorld ()+copyAddrToByteArray (Ptr src#) (MBA# dst#) (I# dst_off#) (I# len#) =+    ST $ \s -> case copyAddrToByteArray# src# dst# dst_off# len# s of+                 s -> (# s, () #)++copyByteArrayToAddr :: BA -> Int -> Ptr a -> Int -> ST RealWorld ()+copyByteArrayToAddr (BA# src#) (I# src_off#) (Ptr dst#) (I# len#) =+    ST $ \s -> case copyByteArrayToAddr# src# src_off# dst# len# s of+                 s -> (# s, () #)++copyByteArray :: BA -> Int -> MBA s -> Int -> Int -> ST s ()+copyByteArray (BA# src#) (I# src_off#) (MBA# dst#) (I# dst_off#) (I# len#) =+    ST $ \s -> case copyByteArray# src# src_off# dst# dst_off# len# s of+                 s -> (# s, () #)+++------------------------------------------------------------------------+-- FFI imports++memcmp_ByteArray :: BA -> BA -> Int -> IO CInt+memcmp_ByteArray (BA# ba1#) (BA# ba2#) len =+  c_memcmp_ByteArray ba1# ba2# (fromIntegral len)++foreign import ccall unsafe "string.h memcmp"+  c_memcmp_ByteArray :: ByteArray# -> ByteArray# -> CSize -> IO CInt+++------------------------------------------------------------------------+-- Primop replacements++copyAddrToByteArray# :: Addr#+                     -> MutableByteArray# RealWorld -> Int#+                     -> Int#+                     -> State# RealWorld -> State# RealWorld++copyByteArrayToAddr# :: ByteArray# -> Int#+                     -> Addr#+                     -> Int#+                     -> State# RealWorld -> State# RealWorld++copyByteArray#       :: ByteArray# -> Int#+                     -> MutableByteArray# s -> Int#+                     -> Int#+                     -> State# s -> State# s++#if MIN_VERSION_base(4,7,0)++-- These exist as real primops in ghc-7.8, and for before that we use+-- FFI to C memcpy.+copyAddrToByteArray# = GHC.Exts.copyAddrToByteArray#+copyByteArrayToAddr# = GHC.Exts.copyByteArrayToAddr#++#else++copyAddrToByteArray# src dst dst_off len s =+  unIO_ (memcpy_AddrToByteArray dst (clong dst_off) src 0 (csize len)) s++copyAddrToByteArray0 :: Addr# -> MutableByteArray# s -> Int#+                     -> State# RealWorld -> State# RealWorld+copyAddrToByteArray0 src dst len s =+  unIO_ (memcpy_AddrToByteArray0 dst src (csize len)) s++{-# INLINE [0] copyAddrToByteArray# #-}+{-# RULES "copyAddrToByteArray# dst_off=0"+      forall src dst len s.+          copyAddrToByteArray# src dst 0# len s+        = copyAddrToByteArray0 src dst    len s  #-}++foreign import ccall unsafe "short_fpstring.h short_fps_memcpy_offsets"+  memcpy_AddrToByteArray :: MutableByteArray# s -> CLong -> Addr# -> CLong -> CSize -> IO ()++foreign import ccall unsafe "string.h memcpy"+  memcpy_AddrToByteArray0 :: MutableByteArray# s -> Addr# -> CSize -> IO ()+++copyByteArrayToAddr# src src_off dst len s =+  unIO_ (memcpy_ByteArrayToAddr dst 0 src (clong src_off) (csize len)) s++copyByteArrayToAddr0 :: ByteArray# -> Addr# -> Int#+                     -> State# RealWorld -> State# RealWorld+copyByteArrayToAddr0 src dst len s =+  unIO_ (memcpy_ByteArrayToAddr0 dst src (csize len)) s++{-# INLINE [0] copyByteArrayToAddr# #-}+{-# RULES "copyByteArrayToAddr# src_off=0"+      forall src dst len s.+          copyByteArrayToAddr# src 0# dst len s+        = copyByteArrayToAddr0 src    dst len s  #-}++foreign import ccall unsafe "short_fpstring.h short_fps_memcpy_offsets"+  memcpy_ByteArrayToAddr :: Addr# -> CLong -> ByteArray# -> CLong -> CSize -> IO ()++foreign import ccall unsafe "string.h memcpy"+  memcpy_ByteArrayToAddr0 :: Addr# -> ByteArray# -> CSize -> IO ()+++unIO_ :: IO () -> State# RealWorld -> State# RealWorld+unIO_ io s = case unIO io s of (# s, _ #) -> s++clong :: Int# -> CLong+clong i# = fromIntegral (I# i#)++csize :: Int# -> CSize+csize i# = fromIntegral (I# i#)+#endif++#if MIN_VERSION_base(4,5,0)+copyByteArray# = GHC.Exts.copyByteArray#+#else+copyByteArray# src src_off dst dst_off len s =+    unST_ (unsafeIOToST+      (memcpy_ByteArray dst (clong dst_off) src (clong src_off) (csize len))) s+  where+    unST (ST st) = st+    unST_ st s = case unST st s of (# s, _ #) -> s++foreign import ccall unsafe "short_fpstring.h short_fps_memcpy_offsets"+  memcpy_ByteArray :: MutableByteArray# s -> CLong+                   -> ByteArray# -> CLong -> CSize -> IO ()+#endif
+ tests/Properties.hs view
@@ -0,0 +1,130 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++import Data.ByteString.Char8 ()+import qualified Data.ByteString            as P+import qualified Data.ByteString.Internal   as P+import qualified Data.ByteString.Short      as Short++import Control.Applicative ((<$>))+import Control.Monad (unless)+import Data.Monoid (mappend, mconcat)+import Data.Maybe (catMaybes)+import Data.String (fromString)+import System.IO (stderr, hPutStrLn)+import Test.QuickCheck+  (Testable, Property, Result (..), quickCheckResult, label,+  Arbitrary (..), choose)+++type Test = (String, Property)++testProperty :: Testable prop => String -> prop -> Test+testProperty m = (,) m . label m++runMayError :: Testable prop => (a, prop) -> IO (Maybe (a, Result))+runMayError (m, prop) = fmap ((,) m) . err <$> quickCheckResult prop  where+  err :: Result -> Maybe Result+  err (Success {})  =  Nothing+  err x             =  Just x++defaultMain :: [Test] -> IO ()+defaultMain xs = do+  es <- catMaybes <$> mapM runMayError xs+  mapM_ (\(m, r) -> hPutStrLn stderr $ m ++ ":\n" ++ show r) es+  unless (null es) $ fail "Found some failures."++main :: IO ()+main = defaultMain tests+++-- Arbitrary instance for only test.+instance Arbitrary P.ByteString where+  arbitrary = do+    bs <- P.pack `fmap` arbitrary+    n  <- choose (0, 2)+    return (P.drop n bs) -- to give us some with non-0 offset++prop_short_pack_unpack xs =+    (Short.unpack . Short.pack) xs == xs+prop_short_toShort_fromShort bs =+    (Short.fromShort . Short.toShort) bs == bs++prop_short_toShort_unpack bs =+    (Short.unpack . Short.toShort) bs == P.unpack bs+prop_short_pack_fromShort xs =+    (Short.fromShort . Short.pack) xs == P.pack xs++prop_short_empty =+    Short.empty == Short.toShort P.empty+ && Short.empty == Short.pack []+ && Short.null (Short.toShort P.empty)+ && Short.null (Short.pack [])+ && Short.null Short.empty++prop_short_null_toShort bs =+    P.null bs == Short.null (Short.toShort bs)+prop_short_null_pack xs =+    null xs == Short.null (Short.pack xs)++prop_short_length_toShort bs =+    P.length bs == Short.length (Short.toShort bs)+prop_short_length_pack xs =+    length xs == Short.length (Short.pack xs)++prop_short_index_pack xs =+    all (\i -> Short.pack xs `Short.index` i == xs !! i)+        [0 .. length xs - 1]+prop_short_index_toShort bs =+    all (\i -> Short.toShort bs `Short.index` i == bs `P.index` i)+        [0 .. P.length bs - 1]++prop_short_eq xs ys =+    (xs == ys) == (Short.pack xs == Short.pack ys)+prop_short_ord xs ys =+    (xs `compare` ys) == (Short.pack xs `compare` Short.pack ys)++prop_short_mappend_empty_empty =+    Short.empty `mappend` Short.empty  == Short.empty+prop_short_mappend_empty xs =+    Short.empty `mappend` Short.pack xs == Short.pack xs+ && Short.pack xs `mappend` Short.empty == Short.pack xs+prop_short_mappend xs ys =+    (xs `mappend` ys) == Short.unpack (Short.pack xs `mappend` Short.pack ys)+prop_short_mconcat xss =+    mconcat xss == Short.unpack (mconcat (map Short.pack xss))++prop_short_fromString s =+    fromString s == Short.fromShort (fromString s)++prop_short_show xs =+    show (Short.pack xs) == show (map P.w2c xs)+prop_short_show' xs =+    show (Short.pack xs) == show (P.pack xs)++prop_short_read xs =+    read (show (Short.pack xs)) == Short.pack xs++tests :: [Test]+tests =+    [ testProperty "pack/unpack"              prop_short_pack_unpack+    , testProperty "toShort/fromShort"        prop_short_toShort_fromShort+    , testProperty "toShort/unpack"           prop_short_toShort_unpack+    , testProperty "pack/fromShort"           prop_short_pack_fromShort+    , testProperty "empty"                    prop_short_empty+    , testProperty "null/toShort"             prop_short_null_toShort+    , testProperty "null/pack"                prop_short_null_pack+    , testProperty "length/toShort"           prop_short_length_toShort+    , testProperty "length/pack"              prop_short_length_pack+    , testProperty "index/pack"               prop_short_index_pack+    , testProperty "index/toShort"            prop_short_index_toShort+    , testProperty "Eq"                       prop_short_eq+    , testProperty "Ord"                      prop_short_ord+    , testProperty "mappend/empty/empty"      prop_short_mappend_empty_empty+    , testProperty "mappend/empty"            prop_short_mappend_empty+    , testProperty "mappend"                  prop_short_mappend+    , testProperty "mconcat"                  prop_short_mconcat+    , testProperty "fromString"               prop_short_fromString+    , testProperty "show"                     prop_short_show+    , testProperty "show'"                    prop_short_show'+    , testProperty "read"                     prop_short_read+    ]