packages feed

basement 0.0.12 → 0.0.13

raw patch · 19 files changed

+619/−491 lines, 19 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

+ Basement.Compat.Primitive: charToWord32# :: Char# -> Word32#
+ Basement.Compat.Primitive: int16ToInt# :: Int16# -> Int#
+ Basement.Compat.Primitive: int16ToInt32# :: Int16# -> Int32#
+ Basement.Compat.Primitive: int32ToInt# :: Int32# -> Int#
+ Basement.Compat.Primitive: int8ToInt# :: Int8# -> Int#
+ Basement.Compat.Primitive: int8ToInt16# :: Int8# -> Int16#
+ Basement.Compat.Primitive: int8ToInt32# :: Int8# -> Int32#
+ Basement.Compat.Primitive: intToInt16# :: Int# -> Int16#
+ Basement.Compat.Primitive: intToInt32# :: Int# -> Int32#
+ Basement.Compat.Primitive: intToInt8# :: Int# -> Int8#
+ Basement.Compat.Primitive: plusInt16# :: Int16# -> Int16# -> Int16#
+ Basement.Compat.Primitive: plusInt32# :: Int32# -> Int32# -> Int32#
+ Basement.Compat.Primitive: plusInt8# :: Int8# -> Int8# -> Int8#
+ Basement.Compat.Primitive: plusWord16# :: Word16# -> Word16# -> Word16#
+ Basement.Compat.Primitive: plusWord32# :: Word32# -> Word32# -> Word32#
+ Basement.Compat.Primitive: plusWord8# :: Word8# -> Word8# -> Word8#
+ Basement.Compat.Primitive: type Int16# = Int#
+ Basement.Compat.Primitive: type Int32# = Int#
+ Basement.Compat.Primitive: type Int8# = Int#
+ Basement.Compat.Primitive: type Word16# = Word#
+ Basement.Compat.Primitive: type Word32# = Word#
+ Basement.Compat.Primitive: type Word8# = Word#
+ Basement.Compat.Primitive: uncheckedShiftRLWord16# :: Word# -> Int# -> Word#
+ Basement.Compat.Primitive: uncheckedShiftRLWord32# :: Word# -> Int# -> Word#
+ Basement.Compat.Primitive: word16ToChar# :: Word16# -> Char#
+ Basement.Compat.Primitive: word16ToWord# :: Word16# -> Word#
+ Basement.Compat.Primitive: word16ToWord32# :: Word16# -> Word32#
+ Basement.Compat.Primitive: word16ToWord8# :: Word16# -> Word8#
+ Basement.Compat.Primitive: word32ToChar# :: Word32# -> Char#
+ Basement.Compat.Primitive: word32ToWord# :: Word32# -> Word#
+ Basement.Compat.Primitive: word32ToWord16# :: Word32# -> Word16#
+ Basement.Compat.Primitive: word32ToWord8# :: Word32# -> Word8#
+ Basement.Compat.Primitive: word8ToChar# :: Word8# -> Char#
+ Basement.Compat.Primitive: word8ToInt# :: Word8# -> Int#
+ Basement.Compat.Primitive: word8ToInt16# :: Word8# -> Int16#
+ Basement.Compat.Primitive: word8ToInt32# :: Word8# -> Int32#
+ Basement.Compat.Primitive: word8ToWord# :: Word8# -> Word#
+ Basement.Compat.Primitive: word8ToWord16# :: Word8# -> Word16#
+ Basement.Compat.Primitive: word8ToWord32# :: Word8# -> Word32#
+ Basement.Compat.Primitive: wordToChar# :: Word# -> Char#
+ Basement.Compat.Primitive: wordToWord16# :: Word# -> Word16#
+ Basement.Compat.Primitive: wordToWord32# :: Word# -> Word32#
+ Basement.Compat.Primitive: wordToWord8# :: Word# -> Word8#
- Basement.Base16: unsafeConvertByte :: Word# -> (# Word#, Word# #)
+ Basement.Base16: unsafeConvertByte :: Word8# -> (# Word8#, Word8# #)

Files

