diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,2 @@ +## 1.0.0 (2024-03-17) +* initial release, finally its own package diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2022-2024 Ben Orchard (@raehik) + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,51 @@ +# bytezap +Build strict bytestrings with zero intermediate allocation. + +If you're looking for general high-performance serialization, you probably want +[mason](https://hackage.haskell.org/package/mason). But if you're dealing with +data that is already "shaped" like binary data, e.g. using types defined in +[binrep](https://hackage.haskell.org/package/binrep), and you want the best +performance possible, read on... + +## Why? +Most binary serialization libraries tend towards a model where the serializer +itself handles allocation. In the plumbing, serialization operations are +bracketed by a check to ensure the current buffer has enough space for the next +operation; if not, we obtain more space in some way, and serialization +continues. This design is nice because we can _chunk_ the serializing: + +* for writing to a lazy bytestring, we can emit a new chunk and clear our buffer +* for writing to a handle, we can write, flush and clear our buffer +* for writing to a strict bytestring, we must grow our current buffer (meh) + +But if we know the size of the serialized data _before_ serializing it, we don't +need those space checks, nor these intermediate steps. We may allocate a single +buffer with the required size upfront, then use that as we like. + +Great, you say, but most data isn't so simple that we can easily calculate its +serialized length without actually performing the serialization. This is true. +bytezap is designed specifically for cases where + +* it's easy to calculate the serialized length of your data, and +* you want to write to a strict bytestring (one big contiguous block of memory) + +This last point notably may limit usage for serializing large data, depending on +memory limitations. In most cases, we'll use more memory than a buffering +library such as mason. + +## So... why? +Well, bytezap will be slightly faster where it's applicable, and the +implementation is extremely simple. It's a fun niche to fill, and it's +convenient for my [binrep](https://hackage.haskell.org/package/binrep) library. + +## Non-features +### Serialize to `ByteString` (pinned byte arrays) only +No `ShortByteString`s, no writing directly to handles. + +(One _may_ support writing to `ShortByteString`s (unpinned byte arrays) by doing +a bunch of class indirection. But it's a lot of extra work for a use case that I +don't see as very popular at all. Check the Git history for an early +implementation.) + +## License +Provided under the MIT license. See `LICENSE` for license text. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bytezap.cabal b/bytezap.cabal new file mode 100644 --- /dev/null +++ b/bytezap.cabal @@ -0,0 +1,68 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.35.2. +-- +-- see: https://github.com/sol/hpack + +name: bytezap +version: 1.0.0 +synopsis: Bytestring builder with zero intermediate allocation +description: Please see README.md. +category: Data, Serialization +homepage: https://github.com/raehik/bytezap#readme +bug-reports: https://github.com/raehik/bytezap/issues +author: Ben Orchard +maintainer: Ben Orchard +license: MIT +license-file: LICENSE +build-type: Simple +tested-with: + GHC == 9.6.4 +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/raehik/bytezap + +library + exposed-modules: + Bytezap + Bytezap.Poke + Bytezap.Poke.Derived + Bytezap.Poke.Derived.Endian + Bytezap.Poke.Json + Bytezap.Poke.KnownLen + Bytezap.Write + Bytezap.Write.Derived + Bytezap.Write.Internal + Raehik.Compat.Data.Int.ByteSwap + Raehik.Compat.Data.Primitive.Types + Raehik.Compat.Data.Primitive.Types.Endian + Raehik.Compat.Data.Word.ByteSwap + Raehik.Compat.GHC.Exts.GHC908MemcpyPrimops + Raehik.Compat.GHC.Exts.GHC910UnalignedAddrPrimops + Util.TypeNats + other-modules: + Paths_bytezap + hs-source-dirs: + src + default-extensions: + LambdaCase + NoStarIsType + DerivingVia + DeriveAnyClass + GADTs + RoleAnnotations + DefaultSignatures + TypeFamilies + DataKinds + MagicHash + ghc-options: -Wall + build-depends: + base >=4.18.0.0 && <4.20 + , bytestring >=0.11.5.3 && <0.13.0.0 + , primitive >=0.8.0.0 && <0.10.0.0 + , text >=2.0.2 && <2.2 + default-language: GHC2021 diff --git a/src/Bytezap.hs b/src/Bytezap.hs new file mode 100644 --- /dev/null +++ b/src/Bytezap.hs @@ -0,0 +1,1 @@ +module Bytezap where diff --git a/src/Bytezap/Poke.hs b/src/Bytezap/Poke.hs new file mode 100644 --- /dev/null +++ b/src/Bytezap/Poke.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE CPP #-} -- for a bytestring version gate >:( +{-# LANGUAGE UnboxedTuples #-} + +-- may as well export everything the interface is highly unsafe +module Bytezap.Poke where + +import GHC.Exts +import Raehik.Compat.GHC.Exts.GHC908MemcpyPrimops + +import GHC.IO +import GHC.Word + +import Data.ByteString qualified as BS +import Data.ByteString.Internal qualified as BS + +import Control.Monad ( void ) + +import Raehik.Compat.Data.Primitive.Types + +import GHC.ForeignPtr + +type Poke# s = Addr# -> Int# -> State# s -> (# State# s, Int# #) + +-- | Poke newtype wrapper. +newtype Poke s = Poke { unPoke :: Poke# s } + +-- | Sequence two 'Poke's left-to-right. +instance Semigroup (Poke s) where + Poke l <> Poke r = Poke $ \addr# os0# s0 -> + case l addr# os0# s0 of (# s1, os1# #) -> r addr# os1# s1 + +instance Monoid (Poke s) where + mempty = Poke $ \_addr# os# s -> (# s, os# #) + +-- | Execute a 'Poke' at a fresh 'BS.ByteString' of the given length. +unsafeRunPokeBS :: Int -> Poke RealWorld -> BS.ByteString +unsafeRunPokeBS len = BS.unsafeCreate len . wrapIO + +wrapIO :: Poke RealWorld -> Ptr Word8 -> IO () +wrapIO f p = void (wrapIOUptoN f p) + +wrapIOUptoN :: Poke RealWorld -> Ptr Word8 -> IO Int +wrapIOUptoN (Poke p) (Ptr addr#) = IO $ \s0 -> + case p addr# 0# s0 of (# s1, len# #) -> (# s1, I# len# #) + +-- | Execute a 'Poke' at a fresh 'BS.ByteString' of the given maximum length. +-- Does not reallocate if final size is less than estimated. +unsafeRunPokeBSUptoN :: Int -> Poke RealWorld -> BS.ByteString +unsafeRunPokeBSUptoN len = BS.unsafeCreateUptoN len . wrapIOUptoN + +-- | Poke a type via its 'Prim'' instance. +prim :: forall a s. Prim' a => a -> Poke s +prim a = Poke $ \addr# os# s0 -> + case writeWord8OffAddrAs# addr# os# a s0 of + s1 -> (# s1, os# +# sizeOf# (undefined :: a) #) + +-- we reimplement withForeignPtr because it's too high level. +-- keepAlive# has the wrong type before GHC 9.10, but it doesn't matter here +-- because copyAddrToAddrNonOverlapping# forces RealWorld. +byteString :: BS.ByteString -> Poke RealWorld +byteString (BS.BS (ForeignPtr p# r) (I# len#)) = Poke $ \addr# os# s0 -> + keepAlive# r s0 $ \s1 -> + case copyAddrToAddrNonOverlapping# p# (addr# `plusAddr#` os#) len# s1 of + s2 -> (# s2, os# +# len# #) + +byteArray# :: ByteArray# -> Int# -> Int# -> Poke s +byteArray# ba# baos# balen# = Poke $ \addr# os# s0 -> + case copyByteArrayToAddr# ba# baos# (addr# `plusAddr#` os#) balen# s0 of + s1 -> (# s1, os# +# balen# #) + +-- | essentially memset +replicateByte :: Int -> Word8 -> Poke RealWorld +replicateByte (I# len#) (W8# byte#) = Poke $ \addr# os# s0 -> + case setAddrRange# (addr# `plusAddr#` os#) len# byteAsInt# s0 of + s1 -> (# s1, os# +# len# #) + where + byteAsInt# = word2Int# (word8ToWord# byte#) diff --git a/src/Bytezap/Poke/Derived.hs b/src/Bytezap/Poke/Derived.hs new file mode 100644 --- /dev/null +++ b/src/Bytezap/Poke/Derived.hs @@ -0,0 +1,62 @@ +module Bytezap.Poke.Derived where + +import Bytezap.Poke + +import Data.ByteString.Short qualified as SBS +import Data.Text.Internal qualified as T +--import Data.Array.Byte qualified as A +-- ^ text-2.1 and above +import Data.Text.Array qualified as A +import Data.Word +import GHC.Int +import Data.Char ( ord ) +import Data.Bits ( shiftR, (.&.) ) +import GHC.Exts ( sizeofByteArray# ) + +-- | Poke a 'SBS.ShortByteString'. +shortByteString :: SBS.ShortByteString -> Poke s +shortByteString (SBS.SBS ba#) = byteArray# ba# 0# (sizeofByteArray# ba#) + +-- | Poke a 'T.Text'. +text :: T.Text -> Poke s +text (T.Text (A.ByteArray ba#) (I# os#) (I# len#)) = byteArray# ba# os# len# + +-- | Poke a 'Char'. +-- +-- Adapted from utf8-string. +char :: Char -> Poke s +char = go . ord + where + w8 :: Word8 -> Poke s + w8 = prim + go oc + | oc <= 0x7f = w8 $ fromIntegral oc + + | oc <= 0x7ff = w8 (fromIntegral (0xc0 + (oc `shiftR` 6))) + <> w8 (fromIntegral (0x80 + oc .&. 0x3f)) + + | oc <= 0xffff = w8 (fromIntegral (0xe0 + (oc `shiftR` 12))) + <> w8 (fromIntegral (0x80 + ((oc `shiftR` 6) .&. 0x3f))) + <> w8 (fromIntegral (0x80 + oc .&. 0x3f)) + | otherwise = w8 (fromIntegral (0xf0 + (oc `shiftR` 18))) + <> w8 (fromIntegral (0x80 + ((oc `shiftR` 12) .&. 0x3f))) + <> w8 (fromIntegral (0x80 + ((oc `shiftR` 6) .&. 0x3f))) + <> w8 (fromIntegral (0x80 + oc .&. 0x3f)) + +-- v TODO maybe not needed any more thanks to removing Pokeable class +-- | @unsafePokeIndexed pokeAt off n@ performs @n@ indexed pokes starting from +-- @off@. +-- +-- Does not check bounds. Largely intended for bytewise pokes where some work +-- needs to be performed for each byte (e.g. escaping text and poking inline). +unsafePokeIndexed :: (Int -> Poke s) -> Int -> Int -> Poke s +-- no tail recursive option since it'd require binding a ptr, which we can't do +-- due to TYPE rr. +-- if you simply expand the monoidal ops here, you get the tail call ver. but +-- like, will GHC be able to do that? +-- hoping INLINE is good enough. but maybe need to check strictness. +unsafePokeIndexed pokeAt off n = go off + where + go i | i >= iend = mempty + | otherwise = pokeAt i <> go (i+1) + iend = off + n diff --git a/src/Bytezap/Poke/Derived/Endian.hs b/src/Bytezap/Poke/Derived/Endian.hs new file mode 100644 --- /dev/null +++ b/src/Bytezap/Poke/Derived/Endian.hs @@ -0,0 +1,44 @@ +module Bytezap.Poke.Derived.Endian where + +import Bytezap.Poke + +import Data.Word +import Data.Int +import Raehik.Compat.Data.Int.ByteSwap +import GHC.ByteOrder ( ByteOrder(BigEndian, LittleEndian), targetByteOrder ) + +w16le, w16be :: Word16 -> Poke s +w16le = case targetByteOrder of LittleEndian -> prim + BigEndian -> prim . byteSwap16 +w16be = case targetByteOrder of LittleEndian -> prim . byteSwap16 + BigEndian -> prim + +w32le, w32be :: Word32 -> Poke s +w32le = case targetByteOrder of LittleEndian -> prim + BigEndian -> prim . byteSwap32 +w32be = case targetByteOrder of LittleEndian -> prim . byteSwap32 + BigEndian -> prim + +w64le, w64be :: Word64 -> Poke s +w64le = case targetByteOrder of LittleEndian -> prim + BigEndian -> prim . byteSwap64 +w64be = case targetByteOrder of LittleEndian -> prim . byteSwap64 + BigEndian -> prim + +i16le, i16be :: Int16 -> Poke s +i16le = case targetByteOrder of LittleEndian -> prim + BigEndian -> prim . byteSwapI16 +i16be = case targetByteOrder of LittleEndian -> prim . byteSwapI16 + BigEndian -> prim + +i32le, i32be :: Int32 -> Poke s +i32le = case targetByteOrder of LittleEndian -> prim + BigEndian -> prim . byteSwapI32 +i32be = case targetByteOrder of LittleEndian -> prim . byteSwapI32 + BigEndian -> prim + +i64le, i64be :: Int64 -> Poke s +i64le = case targetByteOrder of LittleEndian -> prim + BigEndian -> prim . byteSwapI64 +i64be = case targetByteOrder of LittleEndian -> prim . byteSwapI64 + BigEndian -> prim diff --git a/src/Bytezap/Poke/Json.hs b/src/Bytezap/Poke/Json.hs new file mode 100644 --- /dev/null +++ b/src/Bytezap/Poke/Json.hs @@ -0,0 +1,64 @@ +module Bytezap.Poke.Json where + +import Data.Word +import Data.Text.Internal qualified as T +import Data.Text.Array qualified as A + +import Bytezap.Poke.Derived ( unsafePokeIndexed ) +import Bytezap.Poke + +import GHC.Exts +import Foreign.C.Types ( CChar ) +import GHC.Word + +escapedLength8 :: T.Text -> Int +escapedLength8 (T.Text arr off len) = go off 0 + where + go !i escLen + | i >= iend = escLen + | otherwise = go (i+1) (i + escapeW8 (A.unsafeIndex arr i)) + iend = off + len + +-- my benchmarks go much faster without INLINE :/ +escapeW8 :: Word8 -> Int +escapeW8 w | w >= 0x80 = 1 -- all multibyte chars are unescaped + | otherwise = case w of 0x5C -> 2 -- \ + 0x22 -> 2 -- " + 0x0A -> 2 -- \n + 0x0D -> 2 -- \r + 0x09 -> 2 -- \t + _ -> if w < 0x20 then 6 else 1 + +pokeEscapedTextUnquoted :: T.Text -> Poke s +pokeEscapedTextUnquoted (T.Text arr off len) = + unsafePokeIndexed (pokeEscapeW8 . A.unsafeIndex arr) off len + +-- think we have to poke bytes here still thanks to endianness >:( +pokeEscapeW8 :: Word8 -> Poke s +pokeEscapeW8 w + | w >= 0x80 = w8 w -- all multibyte chars are unescaped + | otherwise = + case w of + 0x5C -> w8 0x5C <> w8 0x5C -- \ + 0x22 -> w8 0x5C <> w8 0x22 -- " + 0x0A -> w8 0x5C <> w8 0x6E -- \n + 0x0D -> w8 0x5C <> w8 0x72 -- \r + 0x09 -> w8 0x5C <> w8 0x74 -- \t + _ -> + if w >= 0x20 then w8 w else w8 0x5C <> w8 0x75 <> w8 0x30 <> w8 0x30 <> w8AsciiHex w + where w8 = prim @Word8 + +-- note I index because I _think_ this is immutable mem! but I might be wrong +-- and very stupid!! +-- look I'm copying some very weird code from bytestring here. idk +w8AsciiHex :: Word8 -> Poke s +w8AsciiHex w = prim (W16# (indexWord16OffAddr# c_lower_hex_table# wI)) + where + !(I# wI) = fromIntegral w + !(Ptr c_lower_hex_table#) = c_lower_hex_table + +-- TODO lol I'm saying safe b/c I think it's immutable mem. but I might be +-- making a huge fucky wucky here xd +-- can't do Addr# here, no unlifted top-level values x) +foreign import ccall safe "&hs_bytestring_lower_hex_table" + c_lower_hex_table :: Ptr CChar diff --git a/src/Bytezap/Poke/KnownLen.hs b/src/Bytezap/Poke/KnownLen.hs new file mode 100644 --- /dev/null +++ b/src/Bytezap/Poke/KnownLen.hs @@ -0,0 +1,28 @@ +-- | 'P.Poke's with type-level poke length. +module Bytezap.Poke.KnownLen where + +import Bytezap.Poke qualified as P +import GHC.TypeNats +import Data.ByteString qualified as BS +import GHC.Exts +import Util.TypeNats ( natValInt ) + +import Raehik.Compat.Data.Primitive.Types + +newtype PokeKnownLen (len :: Natural) s = + PokeKnownLen { unPokeKnownLen :: P.Poke s } + +mappend' :: PokeKnownLen n s -> PokeKnownLen m s -> PokeKnownLen (n+m) s +mappend' (PokeKnownLen l) (PokeKnownLen r) = PokeKnownLen (l <> r) + +mempty' :: PokeKnownLen 0 s +mempty' = PokeKnownLen mempty + +runPokeKnownLenBS + :: forall n. KnownNat n + => PokeKnownLen n RealWorld + -> BS.ByteString +runPokeKnownLenBS (PokeKnownLen p) = P.unsafeRunPokeBS (natValInt @n) p + +prim :: Prim' a => a -> PokeKnownLen (SizeOf a) s +prim = PokeKnownLen . P.prim diff --git a/src/Bytezap/Write.hs b/src/Bytezap/Write.hs new file mode 100644 --- /dev/null +++ b/src/Bytezap/Write.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE RecordWildCards #-} + +-- safe module, only export the safe bits (no @Write(..)@!!) +module Bytezap.Write + ( Write(size, poke) + , runWriteBS, runWriteBSUptoN + , prim, byteString, byteArray#, replicateByte + ) where + +import Bytezap.Write.Internal + +import Bytezap.Poke qualified as P +import Raehik.Compat.Data.Primitive.Types +import GHC.Exts +import Data.ByteString qualified as BS +import Data.Word ( Word8 ) + +runWriteBS :: Write RealWorld -> BS.ByteString +runWriteBS = runWriteWith P.unsafeRunPokeBS + +runWriteBSUptoN :: Write RealWorld -> BS.ByteString +runWriteBSUptoN = runWriteWith P.unsafeRunPokeBSUptoN + +-- | Helper for writing 'Write' runners. +runWriteWith :: forall a s. (Int -> P.Poke s -> a) -> Write s -> a +runWriteWith runPoke (Write size poke) = runPoke size poke + +prim :: forall a s. Prim' a => a -> Write s +prim a = Write (sizeOf (undefined :: a)) (P.prim a) + +byteString :: BS.ByteString -> Write RealWorld +byteString bs = Write (BS.length bs) (P.byteString bs) + +byteArray# :: ByteArray# -> Int# -> Int# -> Write s +byteArray# ba# baos# balen# = Write{..} + where + size = I# balen# + poke = P.byteArray# ba# baos# balen# + +-- | essentially memset +replicateByte :: Int -> Word8 -> Write RealWorld +replicateByte len byte = Write len (P.replicateByte len byte) diff --git a/src/Bytezap/Write/Derived.hs b/src/Bytezap/Write/Derived.hs new file mode 100644 --- /dev/null +++ b/src/Bytezap/Write/Derived.hs @@ -0,0 +1,28 @@ +module Bytezap.Write.Derived where + +import Bytezap.Write.Internal +import Bytezap.Poke.Derived qualified as P + +import Data.ByteString.Short qualified as SBS +import Data.Text.Internal qualified as T +import Data.Char ( ord ) + +-- | Write a 'SBS.ShortByteString'. +shortByteString :: SBS.ShortByteString -> Write s +shortByteString sbs = Write (SBS.length sbs) (P.shortByteString sbs) + +-- | Write a 'T.Text'. +text :: T.Text -> Write s +text t@(T.Text _arr _off len) = Write len (P.text t) + +-- | Write a 'Char'. +-- +-- Adapted from utf8-string. +char :: Char -> Write s +char c = Write (go (ord c)) (P.char c) + where + go oc + | oc <= 0x7f = 1 + | oc <= 0x7ff = 2 + | oc <= 0xffff = 3 + | otherwise = 4 diff --git a/src/Bytezap/Write/Internal.hs b/src/Bytezap/Write/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Bytezap/Write/Internal.hs @@ -0,0 +1,15 @@ +module Bytezap.Write.Internal where + +import Bytezap.Poke qualified as P + +-- | A 'Poke' with the associated size it pokes. +data Write s = Write { size :: Int, poke :: P.Poke s } + +-- | Sequence the 'Poke's, sum the sizes. +instance Semigroup (Write s) where + -- TODO feels like this might be INLINE[1] or even INLINE[0]? + Write ll lp <> Write rl rp = Write (ll + rl) (lp <> rp) + +-- | The empty 'Write' is the empty 'Poke', which writes zero bytes. +instance Monoid (Write s) where + mempty = Write 0 mempty diff --git a/src/Raehik/Compat/Data/Int/ByteSwap.hs b/src/Raehik/Compat/Data/Int/ByteSwap.hs new file mode 100644 --- /dev/null +++ b/src/Raehik/Compat/Data/Int/ByteSwap.hs @@ -0,0 +1,26 @@ +-- | Missing @byteSwap@ functions for signed integers. +-- +-- We have them for unsigned integers, but not for signed. +-- They should probably be provided, so I'm considering this a compatibility +-- module for the future when we have them. + +module Raehik.Compat.Data.Int.ByteSwap where + +import GHC.Exts +import GHC.Int + +byteSwapI16 :: Int16 -> Int16 +byteSwapI16 (I16# i#) = I16# (word16ToInt16# (wordToWord16# (byteSwap16# (word16ToWord# (int16ToWord16# i#))))) +{-# INLINE byteSwapI16 #-} + +byteSwapI32 :: Int32 -> Int32 +byteSwapI32 (I32# i#) = I32# (word32ToInt32# (wordToWord32# (byteSwap32# (word32ToWord# (int32ToWord32# i#))))) +{-# INLINE byteSwapI32 #-} + +byteSwapI64 :: Int64 -> Int64 +byteSwapI64 (I64# i#) = I64# (word64ToInt64# (byteSwap64# (int64ToWord64# i#))) +{-# INLINE byteSwapI64 #-} + +byteSwapI :: Int -> Int +byteSwapI (I# i#) = I# (word2Int# (byteSwap# (int2Word# i#))) +{-# INLINE byteSwapI #-} diff --git a/src/Raehik/Compat/Data/Primitive/Types.hs b/src/Raehik/Compat/Data/Primitive/Types.hs new file mode 100644 --- /dev/null +++ b/src/Raehik/Compat/Data/Primitive/Types.hs @@ -0,0 +1,176 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE UnboxedTuples #-} + +#include "MachDeps.h" + +module Raehik.Compat.Data.Primitive.Types + ( Prim'(..) + , P.Prim(..) + , P.sizeOf + ) where + +import Data.Primitive.Types qualified as P +import Raehik.Compat.GHC.Exts.GHC910UnalignedAddrPrimops +import GHC.Exts +import GHC.Word +import GHC.Int +import Numeric.Natural + +-- | 'P.Prim' extension class providing unaligned accesses +-- +-- hoping to get this merged in https://github.com/haskell/primitive/issues/409 +-- +-- (also includes Addr# primops which that issue/PR may not) +-- +-- Also includes an associated type for size in bytes. Another thing that maybe +-- primitive could provide. (Wouldn't be hard!) +class P.Prim a => Prim' a where + type SizeOf a :: Natural + -- | Read a value from the array. The offset is in bytes. + indexWord8ByteArrayAs# :: ByteArray# -> Int# -> a + + readWord8ByteArrayAs# :: MutableByteArray# s -> Int# -> State# s -> (# State# s, a #) + writeWord8ByteArrayAs# :: MutableByteArray# s -> Int# -> a -> State# s -> State# s + + indexWord8OffAddrAs# :: Addr# -> Int# -> a + + readWord8OffAddrAs# :: Addr# -> Int# -> State# s -> (# State# s, a #) + writeWord8OffAddrAs# :: Addr# -> Int# -> a -> State# s -> State# s + +instance Prim' Word8 where + type SizeOf Word8 = SIZEOF_WORD8 + indexWord8ByteArrayAs# = P.indexByteArray# + readWord8ByteArrayAs# = P.readByteArray# + writeWord8ByteArrayAs# = P.writeByteArray# + indexWord8OffAddrAs# = P.indexOffAddr# + readWord8OffAddrAs# = P.readOffAddr# + writeWord8OffAddrAs# = P.writeOffAddr# + +instance Prim' Word16 where + type SizeOf Word16 = SIZEOF_WORD16 + indexWord8ByteArrayAs# arr# os# = W16# (indexWord8ArrayAsWord16# arr# os#) + readWord8ByteArrayAs# arr# os# = \s0 -> + case readWord8ArrayAsWord16# arr# os# s0 of + (# s1, w# #) -> (# s1, W16# w# #) + writeWord8ByteArrayAs# arr# os# (W16# w#) = \s0 -> + writeWord8ArrayAsWord16# arr# os# w# s0 + indexWord8OffAddrAs# addr# os# = W16# (indexWord8OffAddrAsWord16# addr# os#) + readWord8OffAddrAs# addr# os# = \s0 -> + case readWord8OffAddrAsWord16# addr# os# s0 of + (# s1, w# #) -> (# s1, W16# w# #) + writeWord8OffAddrAs# addr# os# (W16# w#) s# = + writeWord8OffAddrAsWord16# addr# os# w# s# + +instance Prim' Word32 where + type SizeOf Word32 = SIZEOF_WORD32 + indexWord8ByteArrayAs# arr# os# = W32# (indexWord8ArrayAsWord32# arr# os#) + readWord8ByteArrayAs# arr# os# = \s0 -> + case readWord8ArrayAsWord32# arr# os# s0 of + (# s1, w# #) -> (# s1, W32# w# #) + writeWord8ByteArrayAs# arr# os# (W32# w#) = \s0 -> + writeWord8ArrayAsWord32# arr# os# w# s0 + indexWord8OffAddrAs# addr# os# = W32# (indexWord8OffAddrAsWord32# addr# os#) + readWord8OffAddrAs# addr# os# = \s0 -> + case readWord8OffAddrAsWord32# addr# os# s0 of + (# s1, w# #) -> (# s1, W32# w# #) + writeWord8OffAddrAs# addr# os# (W32# w#) s# = + writeWord8OffAddrAsWord32# addr# os# w# s# + +instance Prim' Word64 where + type SizeOf Word64 = SIZEOF_WORD64 + indexWord8ByteArrayAs# arr# os# = W64# (indexWord8ArrayAsWord64# arr# os#) + readWord8ByteArrayAs# arr# os# = \s0 -> + case readWord8ArrayAsWord64# arr# os# s0 of + (# s1, w# #) -> (# s1, W64# w# #) + writeWord8ByteArrayAs# arr# os# (W64# w#) = \s0 -> + writeWord8ArrayAsWord64# arr# os# w# s0 + indexWord8OffAddrAs# addr# os# = W64# (indexWord8OffAddrAsWord64# addr# os#) + readWord8OffAddrAs# addr# os# = \s0 -> + case readWord8OffAddrAsWord64# addr# os# s0 of + (# s1, w# #) -> (# s1, W64# w# #) + writeWord8OffAddrAs# addr# os# (W64# w#) s# = + writeWord8OffAddrAsWord64# addr# os# w# s# + +instance Prim' Int8 where + type SizeOf Int8 = SIZEOF_INT8 + indexWord8ByteArrayAs# = P.indexByteArray# + readWord8ByteArrayAs# = P.readByteArray# + writeWord8ByteArrayAs# = P.writeByteArray# + indexWord8OffAddrAs# = P.indexOffAddr# + readWord8OffAddrAs# = P.readOffAddr# + writeWord8OffAddrAs# = P.writeOffAddr# + +instance Prim' Int16 where + type SizeOf Int16 = SIZEOF_INT16 + indexWord8ByteArrayAs# arr# os# = I16# (indexWord8ArrayAsInt16# arr# os#) + readWord8ByteArrayAs# arr# os# = \s0 -> + case readWord8ArrayAsInt16# arr# os# s0 of + (# s1, w# #) -> (# s1, I16# w# #) + writeWord8ByteArrayAs# arr# os# (I16# w#) = \s0 -> + writeWord8ArrayAsInt16# arr# os# w# s0 + indexWord8OffAddrAs# addr# os# = I16# (indexWord8OffAddrAsInt16# addr# os#) + readWord8OffAddrAs# addr# os# = \s0 -> + case readWord8OffAddrAsInt16# addr# os# s0 of + (# s1, w# #) -> (# s1, I16# w# #) + writeWord8OffAddrAs# addr# os# (I16# w#) s# = + writeWord8OffAddrAsInt16# addr# os# w# s# + +instance Prim' Int32 where + type SizeOf Int32 = SIZEOF_INT32 + indexWord8ByteArrayAs# arr# os# = I32# (indexWord8ArrayAsInt32# arr# os#) + readWord8ByteArrayAs# arr# os# = \s0 -> + case readWord8ArrayAsInt32# arr# os# s0 of + (# s1, w# #) -> (# s1, I32# w# #) + writeWord8ByteArrayAs# arr# os# (I32# w#) = \s0 -> + writeWord8ArrayAsInt32# arr# os# w# s0 + indexWord8OffAddrAs# addr# os# = I32# (indexWord8OffAddrAsInt32# addr# os#) + readWord8OffAddrAs# addr# os# = \s0 -> + case readWord8OffAddrAsInt32# addr# os# s0 of + (# s1, w# #) -> (# s1, I32# w# #) + writeWord8OffAddrAs# addr# os# (I32# w#) s# = + writeWord8OffAddrAsInt32# addr# os# w# s# + +instance Prim' Int64 where + type SizeOf Int64 = SIZEOF_INT64 + indexWord8ByteArrayAs# arr# os# = I64# (indexWord8ArrayAsInt64# arr# os#) + readWord8ByteArrayAs# arr# os# = \s0 -> + case readWord8ArrayAsInt64# arr# os# s0 of + (# s1, w# #) -> (# s1, I64# w# #) + writeWord8ByteArrayAs# arr# os# (I64# w#) = \s0 -> + writeWord8ArrayAsInt64# arr# os# w# s0 + indexWord8OffAddrAs# addr# os# = I64# (indexWord8OffAddrAsInt64# addr# os#) + readWord8OffAddrAs# addr# os# = \s0 -> + case readWord8OffAddrAsInt64# addr# os# s0 of + (# s1, w# #) -> (# s1, I64# w# #) + writeWord8OffAddrAs# addr# os# (I64# w#) s# = + writeWord8OffAddrAsInt64# addr# os# w# s# + +instance Prim' Word where + type SizeOf Word = SIZEOF_HSWORD + indexWord8ByteArrayAs# arr# os# = W# (indexWord8ArrayAsWord# arr# os#) + readWord8ByteArrayAs# arr# os# = \s0 -> + case readWord8ArrayAsWord# arr# os# s0 of + (# s1, w# #) -> (# s1, W# w# #) + writeWord8ByteArrayAs# arr# os# (W# w#) = \s0 -> + writeWord8ArrayAsWord# arr# os# w# s0 + indexWord8OffAddrAs# addr# os# = W# (indexWord8OffAddrAsWord# addr# os#) + readWord8OffAddrAs# addr# os# = \s0 -> + case readWord8OffAddrAsWord# addr# os# s0 of + (# s1, w# #) -> (# s1, W# w# #) + writeWord8OffAddrAs# addr# os# (W# w#) s# = + writeWord8OffAddrAsWord# addr# os# w# s# + +instance Prim' Int where + type SizeOf Int = SIZEOF_HSINT + indexWord8ByteArrayAs# arr# os# = I# (indexWord8ArrayAsInt# arr# os#) + readWord8ByteArrayAs# arr# os# = \s0 -> + case readWord8ArrayAsInt# arr# os# s0 of + (# s1, w# #) -> (# s1, I# w# #) + writeWord8ByteArrayAs# arr# os# (I# w#) = \s0 -> + writeWord8ArrayAsInt# arr# os# w# s0 + indexWord8OffAddrAs# addr# os# = I# (indexWord8OffAddrAsInt# addr# os#) + readWord8OffAddrAs# addr# os# = \s0 -> + case readWord8OffAddrAsInt# addr# os# s0 of + (# s1, w# #) -> (# s1, I# w# #) + writeWord8OffAddrAs# addr# os# (I# w#) s# = + writeWord8OffAddrAsInt# addr# os# w# s# diff --git a/src/Raehik/Compat/Data/Primitive/Types/Endian.hs b/src/Raehik/Compat/Data/Primitive/Types/Endian.hs new file mode 100644 --- /dev/null +++ b/src/Raehik/Compat/Data/Primitive/Types/Endian.hs @@ -0,0 +1,100 @@ +-- | I think this should be in primitive. + +{-# LANGUAGE CPP #-} +{-# LANGUAGE UnboxedTuples #-} + +module Raehik.Compat.Data.Primitive.Types.Endian where + +import Raehik.Compat.Data.Primitive.Types +import Data.Word +import Raehik.Compat.Data.Word.ByteSwap qualified as X +import Data.Int +import Raehik.Compat.Data.Int.ByteSwap +import GHC.ByteOrder +import Data.Kind +import GHC.Float + +-- | Boxed types which permit reversing byte order ("byte swapping"). +class ByteSwap a where byteSwap :: a -> a +instance ByteSwap Word16 where byteSwap = byteSwap16 +instance ByteSwap Word32 where byteSwap = byteSwap32 +instance ByteSwap Word64 where byteSwap = byteSwap64 +instance ByteSwap Word where byteSwap = X.byteSwap +instance ByteSwap Int16 where byteSwap = byteSwapI16 +instance ByteSwap Int32 where byteSwap = byteSwapI32 +instance ByteSwap Int64 where byteSwap = byteSwapI64 +instance ByteSwap Int where byteSwap = byteSwapI + +-- I think these two are well-founded. No tests currently though. +instance ByteSwap Float where + byteSwap = castWord32ToFloat . byteSwap . castFloatToWord32 +instance ByteSwap Double where + byteSwap = castWord64ToDouble . byteSwap . castDoubleToWord64 + +newtype ByteOrdered (end :: ByteOrder) a = ByteOrdered + { unByteOrdered :: a } + deriving (Ord, Eq, Show, Num) via a + +-- | Newtype for easier instance derivation. +newtype PrimByteSwapped a = PrimByteSwapped { unPrimByteSwapped :: a } + +-- | Prim instance where we byte swap at accesses. +instance (Prim a, ByteSwap a) => Prim (PrimByteSwapped a) where + sizeOf# (PrimByteSwapped a) = sizeOf# a + alignment# (PrimByteSwapped a) = alignment# a + indexByteArray# arr# i# = + PrimByteSwapped (byteSwap (indexByteArray# arr# i#)) + readByteArray# arr# i# = \s0 -> + case readByteArray# arr# i# s0 of + (# s1, a #) -> (# s1, PrimByteSwapped (byteSwap a) #) + writeByteArray# arr# i# (PrimByteSwapped a) = \s0 -> + writeByteArray# arr# i# (byteSwap a) s0 + setByteArray# arr# i# len# (PrimByteSwapped a) = \s0 -> + setByteArray# arr# i# len# (byteSwap a) s0 + indexOffAddr# addr# i# = + PrimByteSwapped (byteSwap (indexOffAddr# addr# i#)) + readOffAddr# addr# i# = \s0 -> + case readOffAddr# addr# i# s0 of + (# s1, a #) -> (# s1, PrimByteSwapped (byteSwap a) #) + writeOffAddr# addr# i# (PrimByteSwapped a) = \s0 -> + writeOffAddr# addr# i# (byteSwap a) s0 + setOffAddr# arr# i# len# (PrimByteSwapped a) = \s0 -> + setOffAddr# arr# i# len# (byteSwap a) s0 + +instance (Prim' a, ByteSwap a) => Prim' (PrimByteSwapped a) where + type SizeOf (PrimByteSwapped a) = SizeOf a + indexWord8ByteArrayAs# arr# os# = + PrimByteSwapped (byteSwap (indexWord8ByteArrayAs# arr# os#)) + readWord8ByteArrayAs# arr# os# = \s0 -> + case readWord8ByteArrayAs# arr# os# s0 of + (# s1, a #) -> (# s1, PrimByteSwapped (byteSwap a) #) + writeWord8ByteArrayAs# arr# os# (PrimByteSwapped a) = \s0 -> + writeWord8ByteArrayAs# arr# os# (byteSwap a) s0 + indexWord8OffAddrAs# addr# os# = + PrimByteSwapped (byteSwap (indexWord8OffAddrAs# addr# os#)) + readWord8OffAddrAs# addr# os# = \s0 -> + case readWord8OffAddrAs# addr# os# s0 of + (# s1, a #) -> (# s1, PrimByteSwapped (byteSwap a) #) + writeWord8OffAddrAs# addr# os# (PrimByteSwapped a) = \s0 -> + writeWord8OffAddrAs# addr# os# (byteSwap a) s0 + +-- idk why I gotta (a :: Type) why is GHC going kind-polymorphic there lol +#if defined(WORDS_BIGENDIAN) +deriving via (PrimByteSwapped a) instance + (Prim a, ByteSwap a) => Prim (ByteOrdered 'LittleEndian a) +deriving via (PrimByteSwapped a) instance + (Prim' a, ByteSwap a) => Prim' (ByteOrdered 'LittleEndian a) +deriving via (a :: Type) instance + Prim a => Prim (ByteOrdered 'BigEndian a) +deriving via (a :: Type) instance + Prim' a => Prim' (ByteOrdered 'BigEndian a) +#else +deriving via (a :: Type) instance + Prim a => Prim (ByteOrdered 'LittleEndian a) +deriving via (a :: Type) instance + Prim' a => Prim' (ByteOrdered 'LittleEndian a) +deriving via (PrimByteSwapped a) instance + (Prim a, ByteSwap a) => Prim (ByteOrdered 'BigEndian a) +deriving via (PrimByteSwapped a) instance + (Prim' a, ByteSwap a) => Prim' (ByteOrdered 'BigEndian a) +#endif diff --git a/src/Raehik/Compat/Data/Word/ByteSwap.hs b/src/Raehik/Compat/Data/Word/ByteSwap.hs new file mode 100644 --- /dev/null +++ b/src/Raehik/Compat/Data/Word/ByteSwap.hs @@ -0,0 +1,12 @@ +-- | Missing @byteSwap@ functions for unsigned integers. +-- +-- Don't know why this one is missing. + +module Raehik.Compat.Data.Word.ByteSwap where + +import GHC.Exts ( byteSwap# ) +import GHC.Word ( Word(W#) ) + +byteSwap :: Word -> Word +byteSwap (W# i#) = W# (byteSwap# i#) +{-# INLINE byteSwap #-} diff --git a/src/Raehik/Compat/GHC/Exts/GHC908MemcpyPrimops.hs b/src/Raehik/Compat/GHC/Exts/GHC908MemcpyPrimops.hs new file mode 100644 --- /dev/null +++ b/src/Raehik/Compat/GHC/Exts/GHC908MemcpyPrimops.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE UnboxedTuples #-} + +module Raehik.Compat.GHC.Exts.GHC908MemcpyPrimops where + +import GHC.Exts +import GHC.IO ( unIO ) +import Foreign.Marshal.Utils ( copyBytes, fillBytes ) + +copyAddrToAddrNonOverlapping# + :: Addr# -> Addr# -> Int# -> State# RealWorld -> State# RealWorld +copyAddrToAddrNonOverlapping# src# dest# len# s# = + case unIO (copyBytes (Ptr dest#) (Ptr src#) (fromIntegral (I# len#))) s# of + (# s'#, () #) -> s'# + +setAddrRange# + :: Addr# -> Int# -> Int# -> State# RealWorld -> State# RealWorld +setAddrRange# dest# w# len# s0 = + case unIO (fillBytes (Ptr dest#) (fromIntegral (I# w#)) (I# len#)) s0 of + (# s1, () #) -> s1 diff --git a/src/Raehik/Compat/GHC/Exts/GHC910UnalignedAddrPrimops.hs b/src/Raehik/Compat/GHC/Exts/GHC910UnalignedAddrPrimops.hs new file mode 100644 --- /dev/null +++ b/src/Raehik/Compat/GHC/Exts/GHC910UnalignedAddrPrimops.hs @@ -0,0 +1,131 @@ +{- +(index|read|write)OffAddr# primops fail when unaligned on platforms not +supporting unaligned accesses. GHC 9.10 introduces new primops that handle +cases where platforms need aligned accesses. This module imitates that for +older GHCs, but without the safety. So we still fail when unaligned, but it's +easier to upgrade when GHC 9.10 is out. + +Note that GC-managed addresses already have these primops. This is for 'Addr#', +non-GC-managed. + +Import this module unqualified along with 'GHC.Exts' . +-} + +{-# LANGUAGE CPP #-} +{-# LANGUAGE UnboxedTuples #-} + +module Raehik.Compat.GHC.Exts.GHC910UnalignedAddrPrimops where + +#if MIN_VERSION_base(4,20,0) + +-- These should be in base-4.20.0.0. + +#else + +import GHC.Exts + +indexWord8OffAddrAsWord16# :: Addr# -> Int# -> Word16# +indexWord8OffAddrAsWord16# addr# os# = + indexWord16OffAddr# (addr# `plusAddr#` os#) 0# + +readWord8OffAddrAsWord16# + :: Addr# -> Int# -> State# d -> (# State# d, Word16# #) +readWord8OffAddrAsWord16# addr# os# = \s0 -> + readWord16OffAddr# (addr# `plusAddr#` os#) 0# s0 + +writeWord8OffAddrAsWord16# :: Addr# -> Int# -> Word16# -> State# d -> State# d +writeWord8OffAddrAsWord16# addr# os# i# s# = + writeWord16OffAddr# (addr# `plusAddr#` os#) 0# i# s# + +indexWord8OffAddrAsWord32# :: Addr# -> Int# -> Word32# +indexWord8OffAddrAsWord32# addr# os# = + indexWord32OffAddr# (addr# `plusAddr#` os#) 0# + +readWord8OffAddrAsWord32# + :: Addr# -> Int# -> State# d -> (# State# d, Word32# #) +readWord8OffAddrAsWord32# addr# os# = \s0 -> + readWord32OffAddr# (addr# `plusAddr#` os#) 0# s0 + +writeWord8OffAddrAsWord32# :: Addr# -> Int# -> Word32# -> State# d -> State# d +writeWord8OffAddrAsWord32# addr# os# i# s# = + writeWord32OffAddr# (addr# `plusAddr#` os#) 0# i# s# + +indexWord8OffAddrAsWord64# :: Addr# -> Int# -> Word64# +indexWord8OffAddrAsWord64# addr# os# = + indexWord64OffAddr# (addr# `plusAddr#` os#) 0# + +readWord8OffAddrAsWord64# + :: Addr# -> Int# -> State# d -> (# State# d, Word64# #) +readWord8OffAddrAsWord64# addr# os# = \s0 -> + readWord64OffAddr# (addr# `plusAddr#` os#) 0# s0 + +writeWord8OffAddrAsWord64# :: Addr# -> Int# -> Word64# -> State# d -> State# d +writeWord8OffAddrAsWord64# addr# os# i# s# = + writeWord64OffAddr# (addr# `plusAddr#` os#) 0# i# s# + +indexWord8OffAddrAsWord# :: Addr# -> Int# -> Word# +indexWord8OffAddrAsWord# addr# os# = + indexWordOffAddr# (addr# `plusAddr#` os#) 0# + +readWord8OffAddrAsWord# + :: Addr# -> Int# -> State# d -> (# State# d, Word# #) +readWord8OffAddrAsWord# addr# os# = \s0 -> + readWordOffAddr# (addr# `plusAddr#` os#) 0# s0 + +writeWord8OffAddrAsWord# :: Addr# -> Int# -> Word# -> State# d -> State# d +writeWord8OffAddrAsWord# addr# os# i# s# = + writeWordOffAddr# (addr# `plusAddr#` os#) 0# i# s# + +indexWord8OffAddrAsInt16# :: Addr# -> Int# -> Int16# +indexWord8OffAddrAsInt16# addr# os# = + indexInt16OffAddr# (addr# `plusAddr#` os#) 0# + +readWord8OffAddrAsInt16# + :: Addr# -> Int# -> State# d -> (# State# d, Int16# #) +readWord8OffAddrAsInt16# addr# os# = \s0 -> + readInt16OffAddr# (addr# `plusAddr#` os#) 0# s0 + +writeWord8OffAddrAsInt16# :: Addr# -> Int# -> Int16# -> State# d -> State# d +writeWord8OffAddrAsInt16# addr# os# i# s# = + writeInt16OffAddr# (addr# `plusAddr#` os#) 0# i# s# + +indexWord8OffAddrAsInt32# :: Addr# -> Int# -> Int32# +indexWord8OffAddrAsInt32# addr# os# = + indexInt32OffAddr# (addr# `plusAddr#` os#) 0# + +readWord8OffAddrAsInt32# + :: Addr# -> Int# -> State# d -> (# State# d, Int32# #) +readWord8OffAddrAsInt32# addr# os# = \s0 -> + readInt32OffAddr# (addr# `plusAddr#` os#) 0# s0 + +writeWord8OffAddrAsInt32# :: Addr# -> Int# -> Int32# -> State# d -> State# d +writeWord8OffAddrAsInt32# addr# os# i# s# = + writeInt32OffAddr# (addr# `plusAddr#` os#) 0# i# s# + +indexWord8OffAddrAsInt64# :: Addr# -> Int# -> Int64# +indexWord8OffAddrAsInt64# addr# os# = + indexInt64OffAddr# (addr# `plusAddr#` os#) 0# + +readWord8OffAddrAsInt64# + :: Addr# -> Int# -> State# d -> (# State# d, Int64# #) +readWord8OffAddrAsInt64# addr# os# = \s0 -> + readInt64OffAddr# (addr# `plusAddr#` os#) 0# s0 + +writeWord8OffAddrAsInt64# :: Addr# -> Int# -> Int64# -> State# d -> State# d +writeWord8OffAddrAsInt64# addr# os# i# s# = + writeInt64OffAddr# (addr# `plusAddr#` os#) 0# i# s# + +indexWord8OffAddrAsInt# :: Addr# -> Int# -> Int# +indexWord8OffAddrAsInt# addr# os# = + indexIntOffAddr# (addr# `plusAddr#` os#) 0# + +readWord8OffAddrAsInt# + :: Addr# -> Int# -> State# d -> (# State# d, Int# #) +readWord8OffAddrAsInt# addr# os# = \s0 -> + readIntOffAddr# (addr# `plusAddr#` os#) 0# s0 + +writeWord8OffAddrAsInt# :: Addr# -> Int# -> Int# -> State# d -> State# d +writeWord8OffAddrAsInt# addr# os# i# s# = + writeIntOffAddr# (addr# `plusAddr#` os#) 0# i# s# + +#endif diff --git a/src/Util/TypeNats.hs b/src/Util/TypeNats.hs new file mode 100644 --- /dev/null +++ b/src/Util/TypeNats.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} + +-- | Handy typenat utils. + +module Util.TypeNats where + +-- natVal'' +import GHC.TypeNats ( Natural, KnownNat, natVal' ) +import GHC.Exts ( proxy#, Proxy# ) + +natVal'' :: forall n. KnownNat n => Natural +natVal'' = natVal' (proxy# :: Proxy# n) +{-# INLINE natVal'' #-} + +natValInt :: forall n. KnownNat n => Int +natValInt = fromIntegral $ natVal'' @n +{-# INLINE natValInt #-}