rhi/bytebuild
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Prepare 0.3.16.1 release

Browse source 
Reformatted.
Added workflows.
Updated package metadata.
This commit is contained in:
Brian McKeon 2024-02-02 21:37:18 -05:00 • committed by GitHub
parent 0a79b2d0e9
commit 277d03b475
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
26 changed files with 2394 additions and 1912 deletions
Download patch file Download diff file Expand all files Collapse all files

45
common/HexWord64.hs
View file

@ -1,10 +1,10 @@
{-# language BangPatterns #-}
{-# language ScopedTypeVariables #-}
{-# language DataKinds #-}
{-# language UnboxedTuples #-}
{-# language MagicHash #-}
{-# language PolyKinds #-}
{-# language TypeApplications #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UnboxedTuples #-}
module HexWord64
( word64PaddedUpperHex
@ -15,34 +15,37 @@ module HexWord64
-- the hoop jumping, the explicit loop used here is still outperformed
-- by just inlining the loop.
import GHC.ST (ST(ST))
import Data.Bits
import Data.Bytes.Builder.Bounded.Unsafe (Builder,construct)
import Data.Bytes.Builder.Bounded.Unsafe (Builder, construct)
import Data.Primitive
import Data.Word
import GHC.Exts
import GHC.ST (ST (ST))
import qualified Control.Monad.Primitive as PM
type ST# s (a :: TYPE (r :: RuntimeRep)) = State# s -> (# State# s, a #)
word64PaddedUpperHex :: Word64 -> Builder 16
word64PaddedUpperHex w = construct $ \a b -> ST
(\s0 -> case word64PaddedUpperHexLoop w 60 a b s0 of
(# s1, i #) -> (# s1, I# i #)
)
word64PaddedUpperHex w = construct $ \a b ->
ST
( \s0 -> case word64PaddedUpperHexLoop w 60 a b s0 of
(# s1, i #) -> (# s1, I# i #)
)
word64PaddedUpperHexLoop :: forall s. Word64 -> Int -> MutableByteArray s -> Int -> ST# s Int#
word64PaddedUpperHexLoop !w !shiftAmount !arr !i@(I# i#) s0 = if shiftAmount >= 0
then case PM.internal @(ST s) (writeByteArray arr i (toHexUpper (unsafeShiftR w shiftAmount))) s0 of
(# s1, (_ :: ()) #) -> word64PaddedUpperHexLoop w (shiftAmount - 4) arr (i + 1) s1
else (# s0, i# #)
word64PaddedUpperHexLoop !w !shiftAmount !arr !i@(I# i#) s0 =
if shiftAmount >= 0
then case PM.internal @(ST s) (writeByteArray arr i (toHexUpper (unsafeShiftR w shiftAmount))) s0 of
(# s1, (_ :: ()) #) -> word64PaddedUpperHexLoop w (shiftAmount - 4) arr (i + 1) s1
else (# s0, i# #)
toHexUpper :: Word64 -> Word8
toHexUpper w' = fromIntegral
$ (complement theMask .&. loSolved)
.|. (theMask .&. hiSolved)
where
toHexUpper w' =
fromIntegral $
(complement theMask .&. loSolved)
.|. (theMask .&. hiSolved)
where
w = w' .&. 0xF
-- This is all ones if the value was >= 10
theMask = (1 .&. unsafeShiftR (w - 10) 63) - 1

93
common/Word16Tree.hs
View file

@ -1,4 +1,4 @@
{-# language BangPatterns #-}
{-# LANGUAGE BangPatterns #-}
module Word16Tree
( Word16Tree
@ -9,11 +9,11 @@ module Word16Tree
, expectedSmall
) where
import Data.Bytes.Builder as B
import Data.Word (Word16)
import Data.Primitive (ByteArray)
import qualified Data.Bytes as Bytes
import Data.Bytes.Builder as B
import qualified Data.Bytes.Text.Ascii
import Data.Primitive (ByteArray)
import Data.Word (Word16)
data Word16Tree
= Branch !Word16Tree !Word16Tree
@ -23,63 +23,62 @@ encode :: Word16Tree -> Builder
encode (Leaf w) = B.word16PaddedUpperHex w
encode (Branch a b) =
B.ascii '('
<>
encode a
<>
B.ascii ','
<>
encode b
<>
B.ascii ')'
<> encode a
<> B.ascii ','
<> encode b
<> B.ascii ')'
expectedSmall :: ByteArray
expectedSmall = Bytes.toByteArray $ Data.Bytes.Text.Ascii.fromString
"((AB59,(1F33,2E71)),((((FA9A,247B),890C),(0F13,((55BF,7CF1),389B))),1205))"
expectedSmall =
Bytes.toByteArray $
Data.Bytes.Text.Ascii.fromString
"((AB59,(1F33,2E71)),((((FA9A,247B),890C),(0F13,((55BF,7CF1),389B))),1205))"
exampleSmall :: Word16Tree
exampleSmall = Branch
(Branch
(Leaf 0xAB59)
(Branch
(Leaf 0x1F33)
(Leaf 0x2E71)
)
)
(Branch
(Branch
(Branch
(Branch
(Leaf 0xFA9A)
(Leaf 0x247B)
exampleSmall =
Branch
( Branch
(Leaf 0xAB59)
( Branch
(Leaf 0x1F33)
(Leaf 0x2E71)
)
(Leaf 0x890C)
)
(Branch
(Leaf 0x0F13)
(Branch
(Branch
(Leaf 0x55BF)
(Leaf 0x7CF1)
)
(Leaf 0x389B)
)
)
)
(Leaf 0x1205)
)
( Branch
( Branch
( Branch
( Branch
(Leaf 0xFA9A)
(Leaf 0x247B)
)
(Leaf 0x890C)
)
( Branch
(Leaf 0x0F13)
( Branch
( Branch
(Leaf 0x55BF)
(Leaf 0x7CF1)
)
(Leaf 0x389B)
)
)
)
(Leaf 0x1205)
)
example2000 :: Word16Tree
{-# noinline example2000 #-}
{-# NOINLINE example2000 #-}
example2000 = balanced 0 2000
example9000 :: Word16Tree
{-# noinline example9000 #-}
{-# NOINLINE example9000 #-}
example9000 = balanced 0 9000
balanced :: Word16 -> Word16 -> Word16Tree
balanced !off !n
| n == 0 = Leaf off
| n == 1 = Leaf (off + 1)
| otherwise = let x = div n 2 in
Branch (balanced off x) (balanced (off + x) (n - x))
| otherwise =
let x = div n 2
in Branch (balanced off x) (balanced (off + x) (n - x))