Basement/Alg/UTF8.hs view
@@ -35,6 +35,7 @@ import           Basement.Numerical.Subtractive import           Basement.Types.OffsetSize import           Basement.Types.Char7 (Char7(..))+import           Basement.IntegralConv import           Basement.PrimType import           Basement.UTF8.Helper import           Basement.UTF8.Table@@ -94,9 +95,9 @@ -- will fail bad if apply at the beginning of string or an empty string. prev :: Indexable container Word8 => container -> Offset Word8 -> StepBack prev ba offset =-    case index ba prevOfs1 of-        (W8# v1) | isContinuation# v1 -> atLeast2 (maskContinuation# v1)-                 | otherwise          -> StepBack (toChar# v1) prevOfs1+    case integralUpsize $ index ba prevOfs1 of+        (W# v1) | isContinuationW# v1 -> atLeast2 (maskContinuation# v1)+                | otherwise           -> StepBack (toChar# v1) prevOfs1   where     sz1 = CountOf 1     !prevOfs1 = offset `offsetMinusE` sz1@@ -104,16 +105,16 @@     prevOfs3 = prevOfs2 `offsetMinusE` sz1     prevOfs4 = prevOfs3 `offsetMinusE` sz1     atLeast2 !v  =-        case index ba prevOfs2 of-            (W8# v2) | isContinuation# v2 -> atLeast3 (or# (uncheckedShiftL# (maskContinuation# v2) 6#) v)-                     | otherwise          -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader2# v2) 6#) v)) prevOfs2+        case integralUpsize $ index ba prevOfs2 of+            (W# v2) | isContinuationW# v2 -> atLeast3 (or# (uncheckedShiftL# (maskContinuation# v2) 6#) v)+                    | otherwise          -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader2# v2) 6#) v)) prevOfs2     atLeast3 !v =-        case index ba prevOfs3 of-            (W8# v3) | isContinuation# v3 -> atLeast4 (or# (uncheckedShiftL# (maskContinuation# v3) 12#) v)-                     | otherwise          -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader3# v3) 12#) v)) prevOfs3+        case integralUpsize $ index ba prevOfs3 of+            (W# v3) | isContinuationW# v3 -> atLeast4 (or# (uncheckedShiftL# (maskContinuation# v3) 12#) v)+                    | otherwise           -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader3# v3) 12#) v)) prevOfs3     atLeast4 !v =-        case index ba prevOfs4 of-            (W8# v4) -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader4# v4) 18#) v)) prevOfs4+        case integralUpsize $ index ba prevOfs4 of+            (W# v4) -> StepBack (toChar# (or# (uncheckedShiftL# (maskHeader4# v4) 18#) v)) prevOfs4  prevSkip :: Indexable container Word8 => container -> Offset Word8 -> Offset Word8 prevSkip ba offset = loop (offset `offsetMinusE` sz1)@@ -139,21 +140,21 @@     !(I# xi) = fromEnum c     !x       = int2Word# xi -    encode1 = write mba i (W8# x) >> pure (i + Offset 1)+    encode1 = write mba i (W8# (wordToWord8# x)) >> pure (i + Offset 1)     encode2 = do         let x1  = or# (uncheckedShiftRL# x 6#) 0xc0##             x2  = toContinuation x-        write mba i     (W8# x1)-        write mba (i+1) (W8# x2)+        write mba i     (W8# (wordToWord8# x1))+        write mba (i+1) (W8# (wordToWord8# x2))         pure (i + Offset 2)      encode3 = do         let x1  = or# (uncheckedShiftRL# x 12#) 0xe0##             x2  = toContinuation (uncheckedShiftRL# x 6#)             x3  = toContinuation x-        write mba i            (W8# x1)-        write mba (i+Offset 1) (W8# x2)-        write mba (i+Offset 2) (W8# x3)+        write mba i            (W8# (wordToWord8# x1))+        write mba (i+Offset 1) (W8# (wordToWord8# x2))+        write mba (i+Offset 2) (W8# (wordToWord8# x3))         pure (i + Offset 3)      encode4 = do@@ -161,10 +162,10 @@             x2  = toContinuation (uncheckedShiftRL# x 12#)             x3  = toContinuation (uncheckedShiftRL# x 6#)             x4  = toContinuation x-        write mba i            (W8# x1)-        write mba (i+Offset 1) (W8# x2)-        write mba (i+Offset 2) (W8# x3)-        write mba (i+Offset 3) (W8# x4)+        write mba i            (W8# (wordToWord8# x1))+        write mba (i+Offset 1) (W8# (wordToWord8# x2))+        write mba (i+Offset 2) (W8# (wordToWord8# x3))+        write mba (i+Offset 3) (W8# (wordToWord8# x4))         pure (i + Offset 4)      toContinuation :: Word# -> Word#
Basement/Base16.hs view
@@ -9,10 +9,11 @@     , Base16Escape(..)     ) where -import GHC.Prim+import GHC.Prim (Addr#, indexWord8OffAddr#, word2Int#, chr#) import GHC.Types import GHC.Word import Basement.Types.Char7+import Basement.Compat.Primitive  data Base16Escape = Base16Escape {-# UNPACK #-} !Char7 {-# UNPACK #-} !Char7 @@ -22,41 +23,42 @@ -- The output words# are guaranteed to be included in the 0 to 2^7-1 range -- -- Note that calling convertByte with a value greater than 256--- will cause segfault or other horrible effect.-unsafeConvertByte :: Word# -> (# Word#, Word# #)+-- will cause segfault or other horrible effect. From GHC9.2, Word8#+-- cannot be >= 256.+unsafeConvertByte :: Word8# -> (# Word8#, Word8# #) unsafeConvertByte b = (# r tableHi b, r tableLo b #)   where-    r :: Table -> Word# -> Word#-    r (Table !table) index = indexWord8OffAddr# table (word2Int# index)+    r :: Table -> Word8# -> Word8#+    r (Table !table) index = indexWord8OffAddr# table (word2Int# (word8ToWord# index)) {-# INLINE unsafeConvertByte #-}  escapeByte :: Word8 -> Base16Escape escapeByte !(W8# b) = Base16Escape (r tableHi b) (r tableLo b)   where-    r :: Table -> Word# -> Char7-    r (Table !table) index = Char7 (W8# (indexWord8OffAddr# table (word2Int# index)))+    r :: Table -> Word8# -> Char7+    r (Table !table) index = Char7 (W8# (indexWord8OffAddr# table (word2Int# (word8ToWord# index)))) {-# INLINE escapeByte #-}  -- | hex word16 hexWord16 :: Word16 -> (Char, Char, Char, Char) hexWord16 (W16# w) = (toChar w1,toChar w2,toChar w3,toChar w4)   where-    toChar :: Word# -> Char-    toChar c = C# (chr# (word2Int# c))-    !(# w1, w2 #) = unsafeConvertByte (uncheckedShiftRL# w 8#)-    !(# w3, w4 #) = unsafeConvertByte (and# w 0xff##)+    toChar :: Word8# -> Char+    toChar c = C# (chr# (word2Int# (word8ToWord# c)))+    !(# w1, w2 #) = unsafeConvertByte (word16ToWord8# (uncheckedShiftRLWord16# w 8#))+    !(# w3, w4 #) = unsafeConvertByte (word16ToWord8# w)  -- | hex word32 hexWord32 :: Word32 -> (Char, Char, Char, Char, Char, Char, Char, Char) hexWord32 (W32# w) = (toChar w1,toChar w2,toChar w3,toChar w4                      ,toChar w5,toChar w6,toChar w7,toChar w8)   where-    toChar :: Word# -> Char-    toChar c = C# (chr# (word2Int# c))-    !(# w1, w2 #) = unsafeConvertByte (uncheckedShiftRL# w 24#)-    !(# w3, w4 #) = unsafeConvertByte (and# (uncheckedShiftRL# w 16#) 0xff##)-    !(# w5, w6 #) = unsafeConvertByte (and# (uncheckedShiftRL# w 8#) 0xff##)-    !(# w7, w8 #) = unsafeConvertByte (and# w 0xff##)+    toChar :: Word8# -> Char+    toChar c = C# (chr# (word2Int# (word8ToWord# c)))+    !(# w1, w2 #) = unsafeConvertByte (word32ToWord8# (uncheckedShiftRLWord32# w 24#))+    !(# w3, w4 #) = unsafeConvertByte (word32ToWord8# (uncheckedShiftRLWord32# w 16#))+    !(# w5, w6 #) = unsafeConvertByte (word32ToWord8# (uncheckedShiftRLWord32# w 8#))+    !(# w7, w8 #) = unsafeConvertByte (word32ToWord8# w)  data Table = Table Addr# @@ -81,4 +83,3 @@     \aaaaaaaaaaaaaaaabbbbbbbbbbbbbbbb\     \ccccccccccccccccdddddddddddddddd\     \eeeeeeeeeeeeeeeeffffffffffffffff"#-
Basement/Bits.hs view
@@ -51,6 +51,7 @@ import GHC.Types import GHC.Word import GHC.Int+import Basement.Compat.Primitive  #if WORD_SIZE_IN_BITS < 64 import GHC.IntWord64@@ -235,196 +236,114 @@  instance FiniteBitsOps Word8 where     numberOfBits _ = 8-    rotateL (W8# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W8# x#-        | otherwise  = W8# (narrow8Word# ((x# `uncheckedShiftL#` i'#) `or#`-                                          (x# `uncheckedShiftRL#` (8# -# i'#))))-      where-        !i'# = word2Int# (int2Word# i# `and#` 7##)-    rotateR (W8# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W8# x#-        | otherwise  = W8# (narrow8Word# ((x# `uncheckedShiftRL#` i'#) `or#`-                                          (x# `uncheckedShiftL#` (8# -# i'#))))-      where-        !i'# = word2Int# (int2Word# i# `and#` 7##)-    bitFlip (W8# x#) = W8# (x# `xor#` mb#)-        where !(W8# mb#) = maxBound-    popCount (W8# x#) = CountOf $ wordToInt (W# (popCnt8# x#))-    countLeadingZeros (W8# w#) = CountOf $ wordToInt (W# (clz8# w#))-    countTrailingZeros (W8# w#) = CountOf $ wordToInt (W# (ctz8# w#))+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement+    popCount (W8# x#) = CountOf $ wordToInt (W# (popCnt8# (word8ToWord# x#)))+    countLeadingZeros (W8# w) = CountOf (wordToInt (W# (clz8# (word8ToWord# w))))+    countTrailingZeros (W8# w) = CountOf (wordToInt (W# (ctz8# (word8ToWord# w)))) instance BitOps Word8 where-    (W8# x#) .&. (W8# y#)   = W8# (x# `and#` y#)-    (W8# x#) .|. (W8# y#)   = W8# (x# `or#`  y#)-    (W8# x#) .^. (W8# y#)   = W8# (x# `xor#` y#)-    (W8# x#) .<<. (CountOf (I# i#)) = W8# (narrow8Word# (x# `shiftL#` i#))-    (W8# x#) .>>. (CountOf (I# i#)) = W8# (narrow8Word# (x# `shiftRL#` i#))+    (.&.)    a b    = (a OldBits..&. b)+    (.|.)    a b    = (a OldBits..|. b)+    (.^.)    a b    = (a `OldBits.xor` b)+    (.<<.)   a (CountOf w) = (a `OldBits.shiftL` w)+    (.>>.)   a (CountOf w) = (a `OldBits.shiftR` w)  -- Word16 ---------------------------------------------------------------------  instance FiniteBitsOps Word16 where     numberOfBits _ = 16-    rotateL (W16# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W16# x#-        | otherwise  = W16# (narrow16Word# ((x# `uncheckedShiftL#` i'#) `or#`-                                            (x# `uncheckedShiftRL#` (16# -# i'#))))-      where-        !i'# = word2Int# (int2Word# i# `and#` 15##)-    rotateR (W16# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W16# x#-        | otherwise  = W16# (narrow16Word# ((x# `uncheckedShiftRL#` i'#) `or#`-                                            (x# `uncheckedShiftL#` (16# -# i'#))))-      where-        !i'# = word2Int# (int2Word# i# `and#` 15##)-    bitFlip (W16# x#) = W16# (x# `xor#` mb#)-        where !(W16# mb#) = maxBound-    popCount (W16# x#) = CountOf $ wordToInt (W# (popCnt16# x#))-    countLeadingZeros (W16# w#) = CountOf $ wordToInt (W# (clz16# w#))-    countTrailingZeros (W16# w#) = CountOf $ wordToInt (W# (ctz16# w#))+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement+    popCount (W16# x#) = CountOf $ wordToInt (W# (popCnt16# (word16ToWord# x#)))+    countLeadingZeros (W16# w#) = CountOf $ wordToInt (W# (clz16# (word16ToWord# w#)))+    countTrailingZeros (W16# w#) = CountOf $ wordToInt (W# (ctz16# (word16ToWord# w#))) instance BitOps Word16 where-    (W16# x#) .&. (W16# y#)   = W16# (x# `and#` y#)-    (W16# x#) .|. (W16# y#)   = W16# (x# `or#`  y#)-    (W16# x#) .^. (W16# y#)   = W16# (x# `xor#` y#)-    (W16# x#) .<<. (CountOf (I# i#)) = W16# (narrow16Word# (x# `shiftL#` i#))-    (W16# x#) .>>. (CountOf (I# i#)) = W16# (narrow16Word# (x# `shiftRL#` i#))+    (.&.)    a b    = (a OldBits..&. b)+    (.|.)    a b    = (a OldBits..|. b)+    (.^.)    a b    = (a `OldBits.xor` b)+    (.<<.)   a (CountOf w) = (a `OldBits.shiftL` w)+    (.>>.)   a (CountOf w) = (a `OldBits.shiftR` w)  -- Word32 ---------------------------------------------------------------------  instance FiniteBitsOps Word32 where     numberOfBits _ = 32-    rotateL (W32# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W32# x#-        | otherwise  = W32# (narrow32Word# ((x# `uncheckedShiftL#` i'#) `or#`-                                            (x# `uncheckedShiftRL#` (32# -# i'#))))-      where-        !i'# = word2Int# (int2Word# i# `and#` 31##)-    rotateR (W32# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W32# x#-        | otherwise  = W32# (narrow32Word# ((x# `uncheckedShiftRL#` i'#) `or#`-                                            (x# `uncheckedShiftL#` (32# -# i'#))))-      where-        !i'# = word2Int# (int2Word# i# `and#` 31##)-    bitFlip (W32# x#) = W32# (x# `xor#` mb#)-        where !(W32# mb#) = maxBound-    popCount (W32# x#) = CountOf $ wordToInt (W# (popCnt32# x#))-    countLeadingZeros (W32# w#) = CountOf $ wordToInt (W# (clz32# w#))-    countTrailingZeros (W32# w#) = CountOf $ wordToInt (W# (ctz32# w#))+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement+    popCount (W32# x#) = CountOf $ wordToInt (W# (popCnt32# (word32ToWord# x#)))+    countLeadingZeros (W32# w#) = CountOf $ wordToInt (W# (clz32# (word32ToWord# w#)))+    countTrailingZeros (W32# w#) = CountOf $ wordToInt (W# (ctz32# (word32ToWord# w#))) instance BitOps Word32 where-    (W32# x#) .&. (W32# y#)   = W32# (x# `and#` y#)-    (W32# x#) .|. (W32# y#)   = W32# (x# `or#`  y#)-    (W32# x#) .^. (W32# y#)   = W32# (x# `xor#` y#)-    (W32# x#) .<<. (CountOf (I# i#)) = W32# (narrow32Word# (x# `shiftL#` i#))-    (W32# x#) .>>. (CountOf (I# i#)) = W32# (narrow32Word# (x# `shiftRL#` i#))+    (.&.)    a b    = (a OldBits..&. b)+    (.|.)    a b    = (a OldBits..|. b)+    (.^.)    a b    = (a `OldBits.xor` b)+    (.<<.)   a (CountOf w) = (a `OldBits.shiftL` w)+    (.>>.)   a (CountOf w) = (a `OldBits.shiftR` w)  -- Word ---------------------------------------------------------------------  #if WORD_SIZE_IN_BITS == 64 instance FiniteBitsOps Word where     numberOfBits _ = 64-    rotateL (W# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W# x#-        | otherwise  = W# ((x# `uncheckedShiftL#` i'#) `or#`-                           (x# `uncheckedShiftRL#` (64# -# i'#)))-      where-        !i'# = word2Int# (int2Word# i# `and#` 63##)-    rotateR (W# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W# x#-        | otherwise  = W# ((x# `uncheckedShiftRL#` i'#) `or#`-                           (x# `uncheckedShiftL#` (64# -# i'#)))-      where-        !i'# = word2Int# (int2Word# i# `and#` 63##)-    bitFlip (W# x#) = W# (x# `xor#` mb#)-        where !(W# mb#) = maxBound+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement     popCount (W# x#) = CountOf $ wordToInt (W# (popCnt64# x#))     countLeadingZeros (W# w#) = CountOf $ wordToInt (W# (clz64# w#))     countTrailingZeros (W# w#) = CountOf $ wordToInt (W# (ctz64# w#)) #else instance FiniteBitsOps Word where     numberOfBits _ = 32-    rotateL (W# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W# x#-        | otherwise  = W# ((x# `uncheckedShiftL#` i'#) `or#`-                           (x# `uncheckedShiftRL#` (32# -# i'#)))-      where-        !i'# = word2Int# (int2Word# i# `and#` 31##)-    rotateR (W# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W# x#-        | otherwise  = W# ((x# `uncheckedShiftRL#` i'#) `or#`-                           (x# `uncheckedShiftL#` (32# -# i'#)))-      where-        !i'# = word2Int# (int2Word# i# `and#` 31##)-    bitFlip (W# x#) = W# (x# `xor#` mb#)-        where !(W# mb#) = maxBound+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement     popCount (W# x#) = CountOf $ wordToInt (W# (popCnt32# x#))     countLeadingZeros (W# w#) = CountOf $ wordToInt (W# (clz32# w#))     countTrailingZeros (W# w#) = CountOf $ wordToInt (W# (ctz32# w#)) #endif  instance BitOps Word where-    (W# x#) .&. (W# y#)   = W# (x# `and#` y#)-    (W# x#) .|. (W# y#)   = W# (x# `or#`  y#)-    (W# x#) .^. (W# y#)   = W# (x# `xor#` y#)-    (W# x#) .<<. (CountOf (I# i#)) = W# ((x# `shiftL#` i#))-    (W# x#) .>>. (CountOf (I# i#)) = W# ((x# `shiftRL#` i#))+    (.&.)    a b    = (a OldBits..&. b)+    (.|.)    a b    = (a OldBits..|. b)+    (.^.)    a b    = (a `OldBits.xor` b)+    (.<<.)   a (CountOf w) = (a `OldBits.shiftL` w)+    (.>>.)   a (CountOf w) = (a `OldBits.shiftR` w)  -- Word64 ---------------------------------------------------------------------  #if WORD_SIZE_IN_BITS == 64 instance FiniteBitsOps Word64 where     numberOfBits _ = 64-    rotateL (W64# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W64# x#-        | otherwise  = W64# ((x# `uncheckedShiftL#` i'#) `or#`-                             (x# `uncheckedShiftRL#` (64# -# i'#)))-      where-        !i'# = word2Int# (int2Word# i# `and#` 63##)-    rotateR (W64# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W64# x#-        | otherwise  = W64# ((x# `uncheckedShiftRL#` i'#) `or#`-                             (x# `uncheckedShiftL#` (64# -# i'#)))-      where-        !i'# = word2Int# (int2Word# i# `and#` 63##)-    bitFlip (W64# x#) = W64# (x# `xor#` mb#)-        where !(W64# mb#) = maxBound+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement     popCount (W64# x#) = CountOf $ wordToInt (W# (popCnt64# x#))     countLeadingZeros (W64# w#) = CountOf $ wordToInt (W# (clz64# w#))     countTrailingZeros (W64# w#) = CountOf $ wordToInt (W# (ctz64# w#)) instance BitOps Word64 where-    (W64# x#) .&. (W64# y#)   = W64# (x# `and#` y#)-    (W64# x#) .|. (W64# y#)   = W64# (x# `or#`  y#)-    (W64# x#) .^. (W64# y#)   = W64# (x# `xor#` y#)-    (W64# x#) .<<. (CountOf (I# i#)) = W64# (x# `shiftL#` i#)-    (W64# x#) .>>. (CountOf (I# i#)) = W64# (x# `shiftRL#` i#)+    (.&.)    a b    = (a OldBits..&. b)+    (.|.)    a b    = (a OldBits..|. b)+    (.^.)    a b    = (a `OldBits.xor` b)+    (.<<.)   a (CountOf w) = (a `OldBits.shiftL` w)+    (.>>.)   a (CountOf w) = (a `OldBits.shiftR` w) #else instance FiniteBitsOps Word64 where     numberOfBits _ = 64-    rotateL (W64# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W64# x#-        | otherwise  = W64# ((x# `uncheckedShiftL64#` i'#) `or64#`-                             (x# `uncheckedShiftRL64#` (64# -# i'#)))-      where-        !i'# = word2Int# (int2Word# i# `and#` 63##)-    rotateR (W64# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = W64# x#-        | otherwise  = W64# ((x# `uncheckedShiftRL64#` i'#) `or64#`-                             (x# `uncheckedShiftL64#` (64# -# i'#)))-      where-        !i'# = word2Int# (int2Word# i# `and#` 63##)-    bitFlip (W64# x#) = W64# (not64# x#)+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement     popCount (W64# x#) = CountOf $ wordToInt (W# (popCnt64# x#))     countLeadingZeros (W64# w#) = CountOf $ wordToInt (W# (clz64# w#))     countTrailingZeros (W64# w#) = CountOf $ wordToInt (W# (ctz64# w#)) instance BitOps Word64 where-    (W64# x#) .&. (W64# y#)   = W64# (x# `and64#` y#)-    (W64# x#) .|. (W64# y#)   = W64# (x# `or64#`  y#)-    (W64# x#) .^. (W64# y#)   = W64# (x# `xor64#` y#)-    (W64# x#) .<<. (CountOf (I# i#)) = W64# (x# `shiftL64#` i#)-    (W64# x#) .>>. (CountOf (I# i#)) = W64# (x# `shiftRL64#` i#)--shiftL64#, shiftRL64# :: Word64# -> Int# -> Word64#-a `shiftL64#` b  | isTrue# (b >=# 64#) = wordToWord64# 0##-                 | otherwise           = a `uncheckedShiftL64#` b-a `shiftRL64#` b | isTrue# (b >=# 64#) = wordToWord64# 0##-                 | otherwise           = a `uncheckedShiftRL64#` b+    (.&.)    a b    = (a OldBits..&. b)+    (.|.)    a b    = (a OldBits..|. b)+    (.^.)    a b    = (a `OldBits.xor` b)+    (.<<.)   a (CountOf w) = (a `OldBits.shiftL` w)+    (.>>.)   a (CountOf w) = (a `OldBits.shiftR` w) #endif  -- Word128 --------------------------------------------------------------------@@ -458,156 +377,85 @@     (.>>.) w (CountOf n) = Word256.shiftR w n  -- Int8 ------------------------------------------------------------------------ instance FiniteBitsOps Int8 where     numberOfBits _ = 8-    rotateL (I8# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = I8# x#-        | otherwise  = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`-                                                    (x'# `uncheckedShiftRL#` (8# -# i'#)))))-      where-        !x'# = narrow8Word# (int2Word# x#)-        !i'# = word2Int# (int2Word# i# `and#` 7##)-    rotateR (I8# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = I8# x#-        | otherwise  = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#`-                                                    (x'# `uncheckedShiftL#` (8# -# i'#)))))-      where-        !x'# = narrow8Word# (int2Word# x#)-        !i'# = word2Int# (int2Word# i# `and#` 7##)-    bitFlip (I8# x#) = I8# (word2Int# (not# (int2Word# x#)))-    popCount (I8# x#) = CountOf $ wordToInt (W# (popCnt8# (int2Word# x#)))-    countLeadingZeros (I8# w#) = CountOf $ wordToInt (W# (clz8# (int2Word# w#)))-    countTrailingZeros (I8# w#) = CountOf $ wordToInt (W# (ctz8# (int2Word# w#)))+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement+    popCount (I8# x#) = CountOf $ wordToInt (W# (popCnt8# (int2Word# (int8ToInt# x#))))+    countLeadingZeros (I8# w#) = CountOf $ wordToInt (W# (clz8# (int2Word# (int8ToInt# w#))))+    countTrailingZeros (I8# w#) = CountOf $ wordToInt (W# (ctz8# (int2Word# (int8ToInt# w#)))) instance BitOps Int8 where-    (I8# x#) .&. (I8# y#)   = I8# (x# `andI#` y#)-    (I8# x#) .|. (I8# y#)   = I8# (x# `orI#`  y#)-    (I8# x#) .^. (I8# y#)   = I8# (x# `xorI#` y#)-    (I8# x#) .<<. (CountOf (I# i#)) = I8# (narrow8Int# (x# `iShiftL#`  i#))-    (I8# x#) .>>. (CountOf (I# i#)) = I8# (narrow8Int# (x# `iShiftRL#` i#))+    (.&.)    a b    = (a OldBits..&. b)+    (.|.)    a b    = (a OldBits..|. b)+    (.^.)    a b    = (a `OldBits.xor` b)+    (.<<.)   a (CountOf w) = (a `OldBits.shiftL` w)+    (.>>.)   a (CountOf w) = (a `OldBits.shiftR` w)  -- Int16 ----------------------------------------------------------------------  instance FiniteBitsOps Int16 where     numberOfBits _ = 16-    rotateL (I16# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = I16# x#-        | otherwise  = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`-                                                      (x'# `uncheckedShiftRL#` (16# -# i'#)))))-      where-        !x'# = narrow16Word# (int2Word# x#)-        !i'# = word2Int# (int2Word# i# `and#` 15##)-    rotateR (I16# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = I16# x#-        | otherwise  = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#`-                                                      (x'# `uncheckedShiftL#` (16# -# i'#)))))-      where-        !x'# = narrow16Word# (int2Word# x#)-        !i'# = word2Int# (int2Word# i# `and#` 15##)-    bitFlip (I16# x#) = I16# (word2Int# (not# (int2Word# x#)))-    popCount (I16# x#) = CountOf $ wordToInt (W# (popCnt16# (int2Word# x#)))-    countLeadingZeros (I16# w#) = CountOf $ wordToInt (W# (clz16# (int2Word# w#)))-    countTrailingZeros (I16# w#) = CountOf $ wordToInt (W# (ctz16# (int2Word# w#)))+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement+    popCount (I16# x#) = CountOf $ wordToInt (W# (popCnt16# (int2Word# (int16ToInt# x#))))+    countLeadingZeros (I16# w#) = CountOf $ wordToInt (W# (clz16# (int2Word# (int16ToInt# w#))))+    countTrailingZeros (I16# w#) = CountOf $ wordToInt (W# (ctz16# (int2Word# (int16ToInt# w#)))) instance BitOps Int16 where-    (I16# x#) .&. (I16# y#)   = I16# (x# `andI#` y#)-    (I16# x#) .|. (I16# y#)   = I16# (x# `orI#`  y#)-    (I16# x#) .^. (I16# y#)   = I16# (x# `xorI#` y#)-    (I16# x#) .<<. (CountOf (I# i#)) = I16# (narrow16Int# (x# `iShiftL#`  i#))-    (I16# x#) .>>. (CountOf (I# i#)) = I16# (narrow16Int# (x# `iShiftRL#` i#))+    (.&.)    a b    = (a OldBits..&. b)+    (.|.)    a b    = (a OldBits..|. b)+    (.^.)    a b    = (a `OldBits.xor` b)+    (.<<.)   a (CountOf w) = (a `OldBits.shiftL` w)+    (.>>.)   a (CountOf w) = (a `OldBits.shiftR` w)  -- Int32 ----------------------------------------------------------------------  instance FiniteBitsOps Int32 where     numberOfBits _ = 32-    rotateL (I32# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = I32# x#-        | otherwise  = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`-                                                      (x'# `uncheckedShiftRL#` (32# -# i'#)))))-      where-        !x'# = narrow32Word# (int2Word# x#)-        !i'# = word2Int# (int2Word# i# `and#` 31##)-    rotateR (I32# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = I32# x#-        | otherwise  = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#`-                                                      (x'# `uncheckedShiftL#` (32# -# i'#)))))-      where-        !x'# = narrow32Word# (int2Word# x#)-        !i'# = word2Int# (int2Word# i# `and#` 31##)-    bitFlip (I32# x#) = I32# (word2Int# (not# (int2Word# x#)))-    popCount (I32# x#) = CountOf $ wordToInt (W# (popCnt32# (int2Word# x#)))-    countLeadingZeros (I32# w#) = CountOf $ wordToInt (W# (clz32# (int2Word# w#)))-    countTrailingZeros (I32# w#) = CountOf $ wordToInt (W# (ctz32# (int2Word# w#)))+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement+    popCount (I32# x#) = CountOf $ wordToInt (W# (popCnt32# (int2Word# (int32ToInt# x#))))+    countLeadingZeros (I32# w#) = CountOf $ wordToInt (W# (clz32# (int2Word# (int32ToInt# w#))))+    countTrailingZeros (I32# w#) = CountOf $ wordToInt (W# (ctz32# (int2Word# (int32ToInt# w#)))) instance BitOps Int32 where-    (I32# x#) .&. (I32# y#)   = I32# (x# `andI#` y#)-    (I32# x#) .|. (I32# y#)   = I32# (x# `orI#`  y#)-    (I32# x#) .^. (I32# y#)   = I32# (x# `xorI#` y#)-    (I32# x#) .<<. (CountOf (I# i#)) = I32# (narrow32Int# (x# `iShiftL#`  i#))-    (I32# x#) .>>. (CountOf (I# i#)) = I32# (narrow32Int# (x# `iShiftRL#` i#))-+    (.&.)    a b    = (a OldBits..&. b)+    (.|.)    a b    = (a OldBits..|. b)+    (.^.)    a b    = (a `OldBits.xor` b)+    (.<<.)   a (CountOf w) = (a `OldBits.shiftL` w)+    (.>>.)   a (CountOf w) = (a `OldBits.shiftR` w) -- Int64 ----------------------------------------------------------------------  #if WORD_SIZE_IN_BITS == 64 instance FiniteBitsOps Int64 where     numberOfBits _ = 64-    rotateL (I64# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = I64# x#-        | otherwise  = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`-                                        (x'# `uncheckedShiftRL#` (64# -# i'#))))-      where-        !x'# = int2Word# x#-        !i'# = word2Int# (int2Word# i# `and#` 63##)-    rotateR (I64# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = I64# x#-        | otherwise  = I64# (word2Int# ((x'# `uncheckedShiftRL#` i'#) `or#`-                                        (x'# `uncheckedShiftL#` (64# -# i'#))))-      where-        !x'# = int2Word# x#-        !i'# = word2Int# (int2Word# i# `and#` 63##)-    bitFlip (I64# x#) = I64# (word2Int# (int2Word# x# `xor#` int2Word# (-1#)))+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement     popCount (I64# x#) = CountOf $ wordToInt (W# (popCnt64# (int2Word# x#)))     countLeadingZeros (I64# w#) = CountOf $ wordToInt (W# (clz64# (int2Word# w#)))     countTrailingZeros (I64# w#) = CountOf $ wordToInt (W# (ctz64# (int2Word# w#))) instance BitOps Int64 where-    (I64# x#) .&. (I64# y#)   = I64# (x# `andI#` y#)-    (I64# x#) .|. (I64# y#)   = I64# (x# `orI#`  y#)-    (I64# x#) .^. (I64# y#)   = I64# (x# `xorI#` y#)-    (I64# x#) .<<. (CountOf (I# w#)) = I64# (x# `iShiftL#`  w#)-    (I64# x#) .>>. (CountOf (I# w#)) = I64# (x# `iShiftRL#` w#)+    (.&.)    a b    = (a OldBits..&. b)+    (.|.)    a b    = (a OldBits..|. b)+    (.^.)    a b    = (a `OldBits.xor` b)+    (.<<.)   a (CountOf w) = (a `OldBits.shiftL` w)+    (.>>.)   a (CountOf w) = (a `OldBits.shiftR` w) #else instance FiniteBitsOps Int64 where     numberOfBits _ = 64-    rotateL (I64# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = I64# x#-        | otherwise  = I64# (word64ToInt64# ((x'# `uncheckedShiftL64#` i'#) `or64#`-                                             (x'# `uncheckedShiftRL64#` (64# -# i'#))))-      where-        !x'# = int64ToWord64# x#-        !i'# = word2Int# (int2Word# i# `and#` 63##)-    rotateR (I64# x#) (CountOf (I# i#))-        | isTrue# (i'# ==# 0#) = I64# x#-        | otherwise  = I64# (word64ToInt64# ((x'# `uncheckedShiftRL64#` i'#) `or64#`-                                             (x'# `uncheckedShiftL64#` (64# -# i'#))))-      where-        !x'# = int64ToWord64# x#-        !i'# = word2Int# (int2Word# i# `and#` 63##)-    bitFlip (I64# x#) = I64# (word64ToInt64# (not64# (int64ToWord64# x#)))+    rotateL w (CountOf i) = w `OldBits.rotateL` i+    rotateR w (CountOf i) = w `OldBits.rotateR` i+    bitFlip = OldBits.complement     popCount (I64# x#) = CountOf $ wordToInt (W# (popCnt64# (int64ToWord64# x#)))     countLeadingZeros (I64# w#) = CountOf $ wordToInt (W# (clz64# (int64ToWord64# w#)))     countTrailingZeros (I64# w#) = CountOf $ wordToInt (W# (ctz64# (int64ToWord64# w#))) instance BitOps Int64 where-    (I64# x#) .&. (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `and64#` int64ToWord64# y#))-    (I64# x#) .|. (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `or64#`  int64ToWord64# y#))-    (I64# x#) .^. (I64# y#)  = I64# (word64ToInt64# (int64ToWord64# x# `xor64#` int64ToWord64# y#))-    (I64# x#) .<<. (CountOf (I# w#)) = I64# (x# `iShiftL64#`  w#)-    (I64# x#) .>>. (CountOf (I# w#)) = I64# (x# `iShiftRA64#` w#)---iShiftL64#, iShiftRA64# :: Int64# -> Int# -> Int64#-a `iShiftL64#` b  | isTrue# (b >=# 64#) = intToInt64# 0#-                  | otherwise           = a `uncheckedIShiftL64#` b-a `iShiftRA64#` b | isTrue# (b >=# 64#) && isTrue# (a `ltInt64#` (intToInt64# 0#))-                                        = intToInt64# (-1#)-                  | isTrue# (b >=# 64#) = intToInt64# 0#-                  | otherwise = a `uncheckedIShiftRA64#` b+    (.&.)    a b    = (a OldBits..&. b)+    (.|.)    a b    = (a OldBits..|. b)+    (.^.)    a b    = (a `OldBits.xor` b)+    (.<<.)   a (CountOf w) = (a `OldBits.shiftL` w)+    (.>>.)   a (CountOf w) = (a `OldBits.shiftR` w)  #endif
Basement/Cast.hs view
@@ -18,6 +18,7 @@ import qualified Basement.Block.Base as Block import           Basement.Compat.Base import           Basement.Compat.Natural+import           Basement.Compat.Primitive import           Basement.Numerical.Number import           Basement.Numerical.Conversion import           Basement.PrimType@@ -58,22 +59,22 @@         Block.unsafeRead (Block.unsafeRecast mba) 0  instance Cast Int8  Word8 where-    cast (I8# i) = W8# (narrow8Word# (int2Word# i))+    cast (I8# i) = W8# (wordToWord8# (int2Word# (int8ToInt# i))) instance Cast Int16 Word16 where-    cast (I16# i) = W16# (narrow16Word# (int2Word# i))+    cast (I16# i) = W16# (wordToWord16# (int2Word# (int16ToInt# i))) instance Cast Int32 Word32 where-    cast (I32# i) = W32# (narrow32Word# (int2Word# i))+    cast (I32# i) = W32# (wordToWord32# (int2Word# (int32ToInt# i))) instance Cast Int64 Word64 where     cast = int64ToWord64 instance Cast Int   Word where     cast (I# i) = W# (int2Word# i)  instance Cast Word8  Int8 where-    cast (W8# i) = I8# (narrow8Int# (word2Int# i))+    cast (W8# i) = I8# (intToInt8# (word2Int# (word8ToWord# i))) instance Cast Word16 Int16 where-    cast (W16# i) = I16# (narrow16Int# (word2Int# i))+    cast (W16# i) = I16# (intToInt16# (word2Int# (word16ToWord# i))) instance Cast Word32 Int32 where-    cast (W32# i) = I32# (narrow32Int# (word2Int# i))+    cast (W32# i) = I32# (intToInt32# (word2Int# (word32ToWord# i))) instance Cast Word64 Int64 where     cast = word64ToInt64 instance Cast Word   Int where@@ -101,24 +102,24 @@     cast (W64# w) = I# (word2Int# w) #else instance Cast Word   Word32 where-    cast (W# w) = W32# w+    cast (W# w) = W32# (wordToWord32# w) instance Cast Word32 Word where-    cast (W32# w) = W# w+    cast (W32# w) = W# (word32ToWord# w)  instance Cast Word   Int32 where-    cast (W# w) = I32# (word2Int# w)+    cast (W# w) = I32# (intToInt32# (word2Int# w)) instance Cast Int32  Word where-    cast (I32# i) = W# (int2Word# i)+    cast (I32# i) = W# (int2Word# (int32ToInt# i))  instance Cast Int    Int32 where-    cast (I# i) = I32# i+    cast (I# i) = I32# (intToInt32# i) instance Cast Int32  Int where-    cast (I32# i) = I# i+    cast (I32# i) = I# (int32ToInt# i)  instance Cast Int    Word32 where-    cast (I# i) = W32# (int2Word# i)+    cast (I# i) = W32# (wordToWord32# (int2Word# i)) instance Cast Word32 Int where-    cast (W32# w) = I# (word2Int# w)+    cast (W32# w) = I# (word2Int# (word32ToWord# w)) #endif  instance Cast (Block.Block a) (Block.Block Word8) where
Basement/Compat/Primitive.hs view
@@ -17,16 +17,77 @@     , compatIsMutableByteArrayPinned#     , unsafeCoerce#     , Word(..)+    , Word8#+    , Word16#+    , Word32#+    , Int8#+    , Int16#+    , Int32#+    -- word upper sizing+    , word8ToWord16#+    , word8ToWord32#+    , word8ToWord#+    , word16ToWord8#+    , word16ToWord32#+    , word16ToWord#+    , word32ToWord#+    -- word down sizing+    , word32ToWord8#+    , word32ToWord16#+    , wordToWord32#+    , wordToWord16#+    , wordToWord8#+    -- int upper sizing+    , int8ToInt16#+    , int8ToInt32#+    , int8ToInt#+    , int16ToInt32#+    , int16ToInt#+    , int32ToInt#+    -- int down sizing+    , intToInt8#+    , intToInt16#+    , intToInt32#+    -- other+    , word8ToInt#+    , word8ToInt16#+    , word8ToInt32#+    , charToWord32#+    , word8ToChar#+    , word16ToChar#+    , word32ToChar#+    , wordToChar#++    -- word8 ops+    , plusWord8#+    -- word16 ops+    , uncheckedShiftRLWord16#+    , plusWord16#+    -- word32 ops+    , uncheckedShiftRLWord32#+    , plusWord32#+    -- int8 ops+    , plusInt8#+    -- int16 ops+    , plusInt16#+    -- int32 ops+    , plusInt32#     ) where + import qualified Prelude-import           GHC.Exts-import           GHC.Prim+import           GHC.Exts hiding (Word8#, Word16#, Word32#, Int8#, Int16#, Int32#, plusWord8#, plusWord16#, plusInt8#, plusInt16#)+import           GHC.Prim hiding (Word8#, Word16#, Word32#, Int8#, Int16#, Int32#, plusWord8#, plusWord16#, plusInt8#, plusInt16#) import           GHC.Word import           GHC.IO  import           Basement.Compat.PrimTypes +#if __GLASGOW_HASKELL__ >= 902+import           GHC.Exts (Word8#, Word16#, Word32#, Int8#, Int16#, Int32#, plusWord8#, plusWord16#, plusInt8#, plusInt16#)+#endif++--  GHC 9.2  | Base 4.16 --  GHC 9.0  | Base 4.15 --  GHC 8.8  | Base 4.13 4.14 --  GHC 8.6  | Base 4.12@@ -76,4 +137,177 @@  foreign import ccall unsafe "basement_is_bytearray_pinned"     compatIsMutableByteArrayPinned# :: MutableByteArray# s -> Pinned#+#endif++#if __GLASGOW_HASKELL__ >= 902++word8ToWord16# :: Word8# -> Word16#+word8ToWord16# a = wordToWord16# (word8ToWord# a)++word8ToWord32# :: Word8# -> Word32#+word8ToWord32# a = wordToWord32# (word8ToWord# a)++word16ToWord8# :: Word16# -> Word8#+word16ToWord8# a = wordToWord8# (word16ToWord# a)++word16ToWord32# :: Word16# -> Word32#+word16ToWord32# a = wordToWord32# (word16ToWord# a)++word32ToWord8# :: Word32# -> Word8#+word32ToWord8# a = wordToWord8# (word32ToWord# a)++word32ToWord16# :: Word32# -> Word16#+word32ToWord16# a = wordToWord16# (word32ToWord# a)++int8ToInt16# :: Int8# -> Int16#+int8ToInt16# i = intToInt16# (int8ToInt# i)++int8ToInt32# :: Int8# -> Int32#+int8ToInt32# i = intToInt32# (int8ToInt# i)++int16ToInt32# :: Int16# -> Int32#+int16ToInt32# i = intToInt32# (int16ToInt# i)++word8ToInt16# :: Word8# -> Int16#+word8ToInt16# i = intToInt16# (word2Int# (word8ToWord# i))++word8ToInt32# :: Word8# -> Int32#+word8ToInt32# i = intToInt32# (word2Int# (word8ToWord# i))++word8ToInt# :: Word8# -> Int#+word8ToInt# i = word2Int# (word8ToWord# i)++charToWord32# :: Char# -> Word32#+charToWord32# ch = wordToWord32# (int2Word# (ord# ch))++word8ToChar# :: Word8# -> Char#+word8ToChar# ch = chr# (word2Int# (word8ToWord# ch))++word16ToChar# :: Word16# -> Char#+word16ToChar# ch = chr# (word2Int# (word16ToWord# ch))++word32ToChar# :: Word32# -> Char#+word32ToChar# ch = chr# (word2Int# (word32ToWord# ch))++wordToChar# :: Word# -> Char#+wordToChar# ch = chr# (word2Int# ch)++#else+type Word8# = Word#+type Word16# = Word#+type Word32# = Word#++type Int8# = Int#+type Int16# = Int#+type Int32# = Int#++word8ToWord16# :: Word8# -> Word16#+word8ToWord16# a = a++word8ToWord32# :: Word8# -> Word32#+word8ToWord32# a = a++word8ToWord# :: Word8# -> Word#+word8ToWord# a = a++word16ToWord32# :: Word16# -> Word32#+word16ToWord32# a = a++word16ToWord8# :: Word16# -> Word8#+word16ToWord8# w = narrow8Word# w++word16ToWord# :: Word16# -> Word#+word16ToWord# a = a++word32ToWord8# :: Word32# -> Word8#+word32ToWord8# w = narrow32Word# w++word32ToWord16# :: Word32# -> Word16#+word32ToWord16# w = narrow16Word# w++word32ToWord# :: Word32# -> Word#+word32ToWord# a = a++wordToWord32# :: Word# -> Word32#+wordToWord32# w = narrow32Word# w++wordToWord16# :: Word# -> Word16#+wordToWord16# w = narrow16Word# w++wordToWord8# :: Word# -> Word8#+wordToWord8# w = narrow8Word# w++charToWord32# :: Char# -> Word32#+charToWord32# ch = int2Word# (ord# ch)++word8ToInt16# :: Word8# -> Int16#+word8ToInt16# w = word2Int# w++word8ToInt32# :: Word8# -> Int32#+word8ToInt32# w = word2Int# w++word8ToInt# :: Word8# -> Int#+word8ToInt# w = word2Int# w++word8ToChar# :: Word8# -> Char#+word8ToChar# w = chr# (word2Int# w)++word16ToChar# :: Word16# -> Char#+word16ToChar# w = chr# (word2Int# w)++word32ToChar# :: Word32# -> Char#+word32ToChar# w = chr# (word2Int# w)++wordToChar# :: Word# -> Char#+wordToChar# ch = chr# (word2Int# ch)++int8ToInt16# :: Int8# -> Int16#+int8ToInt16# a = a++int8ToInt32# :: Int8# -> Int32#+int8ToInt32# a = a++int8ToInt# :: Int8# -> Int#+int8ToInt# a = a++int16ToInt32# :: Int16# -> Int32#+int16ToInt32# a = a++int16ToInt# :: Int16# -> Int#+int16ToInt# a = a++int32ToInt# :: Int32# -> Int#+int32ToInt# a = a++intToInt8# :: Int# -> Int8#+intToInt8# i = narrow8Int# i++intToInt16# :: Int# -> Int16#+intToInt16# i = narrow16Int# i++intToInt32# :: Int# -> Int32#+intToInt32# i = narrow32Int# i++uncheckedShiftRLWord16# = uncheckedShiftRL#++uncheckedShiftRLWord32# = uncheckedShiftRL#++plusWord8# :: Word8# -> Word8# -> Word8#+plusWord8# a b = narrow8Word# (plusWord# a b)++plusWord16# :: Word16# -> Word16# -> Word16#+plusWord16# a b = narrow16Word# (plusWord# a b)++plusWord32# :: Word32# -> Word32# -> Word32#+plusWord32# a b = narrow32Word# (plusWord# a b)++plusInt8# :: Int8# -> Int8# -> Int8#+plusInt8# a b = narrow8Int# (a +# b)++plusInt16# :: Int16# -> Int16# -> Int16#+plusInt16# a b = narrow16Int# (a +# b)++plusInt32# :: Int32# -> Int32# -> Int32#+plusInt32# a b = narrow32Int# (a +# b)+ #endif
Basement/From.hs view
@@ -54,6 +54,7 @@ import           Basement.PrimType (PrimType, PrimSize) import           Basement.Types.OffsetSize import           Basement.Compat.Natural+import           Basement.Compat.Primitive import qualified Prelude (fromIntegral)  -- nat instances@@ -102,79 +103,79 @@     from = toInteger  instance From Int8 Int16 where-    from (I8# i) = I16# i+    from (I8# i) = I16# (int8ToInt16# i) instance From Int8 Int32 where-    from (I8# i) = I32# i+    from (I8# i) = I32# (int8ToInt32# i) instance From Int8 Int64 where-    from (I8# i) = intToInt64 (I# i)+    from (I8# i) = intToInt64 (I# (int8ToInt# i)) instance From Int8 Int where-    from (I8# i) = I# i+    from (I8# i) = I# (int8ToInt# i)  instance From Int16 Int32 where-    from (I16# i) = I32# i+    from (I16# i) = I32# (int16ToInt32# i) instance From Int16 Int64 where-    from (I16# i) = intToInt64 (I# i)+    from (I16# i) = intToInt64 (I# (int16ToInt# i)) instance From Int16 Int where-    from (I16# i) = I# i+    from (I16# i) = I# (int16ToInt# i)  instance From Int32 Int64 where-    from (I32# i) = intToInt64 (I# i)+    from (I32# i) = intToInt64 (I# (int32ToInt# i)) instance From Int32 Int where-    from (I32# i) = I# i+    from (I32# i) = I# (int32ToInt# i)  instance From Int Int64 where     from = intToInt64  instance From Word8 Word16 where-    from (W8# i) = W16# i+    from (W8# i) = W16# (word8ToWord16# i) instance From Word8 Word32 where-    from (W8# i) = W32# i+    from (W8# i) = W32# (word8ToWord32# i) instance From Word8 Word64 where-    from (W8# i) = wordToWord64 (W# i)+    from (W8# i) = wordToWord64 (W# (word8ToWord# i)) instance From Word8 Word128 where-    from (W8# i) = Word128 0 (wordToWord64 $ W# i)+    from (W8# i) = Word128 0 (wordToWord64 $ W# (word8ToWord# i)) instance From Word8 Word256 where-    from (W8# i) = Word256 0 0 0 (wordToWord64 $ W# i)+    from (W8# i) = Word256 0 0 0 (wordToWord64 $ W# (word8ToWord# i)) instance From Word8 Word where-    from (W8# i) = W# i+    from (W8# i) = W# (word8ToWord# i) instance From Word8 Int16 where-    from (W8# w) = I16# (word2Int# w)+    from (W8# w) = I16# (intToInt16# (word2Int# (word8ToWord# w))) instance From Word8 Int32 where-    from (W8# w) = I32# (word2Int# w)+    from (W8# w) = I32# (intToInt32# (word2Int# (word8ToWord# w))) instance From Word8 Int64 where-    from (W8# w) = intToInt64 (I# (word2Int# w))+    from (W8# w) = intToInt64 (I# (word2Int# (word8ToWord# w))) instance From Word8 Int where-    from (W8# w) = I# (word2Int# w)+    from (W8# w) = I# (word2Int# (word8ToWord# w))  instance From Word16 Word32 where-    from (W16# i) = W32# i+    from (W16# i) = W32# (word16ToWord32# i) instance From Word16 Word64 where-    from (W16# i) = wordToWord64 (W# i)+    from (W16# i) = wordToWord64 (W# (word16ToWord# i)) instance From Word16 Word128 where-    from (W16# i) = Word128 0 (wordToWord64 $ W# i)+    from (W16# i) = Word128 0 (wordToWord64 $ W# (word16ToWord# i)) instance From Word16 Word256 where-    from (W16# i) = Word256 0 0 0 (wordToWord64 $ W# i)+    from (W16# i) = Word256 0 0 0 (wordToWord64 $ W# (word16ToWord# i)) instance From Word16 Word where-    from (W16# i) = W# i+    from (W16# i) = W# (word16ToWord# i) instance From Word16 Int32 where-    from (W16# w) = I32# (word2Int# w)+    from (W16# w) = I32# (intToInt32# (word2Int# (word16ToWord# w))) instance From Word16 Int64 where-    from (W16# w) = intToInt64 (I# (word2Int# w))+    from (W16# w) = intToInt64 (I# (word2Int# (word16ToWord# w))) instance From Word16 Int where-    from (W16# w) = I# (word2Int# w)+    from (W16# w) = I# (word2Int# (word16ToWord# w))  instance From Word32 Word64 where-    from (W32# i) = wordToWord64 (W# i)+    from (W32# i) = wordToWord64 (W# (word32ToWord# i)) instance From Word32 Word128 where-    from (W32# i) = Word128 0 (wordToWord64 $ W# i)+    from (W32# i) = Word128 0 (wordToWord64 $ W# (word32ToWord# i)) instance From Word32 Word256 where-    from (W32# i) = Word256 0 0 0 (wordToWord64 $ W# i)+    from (W32# i) = Word256 0 0 0 (wordToWord64 $ W# (word32ToWord# i)) instance From Word32 Word where-    from (W32# i) = W# i+    from (W32# i) = W# (word32ToWord# i) instance From Word32 Int64 where-    from (W32# w) = intToInt64 (I# (word2Int# w))+    from (W32# w) = intToInt64 (I# (word2Int# (word32ToWord# w))) instance From Word32 Int where-    from (W32# w) = I# (word2Int# w)+    from (W32# w) = I# (word2Int# (word32ToWord# w))  instance From Word64 Word128 where     from w = Word128 0 w@@ -270,11 +271,11 @@     tryFrom = BlockN.toBlockN . UArray.toBlock . BoxArray.mapToUnboxed id  instance (KnownNat n, NatWithinBound Word8 n) => From (Zn64 n) Word8 where-    from = narrow . unZn64 where narrow (W64# w) = W8# (narrow8Word# (word64ToWord# w))+    from = narrow . unZn64 where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# w)) instance (KnownNat n, NatWithinBound Word16 n) => From (Zn64 n) Word16 where-    from = narrow . unZn64 where narrow (W64# w) = W16# (narrow16Word# (word64ToWord# w))+    from = narrow . unZn64 where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# w)) instance (KnownNat n, NatWithinBound Word32 n) => From (Zn64 n) Word32 where-    from = narrow . unZn64 where narrow (W64# w) = W32# (narrow32Word# (word64ToWord# w))+    from = narrow . unZn64 where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# w)) instance From (Zn64 n) Word64 where     from = unZn64 instance From (Zn64 n) Word128 where@@ -283,11 +284,11 @@     from = from . unZn64  instance (KnownNat n, NatWithinBound Word8 n) => From (Zn n) Word8 where-    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (narrow8Word# (word64ToWord# w))+    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# w)) instance (KnownNat n, NatWithinBound Word16 n) => From (Zn n) Word16 where-    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (narrow16Word# (word64ToWord# w))+    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# w)) instance (KnownNat n, NatWithinBound Word32 n) => From (Zn n) Word32 where-    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (narrow32Word# (word64ToWord# w))+    from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# w)) instance (KnownNat n, NatWithinBound Word64 n) => From (Zn n) Word64 where     from = naturalToWord64 . unZn instance (KnownNat n, NatWithinBound Word128 n) => From (Zn n) Word128 where
Basement/IntegralConv.hs view
@@ -26,6 +26,7 @@ import Prelude (Integer, fromIntegral) import Basement.Compat.Base import Basement.Compat.Natural+import Basement.Compat.Primitive import Basement.Numerical.Number import Basement.Numerical.Conversion @@ -58,69 +59,69 @@     integralUpsize = toNatural  instance IntegralUpsize Int8 Int16 where-    integralUpsize (I8# i) = I16# i+    integralUpsize (I8# i) = I16# (int8ToInt16# i) instance IntegralUpsize Int8 Int32 where-    integralUpsize (I8# i) = I32# i+    integralUpsize (I8# i) = I32# (int8ToInt32# i) instance IntegralUpsize Int8 Int64 where-    integralUpsize (I8# i) = intToInt64 (I# i)+    integralUpsize (I8# i) = intToInt64 (I# (int8ToInt# i)) instance IntegralUpsize Int8 Int where-    integralUpsize (I8# i) = I# i+    integralUpsize (I8# i) = I# (int8ToInt# i)  instance IntegralUpsize Int16 Int32 where-    integralUpsize (I16# i) = I32# i+    integralUpsize (I16# i) = I32# (int16ToInt32# i) instance IntegralUpsize Int16 Int64 where-    integralUpsize (I16# i) = intToInt64 (I# i)+    integralUpsize (I16# i) = intToInt64 (I# (int16ToInt# i)) instance IntegralUpsize Int16 Int where-    integralUpsize (I16# i) = I# i+    integralUpsize (I16# i) = I# (int16ToInt# i)  instance IntegralUpsize Int32 Int64 where-    integralUpsize (I32# i) = intToInt64 (I# i)+    integralUpsize (I32# i) = intToInt64 (I# (int32ToInt# i)) instance IntegralUpsize Int32 Int where-    integralUpsize (I32# i) = I# i+    integralUpsize (I32# i) = I# (int32ToInt# i)  instance IntegralUpsize Int Int64 where     integralUpsize = intToInt64  instance IntegralUpsize Word8 Word16 where-    integralUpsize (W8# i) = W16# i+    integralUpsize (W8# i) = W16# (word8ToWord16# i) instance IntegralUpsize Word8 Word32 where-    integralUpsize (W8# i) = W32# i+    integralUpsize (W8# i) = W32# (word8ToWord32# i) instance IntegralUpsize Word8 Word64 where-    integralUpsize (W8# i) = wordToWord64 (W# i)+    integralUpsize (W8# i) = wordToWord64 (W# (word8ToWord# i)) instance IntegralUpsize Word8 Word where-    integralUpsize (W8# i) = W# i+    integralUpsize (W8# i) = W# (word8ToWord# i) instance IntegralUpsize Word8 Int16 where-    integralUpsize (W8# w) = I16# (word2Int# w)+    integralUpsize (W8# w) = I16# (word8ToInt16# w) instance IntegralUpsize Word8 Int32 where-    integralUpsize (W8# w) = I32# (word2Int# w)+    integralUpsize (W8# w) = I32# (word8ToInt32# w) instance IntegralUpsize Word8 Int64 where-    integralUpsize (W8# w) = intToInt64 (I# (word2Int# w))+    integralUpsize (W8# w) = intToInt64 (I# (word2Int# (word8ToWord# w))) instance IntegralUpsize Word8 Int where-    integralUpsize (W8# w) = I# (word2Int# w)+    integralUpsize (W8# w) = I# (word2Int# (word8ToWord# w))  instance IntegralUpsize Word16 Word32 where-    integralUpsize (W16# i) = W32# i+    integralUpsize (W16# i) = W32# (word16ToWord32# i) instance IntegralUpsize Word16 Word64 where-    integralUpsize (W16# i) = wordToWord64 (W# i)+    integralUpsize (W16# i) = wordToWord64 (W# (word16ToWord# i)) instance IntegralUpsize Word16 Word where-    integralUpsize (W16# i) = W# i+    integralUpsize (W16# i) = W# (word16ToWord# i)  instance IntegralUpsize Word32 Word64 where-    integralUpsize (W32# i) = wordToWord64 (W# i)+    integralUpsize (W32# i) = wordToWord64 (W# (word32ToWord# i)) instance IntegralUpsize Word32 Word where-    integralUpsize (W32# i) = W# i+    integralUpsize (W32# i) = W# (word32ToWord# i)  instance IntegralUpsize Word Word64 where     integralUpsize = wordToWord64  instance IntegralDownsize Int Int8 where-    integralDownsize      (I# i) = I8# (narrow8Int# i)+    integralDownsize      (I# i) = I8# (intToInt8# i)     integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Int Int16 where-    integralDownsize      (I# i) = I16# (narrow16Int# i)+    integralDownsize      (I# i) = I16# (intToInt16# i)     integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Int Int32 where-    integralDownsize      (I# i) = I32# (narrow32Int# i)+    integralDownsize      (I# i) = I32# (intToInt32# i)     integralDownsizeCheck = integralDownsizeBounded integralDownsize  instance IntegralDownsize Int64 Int8 where@@ -137,34 +138,34 @@     integralDownsizeCheck = integralDownsizeBounded integralDownsize  instance IntegralDownsize Word64 Word8 where-    integralDownsize      (W64# i) = W8# (narrow8Word# (word64ToWord# i))+    integralDownsize      (W64# i) = W8# (wordToWord8# (word64ToWord# i))     integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word64 Word16 where-    integralDownsize      (W64# i) = W16# (narrow16Word# (word64ToWord# i))+    integralDownsize      (W64# i) = W16# (wordToWord16# (word64ToWord# i))     integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word64 Word32 where-    integralDownsize      (W64# i) = W32# (narrow32Word# (word64ToWord# i))+    integralDownsize      (W64# i) = W32# (wordToWord32# (word64ToWord# i))     integralDownsizeCheck = integralDownsizeBounded integralDownsize  instance IntegralDownsize Word Word8 where-    integralDownsize (W# w) = W8# (narrow8Word# w)+    integralDownsize (W# w) = W8# (wordToWord8# w)     integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word Word16 where-    integralDownsize (W# w) = W16# (narrow16Word# w)+    integralDownsize (W# w) = W16# (wordToWord16# w)     integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word Word32 where-    integralDownsize (W# w) = W32# (narrow32Word# w)+    integralDownsize (W# w) = W32# (wordToWord32# w)     integralDownsizeCheck = integralDownsizeBounded integralDownsize  instance IntegralDownsize Word32 Word8 where-    integralDownsize      (W32# i) = W8# (narrow8Word# i)+    integralDownsize      (W32# i) = W8# (word32ToWord8# i)     integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word32 Word16 where-    integralDownsize      (W32# i) = W16# (narrow16Word# i)+    integralDownsize      (W32# i) = W16# (word32ToWord16# i)     integralDownsizeCheck = integralDownsizeBounded integralDownsize  instance IntegralDownsize Word16 Word8 where-    integralDownsize      (W16# i) = W8# (narrow8Word# i)+    integralDownsize      (W16# i) = W8# (word16ToWord8# i)     integralDownsizeCheck = integralDownsizeBounded integralDownsize  instance IntegralDownsize Integer Int8 where
Basement/Numerical/Additive.hs view
@@ -14,10 +14,11 @@ import           Basement.Compat.Base import           Basement.Compat.C.Types import           Basement.Compat.Natural+import           Basement.Compat.Primitive import           Basement.Numerical.Number import qualified Prelude-import           GHC.Types-import           GHC.Prim+import           GHC.Types (Float(..), Double(..))+import           GHC.Prim (plusWord#, plusFloat#, (+#), (+##)) import           GHC.Int import           GHC.Word import           Basement.Bounded@@ -65,15 +66,15 @@     scale = scaleNum instance Additive Int8 where     azero = 0-    (I8# a) + (I8# b) = I8# (narrow8Int# (a +# b))+    (I8# a) + (I8# b) = I8# (a `plusInt8#` b)     scale = scaleNum instance Additive Int16 where     azero = 0-    (I16# a) + (I16# b) = I16# (narrow16Int# (a +# b))+    (I16# a) + (I16# b) = I16# (a `plusInt16#` b)     scale = scaleNum instance Additive Int32 where     azero = 0-    (I32# a) + (I32# b) = I32# (narrow32Int# (a +# b))+    (I32# a) + (I32# b) = I32# (a `plusInt32#` b)     scale = scaleNum instance Additive Int64 where     azero = 0@@ -93,15 +94,15 @@     scale = scaleNum instance Additive Word8 where     azero = 0-    (W8# a) + (W8# b) = W8# (narrow8Word# (a `plusWord#` b))+    (W8# a) + (W8# b) = W8# (a `plusWord8#` b)     scale = scaleNum instance Additive Word16 where     azero = 0-    (W16# a) + (W16# b) = W16# (narrow16Word# (a `plusWord#` b))+    (W16# a) + (W16# b) = W16# (a `plusWord16#` b)     scale = scaleNum instance Additive Word32 where     azero = 0-    (W32# a) + (W32# b) = W32# (narrow32Word# (a `plusWord#` b))+    (W32# a) + (W32# b) = W32# (a `plusWord32#` b)     scale = scaleNum instance Additive Word64 where     azero = 0
Basement/Numerical/Conversion.hs view
@@ -22,6 +22,7 @@ import GHC.Prim import GHC.Int import GHC.Word+import Basement.Compat.Primitive  #if WORD_SIZE_IN_BITS < 64 import GHC.IntWord64@@ -81,7 +82,7 @@  #if WORD_SIZE_IN_BITS == 64 word64ToWord32s :: Word64 -> Word32x2-word64ToWord32s (W64# w64) = Word32x2 (W32# (uncheckedShiftRL# w64 32#)) (W32# (narrow32Word# w64))+word64ToWord32s (W64# w64) = Word32x2 (W32# (wordToWord32# (uncheckedShiftRL# w64 32#))) (W32# (wordToWord32# w64)) #else word64ToWord32s :: Word64 -> Word32x2 word64ToWord32s (W64# w64) = Word32x2 (W32# (word64ToWord# (uncheckedShiftRL64# w64 32#))) (W32# (word64ToWord# w64))
Basement/String.hs view
@@ -229,7 +229,7 @@                 -> Offset Word8                 -> (Char, Offset Word8) nextWithIndexer getter off =-    case getNbBytes# h of+    case getNbBytes# b# of         0# -> (toChar h, off + 1)         1# -> (toChar (decode2 (getter $ off + 1)), off + 2)         2# -> (toChar (decode3 (getter $ off + 1) (getter $ off + 2)), off + 3)@@ -237,29 +237,39 @@               , off + 4)         r -> error ("next: internal error: invalid input: " <> show (I# r) <> " " <> show (W# h))   where-    !(W8# h) = getter off+    b@(W8# b#) = getter off+    !(W# h) = integralUpsize b      toChar :: Word# -> Char     toChar w = C# (chr# (word2Int# w))      decode2 :: Word8 -> Word#-    decode2 (W8# c1) =+    decode2 (W8# b1) =         or# (uncheckedShiftL# (and# h 0x1f##) 6#)             (and# c1 0x3f##)+      where+        c1 = word8ToWord# b1      decode3 :: Word8 -> Word8 -> Word#-    decode3 (W8# c1) (W8# c2) =+    decode3 (W8# b1) (W8# b2) =         or# (uncheckedShiftL# (and# h 0xf##) 12#)             (or# (uncheckedShiftL# (and# c1 0x3f##) 6#)                  (and# c2 0x3f##))+      where+        c1 = word8ToWord# b1+        c2 = word8ToWord# b2      decode4 :: Word8 -> Word8 -> Word8 -> Word#-    decode4 (W8# c1) (W8# c2) (W8# c3) =+    decode4 (W8# b1) (W8# b2) (W8# b3) =         or# (uncheckedShiftL# (and# h 0x7##) 18#)             (or# (uncheckedShiftL# (and# c1 0x3f##) 12#)                 (or# (uncheckedShiftL# (and# c2 0x3f##) 6#)                     (and# c3 0x3f##))             )+      where+        c1 = word8ToWord# b1+        c2 = word8ToWord# b2+        c3 = word8ToWord# b3  writeWithBuilder :: (PrimMonad st, Monad st)                  => Char@@ -273,25 +283,25 @@     !(I# xi) = fromEnum c     !x       = int2Word# xi -    encode1 = Vec.builderAppend (W8# x)+    encode1 = Vec.builderAppend (W8# (wordToWord8# x))      encode2 = do         let x1  = or# (uncheckedShiftRL# x 6#) 0xc0##             x2  = toContinuation x-        Vec.builderAppend (W8# x1) >> Vec.builderAppend (W8# x2)+        Vec.builderAppend (W8# (wordToWord8# x1)) >> Vec.builderAppend (W8# (wordToWord8# x2))      encode3 = do         let x1  = or# (uncheckedShiftRL# x 12#) 0xe0##             x2  = toContinuation (uncheckedShiftRL# x 6#)             x3  = toContinuation x-        Vec.builderAppend (W8# x1) >> Vec.builderAppend (W8# x2) >> Vec.builderAppend (W8# x3)+        Vec.builderAppend (W8# (wordToWord8# x1)) >> Vec.builderAppend (W8# (wordToWord8# x2)) >> Vec.builderAppend (W8# (wordToWord8# x3))      encode4 = do         let x1  = or# (uncheckedShiftRL# x 18#) 0xf0##             x2  = toContinuation (uncheckedShiftRL# x 12#)             x3  = toContinuation (uncheckedShiftRL# x 6#)             x4  = toContinuation x-        Vec.builderAppend (W8# x1) >> Vec.builderAppend (W8# x2) >> Vec.builderAppend (W8# x3) >> Vec.builderAppend (W8# x4)+        Vec.builderAppend (W8# (wordToWord8# x1)) >> Vec.builderAppend (W8# (wordToWord8# x2)) >> Vec.builderAppend (W8# (wordToWord8# x3)) >> Vec.builderAppend (W8# (wordToWord8# x4))      toContinuation :: Word# -> Word#     toContinuation w = or# (and# w 0x3f##) 0x80##
Basement/String/Encoding/ASCII7.hs view
@@ -14,11 +14,13 @@     ) where  import Basement.Compat.Base+import Basement.Compat.Primitive import Basement.Types.OffsetSize import Basement.Numerical.Additive import Basement.Monad+import Basement.Bits -import GHC.Prim+import GHC.Prim (int2Word#, ord#) import GHC.Word import GHC.Types import Basement.UArray@@ -32,7 +34,7 @@ -- This function check the 8th bit is set to 0 -- isAscii :: Word8 -> Bool-isAscii (W8# w) = W8# (and# w 0x80## ) == 0+isAscii w = (w .&. 0x80) == 0 {-# INLINE isAscii #-}  data ASCII7_Invalid@@ -64,8 +66,8 @@     | otherwise  = Left $ ByteOutOfBound w8   where     !w8@(W8# w) = getter off-    toChar :: Word# -> Char-    toChar a = C# (chr# (word2Int# a))+    toChar :: Word8# -> Char+    toChar a = C# (word8ToChar# w)  -- Write ascii char --@@ -81,4 +83,4 @@     | otherwise       = throw $ CharNotAscii c   where     w8 :: Char -> Word8-    w8 (C# ch) = W8# (int2Word# (ord# ch))+    w8 (C# ch) = W8# (wordToWord8# (int2Word# (ord# ch)))
Basement/String/Encoding/ISO_8859_1.hs view
@@ -14,11 +14,12 @@     ) where  import Basement.Compat.Base+import Basement.Compat.Primitive import Basement.Types.OffsetSize import Basement.Numerical.Additive import Basement.Monad -import GHC.Prim+import GHC.Prim (int2Word#, ord#) import GHC.Word import GHC.Types import Basement.UArray@@ -50,8 +51,8 @@ next getter off = Right (toChar w, off + aone)   where     !(W8# w) = getter off-    toChar :: Word# -> Char-    toChar a = C# (chr# (word2Int# a))+    toChar :: Word8# -> Char+    toChar a = C# (word8ToChar# w)  write :: (PrimMonad st, Monad st)       => Char@@ -60,5 +61,5 @@     | c <= toEnum 0xFF = builderAppend (W8# x)     | otherwise        = throw $ NotISO_8859_1 c   where-    x :: Word#-    !x = int2Word# (ord# ch)+    x :: Word8#+    !x = wordToWord8# (int2Word# (ord# ch))
Basement/String/Encoding/UTF16.hs view
@@ -14,12 +14,15 @@ import GHC.Prim import GHC.Word import GHC.Types-import Data.Bits import qualified Prelude import Basement.Compat.Base+import Basement.Compat.Primitive+import Basement.IntegralConv+import Basement.Bits import Basement.Types.OffsetSize import Basement.Monad import Basement.Numerical.Additive+import Basement.Numerical.Subtractive import Basement.UArray import Basement.UArray.Mutable (MUArray) import Basement.MutableBuilder@@ -54,22 +57,23 @@      -> Offset Word16      -> Either UTF16_Invalid (Char, Offset Word16) next getter off-    | h <  0xd800 = Right (toChar hh, off + Offset 1)-    | h >= 0xe000 = Right (toChar hh, off + Offset 1)+    | h <  0xd800 = Right (toChar16 h, off + Offset 1)+    | h >= 0xe000 = Right (toChar16 h, off + Offset 1)     | otherwise   = nextContinuation   where     h :: Word16-    !h@(W16# hh) = getter off-    toChar :: Word# -> Char-    toChar w = C# (chr# (word2Int# w))+    !h = getter off+     to32 :: Word16 -> Word32-    to32 (W16# w) = W32# w+    to32 (W16# w) = W32# (word16ToWord32# w) +    toChar16 :: Word16 -> Char+    toChar16 (W16# w) = C# (word32ToChar# (word16ToWord32# w))+     nextContinuation         | cont >= 0xdc00 && cont < 0xe00 =-            let !(W32# w) = ((to32 h .&. 0x3ff) `shiftL` 10)-                         .|. (to32 cont .&. 0x3ff)-             in Right (toChar w, off + Offset 2)+            let !(W32# w) = ((to32 h .&. 0x3ff) .<<. 10) .|. (to32 cont .&. 0x3ff)+             in Right (C# (word32ToChar# w), off + Offset 2)         | otherwise = Left InvalidContinuation       where         cont :: Word16@@ -86,12 +90,12 @@     | otherwise = throw $ InvalidUnicode c   where     w16 :: Char -> Word16-    w16 (C# ch) = W16# (int2Word# (ord# ch))+    w16 (C# ch) = W16# (wordToWord16# (int2Word# (ord# ch)))      to16 :: Word32 -> Word16     to16 = Prelude.fromIntegral      wHigh :: Char -> (Word16, Word16)     wHigh (C# ch) =-        let v = W32# (minusWord# (int2Word# (ord# ch)) 0x10000##)-         in (0xdc00 .|. to16 (v `shiftR` 10), 0xd800 .|. to16 (v .&. 0x3ff))+        let v = W32# (charToWord32# ch) - 0x10000+         in (0xdc00 .|. to16 (v .>>. 10), 0xd800 .|. to16 (v .&. 0x3ff))
Basement/String/Encoding/UTF32.hs view
@@ -15,6 +15,7 @@ import GHC.Word import GHC.Types import Basement.Compat.Base+import Basement.Compat.Primitive import Basement.Types.OffsetSize import Basement.Monad import Basement.Numerical.Additive@@ -43,7 +44,7 @@   where     !(W32# hh) = getter off     char :: Char-    char = C# (chr# (word2Int# hh))+    char = C# (word32ToChar# hh)  write :: (PrimMonad st, Monad st)       => Char@@ -52,4 +53,4 @@   where     !(C# ch) = c     w32 :: Word32-    w32 = W32# (int2Word# (ord# ch))+    w32 = W32# (charToWord32# ch)
Basement/Types/Char7.hs view
@@ -36,7 +36,7 @@ import Data.Bits import Data.Maybe import Basement.Compat.Base-import Basement.Compat.Primitive (bool#)+import Basement.Compat.Primitive  -- | ASCII value between 0x0 and 0x7f newtype Char7 = Char7 { toByte :: Word8 }@@ -44,14 +44,14 @@  -- | Convert a 'Char7' to a unicode code point 'Char' toChar :: Char7 -> Char-toChar !(Char7 (W8# w)) = C# (chr# (word2Int# w))+toChar !(Char7 (W8# w)) = C# (chr# (word2Int# (word8ToWord# w)))  -- | Try to convert a 'Char' to a 'Char7' --  -- If the code point is non ascii, then Nothing is returned. fromChar :: Char -> Maybe Char7 fromChar !(C# c#)-    | bool# (ltChar# c# (chr# 0x80#)) = Just $ Char7 $ W8# (int2Word# (ord# c#))+    | bool# (ltChar# c# (chr# 0x80#)) = Just $ Char7 $ W8# (wordToWord8# (int2Word# (ord# c#)))     | otherwise                       = Nothing  -- | Try to convert 'Word8' to a 'Char7'@@ -64,11 +64,11 @@  -- | Convert a 'Char' to a 'Char7' ignoring all higher bits fromCharMask :: Char -> Char7-fromCharMask !(C# c#) = Char7 $ W8# (and# (int2Word# (ord# c#)) 0x7f##)+fromCharMask !(C# c#) = Char7 $ W8# (wordToWord8# (and# (int2Word# (ord# c#)) 0x7f##))  -- | Convert a 'Byte' to a 'Char7' ignoring the higher bit fromByteMask :: Word8 -> Char7-fromByteMask !(W8# w#) = Char7 $ W8# (and# w# 0x7f##)+fromByteMask !w = Char7 (w .&. 0x7f)  c7_LF :: Char7 c7_LF = Char7 0xa
Basement/UArray.hs view
@@ -124,6 +124,7 @@ import           Basement.FinalPtr import           Basement.Exception import           Basement.UArray.Base+import           Basement.Bits import           Basement.Block (Block(..), MutableBlock(..)) import qualified Basement.Block as BLK import qualified Basement.Block.Base as BLK (withPtr, unsafeWrite)@@ -912,15 +913,15 @@     (d,m) = inputLenInt `divMod` 3  convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)-convert3 table (W8# a) (W8# b) (W8# c) =-    let !w = narrow8Word# (uncheckedShiftRL# a 2#)-        !x = or# (and# (uncheckedShiftL# a 4#) 0x30##) (uncheckedShiftRL# b 4#)-        !y = or# (and# (uncheckedShiftL# b 2#) 0x3c##) (uncheckedShiftRL# c 6#)-        !z = and# c 0x3f##+convert3 table a b c =+    let !w = a .>>. 2+        !x = ((a .<<. 4) .&. 0x30) .|. (b .>>. 4)+        !y = ((b .<<. 2) .&. 0x3c) .|. (c .>>. 6)+        !z = c .&. 0x3f      in (idx w, idx x, idx y, idx z)   where-    idx :: Word# -> Word8-    idx i = W8# (indexWord8OffAddr# table (word2Int# i))+    idx :: Word8 -> Word8+    idx (W8# i) = W8# (indexWord8OffAddr# table (word2Int# (word8ToWord# i)))  isPrefixOf :: PrimType ty => UArray ty -> UArray ty -> Bool isPrefixOf pre arr
Basement/UTF8/Helper.hs view
@@ -20,6 +20,7 @@ import           Basement.Compat.Primitive import           Basement.Types.OffsetSize import           Basement.UTF8.Types+import           Basement.Bits import           GHC.Prim import           GHC.Types import           GHC.Word@@ -57,26 +58,38 @@ {-# INLINE toChar# #-}  toChar1 :: StepASCII -> Char-toChar1 (StepASCII (W8# w)) = toChar# w+toChar1 (StepASCII (W8# w)) = C# (word8ToChar# w)  toChar2 :: StepASCII -> Word8 -> Char-toChar2 (StepASCII (W8# w1)) (W8# w2) =+toChar2 (StepASCII (W8# b1)) (W8# b2) =     toChar# (or# (uncheckedShiftL# (maskHeader2# w1) 6#) (maskContinuation# w2))+  where+    w1 = word8ToWord# b1+    w2 = word8ToWord# b2  toChar3 :: StepASCII -> Word8 -> Word8 -> Char-toChar3 (StepASCII (W8# w1)) (W8# w2) (W8# w3) =+toChar3 (StepASCII (W8# b1)) (W8# b2) (W8# b3) =     toChar# (or3# (uncheckedShiftL# (maskHeader3# w1) 12#)                   (uncheckedShiftL# (maskContinuation# w2) 6#)                   (maskContinuation# w3)             )+  where+    w1 = word8ToWord# b1+    w2 = word8ToWord# b2+    w3 = word8ToWord# b3  toChar4 :: StepASCII -> Word8 -> Word8 -> Word8 -> Char-toChar4 (StepASCII (W8# w1)) (W8# w2) (W8# w3) (W8# w4) =+toChar4 (StepASCII (W8# b1)) (W8# b2) (W8# b3) (W8# b4) =     toChar# (or4# (uncheckedShiftL# (maskHeader4# w1) 18#)                   (uncheckedShiftL# (maskContinuation# w2) 12#)                   (uncheckedShiftL# (maskContinuation# w3) 6#)                   (maskContinuation# w4)             )+  where+    w1 = word8ToWord# b1+    w2 = word8ToWord# b2+    w3 = word8ToWord# b3+    w4 = word8ToWord# b4  -- | Different way to encode a Character in UTF8 represented as an ADT data UTF8Char =@@ -98,25 +111,25 @@     where       !x = int2Word# (ord# c) -      encode1 = UTF8_1 (W8# x)+      encode1 = UTF8_1 (W8# (wordToWord8# x))       encode2 =-          let !x1 = W8# (or# (uncheckedShiftRL# x 6#) 0xc0##)+          let !x1 = W8# (wordToWord8# (or# (uncheckedShiftRL# x 6#) 0xc0##))               !x2 = toContinuation x            in UTF8_2 x1 x2       encode3 =-          let !x1 = W8# (or# (uncheckedShiftRL# x 12#) 0xe0##)+          let !x1 = W8# (wordToWord8# (or# (uncheckedShiftRL# x 12#) 0xe0##))               !x2 = toContinuation (uncheckedShiftRL# x 6#)               !x3 = toContinuation x            in UTF8_3 x1 x2 x3       encode4 =-          let !x1 = W8# (or# (uncheckedShiftRL# x 18#) 0xf0##)+          let !x1 = W8# (wordToWord8# (or# (uncheckedShiftRL# x 18#) 0xf0##))               !x2 = toContinuation (uncheckedShiftRL# x 12#)               !x3 = toContinuation (uncheckedShiftRL# x 6#)               !x4 = toContinuation x            in UTF8_4 x1 x2 x3 x4        toContinuation :: Word# -> Word8-      toContinuation w = W8# (or# (and# w 0x3f##) 0x80##)+      toContinuation w = W8# (wordToWord8# (or# (and# w 0x3f##) 0x80##))       {-# INLINE toContinuation #-}  -- given the encoding of UTF8 Char, get the number of bytes of this sequence@@ -149,10 +162,10 @@ -- | Encode a Char into a CharUTF8 encodeCharUTF8 :: Char -> CharUTF8 encodeCharUTF8 !(C# c)-    | bool# (ltWord# x 0x80##   ) = CharUTF8 (W32# x)-    | bool# (ltWord# x 0x800##  ) = CharUTF8 encode2-    | bool# (ltWord# x 0x10000##) = CharUTF8 encode3-    | otherwise                   = CharUTF8 encode4+    | bool# (ltWord# x 0x80##   ) = CharUTF8 (W32# (wordToWord32# x))+    | bool# (ltWord# x 0x800##  ) = CharUTF8 (W32# (wordToWord32# encode2))+    | bool# (ltWord# x 0x10000##) = CharUTF8 (W32# (wordToWord32# encode3))+    | otherwise                   = CharUTF8 (W32# (wordToWord32# encode4))   where     !x = int2Word# (ord# c) @@ -166,34 +179,35 @@     set3  = 0x008080e0## -- 10xxxxxx * 2 1110xxxx     set4  = 0x808080f0## -- 10xxxxxx * 3 11111xxx -    encode2 = W32# (and# mask2 (or3# set2-                                     (uncheckedShiftRL# x 6#) -- 5 bits to 1st byte-                                     (uncheckedShiftL# x 8# ) -- move lowest bits to the 2nd byte-                               ))-    encode3 = W32# (and# mask3 (or4# set3-                                     (uncheckedShiftRL# x 12#) -- 4 bits to 1st byte-                                     (and# 0x3f00## (uncheckedShiftL# x 2#)) -- 6 bits to the 2nd byte-                                     (uncheckedShiftL# x 16# ) -- move lowest bits to the 3rd byte-                               ))-    encode4 = W32# (and# mask4 (or4# set4-                                     (uncheckedShiftRL# x 18#) -- 3 bits to 1st byte-                                     (or# (and# 0x3f00## (uncheckedShiftRL# x 4#))   -- 6 bits to the 2nd byte-                                          (and# 0x3f0000## (uncheckedShiftL# x 10#)) -- 6 bits to the 3nd byte-                                     )-                                     (uncheckedShiftL# x 24# ) -- move lowest bits to the 4rd byte-                               ))+    encode2 = and# mask2 (or3# set2+                               (uncheckedShiftRL# x 6#) -- 5 bits to 1st byte+                               (uncheckedShiftL# x 8# ) -- move lowest bits to the 2nd byte+                         )+    encode3 = and# mask3 (or4# set3+                               (uncheckedShiftRL# x 12#) -- 4 bits to 1st byte+                               (and# 0x3f00## (uncheckedShiftL# x 2#)) -- 6 bits to the 2nd byte+                               (uncheckedShiftL# x 16# ) -- move lowest bits to the 3rd byte+                         )+    encode4 = and# mask4 (or4# set4+                               (uncheckedShiftRL# x 18#) -- 3 bits to 1st byte+                               (or# (and# 0x3f00## (uncheckedShiftRL# x 4#))   -- 6 bits to the 2nd byte+                                    (and# 0x3f0000## (uncheckedShiftL# x 10#)) -- 6 bits to the 3nd byte+                               )+                               (uncheckedShiftL# x 24# ) -- move lowest bits to the 4rd byte+                         )  -- | decode a CharUTF8 into a Char -- -- If the value inside a CharUTF8 is not properly encoded, this will result in violation -- of the Char invariants decodeCharUTF8 :: CharUTF8 -> Char-decodeCharUTF8 c@(CharUTF8 !(W32# w))+decodeCharUTF8 c@(CharUTF8 !(W32# w_))     | isCharUTF8Case1 c = toChar# w     | isCharUTF8Case2 c = encode2     | isCharUTF8Case3 c = encode3     | otherwise         = encode4   where+    w = word32ToWord# w_     encode2 =         toChar# (or# (uncheckedShiftL# (maskHeader2# w) 6#)                      (maskContinuation# (uncheckedShiftRL# w 8#))@@ -216,17 +230,17 @@     --maskContent4 = 0x3f3f3f07## -- 3 continuations, 3 bits header  isCharUTF8Case1 :: CharUTF8 -> Bool-isCharUTF8Case1 (CharUTF8 !(W32# w)) = bool# (eqWord# (and# w 0x80##) 0##)+isCharUTF8Case1 (CharUTF8 !w) = (w .&. 0x80) == 0 {-# INLINE isCharUTF8Case1 #-}  isCharUTF8Case2 :: CharUTF8 -> Bool-isCharUTF8Case2 (CharUTF8 !(W32# w)) = bool# (eqWord# (and# w 0x20##) 0##)+isCharUTF8Case2 (CharUTF8 !w) = (w .&. 0x20) == 0 {-# INLINE isCharUTF8Case2 #-}  isCharUTF8Case3 :: CharUTF8 -> Bool-isCharUTF8Case3 (CharUTF8 !(W32# w)) = bool# (eqWord# (and# w 0x10##) 0##)+isCharUTF8Case3 (CharUTF8 !w) = (w .&. 0x10) == 0 {-# INLINE isCharUTF8Case3 #-}  isCharUTF8Case4 :: CharUTF8 -> Bool-isCharUTF8Case4 (CharUTF8 !(W32# w)) = bool# (eqWord# (and# w 0x08##) 0##)+isCharUTF8Case4 (CharUTF8 !w) = (w .&. 0x08) == 0 {-# INLINE isCharUTF8Case4 #-}
Basement/UTF8/Table.hs view
@@ -13,14 +13,16 @@     , isContinuation3     , getNbBytes     , isContinuation#+    , isContinuationW#     , getNbBytes#     ) where -import           GHC.Prim+import           GHC.Prim (Word#, Int#, Addr#, indexWord8OffAddr#, word2Int#) import           GHC.Types import           GHC.Word import           Basement.Compat.Base import           Basement.Compat.Primitive+import           Basement.Bits import           Basement.UTF8.Types (StepASCII(..))  -- | Check if the byte is a continuation byte@@ -29,17 +31,16 @@ {-# INLINE isContinuation #-}  isContinuation2 :: Word8 -> Word8 -> Bool-isContinuation2 (W8# w1) (W8# w2) =-    bool# (mask w1 `andI#` mask w2)+isContinuation2 !w1 !w2 = mask w1 && mask w2   where-    mask v = (and# 0xC0## v) `eqWord#` 0x80##+    mask v = (v .&. 0xC0) == 0x80 {-# INLINE isContinuation2 #-}  isContinuation3 :: Word8 -> Word8 -> Word8 -> Bool-isContinuation3 (W8# w1) (W8# w2) (W8# w3) =-    bool# (mask w1) && bool# (mask w2) && bool# (mask w3)+isContinuation3 !w1 !w2 !w3 =+    mask w1 && mask w2 && mask w3   where-    mask v = (and# 0xC0## v) `eqWord#` 0x80##+    mask v = (v .&. 0xC0) == 0x80 {-# INLINE isContinuation3 #-}  -- | Number of bytes associated with a specific header byte@@ -58,13 +59,18 @@ {-# INLINE getNbBytes #-}  -- | Check if the byte is a continuation byte-isContinuation# :: Word# -> Bool-isContinuation# w = W# (indexWord8OffAddr# (unTable contTable) (word2Int# w)) == W# 0##+isContinuation# :: Word8# -> Bool+isContinuation# w = W8# (indexWord8OffAddr# (unTable contTable) (word2Int# (word8ToWord# w))) == 0 {-# INLINE isContinuation# #-} +-- | Check if the byte is a continuation byte+isContinuationW# :: Word# -> Bool+isContinuationW# w = W8# (indexWord8OffAddr# (unTable contTable) (word2Int# w)) == 0+{-# INLINE isContinuationW# #-}+ -- | Get the number of following bytes given the first byte of a UTF8 sequence.-getNbBytes# :: Word# -> Int#-getNbBytes# w = word2Int# (indexWord8OffAddr# (unTable headTable) (word2Int# w))+getNbBytes# :: Word8# -> Int#+getNbBytes# w = word8ToInt# (indexWord8OffAddr# (unTable headTable) (word2Int# (word8ToWord# w))) {-# INLINE getNbBytes# #-}  data Table = Table { unTable :: !Addr# }
basement.cabal view
@@ -1,5 +1,5 @@ name:                basement-version:             0.0.12+version:             0.0.13 synopsis:            Foundation scrap box of array & string description:         Foundation most basic primitives without any dependencies license:             BSD3