{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
module Proto3.Wire.Reverse.Prim
(
AssocPlusNat(..)
, CommPlusNat(..)
, PChoose(..)
, Max
, AssocMaxNat(..)
, CommMaxNat(..)
, StoreMethod(..)
, storeMethod
, ByteOrder(..)
, systemByteOrder
, BoundedPrim(..)
, liftBoundedPrim
, composeBoundedPrim
, unsafeBuildBoundedPrim
, FixedPrim
, liftFixedPrim
, word8
, word16
, word16Native
, word16BE
, word16LE
, word32
, word32Native
, word32BE
, word32LE
, word64
, word64Native
, word64BE
, word64LE
, int8
, int16
, int16Native
, int16BE
, int16LE
, int32
, int32Native
, int32BE
, int32LE
, int64
, int64Native
, int64BE
, int64LE
, float
, floatNative
, floatBE
, floatLE
, double
, doubleNative
, doubleBE
, doubleLE
, charUtf8
, wordBase128LEVar
, wordBase128LEVar_inline
, word32Base128LEVar
, word32Base128LEVar_inline
, word64Base128LEVar
, word64Base128LEVar_inline
, vectorFixedPrim
) where
import Data.Bits ( Bits(..) )
import Data.Bool ( bool )
import Data.Char ( ord )
import Data.Int ( Int8, Int16, Int32, Int64 )
import Data.Kind ( Type )
import qualified Data.Vector.Generic
import Foreign ( Storable(..) )
import GHC.Exts ( Addr#, Int#, Proxy#,
RealWorld, State#, (+#),
and#, inline, or#,
plusAddr#, plusWord#, proxy#,
uncheckedShiftRL# )
import GHC.IO ( IO(..) )
import GHC.Int ( Int(..) )
import GHC.Ptr ( Ptr(..) )
import GHC.TypeLits ( KnownNat, Nat,
type (+), natVal' )
import GHC.Word.Compat
import Parameterized.Data.Semigroup ( PNullary, PSemigroup(..),
(&<>) )
import Parameterized.Data.Monoid ( PMEmpty(..) )
import Proto3.Wire.Reverse.Internal
import Proto3.Wire.Reverse.Width ( AssocPlusNat(..),
CommPlusNat(..),
PChoose(..),
Max, AssocMaxNat(..),
CommMaxNat(..) )
#include <MachDeps.h> /* for WORDS_BIGENDIAN and WORD_SIZE_IN_BITS */
#ifdef ghcjs_HOST_OS
import GHC.Exts (Word#)
#endif
#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64 (Word64#)
type WORD64 = Word64#
#else
import GHC.Exts (Word#)
type WORD64 = Word#
#endif
data StoreMethod = StoreAligned | StoreUnaligned
deriving (StoreMethod -> StoreMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StoreMethod -> StoreMethod -> Bool
$c/= :: StoreMethod -> StoreMethod -> Bool
== :: StoreMethod -> StoreMethod -> Bool
$c== :: StoreMethod -> StoreMethod -> Bool
Eq, Int -> StoreMethod -> ShowS
[StoreMethod] -> ShowS
StoreMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StoreMethod] -> ShowS
$cshowList :: [StoreMethod] -> ShowS
show :: StoreMethod -> String
$cshow :: StoreMethod -> String
showsPrec :: Int -> StoreMethod -> ShowS
$cshowsPrec :: Int -> StoreMethod -> ShowS
Show)
storeMethod :: StoreMethod
#if defined(UNALIGNED_POKES)
storeMethod :: StoreMethod
storeMethod = StoreMethod
StoreUnaligned
#else
storeMethod = StoreAligned
#endif
data ByteOrder
= BigEndian
| LittleEndian
deriving (ByteOrder -> ByteOrder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteOrder -> ByteOrder -> Bool
$c/= :: ByteOrder -> ByteOrder -> Bool
== :: ByteOrder -> ByteOrder -> Bool
$c== :: ByteOrder -> ByteOrder -> Bool
Eq, Int -> ByteOrder -> ShowS
[ByteOrder] -> ShowS
ByteOrder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByteOrder] -> ShowS
$cshowList :: [ByteOrder] -> ShowS
show :: ByteOrder -> String
$cshow :: ByteOrder -> String
showsPrec :: Int -> ByteOrder -> ShowS
$cshowsPrec :: Int -> ByteOrder -> ShowS
Show)
systemByteOrder :: ByteOrder
#if defined(WORDS_BIGENDIAN)
systemByteOrder = BigEndian
#else
systemByteOrder :: ByteOrder
systemByteOrder = ByteOrder
LittleEndian
#endif
newtype BoundedPrim (w :: Nat) = BoundedPrim BuildR
type role BoundedPrim nominal
type instance PNullary BoundedPrim width = BoundedPrim width
instance (w1 + w2) ~ w3 =>
PSemigroup BoundedPrim w1 w2 w3
where
pmappend :: PNullary BoundedPrim w1
-> PNullary BoundedPrim w2 -> PNullary BoundedPrim w3
pmappend = forall (v :: Nat) (w :: Nat).
BoundedPrim v -> BoundedPrim w -> BoundedPrim (v + w)
composeBoundedPrim
{-# INLINE CONLIKE pmappend #-}
instance AssocPlusNat BoundedPrim u v w
where
assocLPlusNat :: Proxy# '(u, v, w)
-> PNullary BoundedPrim (u + (v + w))
-> PNullary BoundedPrim ((u + v) + w)
assocLPlusNat = forall (u :: Nat) (v :: Nat) (w :: Nat).
Proxy# '(u, v, w)
-> BoundedPrim (u + (v + w)) -> BoundedPrim ((u + v) + w)
assocLPlusNatBoundedPrim
{-# INLINE CONLIKE assocLPlusNat #-}
assocRPlusNat :: Proxy# '(u, v, w)
-> PNullary BoundedPrim ((u + v) + w)
-> PNullary BoundedPrim (u + (v + w))
assocRPlusNat = forall (u :: Nat) (v :: Nat) (w :: Nat).
Proxy# '(u, v, w)
-> BoundedPrim ((u + v) + w) -> BoundedPrim (u + (v + w))
assocRPlusNatBoundedPrim
{-# INLINE CONLIKE assocRPlusNat #-}
instance CommPlusNat BoundedPrim u v
where
commPlusNat :: Proxy# '(u, v)
-> PNullary BoundedPrim (u + v) -> PNullary BoundedPrim (v + u)
commPlusNat Proxy# '(u, v)
_ (BoundedPrim BuildR
f) = forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim BuildR
f
{-# INLINE CONLIKE commPlusNat #-}
instance PMEmpty BoundedPrim 0
where
pmempty :: PNullary BoundedPrim 0
pmempty = forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim forall a. Monoid a => a
mempty
#ifdef ghcjs_HOST_OS
{-# NOINLINE pmempty #-}
#else
{-# INLINE CONLIKE pmempty #-}
#endif
instance Max u v ~ w =>
PChoose BoundedPrim u v w
where
pbool :: PNullary BoundedPrim u
-> PNullary BoundedPrim v -> Bool -> PNullary BoundedPrim w
pbool = \(BoundedPrim BuildR
f) (BoundedPrim BuildR
g) -> forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a -> Bool -> a
bool BuildR
f BuildR
g
{-# INLINE CONLIKE pbool #-}
instance AssocMaxNat BoundedPrim u v w
where
assocLMaxNat :: Proxy# '(u, v, w)
-> PNullary BoundedPrim (Max u (Max v w))
-> PNullary BoundedPrim (Max (Max u v) w)
assocLMaxNat = \Proxy# '(u, v, w)
_ (BoundedPrim BuildR
f) -> forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim BuildR
f
{-# INLINE CONLIKE assocLMaxNat #-}
assocRMaxNat :: Proxy# '(u, v, w)
-> PNullary BoundedPrim (Max (Max u v) w)
-> PNullary BoundedPrim (Max u (Max v w))
assocRMaxNat = \Proxy# '(u, v, w)
_ (BoundedPrim BuildR
f) -> forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim BuildR
f
{-# INLINE CONLIKE assocRMaxNat #-}
instance CommMaxNat BoundedPrim u v
where
commMaxNat :: Proxy# '(u, v)
-> PNullary BoundedPrim (Max u v) -> PNullary BoundedPrim (Max v u)
commMaxNat = \Proxy# '(u, v)
_ (BoundedPrim BuildR
f) -> forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim BuildR
f
{-# INLINE CONLIKE commMaxNat #-}
assocLPlusNatBoundedPrim ::
forall u v w .
Proxy# '(u, v, w) -> BoundedPrim (u + (v + w)) -> BoundedPrim ((u + v) + w)
assocLPlusNatBoundedPrim :: forall (u :: Nat) (v :: Nat) (w :: Nat).
Proxy# '(u, v, w)
-> BoundedPrim (u + (v + w)) -> BoundedPrim ((u + v) + w)
assocLPlusNatBoundedPrim = \Proxy# '(u, v, w)
_ (BoundedPrim BuildR
f) -> forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim BuildR
f
{-# INLINE CONLIKE assocLPlusNatBoundedPrim #-}
assocRPlusNatBoundedPrim ::
forall u v w .
Proxy# '(u, v, w) -> BoundedPrim ((u + v) + w) -> BoundedPrim (u + (v + w))
assocRPlusNatBoundedPrim :: forall (u :: Nat) (v :: Nat) (w :: Nat).
Proxy# '(u, v, w)
-> BoundedPrim ((u + v) + w) -> BoundedPrim (u + (v + w))
assocRPlusNatBoundedPrim = \Proxy# '(u, v, w)
_ (BoundedPrim BuildR
f) -> forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim BuildR
f
{-# INLINE CONLIKE assocRPlusNatBoundedPrim #-}
composeBoundedPrim :: BoundedPrim v -> BoundedPrim w -> BoundedPrim (v + w)
composeBoundedPrim :: forall (v :: Nat) (w :: Nat).
BoundedPrim v -> BoundedPrim w -> BoundedPrim (v + w)
composeBoundedPrim =
\(BoundedPrim BuildR
f) (BoundedPrim BuildR
g) -> forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim (BuildR
f forall a. Semigroup a => a -> a -> a
<> BuildR
g)
{-# INLINE CONLIKE [1] composeBoundedPrim #-}
unsafeBuildBoundedPrim :: BoundedPrim w -> BuildR
unsafeBuildBoundedPrim :: forall (w :: Nat). BoundedPrim w -> BuildR
unsafeBuildBoundedPrim (BoundedPrim BuildR
build) = BuildR
build
liftBoundedPrim :: forall w . KnownNat w => BoundedPrim w -> BuildR
liftBoundedPrim :: forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
liftBoundedPrim = case forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall {k} (a :: k). Proxy# a
proxy# :: Proxy# w)) of
I# Int#
w -> forall (w :: Nat). Int# -> BoundedPrim w -> BuildR
unsafeLiftBoundedPrim Int#
w
{-# INLINE CONLIKE liftBoundedPrim #-}
unsafeLiftBoundedPrim :: Int# -> BoundedPrim w -> BuildR
unsafeLiftBoundedPrim :: forall (w :: Nat). Int# -> BoundedPrim w -> BuildR
unsafeLiftBoundedPrim = \Int#
w (BoundedPrim BuildR
f) -> Int# -> BuildR -> BuildR
ensure# Int#
w BuildR
f
{-# INLINE CONLIKE [1] unsafeLiftBoundedPrim #-}
{-# RULES
"appendBuildR/unsafeLiftBoundedPrim" forall w1 w2 f1 f2 .
appendBuildR (unsafeLiftBoundedPrim w1 f1) (unsafeLiftBoundedPrim w2 f2)
= unsafeLiftBoundedPrim (w1 +# w2) (composeBoundedPrim f1 f2)
"appendBuildR/unsafeLiftBoundedPrim/assoc_r" forall w1 w2 f1 f2 b .
appendBuildR (unsafeLiftBoundedPrim w1 f1)
(appendBuildR (unsafeLiftBoundedPrim w2 f2) b)
= appendBuildR (unsafeLiftBoundedPrim (w1 +# w2) (composeBoundedPrim f1 f2)) b
"appendBuildR/unsafeLiftBoundedPrim/assoc_l" forall w1 w2 f1 f2 b .
appendBuildR (appendBuildR b (unsafeLiftBoundedPrim w1 f1))
(unsafeLiftBoundedPrim w2 f2)
= appendBuildR b (unsafeLiftBoundedPrim (w1 +# w2) (composeBoundedPrim f1 f2))
#-}
newtype FixedPrim (w :: Nat) = FixedPrim
( Addr# -> Int# -> State# RealWorld -> Int# ->
(# Addr#, Int#, State# RealWorld #)
)
type role FixedPrim nominal
type instance PNullary FixedPrim width = FixedPrim width
instance ((w1 + w2) ~ w3, KnownNat w1) =>
PSemigroup FixedPrim w1 w2 w3
where
pmappend :: PNullary FixedPrim w1
-> PNullary FixedPrim w2 -> PNullary FixedPrim w3
pmappend = \(FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f) (FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
g) ->
case forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall {k} (a :: k). Proxy# a
proxy# :: Proxy# w1)) of
I# Int#
w1 -> forall (w :: Nat).
(Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim w
FixedPrim
( \Addr#
v0 Int#
u0 State# RealWorld
s0 Int#
o -> case Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
g Addr#
v0 Int#
u0 State# RealWorld
s0 (Int#
o Int# -> Int# -> Int#
+# Int#
w1) of
(# Addr#
v1, Int#
u1, State# RealWorld
s1 #) -> Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f Addr#
v1 Int#
u1 State# RealWorld
s1 Int#
o )
{-# INLINE CONLIKE pmappend #-}
instance AssocPlusNat FixedPrim u v w
where
assocLPlusNat :: Proxy# '(u, v, w)
-> PNullary FixedPrim (u + (v + w))
-> PNullary FixedPrim ((u + v) + w)
assocLPlusNat = \Proxy# '(u, v, w)
_ (FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f) -> forall (w :: Nat).
(Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim w
FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f
{-# INLINE CONLIKE assocLPlusNat #-}
assocRPlusNat :: Proxy# '(u, v, w)
-> PNullary FixedPrim ((u + v) + w)
-> PNullary FixedPrim (u + (v + w))
assocRPlusNat = \Proxy# '(u, v, w)
_ (FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f) -> forall (w :: Nat).
(Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim w
FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f
{-# INLINE CONLIKE assocRPlusNat #-}
instance CommPlusNat FixedPrim u v
where
commPlusNat :: Proxy# '(u, v)
-> PNullary FixedPrim (u + v) -> PNullary FixedPrim (v + u)
commPlusNat = \Proxy# '(u, v)
_ (FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f) -> forall (w :: Nat).
(Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim w
FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f
{-# INLINE CONLIKE commPlusNat #-}
instance PMEmpty FixedPrim 0
where
pmempty :: PNullary FixedPrim 0
pmempty = forall (w :: Nat).
(Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim w
FixedPrim (\Addr#
v Int#
u State# RealWorld
s Int#
_ -> (# Addr#
v, Int#
u, State# RealWorld
s #))
{-# INLINE CONLIKE pmempty #-}
liftFixedPrim :: forall w . KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim :: forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim = \(FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f) -> forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim ((Addr#
-> Int# -> State# RealWorld -> (# Addr#, Int#, State# RealWorld #))
-> BuildR
BuildR ((Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> Addr#
-> Int#
-> State# RealWorld
-> (# Addr#, Int#, State# RealWorld #)
g Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f))
where
!(I# Int#
o) = - forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall {k} (a :: k). Proxy# a
proxy# :: Proxy# w))
g :: (Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> Addr#
-> Int#
-> State# RealWorld
-> (# Addr#, Int#, State# RealWorld #)
g = \Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f Addr#
v0 Int#
u0 State# RealWorld
s0 -> case Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f Addr#
v0 Int#
u0 State# RealWorld
s0 Int#
o of
(# Addr#
v1, Int#
u1, State# RealWorld
s1 #) -> (# Addr# -> Int# -> Addr#
plusAddr# Addr#
v1 Int#
o, Int#
u1 Int# -> Int# -> Int#
+# Int#
o, State# RealWorld
s1 #)
{-# INLINE g #-}
{-# INLINE CONLIKE [1] liftFixedPrim #-}
{-# RULES
"composeBoundedPrim/liftFixedPrim"
forall (f1 :: KnownNat w1 => FixedPrim w1)
(f2 :: KnownNat (w1 + w2) => FixedPrim w2).
composeBoundedPrim (liftFixedPrim f1) (liftFixedPrim f2)
= liftFixedPrim (pmappend f1 f2)
"composeBoundedPrim/liftFixedPrim/assoc_r"
forall (f1 :: KnownNat w1 => FixedPrim w1)
(f2 :: KnownNat (w1 + w2) => FixedPrim w2)
(b3 :: BoundedPrim w3) .
composeBoundedPrim (liftFixedPrim f1)
(composeBoundedPrim (liftFixedPrim f2) b3)
= assocRPlusNatBoundedPrim (proxy# :: Proxy# '(w1, w2, w3))
(composeBoundedPrim (liftFixedPrim (pmappend f1 f2)) b3)
"composeBoundedPrim/liftFixedPrim/assoc_l"
forall (b1 :: BoundedPrim w1)
(f2 :: KnownNat w2 => FixedPrim w2)
(f3 :: KnownNat (w2 + w3) => FixedPrim w3) .
composeBoundedPrim (composeBoundedPrim b1 (liftFixedPrim f2))
(liftFixedPrim f3)
= assocLPlusNatBoundedPrim (proxy# :: Proxy# '(w1, w2, w3))
(composeBoundedPrim b1 (liftFixedPrim (pmappend f2 f3)))
"withLengthOf#/unsafeLiftBoundedPrim/liftFixedPrim" forall f w g .
withLengthOf# f (unsafeLiftBoundedPrim w (liftFixedPrim g))
= appendBuildR (f w) (unsafeLiftBoundedPrim w (liftFixedPrim g))
#-}
type family StorableWidth (a :: Type) :: Nat
type instance StorableWidth Word8 = 1
type instance StorableWidth Word16 = 2
type instance StorableWidth Word32 = 4
type instance StorableWidth Word64 = 8
type instance StorableWidth Int8 = 1
type instance StorableWidth Int16 = 2
type instance StorableWidth Int32 = 4
type instance StorableWidth Int64 = 8
type instance StorableWidth Float = 4
type instance StorableWidth Double = 8
primPoke :: Storable x => x -> FixedPrim (StorableWidth x)
primPoke :: forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke !x
x = forall (w :: Nat).
(Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim w
FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
p
where
p :: Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
p Addr#
v Int#
u State# RealWorld
s0 Int#
o =
let IO State# RealWorld -> (# State# RealWorld, () #)
q = forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (forall a. Addr# -> Ptr a
Ptr Addr#
v) (Int# -> Int
I# Int#
o) x
x
in case State# RealWorld -> (# State# RealWorld, () #)
q State# RealWorld
s0 of (# State# RealWorld
s1, (()
_ :: ()) #) -> (# Addr#
v, Int#
u, State# RealWorld
s1 #)
word8 :: Word8 -> FixedPrim 1
word8 :: Word8 -> FixedPrim 1
word8 = forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke
word8Shift :: Int -> Word -> FixedPrim 1
word8Shift :: Int -> Word -> FixedPrim 1
word8Shift Int
s Word
x = Word8 -> FixedPrim 1
word8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word
x Int
s))
word16Shift :: ByteOrder -> Int -> Word -> FixedPrim 2
word16Shift :: ByteOrder -> Int -> Word -> FixedPrim 2
word16Shift ByteOrder
bo = case ByteOrder
bo of
ByteOrder
BigEndian -> \(!Int
s) (!Word
x) -> Int -> Word -> FixedPrim 1
p (Int
s forall a. Num a => a -> a -> a
+ Int
h) Word
x forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<> Int -> Word -> FixedPrim 1
p Int
s Word
x
ByteOrder
LittleEndian -> \(!Int
s) (!Word
x) -> Int -> Word -> FixedPrim 1
p Int
s Word
x forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<> Int -> Word -> FixedPrim 1
p (Int
s forall a. Num a => a -> a -> a
+ Int
h) Word
x
where
h :: Int
h = Int
8
p :: Int -> Word -> FixedPrim 1
p = Int -> Word -> FixedPrim 1
word8Shift
word32Shift :: ByteOrder -> Word -> FixedPrim 4
word32Shift :: ByteOrder -> Word -> FixedPrim 4
word32Shift ByteOrder
bo = case ByteOrder
bo of
ByteOrder
BigEndian -> \(!Word
x) -> Int -> Word -> FixedPrim 2
p Int
h Word
x forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<> Int -> Word -> FixedPrim 2
p Int
0 Word
x
ByteOrder
LittleEndian -> \(!Word
x) -> Int -> Word -> FixedPrim 2
p Int
0 Word
x forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<> Int -> Word -> FixedPrim 2
p Int
h Word
x
where
h :: Int
h = Int
16
p :: Int -> Word -> FixedPrim 2
p = ByteOrder -> Int -> Word -> FixedPrim 2
word16Shift ByteOrder
bo
word64Shift :: ByteOrder -> Word64 -> FixedPrim 8
word64Shift :: ByteOrder -> Word64 -> FixedPrim 8
word64Shift ByteOrder
bo = case ByteOrder
bo of
ByteOrder
BigEndian -> \(!Word64
x) -> Word64 -> FixedPrim 4
p (forall {a}. Bits a => a -> a
h Word64
x) forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<> Word64 -> FixedPrim 4
p Word64
x
ByteOrder
LittleEndian -> \(!Word64
x) -> Word64 -> FixedPrim 4
p Word64
x forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<> Word64 -> FixedPrim 4
p (forall {a}. Bits a => a -> a
h Word64
x)
where
h :: a -> a
h a
x = forall a. Bits a => a -> Int -> a
shiftR a
x Int
32
p :: Word64 -> FixedPrim 4
p = ByteOrder -> Word -> FixedPrim 4
word32Shift ByteOrder
bo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word
word16 :: ByteOrder -> Word16 -> FixedPrim 2
word16 :: ByteOrder -> Word16 -> FixedPrim 2
word16 !ByteOrder
bo !Word16
x = case StoreMethod
storeMethod of
StoreMethod
StoreAligned -> ByteOrder -> Int -> Word -> FixedPrim 2
word16Shift ByteOrder
bo Int
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x)
StoreMethod
StoreUnaligned
| ByteOrder
systemByteOrder forall a. Eq a => a -> a -> Bool
== ByteOrder
bo -> forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke Word16
x
| Bool
otherwise -> forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke (Word16 -> Word16
byteSwap16 Word16
x)
word16Native :: Word16 -> FixedPrim 2
word16Native :: Word16 -> FixedPrim 2
word16Native = ByteOrder -> Word16 -> FixedPrim 2
word16 ByteOrder
systemByteOrder
word16BE :: Word16 -> FixedPrim 2
word16BE :: Word16 -> FixedPrim 2
word16BE = ByteOrder -> Word16 -> FixedPrim 2
word16 ByteOrder
BigEndian
word16LE :: Word16 -> FixedPrim 2
word16LE :: Word16 -> FixedPrim 2
word16LE = ByteOrder -> Word16 -> FixedPrim 2
word16 ByteOrder
LittleEndian
word32 :: ByteOrder -> Word32 -> FixedPrim 4
word32 :: ByteOrder -> Word32 -> FixedPrim 4
word32 !ByteOrder
bo !Word32
x = case StoreMethod
storeMethod of
StoreMethod
StoreAligned -> ByteOrder -> Word -> FixedPrim 4
word32Shift ByteOrder
bo (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x)
StoreMethod
StoreUnaligned
| ByteOrder
systemByteOrder forall a. Eq a => a -> a -> Bool
== ByteOrder
bo -> forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke Word32
x
| Bool
otherwise -> forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke (Word32 -> Word32
byteSwap32 Word32
x)
word32Native :: Word32 -> FixedPrim 4
word32Native :: Word32 -> FixedPrim 4
word32Native = ByteOrder -> Word32 -> FixedPrim 4
word32 ByteOrder
systemByteOrder
word32BE :: Word32 -> FixedPrim 4
word32BE :: Word32 -> FixedPrim 4
word32BE = ByteOrder -> Word32 -> FixedPrim 4
word32 ByteOrder
BigEndian
word32LE :: Word32 -> FixedPrim 4
word32LE :: Word32 -> FixedPrim 4
word32LE = ByteOrder -> Word32 -> FixedPrim 4
word32 ByteOrder
LittleEndian
word64 :: ByteOrder -> Word64 -> FixedPrim 8
word64 :: ByteOrder -> Word64 -> FixedPrim 8
word64 !ByteOrder
bo !Word64
x = case StoreMethod
storeMethod of
StoreMethod
StoreAligned -> ByteOrder -> Word64 -> FixedPrim 8
word64Shift ByteOrder
bo (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x)
StoreMethod
StoreUnaligned
| ByteOrder
systemByteOrder forall a. Eq a => a -> a -> Bool
== ByteOrder
bo -> forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke Word64
x
| Bool
otherwise -> forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke (Word64 -> Word64
byteSwap64 Word64
x)
word64Native :: Word64 -> FixedPrim 8
word64Native :: Word64 -> FixedPrim 8
word64Native = ByteOrder -> Word64 -> FixedPrim 8
word64 ByteOrder
systemByteOrder
word64BE :: Word64 -> FixedPrim 8
word64BE :: Word64 -> FixedPrim 8
word64BE = ByteOrder -> Word64 -> FixedPrim 8
word64 ByteOrder
BigEndian
word64LE :: Word64 -> FixedPrim 8
word64LE :: Word64 -> FixedPrim 8
word64LE = ByteOrder -> Word64 -> FixedPrim 8
word64 ByteOrder
LittleEndian
int8 :: Int8 -> FixedPrim 1
int8 :: Int8 -> FixedPrim 1
int8 = Word8 -> FixedPrim 1
word8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int16 :: ByteOrder -> Int16 -> FixedPrim 2
int16 :: ByteOrder -> Int16 -> FixedPrim 2
int16 !ByteOrder
bo = ByteOrder -> Word16 -> FixedPrim 2
word16 ByteOrder
bo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int16Native :: Int16 -> FixedPrim 2
int16Native :: Int16 -> FixedPrim 2
int16Native = Word16 -> FixedPrim 2
word16Native forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int16BE :: Int16 -> FixedPrim 2
int16BE :: Int16 -> FixedPrim 2
int16BE = Word16 -> FixedPrim 2
word16BE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int16LE :: Int16 -> FixedPrim 2
int16LE :: Int16 -> FixedPrim 2
int16LE = Word16 -> FixedPrim 2
word16LE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int32 :: ByteOrder -> Int32 -> FixedPrim 4
int32 :: ByteOrder -> Int32 -> FixedPrim 4
int32 ByteOrder
bo = ByteOrder -> Word32 -> FixedPrim 4
word32 ByteOrder
bo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int32Native :: Int32 -> FixedPrim 4
int32Native :: Int32 -> FixedPrim 4
int32Native = Word32 -> FixedPrim 4
word32Native forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int32BE :: Int32 -> FixedPrim 4
int32BE :: Int32 -> FixedPrim 4
int32BE = Word32 -> FixedPrim 4
word32BE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int32LE :: Int32 -> FixedPrim 4
int32LE :: Int32 -> FixedPrim 4
int32LE = Word32 -> FixedPrim 4
word32LE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int64 :: ByteOrder -> Int64 -> FixedPrim 8
int64 :: ByteOrder -> Int64 -> FixedPrim 8
int64 ByteOrder
bo = ByteOrder -> Word64 -> FixedPrim 8
word64 ByteOrder
bo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int64Native :: Int64 -> FixedPrim 8
int64Native :: Int64 -> FixedPrim 8
int64Native = Word64 -> FixedPrim 8
word64Native forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int64BE :: Int64 -> FixedPrim 8
int64BE :: Int64 -> FixedPrim 8
int64BE = Word64 -> FixedPrim 8
word64BE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
int64LE :: Int64 -> FixedPrim 8
int64LE :: Int64 -> FixedPrim 8
int64LE = Word64 -> FixedPrim 8
word64LE forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
float :: ByteOrder -> Float -> FixedPrim 4
float :: ByteOrder -> Float -> FixedPrim 4
float ByteOrder
BigEndian = Float -> FixedPrim 4
floatBE
float ByteOrder
LittleEndian = Float -> FixedPrim 4
floatLE
floatNative :: Float -> FixedPrim 4
floatNative :: Float -> FixedPrim 4
floatNative = ByteOrder -> Float -> FixedPrim 4
float ByteOrder
systemByteOrder
floatBE :: Float -> FixedPrim 4
floatBE :: Float -> FixedPrim 4
floatBE !Float
x = forall (w :: Nat).
(Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim w
FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
g
where
g :: Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
g Addr#
v Int#
u State# RealWorld
s0 Int#
o = case Ptr Word8 -> Int -> Float -> IO Word32
floatToWord32 (forall a. Addr# -> Ptr a
Ptr Addr#
v) (Int# -> Int
I# Int#
u) Float
x of
IO State# RealWorld -> (# State# RealWorld, Word32 #)
h -> case State# RealWorld -> (# State# RealWorld, Word32 #)
h State# RealWorld
s0 of
(# State# RealWorld
s1, Word32
y #) ->
let FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f = Word32 -> FixedPrim 4
word32BE Word32
y
in Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f Addr#
v Int#
u State# RealWorld
s1 Int#
o
floatLE :: Float -> FixedPrim 4
floatLE :: Float -> FixedPrim 4
floatLE !Float
x = forall (w :: Nat).
(Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim w
FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
g
where
g :: Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
g Addr#
v Int#
u State# RealWorld
s0 Int#
o = case Ptr Word8 -> Int -> Float -> IO Word32
floatToWord32 (forall a. Addr# -> Ptr a
Ptr Addr#
v) (Int# -> Int
I# Int#
u) Float
x of
IO State# RealWorld -> (# State# RealWorld, Word32 #)
h -> case State# RealWorld -> (# State# RealWorld, Word32 #)
h State# RealWorld
s0 of
(# State# RealWorld
s1, Word32
y #) ->
let FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f = Word32 -> FixedPrim 4
word32LE Word32
y
in Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f Addr#
v Int#
u State# RealWorld
s1 Int#
o
double :: ByteOrder -> Double -> FixedPrim 8
double :: ByteOrder -> Double -> FixedPrim 8
double ByteOrder
BigEndian = Double -> FixedPrim 8
doubleBE
double ByteOrder
LittleEndian = Double -> FixedPrim 8
doubleLE
doubleNative :: Double -> FixedPrim 8
doubleNative :: Double -> FixedPrim 8
doubleNative = ByteOrder -> Double -> FixedPrim 8
double ByteOrder
systemByteOrder
doubleBE :: Double -> FixedPrim 8
doubleBE :: Double -> FixedPrim 8
doubleBE !Double
x = forall (w :: Nat).
(Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim w
FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
g
where
g :: Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
g Addr#
v Int#
u State# RealWorld
s0 Int#
o = case Ptr Word8 -> Int -> Double -> IO Word64
doubleToWord64 (forall a. Addr# -> Ptr a
Ptr Addr#
v) (Int# -> Int
I# Int#
u) Double
x of
IO State# RealWorld -> (# State# RealWorld, Word64 #)
h -> case State# RealWorld -> (# State# RealWorld, Word64 #)
h State# RealWorld
s0 of
(# State# RealWorld
s1, Word64
y #) ->
let FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f = Word64 -> FixedPrim 8
word64BE Word64
y
in Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f Addr#
v Int#
u State# RealWorld
s1 Int#
o
doubleLE :: Double -> FixedPrim 8
doubleLE :: Double -> FixedPrim 8
doubleLE !Double
x = forall (w :: Nat).
(Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim w
FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
g
where
g :: Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
g Addr#
v Int#
u State# RealWorld
s0 Int#
o = case Ptr Word8 -> Int -> Double -> IO Word64
doubleToWord64 (forall a. Addr# -> Ptr a
Ptr Addr#
v) (Int# -> Int
I# Int#
u) Double
x of
IO State# RealWorld -> (# State# RealWorld, Word64 #)
h -> case State# RealWorld -> (# State# RealWorld, Word64 #)
h State# RealWorld
s0 of
(# State# RealWorld
s1, Word64
y #) ->
let FixedPrim Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f = Word64 -> FixedPrim 8
word64LE Word64
y
in Addr#
-> Int#
-> State# RealWorld
-> Int#
-> (# Addr#, Int#, State# RealWorld #)
f Addr#
v Int#
u State# RealWorld
s1 Int#
o
charUtf8 :: Char -> BoundedPrim 4
charUtf8 :: Char -> BoundedPrim 4
charUtf8 = \Char
ch -> case forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
ch) of W# Word#
x -> Word# -> BoundedPrim 4
wordUtf8 Word#
x
where
wordUtf8 :: Word# -> BoundedPrim 4
wordUtf8 :: Word# -> BoundedPrim 4
wordUtf8 =
forall (v :: Nat) (w :: Nat).
(KnownNat v, KnownNat w) =>
Word
-> (Word# -> FixedPrim v)
-> (Word# -> BoundedPrim w)
-> Word#
-> BoundedPrim (Max w v)
choose Word
0x7F Word# -> FixedPrim 1
p1 forall a b. (a -> b) -> a -> b
$
forall (v :: Nat) (w :: Nat).
(KnownNat v, KnownNat w) =>
Word
-> (Word# -> FixedPrim v)
-> (Word# -> BoundedPrim w)
-> Word#
-> BoundedPrim (Max w v)
choose Word
0x7FF Word# -> FixedPrim 2
p2 forall a b. (a -> b) -> a -> b
$
forall (v :: Nat) (w :: Nat).
(KnownNat v, KnownNat w) =>
Word
-> (Word# -> FixedPrim v)
-> (Word# -> BoundedPrim w)
-> Word#
-> BoundedPrim (Max w v)
choose Word
0xFFFF Word# -> FixedPrim 3
p3 forall a b. (a -> b) -> a -> b
$
(\Word#
y -> forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> FixedPrim 4
p4 Word#
y))
{-# INLINE wordUtf8 #-}
choose ::
forall v w .
(KnownNat v, KnownNat w) =>
Word ->
(Word# -> FixedPrim v) ->
(Word# -> BoundedPrim w) ->
Word# -> BoundedPrim (Max w v)
choose :: forall (v :: Nat) (w :: Nat).
(KnownNat v, KnownNat w) =>
Word
-> (Word# -> FixedPrim v)
-> (Word# -> BoundedPrim w)
-> Word#
-> BoundedPrim (Max w v)
choose = \Word
t Word# -> FixedPrim v
f Word# -> BoundedPrim w
g Word#
x -> forall {k} (n :: k -> *) (f :: k) (t :: k) (w :: k).
PChoose n f t w =>
Bool -> PNullary n t -> PNullary n f -> PNullary n w
pif (Word# -> Word
W# Word#
x forall a. Ord a => a -> a -> Bool
<= Word
t) (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> FixedPrim v
f Word#
x)) (Word# -> BoundedPrim w
g Word#
x)
{-# INLINE choose #-}
lsb ::
KnownNat n =>
(Word# -> FixedPrim n) ->
Word# ->
FixedPrim (n + 1)
lsb :: forall (n :: Nat).
KnownNat n =>
(Word# -> FixedPrim n) -> Word# -> FixedPrim (n + 1)
lsb = \Word# -> FixedPrim n
p Word#
x -> Word# -> FixedPrim n
p (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
6#) forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<>
Word8 -> FixedPrim 1
word8 (Word# -> Word8
W8# (Word# -> Word# -> Word#
plusWord# Word#
0x80## (Word# -> Word# -> Word#
and# Word#
x Word#
0x3F##)))
{-# INLINE lsb #-}
p1 :: Word# -> FixedPrim 1
p2 :: Word# -> FixedPrim 2
p3 :: Word# -> FixedPrim 3
p4 :: Word# -> FixedPrim 4
p1 :: Word# -> FixedPrim 1
p1 Word#
x = Word8 -> FixedPrim 1
word8 (Word# -> Word8
W8# Word#
x)
p2 :: Word# -> FixedPrim 2
p2 = forall (n :: Nat).
KnownNat n =>
(Word# -> FixedPrim n) -> Word# -> FixedPrim (n + 1)
lsb (\Word#
x -> Word8 -> FixedPrim 1
word8 (Word# -> Word8
W8# (Word# -> Word# -> Word#
plusWord# Word#
0xC0## Word#
x)))
p3 :: Word# -> FixedPrim 3
p3 = forall (n :: Nat).
KnownNat n =>
(Word# -> FixedPrim n) -> Word# -> FixedPrim (n + 1)
lsb (forall (n :: Nat).
KnownNat n =>
(Word# -> FixedPrim n) -> Word# -> FixedPrim (n + 1)
lsb (\Word#
x -> Word8 -> FixedPrim 1
word8 (Word# -> Word8
W8# (Word# -> Word# -> Word#
plusWord# Word#
0xE0## Word#
x))))
p4 :: Word# -> FixedPrim 4
p4 = forall (n :: Nat).
KnownNat n =>
(Word# -> FixedPrim n) -> Word# -> FixedPrim (n + 1)
lsb (forall (n :: Nat).
KnownNat n =>
(Word# -> FixedPrim n) -> Word# -> FixedPrim (n + 1)
lsb (forall (n :: Nat).
KnownNat n =>
(Word# -> FixedPrim n) -> Word# -> FixedPrim (n + 1)
lsb (\Word#
x -> Word8 -> FixedPrim 1
word8 (Word# -> Word8
W8# (Word# -> Word# -> Word#
plusWord# Word#
0xF0## Word#
x)))))
{-# INLINE p1 #-}
{-# INLINE p2 #-}
{-# INLINE p3 #-}
{-# INLINE p4 #-}
{-# INLINE charUtf8 #-}
#if WORD_SIZE_IN_BITS < 64
wordBase128LEVar :: Word -> BoundedPrim 5
wordBase128LEVar (W# w) = word32Base128LEVar (W32# w)
#else
wordBase128LEVar :: Word -> BoundedPrim 10
wordBase128LEVar :: Word -> BoundedPrim 10
wordBase128LEVar (W# Word#
w) = Word64 -> BoundedPrim 10
word64Base128LEVar (Word# -> Word64
W64# Word#
w)
#endif
{-# INLINE wordBase128LEVar #-}
#if WORD_SIZE_IN_BITS < 64
wordBase128LEVar_inline :: Word -> BoundedPrim 5
wordBase128LEVar_inline (W# w) = word32Base128LEVar_inline (W32# w)
#else
wordBase128LEVar_inline :: Word -> BoundedPrim 10
wordBase128LEVar_inline :: Word -> BoundedPrim 10
wordBase128LEVar_inline (W# Word#
w) = Word64 -> BoundedPrim 10
word64Base128LEVar_inline (Word# -> Word64
W64# Word#
w)
#endif
{-# INLINE wordBase128LEVar_inline #-}
word32Base128LEVar :: Word32 -> BoundedPrim 5
word32Base128LEVar :: Word32 -> BoundedPrim 5
word32Base128LEVar = Word32 -> BoundedPrim 5
word32Base128LEVar_inline
{-# INLINE word32Base128LEVar #-}
word32Base128LEVar_inline :: Word32 -> BoundedPrim 5
word32Base128LEVar_inline :: Word32 -> BoundedPrim 5
word32Base128LEVar_inline = \(W32# Word#
x0) ->
( forall (v :: Nat) (w :: Nat).
(KnownNat v, KnownNat w) =>
Int
-> (Word# -> Word# -> FixedPrim v)
-> (Word# -> BoundedPrim w)
-> Word#
-> BoundedPrim (Max w v)
wordBase128LEVar_choose Int
1 Word# -> Word# -> FixedPrim 1
wordBase128LE_p1 forall a b. (a -> b) -> a -> b
$
forall (v :: Nat) (w :: Nat).
(KnownNat v, KnownNat w) =>
Int
-> (Word# -> Word# -> FixedPrim v)
-> (Word# -> BoundedPrim w)
-> Word#
-> BoundedPrim (Max w v)
wordBase128LEVar_choose Int
2 Word# -> Word# -> FixedPrim 2
wordBase128LE_p2 forall a b. (a -> b) -> a -> b
$
forall (v :: Nat) (w :: Nat).
(KnownNat v, KnownNat w) =>
Int
-> (Word# -> Word# -> FixedPrim v)
-> (Word# -> BoundedPrim w)
-> Word#
-> BoundedPrim (Max w v)
wordBase128LEVar_choose Int
3 Word# -> Word# -> FixedPrim 3
wordBase128LE_p3 forall a b. (a -> b) -> a -> b
$
forall (v :: Nat) (w :: Nat).
(KnownNat v, KnownNat w) =>
Int
-> (Word# -> Word# -> FixedPrim v)
-> (Word# -> BoundedPrim w)
-> Word#
-> BoundedPrim (Max w v)
wordBase128LEVar_choose Int
4 Word# -> Word# -> FixedPrim 4
wordBase128LE_p4 forall a b. (a -> b) -> a -> b
$
(\Word#
x -> forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> Word# -> FixedPrim 5
wordBase128LE_p5 Word#
0## Word#
x))
) Word#
x0
{-# INLINE word32Base128LEVar_inline #-}
wordBase128LEVar_choose ::
forall v w .
(KnownNat v, KnownNat w) =>
Int ->
(Word# -> Word# -> FixedPrim v) ->
(Word# -> BoundedPrim w) ->
Word# -> BoundedPrim (Max w v)
wordBase128LEVar_choose :: forall (v :: Nat) (w :: Nat).
(KnownNat v, KnownNat w) =>
Int
-> (Word# -> Word# -> FixedPrim v)
-> (Word# -> BoundedPrim w)
-> Word#
-> BoundedPrim (Max w v)
wordBase128LEVar_choose = \Int
d Word# -> Word# -> FixedPrim v
f Word# -> BoundedPrim w
g Word#
x ->
forall {k} (n :: k -> *) (f :: k) (t :: k) (w :: k).
PChoose n f t w =>
Bool -> PNullary n t -> PNullary n f -> PNullary n w
pif (Word# -> Word
W# Word#
x forall a. Ord a => a -> a -> Bool
<= forall a. Bits a => a -> Int -> a
shiftL Word
1 (Int
7 forall a. Num a => a -> a -> a
* Int
d) forall a. Num a => a -> a -> a
- Word
1) (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> Word# -> FixedPrim v
f Word#
0## Word#
x)) (Word# -> BoundedPrim w
g Word#
x)
{-# INLINE wordBase128LEVar_choose #-}
wordBase128LE_msb ::
forall n .
KnownNat n =>
(Word# -> Word# -> FixedPrim n) ->
Word# -> Word# -> FixedPrim (n + 1)
wordBase128LE_msb :: forall (n :: Nat).
KnownNat n =>
(Word# -> Word# -> FixedPrim n)
-> Word# -> Word# -> FixedPrim (n + 1)
wordBase128LE_msb = \Word# -> Word# -> FixedPrim n
p Word#
m Word#
x ->
Word# -> Word# -> FixedPrim n
p Word#
0x80## Word#
x forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<> Word8 -> FixedPrim 1
word8 (Word# -> Word8
W8# (Word# -> Word# -> Word#
or# Word#
m (Word# -> Int# -> Word#
uncheckedShiftRL# Word#
x Int#
s)))
where
!(I# Int#
s) = Int
7 forall a. Num a => a -> a -> a
* forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall {k} (a :: k). Proxy# a
proxy# :: Proxy# n))
{-# INLINE wordBase128LE_msb #-}
wordBase128LE_p1 :: Word# -> Word# -> FixedPrim 1
wordBase128LE_p1 :: Word# -> Word# -> FixedPrim 1
wordBase128LE_p1 = \Word#
m Word#
x -> Word8 -> FixedPrim 1
word8 (Word# -> Word8
W8# (Word# -> Word# -> Word#
or# Word#
m Word#
x))
{-# INLINE wordBase128LE_p1 #-}
wordBase128LE_p2 :: Word# -> Word# -> FixedPrim 2
wordBase128LE_p2 :: Word# -> Word# -> FixedPrim 2
wordBase128LE_p2 = forall (n :: Nat).
KnownNat n =>
(Word# -> Word# -> FixedPrim n)
-> Word# -> Word# -> FixedPrim (n + 1)
wordBase128LE_msb Word# -> Word# -> FixedPrim 1
wordBase128LE_p1
{-# INLINE wordBase128LE_p2 #-}
wordBase128LE_p3 :: Word# -> Word# -> FixedPrim 3
wordBase128LE_p3 :: Word# -> Word# -> FixedPrim 3
wordBase128LE_p3 = forall (n :: Nat).
KnownNat n =>
(Word# -> Word# -> FixedPrim n)
-> Word# -> Word# -> FixedPrim (n + 1)
wordBase128LE_msb Word# -> Word# -> FixedPrim 2
wordBase128LE_p2
{-# INLINE wordBase128LE_p3 #-}
wordBase128LE_p4 :: Word# -> Word# -> FixedPrim 4
wordBase128LE_p4 :: Word# -> Word# -> FixedPrim 4
wordBase128LE_p4 = forall (n :: Nat).
KnownNat n =>
(Word# -> Word# -> FixedPrim n)
-> Word# -> Word# -> FixedPrim (n + 1)
wordBase128LE_msb Word# -> Word# -> FixedPrim 3
wordBase128LE_p3
{-# INLINE wordBase128LE_p4 #-}
wordBase128LE_p5 :: Word# -> Word# -> FixedPrim 5
wordBase128LE_p5 :: Word# -> Word# -> FixedPrim 5
wordBase128LE_p5 = forall (n :: Nat).
KnownNat n =>
(Word# -> Word# -> FixedPrim n)
-> Word# -> Word# -> FixedPrim (n + 1)
wordBase128LE_msb Word# -> Word# -> FixedPrim 4
wordBase128LE_p4
{-# INLINE wordBase128LE_p5 #-}
word14Base128LEVar :: Word# -> BoundedPrim 2
word14Base128LEVar :: Word# -> BoundedPrim 2
word14Base128LEVar = \Word#
x0 ->
( forall (v :: Nat) (w :: Nat).
(KnownNat v, KnownNat w) =>
Int
-> (Word# -> Word# -> FixedPrim v)
-> (Word# -> BoundedPrim w)
-> Word#
-> BoundedPrim (Max w v)
wordBase128LEVar_choose Int
1 Word# -> Word# -> FixedPrim 1
wordBase128LE_p1 forall a b. (a -> b) -> a -> b
$
(\Word#
x -> forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> Word# -> FixedPrim 2
wordBase128LE_p2 Word#
0## Word#
x))
) Word#
x0
{-# INLINE word14Base128LEVar #-}
word28Base128LE :: Word# -> FixedPrim 4
word28Base128LE :: Word# -> FixedPrim 4
word28Base128LE = Word# -> Word# -> FixedPrim 4
wordBase128LE_p4 Word#
0x80##
{-# INLINE word28Base128LE #-}
word64Base128LEVar :: Word64 -> BoundedPrim 10
word64Base128LEVar :: Word64 -> BoundedPrim 10
word64Base128LEVar = \(W64# Word#
x) ->
forall {k} (n :: k -> *) (f :: k) (t :: k) (w :: k).
PChoose n f t w =>
Bool -> PNullary n t -> PNullary n f -> PNullary n w
pif (Word# -> Word64
W64# Word#
x forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word32))
(Word32 -> BoundedPrim 5
word32Base128LEVar (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word# -> Word64
W64# Word#
x)))
(Word# -> BoundedPrim 10
word64Base128LEVar_big Word#
x)
{-# INLINE word64Base128LEVar #-}
word64Base128LEVar_inline :: Word64 -> BoundedPrim 10
word64Base128LEVar_inline :: Word64 -> BoundedPrim 10
word64Base128LEVar_inline = \(W64# Word#
x) ->
forall {k} (n :: k -> *) (f :: k) (t :: k) (w :: k).
PChoose n f t w =>
Bool -> PNullary n t -> PNullary n f -> PNullary n w
pif (Word# -> Word64
W64# Word#
x forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Word32))
(Word32 -> BoundedPrim 5
word32Base128LEVar (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word# -> Word64
W64# Word#
x)))
(forall a. a -> a
inline (Word# -> BoundedPrim 10
word64Base128LEVar_big Word#
x))
{-# INLINE word64Base128LEVar_inline #-}
word64Base128LEVar_big :: WORD64 -> BoundedPrim 10
word64Base128LEVar_big :: Word# -> BoundedPrim 10
word64Base128LEVar_big Word#
x = forall {k} (n :: k -> *) (f :: k) (t :: k) (w :: k).
PChoose n f t w =>
Bool -> PNullary n t -> PNullary n f -> PNullary n w
pif (Word# -> Word64
W64# Word#
x forall a. Ord a => a -> a -> Bool
<= forall a. Bits a => a -> Int -> a
shiftL Word64
1 Int
60 forall a. Num a => a -> a -> a
- Word64
1) PNullary BoundedPrim 9
p60 PNullary BoundedPrim (8 + 2)
p64
where
p60 :: PNullary BoundedPrim 9
p60 = forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> FixedPrim 4
word28Base128LE Word#
x32) forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<>
Word32 -> BoundedPrim 5
word32Base128LEVar (Word# -> Word32
W32# (Int -> Word#
shR Int
28))
p64 :: PNullary BoundedPrim (8 + 2)
p64 = ( forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> FixedPrim 4
word28Base128LE Word#
x32) forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<>
forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> FixedPrim 4
word28Base128LE (Int -> Word#
shR Int
28)) ) forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<>
Word# -> BoundedPrim 2
word14Base128LEVar (Int -> Word#
shR Int
56)
x32 :: Word#
x32 = case forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word# -> Word64
W64# Word#
x) of W32# Word#
y -> Word#
y
shR :: Int -> Word#
shR Int
s = case forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR (Word# -> Word64
W64# Word#
x) Int
s) of W32# Word#
y -> Word#
y
{-# NOINLINE word64Base128LEVar_big #-}
vectorFixedPrim ::
forall w v a .
(KnownNat w, Data.Vector.Generic.Vector v a) =>
(a -> FixedPrim w) ->
v a ->
BuildR
vectorFixedPrim :: forall (w :: Nat) (v :: * -> *) a.
(KnownNat w, Vector v a) =>
(a -> FixedPrim w) -> v a -> BuildR
vectorFixedPrim a -> FixedPrim w
f = forall a. (a -> BuildR) -> a -> BuildR
etaBuildR forall a b. (a -> b) -> a -> b
$ \v a
v ->
let op :: BuildR -> a -> BuildR
op BuildR
acc a
x = BuildR
acc forall a. Semigroup a => a -> a -> a
<> forall (w :: Nat). BoundedPrim w -> BuildR
unsafeBuildBoundedPrim (forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (a -> FixedPrim w
f a
x))
in Int -> BuildR -> BuildR
ensure (Int
w forall a. Num a => a -> a -> a
* forall (v :: * -> *) a. Vector v a => v a -> Int
Data.Vector.Generic.length v a
v) (forall (v :: * -> *) a b.
Vector v a =>
(b -> a -> b) -> b -> v a -> b
foldlRVector BuildR -> a -> BuildR
op forall a. Monoid a => a
mempty v a
v)
where
w :: Int
w = forall a. Num a => Integer -> a
fromInteger (forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (forall {k} (a :: k). Proxy# a
proxy# :: Proxy# w))
{-# INLINE vectorFixedPrim #-}