{-# LANGUAGE ScopedTypeVariables, CPP #-}
{-# LANGUAGE Unsafe #-}
{-# OPTIONS_HADDOCK not-home #-}
module Data.ByteString.Builder.Prim.Internal (
Size
, FixedPrim
, fixedPrim
, size
, runF
, emptyF
, contramapF
, pairF
, storableToF
, BoundedPrim
, boundedPrim
, sizeBound
, runB
, emptyB
, contramapB
, pairB
, eitherB
, condB
, toB
, liftFixedToBounded
, (>$<)
, (>*<)
, caseWordSize_32_64
, boudedPrim
) where
import Foreign
import Prelude hiding (maxBound)
#include "MachDeps.h"
class Contravariant f where
contramap :: (b -> a) -> f a -> f b
infixl 4 >$<
(>$<) :: Contravariant f => (b -> a) -> f a -> f b
>$< :: forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
(>$<) = (b -> a) -> f a -> f b
forall b a. (b -> a) -> f a -> f b
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
contramap
instance Contravariant FixedPrim where
contramap :: forall b a. (b -> a) -> FixedPrim a -> FixedPrim b
contramap = (b -> a) -> FixedPrim a -> FixedPrim b
forall b a. (b -> a) -> FixedPrim a -> FixedPrim b
contramapF
instance Contravariant BoundedPrim where
contramap :: forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
contramap = (b -> a) -> BoundedPrim a -> BoundedPrim b
forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
contramapB
class Monoidal f where
pair :: f a -> f b -> f (a, b)
instance Monoidal FixedPrim where
pair :: forall a b. FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
pair = FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
forall a b. FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
pairF
instance Monoidal BoundedPrim where
pair :: forall a b. BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
pair = BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
forall a b. BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
pairB
infixr 5 >*<
(>*<) :: Monoidal f => f a -> f b -> f (a, b)
>*< :: forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
(>*<) = f a -> f b -> f (a, b)
forall a b. f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
pair
type Size = Int
data FixedPrim a = FP {-# UNPACK #-} !Int (a -> Ptr Word8 -> IO ())
fixedPrim :: Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim :: forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
fixedPrim = Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
FP
{-# INLINE CONLIKE size #-}
size :: FixedPrim a -> Int
size :: forall a. FixedPrim a -> Int
size (FP Int
l a -> Ptr Word8 -> IO ()
_) = Int
l
{-# INLINE CONLIKE runF #-}
runF :: FixedPrim a -> a -> Ptr Word8 -> IO ()
runF :: forall a. FixedPrim a -> a -> Ptr Word8 -> IO ()
runF (FP Int
_ a -> Ptr Word8 -> IO ()
io) = a -> Ptr Word8 -> IO ()
io
{-# INLINE CONLIKE emptyF #-}
emptyF :: FixedPrim a
emptyF :: forall a. FixedPrim a
emptyF = Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
FP Int
0 (\a
_ Ptr Word8
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINE CONLIKE pairF #-}
pairF :: FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
pairF :: forall a b. FixedPrim a -> FixedPrim b -> FixedPrim (a, b)
pairF (FP Int
l1 a -> Ptr Word8 -> IO ()
io1) (FP Int
l2 b -> Ptr Word8 -> IO ()
io2) =
Int -> ((a, b) -> Ptr Word8 -> IO ()) -> FixedPrim (a, b)
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
FP (Int
l1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l2) (\(a
x1,b
x2) Ptr Word8
op -> a -> Ptr Word8 -> IO ()
io1 a
x1 Ptr Word8
op IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> Ptr Word8 -> IO ()
io2 b
x2 (Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
l1))
{-# INLINE CONLIKE contramapF #-}
contramapF :: (b -> a) -> FixedPrim a -> FixedPrim b
contramapF :: forall b a. (b -> a) -> FixedPrim a -> FixedPrim b
contramapF b -> a
f (FP Int
l a -> Ptr Word8 -> IO ()
io) = Int -> (b -> Ptr Word8 -> IO ()) -> FixedPrim b
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
FP Int
l (a -> Ptr Word8 -> IO ()
io (a -> Ptr Word8 -> IO ()) -> (b -> a) -> b -> Ptr Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
{-# INLINE CONLIKE toB #-}
toB :: FixedPrim a -> BoundedPrim a
toB :: forall a. FixedPrim a -> BoundedPrim a
toB (FP Int
l a -> Ptr Word8 -> IO ()
io) = Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP Int
l (\a
x Ptr Word8
op -> a -> Ptr Word8 -> IO ()
io a
x Ptr Word8
op IO () -> IO (Ptr Word8) -> IO (Ptr Word8)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Word8 -> IO (Ptr Word8)) -> Ptr Word8 -> IO (Ptr Word8)
forall a b. (a -> b) -> a -> b
$! Ptr Word8
op Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
l))
{-# INLINE CONLIKE liftFixedToBounded #-}
liftFixedToBounded :: FixedPrim a -> BoundedPrim a
liftFixedToBounded :: forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
toB
{-# INLINE CONLIKE storableToF #-}
storableToF :: forall a. Storable a => FixedPrim a
#if defined(i386_HOST_ARCH) || defined(x86_64_HOST_ARCH) \
|| ((defined(arm_HOST_ARCH) || defined(aarch64_HOST_ARCH)) \
&& defined(__ARM_FEATURE_UNALIGNED)) \
|| defined(powerpc_HOST_ARCH) || defined(powerpc64_HOST_ARCH) \
|| defined(powerpc64le_HOST_ARCH)
storableToF :: forall a. Storable a => FixedPrim a
storableToF = Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
forall a. Int -> (a -> Ptr Word8 -> IO ()) -> FixedPrim a
FP (a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)) (\a
x Ptr Word8
op -> Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr Word8 -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
op) a
x)
#else
storableToF = FP (sizeOf (undefined :: a)) $ \x op ->
if ptrToWordPtr op `mod` fromIntegral (alignment (undefined :: a)) == 0 then poke (castPtr op) x
else with x $ \tp -> copyBytes op (castPtr tp) (sizeOf (undefined :: a))
#endif
data BoundedPrim a = BP {-# UNPACK #-} !Int (a -> Ptr Word8 -> IO (Ptr Word8))
{-# INLINE CONLIKE sizeBound #-}
sizeBound :: BoundedPrim a -> Int
sizeBound :: forall a. BoundedPrim a -> Int
sizeBound (BP Int
b a -> Ptr Word8 -> IO (Ptr Word8)
_) = Int
b
boundedPrim :: Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
boundedPrim :: forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
boundedPrim = Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP
{-# DEPRECATED boudedPrim "Use 'boundedPrim' instead" #-}
boudedPrim :: Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
boudedPrim :: forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
boudedPrim = Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP
{-# INLINE CONLIKE runB #-}
runB :: BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
runB :: forall a. BoundedPrim a -> a -> Ptr Word8 -> IO (Ptr Word8)
runB (BP Int
_ a -> Ptr Word8 -> IO (Ptr Word8)
io) = a -> Ptr Word8 -> IO (Ptr Word8)
io
{-# INLINE CONLIKE contramapB #-}
contramapB :: (b -> a) -> BoundedPrim a -> BoundedPrim b
contramapB :: forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
contramapB b -> a
f (BP Int
b a -> Ptr Word8 -> IO (Ptr Word8)
io) = Int -> (b -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim b
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP Int
b (a -> Ptr Word8 -> IO (Ptr Word8)
io (a -> Ptr Word8 -> IO (Ptr Word8))
-> (b -> a) -> b -> Ptr Word8 -> IO (Ptr Word8)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
{-# INLINE CONLIKE emptyB #-}
emptyB :: BoundedPrim a
emptyB :: forall a. BoundedPrim a
emptyB = Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP Int
0 (\a
_ Ptr Word8
op -> Ptr Word8 -> IO (Ptr Word8)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Word8
op)
{-# INLINE CONLIKE pairB #-}
pairB :: BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
pairB :: forall a b. BoundedPrim a -> BoundedPrim b -> BoundedPrim (a, b)
pairB (BP Int
b1 a -> Ptr Word8 -> IO (Ptr Word8)
io1) (BP Int
b2 b -> Ptr Word8 -> IO (Ptr Word8)
io2) =
Int
-> ((a, b) -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim (a, b)
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP (Int
b1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b2) (\(a
x1,b
x2) Ptr Word8
op -> a -> Ptr Word8 -> IO (Ptr Word8)
io1 a
x1 Ptr Word8
op IO (Ptr Word8) -> (Ptr Word8 -> IO (Ptr Word8)) -> IO (Ptr Word8)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> Ptr Word8 -> IO (Ptr Word8)
io2 b
x2)
{-# INLINE CONLIKE eitherB #-}
eitherB :: BoundedPrim a -> BoundedPrim b -> BoundedPrim (Either a b)
eitherB :: forall a b.
BoundedPrim a -> BoundedPrim b -> BoundedPrim (Either a b)
eitherB (BP Int
b1 a -> Ptr Word8 -> IO (Ptr Word8)
io1) (BP Int
b2 b -> Ptr Word8 -> IO (Ptr Word8)
io2) =
Int
-> (Either a b -> Ptr Word8 -> IO (Ptr Word8))
-> BoundedPrim (Either a b)
forall a.
Int -> (a -> Ptr Word8 -> IO (Ptr Word8)) -> BoundedPrim a
BP (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
b1 Int
b2)
(\Either a b
x Ptr Word8
op -> case Either a b
x of Left a
x1 -> a -> Ptr Word8 -> IO (Ptr Word8)
io1 a
x1 Ptr Word8
op; Right b
x2 -> b -> Ptr Word8 -> IO (Ptr Word8)
io2 b
x2 Ptr Word8
op)
{-# INLINE CONLIKE condB #-}
condB :: (a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB :: forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB a -> Bool
p BoundedPrim a
be1 BoundedPrim a
be2 =
(a -> Either a a) -> BoundedPrim (Either a a) -> BoundedPrim a
forall b a. (b -> a) -> BoundedPrim a -> BoundedPrim b
contramapB (\a
x -> if a -> Bool
p a
x then a -> Either a a
forall a b. a -> Either a b
Left a
x else a -> Either a a
forall a b. b -> Either a b
Right a
x) (BoundedPrim a -> BoundedPrim a -> BoundedPrim (Either a a)
forall a b.
BoundedPrim a -> BoundedPrim b -> BoundedPrim (Either a b)
eitherB BoundedPrim a
be1 BoundedPrim a
be2)
{-# INLINE caseWordSize_32_64 #-}
caseWordSize_32_64
:: a
-> a
-> a
#if WORD_SIZE_IN_BITS == 32
caseWordSize_32_64 = const
#endif
#if WORD_SIZE_IN_BITS == 64
caseWordSize_32_64 :: forall a. a -> a -> a
caseWordSize_32_64 = (a -> a) -> a -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id
#endif