Fix a nasty bug in atom<->bytestring conversion.

This commit is contained in:
Benjamin Summers 2019-12-16 02:18:06 -08:00
parent 398d90227a
commit 0fa9086b4d

View File

@ -16,7 +16,7 @@ import ClassyPrelude
import Control.Lens hiding (Index) import Control.Lens hiding (Index)
import Data.Bits (shiftL, shiftR, (.&.), (.|.)) import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import GHC.Exts (sizeofByteArray#) import GHC.Exts (sizeofByteArray#, Ptr(Ptr))
import GHC.Int (Int(..)) import GHC.Int (Int(..))
import GHC.Integer.GMP.Internals (BigNat(..), bigNatToWord, sizeofBigNat#) import GHC.Integer.GMP.Internals (BigNat(..), bigNatToWord, sizeofBigNat#)
import GHC.Integer.GMP.Internals (indexBigNat#) import GHC.Integer.GMP.Internals (indexBigNat#)
@ -27,11 +27,12 @@ import GHC.Prim (Word#, int2Word#, subIntC#, timesWord#)
import GHC.Word (Word(..)) import GHC.Word (Word(..))
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BU import qualified Data.ByteString.Internal as BS
import qualified Data.Primitive.ByteArray as Prim import qualified Data.Primitive.ByteArray as Prim
import qualified Data.Primitive.Types as Prim import qualified Data.Primitive.Types as Prim
import qualified Data.Vector.Primitive as VP import qualified Data.Vector.Primitive as VP
import qualified Foreign.ForeignPtr.Unsafe as Ptr
-- Types ----------------------------------------------------------------------- -- Types -----------------------------------------------------------------------
@ -163,10 +164,6 @@ bsToWords bs =
{- {-
TODO Support Big-Endian TODO Support Big-Endian
TODO This still has a (small) risk of segfaulting. The right thing to
do is to manually copy the data to the C heap, setup the
finalizers, and then manually construct a bytestring from
that pointer.
-} -}
bytesBS :: Iso' (VP.Vector Word8) ByteString bytesBS :: Iso' (VP.Vector Word8) ByteString
bytesBS = iso to from bytesBS = iso to from
@ -174,9 +171,10 @@ bytesBS = iso to from
to :: VP.Vector Word8 -> ByteString to :: VP.Vector Word8 -> ByteString
to (VP.Vector off sz buf) = to (VP.Vector off sz buf) =
unsafePerformIO $ do unsafePerformIO $ do
Prim.Addr ptr <- evaluate $ Prim.byteArrayContents buf fp <- BS.mallocByteString sz
bs <- BU.unsafePackAddressLen sz ptr let Ptr a = Ptr.unsafeForeignPtrToPtr fp -- Safe b/c returning fp
evaluate $ force $ BS.copy $ BS.drop off bs Prim.copyByteArrayToAddr (Prim.Addr a) buf 0 sz
pure (BS.PS fp off sz)
from :: ByteString -> VP.Vector Word8 from :: ByteString -> VP.Vector Word8
from bs = VP.generate (length bs) (BS.index bs) from bs = VP.generate (length bs) (BS.index bs)