urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-26 05:23:35 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'king-haskell' of github.com:urbit/urbit into merge-king

Browse Source
This commit is contained in:
Benjamin Summers 2019-12-16 14:43:44 -08:00
commit 7e124cd3dd
1 changed files with 11 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
pkg/king/lib/Noun/Atom.hs
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)