{-
  Copyright 2020 Awake Networks

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
-}

-- | Implementation details of the "Data.ByteString.Reverse" module.
-- Breaking changes will be more frequent in this module; use with caution.

{-# 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
  ( -- * Combine types such as `BoundedPrim` and `FixedPrim`.
    AssocPlusNat(..)
  , CommPlusNat(..)
  , PChoose(..)
  , Max
  , AssocMaxNat(..)
  , CommMaxNat(..)

    -- * Architectural attributes.
  , StoreMethod(..)
  , storeMethod
  , ByteOrder(..)
  , systemByteOrder

    -- * Bounded primitives.
  , BoundedPrim(..)
  , liftBoundedPrim
  , composeBoundedPrim
  , unsafeBuildBoundedPrim

    -- * Fixed-width primitives.
  , 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

-- "ghc-prim" v0.6.1 defines `GHC.Prim.Ext.WORD64`, but we do not wish
-- to require that version of "ghc-prim".  Therefore we define it locally.
#if WORD_SIZE_IN_BITS < 64
import GHC.IntWord64 (Word64#)
type WORD64 = Word64#
#else
import GHC.Exts (Word#)
type WORD64 = Word#
#endif

-- $setup
-- >>> :set -XOverloadedStrings

-- | Are we restricted to aligned writes only?
data StoreMethod = StoreAligned | StoreUnaligned
  deriving (StoreMethod -> StoreMethod -> Bool
(StoreMethod -> StoreMethod -> Bool)
-> (StoreMethod -> StoreMethod -> Bool) -> Eq StoreMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StoreMethod -> StoreMethod -> Bool
== :: StoreMethod -> StoreMethod -> Bool
$c/= :: StoreMethod -> StoreMethod -> Bool
/= :: StoreMethod -> StoreMethod -> Bool
Eq, Int -> StoreMethod -> ShowS
[StoreMethod] -> ShowS
StoreMethod -> String
(Int -> StoreMethod -> ShowS)
-> (StoreMethod -> String)
-> ([StoreMethod] -> ShowS)
-> Show StoreMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StoreMethod -> ShowS
showsPrec :: Int -> StoreMethod -> ShowS
$cshow :: StoreMethod -> String
show :: StoreMethod -> String
$cshowList :: [StoreMethod] -> ShowS
showList :: [StoreMethod] -> ShowS
Show)

-- | 'StoreUnaligned' if the Cabal file defines @UNALIGNED_POKES@, which it
-- does on architectures where that approach is known to be safe and faster
-- then writing bytes one by one.  Otherwise 'StoreAligned'.
storeMethod :: StoreMethod
#if defined(UNALIGNED_POKES)
storeMethod :: StoreMethod
storeMethod = StoreMethod
StoreUnaligned
#else
storeMethod = StoreAligned
#endif

-- | Specifies order in which the bytes of an integer are encoded.
data ByteOrder
  = BigEndian     -- ^ Most significant byte first.
  | LittleEndian  -- ^ Least significant byte first.
  deriving (ByteOrder -> ByteOrder -> Bool
(ByteOrder -> ByteOrder -> Bool)
-> (ByteOrder -> ByteOrder -> Bool) -> Eq ByteOrder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByteOrder -> ByteOrder -> Bool
== :: ByteOrder -> ByteOrder -> Bool
$c/= :: ByteOrder -> ByteOrder -> Bool
/= :: ByteOrder -> ByteOrder -> Bool
Eq, Int -> ByteOrder -> ShowS
[ByteOrder] -> ShowS
ByteOrder -> String
(Int -> ByteOrder -> ShowS)
-> (ByteOrder -> String)
-> ([ByteOrder] -> ShowS)
-> Show ByteOrder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByteOrder -> ShowS
showsPrec :: Int -> ByteOrder -> ShowS
$cshow :: ByteOrder -> String
show :: ByteOrder -> String
$cshowList :: [ByteOrder] -> ShowS
showList :: [ByteOrder] -> ShowS
Show)

-- | The 'ByteOrder' native to the current architecture.
--
-- For example, the order of the bytes when you poke a 'Word32'.
systemByteOrder :: ByteOrder
-- WORDS_BIGENDIAN is defined for big-endian architectures
-- by the GHC header <MachDeps.h>.
#if defined(WORDS_BIGENDIAN)
systemByteOrder = BigEndian
#else
systemByteOrder :: ByteOrder
systemByteOrder = ByteOrder
LittleEndian
#endif

-- | A 'BuildR' together with a type-level bound on the number of bytes
-- written and a requirement that the current buffer already contain at
-- least that many bytes.
--
-- As in the "bytestring" package, the purpose of a bounded primitive is to
-- improve speed by consolidating the space checks of several small builders.
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 = PNullary BoundedPrim w1
-> PNullary BoundedPrim w2 -> PNullary BoundedPrim w3
BoundedPrim w1 -> BoundedPrim w2 -> BoundedPrim (w1 + w2)
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 = Proxy# '(u, v, w)
-> PNullary BoundedPrim (u + (v + w))
-> PNullary BoundedPrim ((u + v) + w)
Proxy# '(u, v, w)
-> BoundedPrim (u + (v + w)) -> BoundedPrim ((u + v) + w)
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 = Proxy# '(u, v, w)
-> PNullary BoundedPrim ((u + v) + w)
-> PNullary BoundedPrim (u + (v + w))
Proxy# '(u, v, w)
-> BoundedPrim ((u + v) + w) -> BoundedPrim (u + (v + w))
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) = BuildR -> BoundedPrim (v + u)
forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim BuildR
f
    {-# INLINE CONLIKE commPlusNat #-}

instance PMEmpty BoundedPrim 0
  where
    pmempty :: PNullary BoundedPrim 0
pmempty = BuildR -> BoundedPrim 0
forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim BuildR
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) -> BuildR -> BoundedPrim w
forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim (BuildR -> BoundedPrim w)
-> (Bool -> BuildR) -> Bool -> BoundedPrim w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildR -> BuildR -> Bool -> BuildR
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) -> BuildR
-> BoundedPrim
     (If
        (OrdCond
           (CmpNat w (If (OrdCond (CmpNat v u) 'True 'True 'False) u v))
           'True
           'True
           'False)
        (If (OrdCond (CmpNat v u) 'True 'True 'False) u v)
        w)
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) -> BuildR
-> BoundedPrim
     (If
        (OrdCond
           (CmpNat (If (OrdCond (CmpNat w v) 'True 'True 'False) v w) u)
           'True
           'True
           'False)
        u
        (If (OrdCond (CmpNat w v) 'True 'True 'False) v w))
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) -> BuildR
-> BoundedPrim (If (OrdCond (CmpNat u v) 'True 'True 'False) v u)
forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim BuildR
f
    {-# INLINE CONLIKE commMaxNat #-}

-- | Like 'assocLPlusNat' but can be used in rules without
-- causing GHC to think the class dictionary is recursive.
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) -> BuildR -> BoundedPrim ((u + v) + w)
forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim BuildR
f
{-# INLINE CONLIKE assocLPlusNatBoundedPrim #-}

-- | Like 'assocRPlusNat' but can be used in rules without
-- causing GHC to think the class dictionary is recursive.
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) -> BuildR -> BoundedPrim (u + (v + w))
forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim BuildR
f
{-# INLINE CONLIKE assocRPlusNatBoundedPrim #-}

-- | Needed for rewrite rules; normally you would use 'pmappend' or '(&<>)'.
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) -> BuildR -> BoundedPrim (v + w)
forall (w :: Nat). BuildR -> BoundedPrim w
BoundedPrim (BuildR
f BuildR -> BuildR -> BuildR
forall a. Semigroup a => a -> a -> a
<> BuildR
g)
{-# INLINE CONLIKE [1] composeBoundedPrim #-}

-- | Executes the bounded primitive WITHOUT first ensuring it has enough space.
unsafeBuildBoundedPrim :: BoundedPrim w -> BuildR
unsafeBuildBoundedPrim :: forall (w :: Nat). BoundedPrim w -> BuildR
unsafeBuildBoundedPrim (BoundedPrim BuildR
build) = BuildR
build

-- | Executes the given bounded primitive
-- after obtaining the space it requires.
liftBoundedPrim :: forall w . KnownNat w => BoundedPrim w -> BuildR
liftBoundedPrim :: forall (w :: Nat). KnownNat w => BoundedPrim w -> BuildR
liftBoundedPrim = case Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# w -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# w
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# w)) of
  I# Int#
w -> Int# -> BoundedPrim w -> BuildR
forall (w :: Nat). Int# -> BoundedPrim w -> BuildR
unsafeLiftBoundedPrim Int#
w
{-# INLINE CONLIKE liftBoundedPrim #-}

-- | Needed for rewrite rules; normally you would use '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))

  #-}

-- | Similar to a 'BoundedPrim' but also consolidates address updates in
-- order to take advantage of machine instructions that write at an offset.
--
-- The additional input is an offset from the current address
-- that specifies the beginning of the region being encoded.
--
-- (If GHC learns to consolidate address offsets automatically
-- then we might be able to just use 'BoundedPrim' instead.)
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 Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# w1 -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# w1
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# w1)) of
        I# Int#
w1 -> (Addr#
 -> Int#
 -> State# RealWorld
 -> Int#
 -> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim w3
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) -> (Addr#
 -> Int#
 -> State# RealWorld
 -> Int#
 -> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim ((u + v) + w)
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) -> (Addr#
 -> Int#
 -> State# RealWorld
 -> Int#
 -> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim (u + (v + w))
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) -> (Addr#
 -> Int#
 -> State# RealWorld
 -> Int#
 -> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim (v + u)
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 = (Addr#
 -> Int#
 -> State# RealWorld
 -> Int#
 -> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim 0
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 #-}

-- | Executes the given fixed primitive and adjusts the current address.
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) -> BuildR -> BoundedPrim w
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) = - Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# w -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# w
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))

  #-}

-- | Required:
--
-- > fromInteger (natVal' (proxy# :: Proxy# (StorableWidth a))) =
-- >   sizeOf (undefined :: x)
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

-- | WARNING: The write may be unaligned; check 'storeMethod' first.
primPoke :: Storable x => x -> FixedPrim (StorableWidth x)
primPoke :: forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke !x
x = (Addr#
 -> Int#
 -> State# RealWorld
 -> Int#
 -> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim (StorableWidth 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 = Ptr Any -> Int -> x -> IO ()
forall b. Ptr b -> Int -> x -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Addr# -> Ptr Any
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 #)

-- | Fixed-width primitive that writes a single byte as-is.
word8 :: Word8 -> FixedPrim 1
word8 :: Word8 -> FixedPrim 1
word8 = Word8 -> FixedPrim 1
Word8 -> FixedPrim (StorableWidth Word8)
forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke
  -- Byte order and alignment do not matter for a single byte.

-- | Shifts right by @s@ bits, then writes the least significant byte.
word8Shift :: Int -> Word -> FixedPrim 1
word8Shift :: Int -> Word -> FixedPrim 1
word8Shift Int
s Word
x = Word8 -> FixedPrim 1
word8 (Word -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int -> Word
forall a. Bits a => a -> Int -> a
shiftR Word
x Int
s))

-- | Shifts right by @s@ bits, then writes the least significant 16-bit word.
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h) Word
x PNullary FixedPrim 1
-> PNullary FixedPrim 1 -> PNullary FixedPrim 2
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 PNullary FixedPrim 1
-> PNullary FixedPrim 1 -> PNullary FixedPrim 2
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 Int -> Int -> Int
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

-- | Writes the least significant 32-bit word, one byte at a time.
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 PNullary FixedPrim 2
-> PNullary FixedPrim 2 -> PNullary FixedPrim 4
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 PNullary FixedPrim 2
-> PNullary FixedPrim 2 -> PNullary FixedPrim 4
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

-- | Writes one byte at a time.
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 (Word64 -> Word64
forall {a}. Bits a => a -> a
h Word64
x) PNullary FixedPrim 4
-> PNullary FixedPrim 4 -> PNullary FixedPrim 8
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 PNullary FixedPrim 4
-> PNullary FixedPrim 4 -> PNullary FixedPrim 8
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 -> Word64
forall {a}. Bits a => a -> a
h Word64
x)
  where
    h :: a -> a
h a
x = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
x Int
32
    p :: Word64 -> FixedPrim 4
p = ByteOrder -> Word -> FixedPrim 4
word32Shift ByteOrder
bo (Word -> FixedPrim 4) -> (Word64 -> Word) -> Word64 -> FixedPrim 4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral @Word64 @Word

-- | Fixed-width primitive that writes a 16-bit word
-- in the specified byte order.
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 (Word16 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
x)
  StoreMethod
StoreUnaligned
    | ByteOrder
systemByteOrder ByteOrder -> ByteOrder -> Bool
forall a. Eq a => a -> a -> Bool
== ByteOrder
bo -> Word16 -> FixedPrim (StorableWidth Word16)
forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke Word16
x
    | Bool
otherwise -> Word16 -> FixedPrim (StorableWidth Word16)
forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke (Word16 -> Word16
byteSwap16 Word16
x)

-- | Fixed-width primitive that writes a 16-bit word
-- in native byte order.
word16Native :: Word16 -> FixedPrim 2
word16Native :: Word16 -> FixedPrim 2
word16Native = ByteOrder -> Word16 -> FixedPrim 2
word16 ByteOrder
systemByteOrder

-- | Fixed-width primitive that writes a 16-bit word
-- in big-endian byte order.
word16BE :: Word16 -> FixedPrim 2
word16BE :: Word16 -> FixedPrim 2
word16BE = ByteOrder -> Word16 -> FixedPrim 2
word16 ByteOrder
BigEndian

-- | Fixed-width primitive that writes a 16-bit word
-- in little-endian byte order.
word16LE :: Word16 -> FixedPrim 2
word16LE :: Word16 -> FixedPrim 2
word16LE = ByteOrder -> Word16 -> FixedPrim 2
word16 ByteOrder
LittleEndian

-- | Fixed-width primitive that writes a 32-bit word
-- in the specified byte order.
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 (Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x)
  StoreMethod
StoreUnaligned
    | ByteOrder
systemByteOrder ByteOrder -> ByteOrder -> Bool
forall a. Eq a => a -> a -> Bool
== ByteOrder
bo -> Word32 -> FixedPrim (StorableWidth Word32)
forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke Word32
x
    | Bool
otherwise -> Word32 -> FixedPrim (StorableWidth Word32)
forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke (Word32 -> Word32
byteSwap32 Word32
x)

-- | Fixed-width primitive that writes a 32-bit word
-- in native byte order.
word32Native :: Word32 -> FixedPrim 4
word32Native :: Word32 -> FixedPrim 4
word32Native = ByteOrder -> Word32 -> FixedPrim 4
word32 ByteOrder
systemByteOrder

-- | Fixed-width primitive that writes a 32-bit word
-- in big-endian byte order.
word32BE :: Word32 -> FixedPrim 4
word32BE :: Word32 -> FixedPrim 4
word32BE = ByteOrder -> Word32 -> FixedPrim 4
word32 ByteOrder
BigEndian

-- | Fixed-width primitive that writes a 32-bit word
-- in little-endian byte order.
word32LE :: Word32 -> FixedPrim 4
word32LE :: Word32 -> FixedPrim 4
word32LE = ByteOrder -> Word32 -> FixedPrim 4
word32 ByteOrder
LittleEndian

-- | Fixed-width primitive that writes a 64-bit word
-- in the specified byte order.
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 (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x)
  StoreMethod
StoreUnaligned
    | ByteOrder
systemByteOrder ByteOrder -> ByteOrder -> Bool
forall a. Eq a => a -> a -> Bool
== ByteOrder
bo -> Word64 -> FixedPrim (StorableWidth Word64)
forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke Word64
x
    | Bool
otherwise -> Word64 -> FixedPrim (StorableWidth Word64)
forall x. Storable x => x -> FixedPrim (StorableWidth x)
primPoke (Word64 -> Word64
byteSwap64 Word64
x)

-- | Fixed-width primitive that writes a 64-bit word
-- in native byte order.
word64Native :: Word64 -> FixedPrim 8
word64Native :: Word64 -> FixedPrim 8
word64Native = ByteOrder -> Word64 -> FixedPrim 8
word64 ByteOrder
systemByteOrder

-- | Fixed-width primitive that writes a 64-bit word
-- in big-endian byte order.
word64BE :: Word64 -> FixedPrim 8
word64BE :: Word64 -> FixedPrim 8
word64BE = ByteOrder -> Word64 -> FixedPrim 8
word64 ByteOrder
BigEndian

-- | Fixed-width primitive that writes a 64-bit word
-- in little-endian byte order.
word64LE :: Word64 -> FixedPrim 8
word64LE :: Word64 -> FixedPrim 8
word64LE = ByteOrder -> Word64 -> FixedPrim 8
word64 ByteOrder
LittleEndian

-- | @'word8' . 'fromIntegral'@
int8 :: Int8 -> FixedPrim 1
int8 :: Int8 -> FixedPrim 1
int8 = Word8 -> FixedPrim 1
word8 (Word8 -> FixedPrim 1) -> (Int8 -> Word8) -> Int8 -> FixedPrim 1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @\bo -> 'word16' bo . 'fromIntegral'@
int16 :: ByteOrder -> Int16 -> FixedPrim 2
int16 :: ByteOrder -> Int16 -> FixedPrim 2
int16 !ByteOrder
bo = ByteOrder -> Word16 -> FixedPrim 2
word16 ByteOrder
bo (Word16 -> FixedPrim 2)
-> (Int16 -> Word16) -> Int16 -> FixedPrim 2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @'word16Native' . 'fromIntegral'@
int16Native :: Int16 -> FixedPrim 2
int16Native :: Int16 -> FixedPrim 2
int16Native = Word16 -> FixedPrim 2
word16Native (Word16 -> FixedPrim 2)
-> (Int16 -> Word16) -> Int16 -> FixedPrim 2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @'word16BE' . 'fromIntegral'@
int16BE :: Int16 -> FixedPrim 2
int16BE :: Int16 -> FixedPrim 2
int16BE = Word16 -> FixedPrim 2
word16BE (Word16 -> FixedPrim 2)
-> (Int16 -> Word16) -> Int16 -> FixedPrim 2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @'word16LE' . 'fromIntegral'@
int16LE :: Int16 -> FixedPrim 2
int16LE :: Int16 -> FixedPrim 2
int16LE = Word16 -> FixedPrim 2
word16LE (Word16 -> FixedPrim 2)
-> (Int16 -> Word16) -> Int16 -> FixedPrim 2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @\bo -> 'word32' bo . 'fromIntegral'@
int32 :: ByteOrder -> Int32 -> FixedPrim 4
int32 :: ByteOrder -> Int32 -> FixedPrim 4
int32 ByteOrder
bo = ByteOrder -> Word32 -> FixedPrim 4
word32 ByteOrder
bo (Word32 -> FixedPrim 4)
-> (Int32 -> Word32) -> Int32 -> FixedPrim 4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @'word32Native' . 'fromIntegral'@
int32Native :: Int32 -> FixedPrim 4
int32Native :: Int32 -> FixedPrim 4
int32Native = Word32 -> FixedPrim 4
word32Native (Word32 -> FixedPrim 4)
-> (Int32 -> Word32) -> Int32 -> FixedPrim 4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @'word32BE' . 'fromIntegral'@
int32BE :: Int32 -> FixedPrim 4
int32BE :: Int32 -> FixedPrim 4
int32BE = Word32 -> FixedPrim 4
word32BE (Word32 -> FixedPrim 4)
-> (Int32 -> Word32) -> Int32 -> FixedPrim 4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @'word32LE' . 'fromIntegral'@
int32LE :: Int32 -> FixedPrim 4
int32LE :: Int32 -> FixedPrim 4
int32LE = Word32 -> FixedPrim 4
word32LE (Word32 -> FixedPrim 4)
-> (Int32 -> Word32) -> Int32 -> FixedPrim 4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @\bo -> 'word64' bo . 'fromIntegral'@
int64 :: ByteOrder -> Int64 -> FixedPrim 8
int64 :: ByteOrder -> Int64 -> FixedPrim 8
int64 ByteOrder
bo = ByteOrder -> Word64 -> FixedPrim 8
word64 ByteOrder
bo (Word64 -> FixedPrim 8)
-> (Int64 -> Word64) -> Int64 -> FixedPrim 8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @'word64Native' . 'fromIntegral'@
int64Native :: Int64 -> FixedPrim 8
int64Native :: Int64 -> FixedPrim 8
int64Native = Word64 -> FixedPrim 8
word64Native (Word64 -> FixedPrim 8)
-> (Int64 -> Word64) -> Int64 -> FixedPrim 8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @'word64BE' . 'fromIntegral'@
int64BE :: Int64 -> FixedPrim 8
int64BE :: Int64 -> FixedPrim 8
int64BE = Word64 -> FixedPrim 8
word64BE (Word64 -> FixedPrim 8)
-> (Int64 -> Word64) -> Int64 -> FixedPrim 8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | @'word64LE' . 'fromIntegral'@
int64LE :: Int64 -> FixedPrim 8
int64LE :: Int64 -> FixedPrim 8
int64LE = Word64 -> FixedPrim 8
word64LE (Word64 -> FixedPrim 8)
-> (Int64 -> Word64) -> Int64 -> FixedPrim 8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Fixed-width primitive that writes a 'Float'
-- in the specified byte order.
float :: ByteOrder -> Float -> FixedPrim 4
float :: ByteOrder -> Float -> FixedPrim 4
float ByteOrder
BigEndian = Float -> FixedPrim 4
floatBE
float ByteOrder
LittleEndian = Float -> FixedPrim 4
floatLE

-- | Fixed-width primitive that writes a 'Float'
-- in native byte order.
floatNative :: Float -> FixedPrim 4
floatNative :: Float -> FixedPrim 4
floatNative = ByteOrder -> Float -> FixedPrim 4
float ByteOrder
systemByteOrder

-- | Fixed-width primitive that writes a 'Float'
-- in big-endian byte order.
floatBE :: Float -> FixedPrim 4
floatBE :: Float -> FixedPrim 4
floatBE !Float
x = (Addr#
 -> Int#
 -> State# RealWorld
 -> Int#
 -> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim 4
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 (Addr# -> Ptr Word8
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

-- | Fixed-width primitive that writes a 'Float'
-- in little-endian byte order.
floatLE :: Float -> FixedPrim 4
floatLE :: Float -> FixedPrim 4
floatLE !Float
x = (Addr#
 -> Int#
 -> State# RealWorld
 -> Int#
 -> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim 4
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 (Addr# -> Ptr Word8
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

-- | Fixed-width primitive that writes a 'Double'
-- in the specified byte order.
double :: ByteOrder -> Double -> FixedPrim 8
double :: ByteOrder -> Double -> FixedPrim 8
double ByteOrder
BigEndian = Double -> FixedPrim 8
doubleBE
double ByteOrder
LittleEndian = Double -> FixedPrim 8
doubleLE

-- | Fixed-width primitive that writes a 'Double'
-- in native byte order.
doubleNative :: Double -> FixedPrim 8
doubleNative :: Double -> FixedPrim 8
doubleNative = ByteOrder -> Double -> FixedPrim 8
double ByteOrder
systemByteOrder

-- | Fixed-width primitive that writes a 'Double'
-- in big-endian byte order.
doubleBE :: Double -> FixedPrim 8
doubleBE :: Double -> FixedPrim 8
doubleBE !Double
x = (Addr#
 -> Int#
 -> State# RealWorld
 -> Int#
 -> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim 8
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 (Addr# -> Ptr Word8
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

-- | Fixed-width primitive that writes a 'Double'
-- in little-endian byte order.
doubleLE :: Double -> FixedPrim 8
doubleLE :: Double -> FixedPrim 8
doubleLE !Double
x = (Addr#
 -> Int#
 -> State# RealWorld
 -> Int#
 -> (# Addr#, Int#, State# RealWorld #))
-> FixedPrim 8
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 (Addr# -> Ptr Word8
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

-- | Bounded-width primitive that writes a 'Char'
-- according to the UTF-8 encoding.
charUtf8 :: Char -> BoundedPrim 4
charUtf8 :: Char -> BoundedPrim 4
charUtf8 = \Char
ch -> case Int -> Word
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 =
      Word
-> (Word# -> FixedPrim 1)
-> (Word#
    -> BoundedPrim (If (OrdCond (CmpNat 2 4) 'True 'True 'False) 4 2))
-> Word#
-> BoundedPrim
     (Max (If (OrdCond (CmpNat 2 4) 'True 'True 'False) 4 2) 1)
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 ((Word#
  -> BoundedPrim (If (OrdCond (CmpNat 2 4) 'True 'True 'False) 4 2))
 -> Word#
 -> BoundedPrim
      (Max (If (OrdCond (CmpNat 2 4) 'True 'True 'False) 4 2) 1))
-> (Word#
    -> BoundedPrim (If (OrdCond (CmpNat 2 4) 'True 'True 'False) 4 2))
-> Word#
-> BoundedPrim
     (Max (If (OrdCond (CmpNat 2 4) 'True 'True 'False) 4 2) 1)
forall a b. (a -> b) -> a -> b
$
      Word
-> (Word# -> FixedPrim 2)
-> (Word# -> BoundedPrim 4)
-> Word#
-> BoundedPrim (Max 4 2)
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 ((Word# -> BoundedPrim 4) -> Word# -> BoundedPrim (Max 4 2))
-> (Word# -> BoundedPrim 4) -> Word# -> BoundedPrim (Max 4 2)
forall a b. (a -> b) -> a -> b
$
      Word
-> (Word# -> FixedPrim 3)
-> (Word# -> BoundedPrim 4)
-> Word#
-> BoundedPrim (Max 4 3)
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 ((Word# -> BoundedPrim 4) -> Word# -> BoundedPrim (Max 4 3))
-> (Word# -> BoundedPrim 4) -> Word# -> BoundedPrim (Max 4 3)
forall a b. (a -> b) -> a -> b
$
      (\Word#
y -> FixedPrim 4 -> BoundedPrim 4
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 -> Bool
-> PNullary BoundedPrim v
-> PNullary BoundedPrim w
-> PNullary
     BoundedPrim (If (OrdCond (CmpNat v w) 'True 'True 'False) w v)
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 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
t) (FixedPrim v -> BoundedPrim v
forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> FixedPrim v
f Word#
x)) (Word# -> BoundedPrim w
g Word#
x)
      -- We have observed GHC v8.6.5 jumping on the 'False' branch
      -- and falling through on the 'True' branch.  We set up our
      -- condition to favor lower character codes.
    {-# 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#) PNullary FixedPrim n
-> PNullary FixedPrim 1 -> PNullary FixedPrim (n + 1)
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 = (Word# -> FixedPrim 1) -> Word# -> FixedPrim (1 + 1)
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 = (Word# -> FixedPrim 2) -> Word# -> FixedPrim (2 + 1)
forall (n :: Nat).
KnownNat n =>
(Word# -> FixedPrim n) -> Word# -> FixedPrim (n + 1)
lsb ((Word# -> FixedPrim 1) -> Word# -> FixedPrim (1 + 1)
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 = (Word# -> FixedPrim 3) -> Word# -> FixedPrim (3 + 1)
forall (n :: Nat).
KnownNat n =>
(Word# -> FixedPrim n) -> Word# -> FixedPrim (n + 1)
lsb ((Word# -> FixedPrim 2) -> Word# -> FixedPrim (2 + 1)
forall (n :: Nat).
KnownNat n =>
(Word# -> FixedPrim n) -> Word# -> FixedPrim (n + 1)
lsb ((Word# -> FixedPrim 1) -> Word# -> FixedPrim (1 + 1)
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 #-}

-- | The bounded primitive implementing
-- `Proto3.Wire.Reverse.wordBase128LEVar`.
#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 #-}

-- | Like 'wordBase128LEVar' but inlined, possibly bloating your code.  On
-- the other hand, inlining an application to a constant may shrink your code.
#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 #-}

-- | The bounded primitive implementing
-- `Proto3.Wire.Reverse.word32Base128LEVar`.
word32Base128LEVar :: Word32 -> BoundedPrim 5
word32Base128LEVar :: Word32 -> BoundedPrim 5
word32Base128LEVar (W32# Word#
x0) =
  ( Int
-> (Word# -> Word# -> FixedPrim 1)
-> (Word#
    -> BoundedPrim
         (If
            (OrdCond
               (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
               'True
               'True
               'False)
            (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
            2))
-> Word#
-> BoundedPrim
     (Max
        (If
           (OrdCond
              (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
              'True
              'True
              'False)
           (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
           2)
        1)
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 ((Word#
  -> BoundedPrim
       (If
          (OrdCond
             (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
             'True
             'True
             'False)
          (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
          2))
 -> Word#
 -> BoundedPrim
      (Max
         (If
            (OrdCond
               (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
               'True
               'True
               'False)
            (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
            2)
         1))
-> (Word#
    -> BoundedPrim
         (If
            (OrdCond
               (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
               'True
               'True
               'False)
            (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
            2))
-> Word#
-> BoundedPrim
     (Max
        (If
           (OrdCond
              (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
              'True
              'True
              'False)
           (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
           2)
        1)
forall a b. (a -> b) -> a -> b
$
    Int
-> (Word# -> Word# -> FixedPrim 2)
-> (Word#
    -> BoundedPrim (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
-> Word#
-> BoundedPrim
     (Max (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3) 2)
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 ((Word#
  -> BoundedPrim (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
 -> Word#
 -> BoundedPrim
      (Max (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3) 2))
-> (Word#
    -> BoundedPrim (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
-> Word#
-> BoundedPrim
     (Max (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3) 2)
forall a b. (a -> b) -> a -> b
$
    Int
-> (Word# -> Word# -> FixedPrim 3)
-> (Word# -> BoundedPrim 5)
-> Word#
-> BoundedPrim (Max 5 3)
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 ((Word# -> BoundedPrim 5) -> Word# -> BoundedPrim (Max 5 3))
-> (Word# -> BoundedPrim 5) -> Word# -> BoundedPrim (Max 5 3)
forall a b. (a -> b) -> a -> b
$
    Int
-> (Word# -> Word# -> FixedPrim 4)
-> (Word# -> BoundedPrim 5)
-> Word#
-> BoundedPrim (Max 5 4)
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 ((Word# -> BoundedPrim 5) -> Word# -> BoundedPrim (Max 5 4))
-> (Word# -> BoundedPrim 5) -> Word# -> BoundedPrim (Max 5 4)
forall a b. (a -> b) -> a -> b
$
    (\Word#
x -> FixedPrim 5 -> BoundedPrim 5
forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> Word# -> FixedPrim 5
wordBase128LE_p5 Word#
0## Word#
x))
  ) Word#
x0

-- | Like 'word32Base128LEVar' but inlined, which currently means
-- that it is just the same as 'word32Base128LEVar', which we inline.
word32Base128LEVar_inline :: Word32 -> BoundedPrim 5
word32Base128LEVar_inline :: Word32 -> BoundedPrim 5
word32Base128LEVar_inline = \(W32# Word#
x0) ->
  ( Int
-> (Word# -> Word# -> FixedPrim 1)
-> (Word#
    -> BoundedPrim
         (If
            (OrdCond
               (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
               'True
               'True
               'False)
            (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
            2))
-> Word#
-> BoundedPrim
     (Max
        (If
           (OrdCond
              (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
              'True
              'True
              'False)
           (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
           2)
        1)
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 ((Word#
  -> BoundedPrim
       (If
          (OrdCond
             (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
             'True
             'True
             'False)
          (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
          2))
 -> Word#
 -> BoundedPrim
      (Max
         (If
            (OrdCond
               (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
               'True
               'True
               'False)
            (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
            2)
         1))
-> (Word#
    -> BoundedPrim
         (If
            (OrdCond
               (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
               'True
               'True
               'False)
            (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
            2))
-> Word#
-> BoundedPrim
     (Max
        (If
           (OrdCond
              (CmpNat 2 (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
              'True
              'True
              'False)
           (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3)
           2)
        1)
forall a b. (a -> b) -> a -> b
$
    Int
-> (Word# -> Word# -> FixedPrim 2)
-> (Word#
    -> BoundedPrim (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
-> Word#
-> BoundedPrim
     (Max (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3) 2)
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 ((Word#
  -> BoundedPrim (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
 -> Word#
 -> BoundedPrim
      (Max (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3) 2))
-> (Word#
    -> BoundedPrim (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3))
-> Word#
-> BoundedPrim
     (Max (If (OrdCond (CmpNat 3 5) 'True 'True 'False) 5 3) 2)
forall a b. (a -> b) -> a -> b
$
    Int
-> (Word# -> Word# -> FixedPrim 3)
-> (Word# -> BoundedPrim 5)
-> Word#
-> BoundedPrim (Max 5 3)
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 ((Word# -> BoundedPrim 5) -> Word# -> BoundedPrim (Max 5 3))
-> (Word# -> BoundedPrim 5) -> Word# -> BoundedPrim (Max 5 3)
forall a b. (a -> b) -> a -> b
$
    Int
-> (Word# -> Word# -> FixedPrim 4)
-> (Word# -> BoundedPrim 5)
-> Word#
-> BoundedPrim (Max 5 4)
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 ((Word# -> BoundedPrim 5) -> Word# -> BoundedPrim (Max 5 4))
-> (Word# -> BoundedPrim 5) -> Word# -> BoundedPrim (Max 5 4)
forall a b. (a -> b) -> a -> b
$
    (\Word#
x -> FixedPrim 5 -> BoundedPrim 5
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 ->
  Bool
-> PNullary BoundedPrim v
-> PNullary BoundedPrim w
-> PNullary
     BoundedPrim (If (OrdCond (CmpNat v w) 'True 'True 'False) w v)
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 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Int -> Word
forall a. Bits a => a -> Int -> a
shiftL Word
1 (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
d) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) (FixedPrim v -> BoundedPrim v
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)
  -- We have observed GHC v8.6.5 jumping on the 'False' branch
  -- and falling through on the 'True' branch.  We set up our
  -- condition to favor lower numeric values.
{-# 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 PNullary FixedPrim n
-> PNullary FixedPrim 1 -> PNullary FixedPrim (n + 1)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# n -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# n
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 = (Word# -> Word# -> FixedPrim 1)
-> Word# -> Word# -> FixedPrim (1 + 1)
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 = (Word# -> Word# -> FixedPrim 2)
-> Word# -> Word# -> FixedPrim (2 + 1)
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 = (Word# -> Word# -> FixedPrim 3)
-> Word# -> Word# -> FixedPrim (3 + 1)
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 = (Word# -> Word# -> FixedPrim 4)
-> Word# -> Word# -> FixedPrim (4 + 1)
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 #-}

-- | Writes 1 or 2 base-128 digits in little-endian order;
-- in the 2-digit case the high bit of the containing byte of
-- the low digit is set, and the other byte has a clear high bit.
--
-- WARNING: The argument is ASSUMED to be in [0 .. 2^14 - 1].
word14Base128LEVar :: Word# -> BoundedPrim 2
word14Base128LEVar :: Word# -> BoundedPrim 2
word14Base128LEVar = \Word#
x0 ->
  ( Int
-> (Word# -> Word# -> FixedPrim 1)
-> (Word# -> BoundedPrim 2)
-> Word#
-> BoundedPrim (Max 2 1)
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 ((Word# -> BoundedPrim 2) -> Word# -> BoundedPrim (Max 2 1))
-> (Word# -> BoundedPrim 2) -> Word# -> BoundedPrim (Max 2 1)
forall a b. (a -> b) -> a -> b
$
    (\Word#
x -> FixedPrim 2 -> BoundedPrim 2
forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> Word# -> FixedPrim 2
wordBase128LE_p2 Word#
0## Word#
x))
  ) Word#
x0
{-# INLINE word14Base128LEVar #-}

-- | Writes four base-128 digits, one per byte, with
-- the high bit of each byte set, in little-endian order.
--
-- There is no requirement that the argument be @< 2^28@.
word28Base128LE :: Word# -> FixedPrim 4
word28Base128LE :: Word# -> FixedPrim 4
word28Base128LE = Word# -> Word# -> FixedPrim 4
wordBase128LE_p4 Word#
0x80##
{-# INLINE word28Base128LE #-}

-- | The bounded primitive implementing
-- `Proto3.Wire.Reverse.word64Base128LEVar`.
word64Base128LEVar :: Word64 -> BoundedPrim 10
word64Base128LEVar :: Word64 -> BoundedPrim 10
word64Base128LEVar = \(W64# Word#
x) ->
    Bool
-> PNullary BoundedPrim 5
-> PNullary BoundedPrim 10
-> PNullary BoundedPrim 10
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 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32))
          (Word32 -> BoundedPrim 5
word32Base128LEVar (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word# -> Word64
W64# Word#
x)))
          (Word# -> BoundedPrim 10
word64Base128LEVar_big Word#
x)

-- | Like 'word64Base128LEVar' but inlined, possibly bloating your code.  On
-- the other hand, inlining an application to a constant may shrink your code.
word64Base128LEVar_inline :: Word64 -> BoundedPrim 10
word64Base128LEVar_inline :: Word64 -> BoundedPrim 10
word64Base128LEVar_inline = \(W64# Word#
x) ->
    Bool
-> PNullary BoundedPrim 5
-> PNullary BoundedPrim 10
-> PNullary BoundedPrim 10
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 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32))
          (Word32 -> BoundedPrim 5
word32Base128LEVar_inline (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word# -> Word64
W64# Word#
x)))
          (BoundedPrim 10 -> BoundedPrim 10
forall a. a -> a
inline (Word# -> BoundedPrim 10
word64Base128LEVar_big Word#
x))
{-# INLINE word64Base128LEVar_inline #-}

-- | The input must be at least 2^32.
word64Base128LEVar_big :: WORD64 -> BoundedPrim 10
word64Base128LEVar_big :: Word# -> BoundedPrim 10
word64Base128LEVar_big Word#
x = Bool
-> PNullary BoundedPrim 9
-> PNullary BoundedPrim (8 + 2)
-> PNullary BoundedPrim 10
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 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL Word64
1 Int
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) PNullary BoundedPrim 9
p60 PNullary BoundedPrim (8 + 2)
p64
  where
    p60 :: PNullary BoundedPrim 9
p60 = FixedPrim 4 -> BoundedPrim 4
forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> FixedPrim 4
word28Base128LE Word#
x32) PNullary BoundedPrim 4
-> PNullary BoundedPrim 5 -> PNullary BoundedPrim 9
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 = ( FixedPrim 4 -> BoundedPrim 4
forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> FixedPrim 4
word28Base128LE Word#
x32) PNullary BoundedPrim 4
-> PNullary BoundedPrim 4 -> PNullary BoundedPrim 8
forall {k} (n :: k -> *) (t :: k) (u :: k) (v :: k).
PSemigroup n t u v =>
PNullary n t -> PNullary n u -> PNullary n v
&<>
            FixedPrim 4 -> BoundedPrim 4
forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (Word# -> FixedPrim 4
word28Base128LE (Int -> Word#
shR Int
28)) ) PNullary BoundedPrim 8
-> PNullary BoundedPrim 2 -> PNullary BoundedPrim (8 + 2)
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 Word64 -> Word32
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 Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR (Word# -> Word64
W64# Word#
x) Int
s) of W32# Word#
y -> Word#
y
{-# NOINLINE word64Base128LEVar_big #-}

-- | The analog of `Proto3.Wire.Reverse.vectorBuildR` for when fixed-width
-- primitives encode the elements of the vector.  In this special case we
-- can predict the overall length.
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 = (v a -> BuildR) -> v a -> BuildR
forall a. (a -> BuildR) -> a -> BuildR
etaBuildR ((v a -> BuildR) -> v a -> BuildR)
-> (v a -> BuildR) -> v a -> BuildR
forall a b. (a -> b) -> a -> b
$ \v a
v ->
    let op :: BuildR -> a -> BuildR
op BuildR
acc a
x = BuildR
acc BuildR -> BuildR -> BuildR
forall a. Semigroup a => a -> a -> a
<> BoundedPrim w -> BuildR
forall (w :: Nat). BoundedPrim w -> BuildR
unsafeBuildBoundedPrim (FixedPrim w -> BoundedPrim w
forall (w :: Nat). KnownNat w => FixedPrim w -> BoundedPrim w
liftFixedPrim (a -> FixedPrim w
f a
x))
    in Int -> BuildR -> BuildR
ensure (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
* v a -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
Data.Vector.Generic.length v a
v) ((BuildR -> a -> BuildR) -> BuildR -> v a -> BuildR
forall (v :: * -> *) a b.
Vector v a =>
(b -> a -> b) -> b -> v a -> b
foldlRVector BuildR -> a -> BuildR
op BuildR
forall a. Monoid a => a
mempty v a
v)
  where
    w :: Int
w = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Proxy# w -> Integer
forall (n :: Nat). KnownNat n => Proxy# n -> Integer
natVal' (Proxy# w
forall {k} (a :: k). Proxy# a
proxy# :: Proxy# w))
{-# INLINE vectorFixedPrim #-}