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 +22/−21
- Basement/Base16.hs +19/−18
- Basement/Bits.hs +110/−262
- Basement/Cast.hs +15/−14
- Basement/Compat/Primitive.hs +236/−2
- Basement/From.hs +40/−39
- Basement/IntegralConv.hs +35/−34
- Basement/Numerical/Additive.hs +9/−8
- Basement/Numerical/Conversion.hs +2/−1
- Basement/String.hs +19/−9
- Basement/String/Encoding/ASCII7.hs +7/−5
- Basement/String/Encoding/ISO_8859_1.hs +6/−5
- Basement/String/Encoding/UTF16.hs +17/−13
- Basement/String/Encoding/UTF32.hs +3/−2
- Basement/Types/Char7.hs +5/−5
- Basement/UArray.hs +8/−7
- Basement/UTF8/Helper.hs +48/−34
- Basement/UTF8/Table.hs +17/−11
- basement.cabal +1/−1
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