Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-basement for openSUSE:Factory checked in at 2022-10-13 15:41:11 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-basement (Old) and /work/SRC/openSUSE:Factory/.ghc-basement.new.2275 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-basement" Thu Oct 13 15:41:11 2022 rev:16 rq:1008438 version:0.0.15 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-basement/ghc-basement.changes 2022-08-01 21:28:35.713345977 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-basement.new.2275/ghc-basement.changes 2022-10-13 15:41:14.046631209 +0200 @@ -1,0 +2,12 @@ +Fri Aug 19 04:42:34 UTC 2022 - Peter Simons <[email protected]> + +- Update basement to version 0.0.15. + Upstream does not provide a change log file. + +------------------------------------------------------------------- +Sun Aug 14 14:11:01 UTC 2022 - Peter Simons <[email protected]> + +- Update basement to version 0.0.14 revision 2. + Upstream has revised the Cabal build instructions on Hackage. + +------------------------------------------------------------------- Old: ---- basement-0.0.14.tar.gz New: ---- basement-0.0.15.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-basement.spec ++++++ --- /var/tmp/diff_new_pack.Ayx1qm/_old 2022-10-13 15:41:14.746632576 +0200 +++ /var/tmp/diff_new_pack.Ayx1qm/_new 2022-10-13 15:41:14.750632583 +0200 @@ -18,7 +18,7 @@ %global pkg_name basement Name: ghc-%{pkg_name} -Version: 0.0.14 +Version: 0.0.15 Release: 0 Summary: Foundation scrap box of array & string License: BSD-3-Clause ++++++ basement-0.0.14.tar.gz -> basement-0.0.15.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Bits.hs new/basement-0.0.15/Basement/Bits.hs --- old/basement-0.0.14/Basement/Bits.hs 2022-02-28 05:00:48.000000000 +0100 +++ new/basement-0.0.15/Basement/Bits.hs 2022-08-19 04:42:59.000000000 +0200 @@ -291,9 +291,15 @@ rotateL w (CountOf i) = w `OldBits.rotateL` i rotateR w (CountOf i) = w `OldBits.rotateR` i bitFlip = OldBits.complement +#if __GLASGOW_HASKELL__ >= 904 + popCount (W# x#) = CountOf $ wordToInt (W# (popCnt64# (wordToWord64# x#))) + countLeadingZeros (W# w#) = CountOf $ wordToInt (W# (clz64# (wordToWord64# w#))) + countTrailingZeros (W# w#) = CountOf $ wordToInt (W# (ctz64# (wordToWord64# w#))) +#else popCount (W# x#) = CountOf $ wordToInt (W# (popCnt64# x#)) countLeadingZeros (W# w#) = CountOf $ wordToInt (W# (clz64# w#)) countTrailingZeros (W# w#) = CountOf $ wordToInt (W# (ctz64# w#)) +#endif #else instance FiniteBitsOps Word where numberOfBits _ = 32 @@ -433,9 +439,15 @@ rotateL w (CountOf i) = w `OldBits.rotateL` i rotateR w (CountOf i) = w `OldBits.rotateR` i bitFlip = OldBits.complement +#if __GLASGOW_HASKELL__ >= 904 + popCount (I64# x#) = CountOf $ wordToInt (W# (popCnt64# (wordToWord64# (int2Word# (int64ToInt# x#))))) + countLeadingZeros (I64# w#) = CountOf $ wordToInt (W# (clz64# (wordToWord64# (int2Word# (int64ToInt# w#))))) + countTrailingZeros (I64# w#) = CountOf $ wordToInt (W# (ctz64# (wordToWord64# (int2Word# (int64ToInt# w#))))) +#else 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#))) +#endif instance BitOps Int64 where (.&.) a b = (a OldBits..&. b) (.|.) a b = (a OldBits..|. b) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Block/Base.hs new/basement-0.0.15/Basement/Block/Base.hs --- old/basement-0.0.14/Basement/Block/Base.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/basement-0.0.15/Basement/Block/Base.hs 2022-08-19 05:04:39.000000000 +0200 @@ -82,7 +82,6 @@ (<>) = append instance PrimType ty => Monoid (Block ty) where mempty = empty - mappend = append mconcat = concat instance PrimType ty => IsList (Block ty) where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Block/Builder.hs new/basement-0.0.15/Basement/Block/Builder.hs --- old/basement-0.0.14/Basement/Block/Builder.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/basement-0.0.15/Basement/Block/Builder.hs 2022-08-19 05:06:40.000000000 +0200 @@ -6,6 +6,7 @@ -- Block builder {-# LANGUAGE Rank2Types #-} +{-# LANGUAGE TypeOperators #-} module Basement.Block.Builder ( Builder @@ -57,9 +58,7 @@ {-# INLINABLE (<>) #-} instance Monoid Builder where mempty = empty - {-# INLINE mempty #-} - mappend = append - {-# INLINABLE mappend #-} + {-# INLINABLE mempty #-} mconcat = concat {-# INLINABLE mconcat #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Block.hs new/basement-0.0.15/Basement/Block.hs --- old/basement-0.0.14/Basement/Block.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/basement-0.0.15/Basement/Block.hs 2022-08-19 05:04:58.000000000 +0200 @@ -16,6 +16,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeOperators #-} module Basement.Block ( Block(..) , MutableBlock(..) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Bounded.hs new/basement-0.0.15/Basement/Bounded.hs --- old/basement-0.0.14/Basement/Bounded.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/basement-0.0.15/Basement/Bounded.hs 2022-08-19 05:12:59.000000000 +0200 @@ -11,6 +11,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeOperators #-} module Basement.Bounded ( Zn64 , unZn64 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/BoxedArray.hs new/basement-0.0.15/Basement/BoxedArray.hs --- old/basement-0.0.14/Basement/BoxedArray.hs 2021-04-05 05:11:46.000000000 +0200 +++ new/basement-0.0.15/Basement/BoxedArray.hs 2022-08-19 05:05:40.000000000 +0200 @@ -13,6 +13,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeOperators #-} module Basement.BoxedArray ( Array , MArray @@ -132,7 +133,6 @@ (<>) = append instance Monoid (Array a) where mempty = empty - mappend = append mconcat = concat instance Show a => Show (Array a) where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Cast.hs new/basement-0.0.15/Basement/Cast.hs --- old/basement-0.0.14/Basement/Cast.hs 2022-02-28 05:00:48.000000000 +0100 +++ new/basement-0.0.15/Basement/Cast.hs 2022-08-19 05:13:22.000000000 +0200 @@ -4,6 +4,7 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} -- | -- Module : Basement.Cast -- License : BSD-style @@ -81,6 +82,27 @@ cast (W# w) = I# (word2Int# w) #if WORD_SIZE_IN_BITS == 64 +#if __GLASGOW_HASKELL__ >= 904 +instance Cast Word Word64 where + cast (W# w) = W64# (wordToWord64# w) +instance Cast Word64 Word where + cast (W64# w) = W# (GHC.Prim.word64ToWord# w) + +instance Cast Word Int64 where + cast (W# w) = I64# (intToInt64# (word2Int# w)) +instance Cast Int64 Word where + cast (I64# i) = W# (int2Word# (int64ToInt# i)) + +instance Cast Int Int64 where + cast (I# i) = I64# (intToInt64# i) +instance Cast Int64 Int where + cast (I64# i) = I# (int64ToInt# i) + +instance Cast Int Word64 where + cast (I# i) = W64# (wordToWord64# (int2Word# i)) +instance Cast Word64 Int where + cast (W64# w) = I# (word2Int# (GHC.Prim.word64ToWord# w)) +#else instance Cast Word Word64 where cast (W# w) = W64# w instance Cast Word64 Word where @@ -100,6 +122,7 @@ cast (I# i) = W64# (int2Word# i) instance Cast Word64 Int where cast (W64# w) = I# (word2Int# w) +#endif #else instance Cast Word Word32 where cast (W# w) = W32# (wordToWord32# w) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Compat/MonadTrans.hs new/basement-0.0.15/Basement/Compat/MonadTrans.hs --- old/basement-0.0.14/Basement/Compat/MonadTrans.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/basement-0.0.15/Basement/Compat/MonadTrans.hs 2022-08-19 05:03:57.000000000 +0200 @@ -27,7 +27,7 @@ (a,s3) <- runState fa s2 return (ab a, s3) instance Monad m => Monad (State r m) where - return a = State $ \st -> return (a,st) + return = pure ma >>= mb = State $ \s1 -> do (a,s2) <- runState ma s1 runState (mb a) s2 @@ -44,7 +44,7 @@ ab <- runReader fab r return $ ab a instance Monad m => Monad (Reader r m) where - return a = Reader $ \_ -> return a + return = pure ma >>= mb = Reader $ \r -> do a <- runReader ma r runReader (mb a) r diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/From.hs new/basement-0.0.15/Basement/From.hs --- old/basement-0.0.14/Basement/From.hs 2022-02-28 05:00:48.000000000 +0100 +++ new/basement-0.0.15/Basement/From.hs 2022-08-19 04:42:59.000000000 +0200 @@ -35,7 +35,8 @@ -- basic instances import GHC.Types -import GHC.Prim +import GHC.Prim hiding (word64ToWord#) +import qualified GHC.Prim import GHC.Int import GHC.Word import Basement.Numerical.Number @@ -271,11 +272,23 @@ tryFrom = BlockN.toBlockN . UArray.toBlock . BoxArray.mapToUnboxed id instance (KnownNat n, NatWithinBound Word8 n) => From (Zn64 n) Word8 where +#if __GLASGOW_HASKELL__ >= 904 + from = narrow . unZn64 where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# (GHC.Prim.word64ToWord# w))) +#else from = narrow . unZn64 where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# w)) +#endif instance (KnownNat n, NatWithinBound Word16 n) => From (Zn64 n) Word16 where +#if __GLASGOW_HASKELL__ >= 904 + from = narrow . unZn64 where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# (GHC.Prim.word64ToWord# w))) +#else from = narrow . unZn64 where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# w)) +#endif instance (KnownNat n, NatWithinBound Word32 n) => From (Zn64 n) Word32 where +#if __GLASGOW_HASKELL__ >= 904 + from = narrow . unZn64 where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# (GHC.Prim.word64ToWord# w))) +#else from = narrow . unZn64 where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# w)) +#endif instance From (Zn64 n) Word64 where from = unZn64 instance From (Zn64 n) Word128 where @@ -284,11 +297,23 @@ from = from . unZn64 instance (KnownNat n, NatWithinBound Word8 n) => From (Zn n) Word8 where +#if __GLASGOW_HASKELL__ >= 904 + from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# (GHC.Prim.word64ToWord# w))) +#else from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W8# (wordToWord8# (word64ToWord# w)) +#endif instance (KnownNat n, NatWithinBound Word16 n) => From (Zn n) Word16 where +#if __GLASGOW_HASKELL__ >= 904 + from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# (GHC.Prim.word64ToWord# w))) +#else from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W16# (wordToWord16# (word64ToWord# w)) +#endif instance (KnownNat n, NatWithinBound Word32 n) => From (Zn n) Word32 where +#if __GLASGOW_HASKELL__ >= 904 + from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# (GHC.Prim.word64ToWord# w))) +#else from = narrow . naturalToWord64 . unZn where narrow (W64# w) = W32# (wordToWord32# (word64ToWord# w)) +#endif 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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/IntegralConv.hs new/basement-0.0.15/Basement/IntegralConv.hs --- old/basement-0.0.14/Basement/IntegralConv.hs 2022-02-28 05:00:48.000000000 +0100 +++ new/basement-0.0.15/Basement/IntegralConv.hs 2022-08-19 05:12:43.000000000 +0200 @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -5,6 +6,7 @@ {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeOperators #-} module Basement.IntegralConv ( IntegralDownsize(..) , IntegralUpsize(..) @@ -20,7 +22,8 @@ ) where import GHC.Types -import GHC.Prim +import GHC.Prim hiding (word64ToWord#) +import qualified GHC.Prim import GHC.Int import GHC.Word import Prelude (Integer, fromIntegral) @@ -138,13 +141,25 @@ integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word64 Word8 where +#if __GLASGOW_HASKELL__ >= 904 + integralDownsize (W64# i) = W8# (wordToWord8# (GHC.Prim.word64ToWord# i)) +#else integralDownsize (W64# i) = W8# (wordToWord8# (word64ToWord# i)) +#endif integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word64 Word16 where +#if __GLASGOW_HASKELL__ >= 904 + integralDownsize (W64# i) = W16# (wordToWord16# (GHC.Prim.word64ToWord# i)) +#else integralDownsize (W64# i) = W16# (wordToWord16# (word64ToWord# i)) +#endif integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word64 Word32 where +#if __GLASGOW_HASKELL__ >= 904 + integralDownsize (W64# i) = W32# (wordToWord32# (GHC.Prim.word64ToWord# i)) +#else integralDownsize (W64# i) = W32# (wordToWord32# (word64ToWord# i)) +#endif integralDownsizeCheck = integralDownsizeBounded integralDownsize instance IntegralDownsize Word Word8 where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Numerical/Additive.hs new/basement-0.0.15/Basement/Numerical/Additive.hs --- old/basement-0.0.14/Basement/Numerical/Additive.hs 2022-02-28 05:00:48.000000000 +0100 +++ new/basement-0.0.15/Basement/Numerical/Additive.hs 2022-08-19 04:42:59.000000000 +0200 @@ -19,6 +19,7 @@ import qualified Prelude import GHC.Types (Float(..), Double(..)) import GHC.Prim (plusWord#, plusFloat#, (+#), (+##)) +import qualified GHC.Prim import GHC.Int import GHC.Word import Basement.Bounded @@ -79,7 +80,13 @@ instance Additive Int64 where azero = 0 #if WORD_SIZE_IN_BITS == 64 +#if __GLASGOW_HASKELL__ >= 904 + (I64# a) + (I64# b) = I64# (GHC.Prim.intToInt64# (GHC.Prim.int64ToInt# a +# GHC.Prim.int64ToInt# b)) + +#else (I64# a) + (I64# b) = I64# (a +# b) + +#endif #else (I64# a) + (I64# b) = I64# (a `plusInt64#` b) #endif @@ -107,7 +114,13 @@ instance Additive Word64 where azero = 0 #if WORD_SIZE_IN_BITS == 64 +#if __GLASGOW_HASKELL__ >= 904 + (W64# a) + (W64# b) = W64# (GHC.Prim.wordToWord64# (GHC.Prim.word64ToWord# a `plusWord#` GHC.Prim.word64ToWord# b)) + +#else (W64# a) + (W64# b) = W64# (a `plusWord#` b) + +#endif #else (W64# a) + (W64# b) = W64# (int64ToWord64# (word64ToInt64# a `plusInt64#` word64ToInt64# b)) #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Numerical/Conversion.hs new/basement-0.0.15/Basement/Numerical/Conversion.hs --- old/basement-0.0.14/Basement/Numerical/Conversion.hs 2022-02-28 05:00:48.000000000 +0100 +++ new/basement-0.0.15/Basement/Numerical/Conversion.hs 2022-08-19 05:02:51.000000000 +0200 @@ -19,7 +19,8 @@ #include "MachDeps.h" import GHC.Types -import GHC.Prim +import GHC.Prim hiding (word64ToWord#) +import qualified GHC.Prim import GHC.Int import GHC.Word import Basement.Compat.Primitive @@ -30,42 +31,66 @@ intToInt64 :: Int -> Int64 #if WORD_SIZE_IN_BITS == 64 +#if __GLASGOW_HASKELL__ >= 904 +intToInt64 (I# i) = I64# (intToInt64# i) +#else intToInt64 (I# i) = I64# i +#endif #else intToInt64 (I# i) = I64# (intToInt64# i) #endif int64ToInt :: Int64 -> Int #if WORD_SIZE_IN_BITS == 64 +#if __GLASGOW_HASKELL__ >= 904 +int64ToInt (I64# i) = I# (int64ToInt# i) +#else int64ToInt (I64# i) = I# i +#endif #else int64ToInt (I64# i) = I# (int64ToInt# i) #endif wordToWord64 :: Word -> Word64 #if WORD_SIZE_IN_BITS == 64 +#if __GLASGOW_HASKELL__ >= 904 +wordToWord64 (W# i) = W64# (wordToWord64# i) +#else wordToWord64 (W# i) = W64# i +#endif #else wordToWord64 (W# i) = W64# (wordToWord64# i) #endif word64ToWord :: Word64 -> Word #if WORD_SIZE_IN_BITS == 64 +#if __GLASGOW_HASKELL__ >= 904 +word64ToWord (W64# i) = W# (GHC.Prim.word64ToWord# i) +#else word64ToWord (W64# i) = W# i +#endif #else word64ToWord (W64# i) = W# (word64ToWord# i) #endif word64ToInt64 :: Word64 -> Int64 #if WORD_SIZE_IN_BITS == 64 +#if __GLASGOW_HASKELL__ >= 904 +word64ToInt64 (W64# i) = I64# (word64ToInt64# i) +#else word64ToInt64 (W64# i) = I64# (word2Int# i) +#endif #else word64ToInt64 (W64# i) = I64# (word64ToInt64# i) #endif int64ToWord64 :: Int64 -> Word64 #if WORD_SIZE_IN_BITS == 64 +#if __GLASGOW_HASKELL__ >= 904 +int64ToWord64 (I64# i) = W64# (int64ToWord64# i) +#else int64ToWord64 (I64# i) = W64# (int2Word# i) +#endif #else int64ToWord64 (I64# i) = W64# (int64ToWord64# i) #endif @@ -82,7 +107,11 @@ #if WORD_SIZE_IN_BITS == 64 word64ToWord32s :: Word64 -> Word32x2 +#if __GLASGOW_HASKELL__ >= 904 +word64ToWord32s (W64# w64) = Word32x2 (W32# (wordToWord32# (uncheckedShiftRL# (GHC.Prim.word64ToWord# w64 ) 32#))) (W32# (wordToWord32# (GHC.Prim.word64ToWord# w64))) +#else word64ToWord32s (W64# w64) = Word32x2 (W32# (wordToWord32# (uncheckedShiftRL# w64 32#))) (W32# (wordToWord32# w64)) +#endif #else word64ToWord32s :: Word64 -> Word32x2 word64ToWord32s (W64# w64) = Word32x2 (W32# (word64ToWord# (uncheckedShiftRL64# w64 32#))) (W32# (word64ToWord# w64)) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Types/OffsetSize.hs new/basement-0.0.15/Basement/Types/OffsetSize.hs --- old/basement-0.0.14/Basement/Types/OffsetSize.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/basement-0.0.15/Basement/Types/OffsetSize.hs 2022-08-19 05:04:23.000000000 +0200 @@ -52,6 +52,7 @@ import GHC.Word import GHC.Int import GHC.Prim +import qualified GHC.Prim import System.Posix.Types (CSsize (..)) import Data.Bits import Basement.Compat.Base @@ -209,7 +210,6 @@ instance Monoid (CountOf ty) where mempty = azero - mappend = (+) mconcat = foldl' (+) 0 sizeOfE :: CountOf Word8 -> CountOf ty -> CountOf Word8 @@ -227,30 +227,48 @@ #if WORD_SIZE_IN_BITS < 64 csizeOfSize (CountOf (I# sz)) = CSize (W32# (int2Word# sz)) #else +#if __GLASGOW_HASKELL__ >= 904 +csizeOfSize (CountOf (I# sz)) = CSize (W64# (wordToWord64# (int2Word# sz))) + +#else csizeOfSize (CountOf (I# sz)) = CSize (W64# (int2Word# sz)) + +#endif #endif csizeOfOffset :: Offset8 -> CSize #if WORD_SIZE_IN_BITS < 64 csizeOfOffset (Offset (I# sz)) = CSize (W32# (int2Word# sz)) #else +#if __GLASGOW_HASKELL__ >= 904 +csizeOfOffset (Offset (I# sz)) = CSize (W64# (wordToWord64# (int2Word# sz))) +#else csizeOfOffset (Offset (I# sz)) = CSize (W64# (int2Word# sz)) #endif +#endif sizeOfCSSize :: CSsize -> CountOf Word8 sizeOfCSSize (CSsize (-1)) = error "invalid size: CSSize is -1" #if WORD_SIZE_IN_BITS < 64 sizeOfCSSize (CSsize (I32# sz)) = CountOf (I# sz) #else +#if __GLASGOW_HASKELL__ >= 904 +sizeOfCSSize (CSsize (I64# sz)) = CountOf (I# (int64ToInt# sz)) +#else sizeOfCSSize (CSsize (I64# sz)) = CountOf (I# sz) #endif +#endif sizeOfCSize :: CSize -> CountOf Word8 #if WORD_SIZE_IN_BITS < 64 sizeOfCSize (CSize (W32# sz)) = CountOf (I# (word2Int# sz)) #else +#if __GLASGOW_HASKELL__ >= 904 +sizeOfCSize (CSize (W64# sz)) = CountOf (I# (word2Int# (word64ToWord# sz))) +#else sizeOfCSize (CSize (W64# sz)) = CountOf (I# (word2Int# sz)) #endif +#endif natValCountOf :: forall n ty proxy . (KnownNat n, NatWithinBound (CountOf ty) n) => proxy n -> CountOf ty natValCountOf n = CountOf $ Prelude.fromIntegral (natVal n) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Types/Word128.hs new/basement-0.0.15/Basement/Types/Word128.hs --- old/basement-0.0.14/Basement/Types/Word128.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/basement-0.0.15/Basement/Types/Word128.hs 2022-08-19 04:42:59.000000000 +0200 @@ -128,11 +128,18 @@ #if WORD_SIZE_IN_BITS < 64 (+) = applyBiWordOnNatural (Prelude.+) #else +#if __GLASGOW_HASKELL__ >= 904 +(+) (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = Word128 (W64# s1) (W64# (wordToWord64# s0)) + where + !(# carry, s0 #) = plusWord2# (GHC.Prim.word64ToWord# a0) (GHC.Prim.word64ToWord# b0) + s1 = wordToWord64# (plusWord# (plusWord# (GHC.Prim.word64ToWord# a1) (GHC.Prim.word64ToWord# b1)) carry) +#else (+) (Word128 (W64# a1) (W64# a0)) (Word128 (W64# b1) (W64# b0)) = Word128 (W64# s1) (W64# s0) where !(# carry, s0 #) = plusWord2# a0 b0 s1 = plusWord# (plusWord# a1 b1) carry #endif +#endif -- temporary available until native operation available applyBiWordOnNatural :: (Natural -> Natural -> Natural) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/Types/Word256.hs new/basement-0.0.15/Basement/Types/Word256.hs --- old/basement-0.0.14/Basement/Types/Word256.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/basement-0.0.15/Basement/Types/Word256.hs 2022-08-19 04:42:59.000000000 +0200 @@ -21,7 +21,8 @@ , fromNatural ) where -import GHC.Prim +import GHC.Prim hiding (word64ToWord#) +import qualified GHC.Prim import GHC.Word import GHC.Types import qualified Prelude (fromInteger, show, Num(..), quot, rem, mod) @@ -149,6 +150,25 @@ #else (+) (Word256 (W64# a3) (W64# a2) (W64# a1) (W64# a0)) (Word256 (W64# b3) (W64# b2) (W64# b1) (W64# b0)) = +#if __GLASGOW_HASKELL__ >= 904 + Word256 (W64# (wordToWord64# s3)) (W64# (wordToWord64# s2)) (W64# (wordToWord64# s1)) (W64# (wordToWord64# s0)) + where + !(# c0, s0 #) = plusWord2# (GHC.Prim.word64ToWord# a0) (GHC.Prim.word64ToWord# b0) + !(# c1, s1 #) = plusWord3# (GHC.Prim.word64ToWord# a1) (GHC.Prim.word64ToWord# b1) (c0) + !(# c2, s2 #) = plusWord3# (GHC.Prim.word64ToWord# a2) (GHC.Prim.word64ToWord# b2) c1 + !s3 = plusWord3NoCarry# (GHC.Prim.word64ToWord# a3) (GHC.Prim.word64ToWord# b3) c2 + + plusWord3NoCarry# a b c = plusWord# (plusWord# a b) c + plusWord3# a b c + | bool# (eqWord# carry 0##) = plusWord2# x c + | otherwise = + case plusWord2# x c of + (# carry2, x' #) + | bool# (eqWord# carry2 0##) -> (# carry, x' #) + | otherwise -> (# plusWord# carry carry2, x' #) + where + (# carry, x #) = plusWord2# a b +#else Word256 (W64# s3) (W64# s2) (W64# s1) (W64# s0) where !(# c0, s0 #) = plusWord2# a0 b0 @@ -167,6 +187,7 @@ where (# carry, x #) = plusWord2# a b #endif +#endif -- temporary available until native operation available applyBiWordOnNatural :: (Natural -> Natural -> Natural) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/UArray/Base.hs new/basement-0.0.15/Basement/UArray/Base.hs --- old/basement-0.0.14/Basement/UArray/Base.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/basement-0.0.15/Basement/UArray/Base.hs 2022-08-19 05:05:21.000000000 +0200 @@ -133,7 +133,6 @@ (<>) = append instance PrimType ty => Monoid (UArray ty) where mempty = empty - mappend = append mconcat = concat instance PrimType ty => IsList (UArray ty) where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/Basement/UArray/Mutable.hs new/basement-0.0.15/Basement/UArray/Mutable.hs --- old/basement-0.0.14/Basement/UArray/Mutable.hs 2019-09-02 05:58:08.000000000 +0200 +++ new/basement-0.0.15/Basement/UArray/Mutable.hs 2022-08-19 04:42:59.000000000 +0200 @@ -41,6 +41,7 @@ ) where import GHC.Prim +import GHC.Exts import GHC.Types import GHC.Ptr import Basement.Compat.Base @@ -104,7 +105,7 @@ -> prim (MUArray ty (PrimState prim)) sub (MUArray start sz back) dropElems' takeElems | takeElems <= 0 = empty - | Just keepElems <- sz - dropElems, keepElems > 0 + | Just keepElems <- sz - dropElems, keepElems > 0 = pure $ MUArray (start `offsetPlusE` dropElems) (min (CountOf takeElems) keepElems) back | otherwise = empty where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/basement-0.0.14/basement.cabal new/basement-0.0.15/basement.cabal --- old/basement-0.0.14/basement.cabal 2022-03-03 04:08:59.000000000 +0100 +++ new/basement-0.0.15/basement.cabal 2022-08-19 06:34:07.000000000 +0200 @@ -1,5 +1,5 @@ name: basement -version: 0.0.14 +version: 0.0.15 synopsis: Foundation scrap box of array & string description: Foundation most basic primitives without any dependencies license: BSD3 @@ -137,7 +137,7 @@ Basement.Terminal.Size -- support and dependencies - if impl(ghc < 8.8) + if impl(ghc < 8.10) buildable: False else build-depends: base
