finitary 2.1.0.1 → 2.1.1.0

raw patch · 3 files changed

+53/−26 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• finitary.cabal +5/−5
• src/Data/Finitary.hs +44/−21

@@ -1,5 +1,9 @@ # Revision history for finitary
 
+## 2.1.1.0 -- 2021-02-11
+
+* Work around a bug in `fromIntegral :: Natural -> Integer` in GHC 9.0 (GHC issue #19345).
+
 ## 2.1.0.1 -- 2021-02-09
 
 * Fix incorrect instance for `Finite a => Finite ( Down a )`

@@ -1,6 +1,6 @@ cabal-version:      2.2
 name:               finitary
-version:            2.1.0.1
+version:            2.1.1.0
 synopsis:           A better, more type-safe Enum.
 description:
   Provides a type class witnessing that a type has
@@ -27,12 +27,12 @@ flag bitvec
   description: Include 'bitvec' instances
   default: True
-  manual: False
+  manual: True
 
 flag vector
-  description: Include 'vector' instances
+  description: Include 'vector-sized' instances
   default: True
-  manual: False
+  manual: True
 
 source-repository head
   type:     git
@@ -47,7 +47,6 @@     , ghc-typelits-knownnat      ^>=0.7.2
     , ghc-typelits-natnormalise  ^>=0.7.2
     , template-haskell           >=2.14.0.0 && <3.0.0.0
-    , typelits-witnesses         ^>=0.4.0.0
 
   if flag(bitvec)
     cpp-options:
@@ -61,6 +60,7 @@       , primitive                ^>=0.7.0.1
       , vector                   ^>=0.12.1.2
       , vector-sized             ^>=1.4.1.0
+      , typelits-witnesses       ^>=0.4.0.0
 
   hs-source-dirs:   src
   ghc-options:

@@ -5,6 +5,7 @@ {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MagicHash #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE Trustworthy #-}
@@ -92,18 +93,9 @@   )
 where
 
+-- base
 import Control.Applicative (Alternative (..), Const)
-import Control.Monad (join)
-import Data.Bifunctor (bimap, first)
 import Data.Bool (bool)
-import Data.Finitary.TH
-import Data.Finite
-  ( Finite,
-    finites,
-    separateSum,
-    shiftN,
-    weakenN,
-  )
 import Data.Functor.Identity (Identity)
 import Data.Int (Int16, Int32, Int64, Int8)
 import Data.Kind (Type)
@@ -114,6 +106,7 @@ import Data.Semigroup (All, Any, Dual, First, Last, Max, Min, Product, Sum)
 import Data.Void (Void)
 import Data.Word (Word16, Word32, Word64, Word8)
+import GHC.Exts (proxy#)
 import GHC.Generics
   ( (:*:) (..),
     (:+:) (..),
@@ -126,26 +119,49 @@     from,
     to,
   )
-
 import GHC.TypeNats
-import Numeric.Natural (Natural)
 
+-- finitary
+import Data.Finitary.TH
+
+-- finite-typelits
+import Data.Finite
+  ( finites
+  , separateSum
+  , shiftN
+  , weakenN
+  )
+import Data.Finite.Internal
+  ( Finite(..) )
+
 #ifdef BITVEC
+-- bitvec
 import qualified Data.Bit as B
 import qualified Data.Bit.ThreadSafe as BTS
 #endif
 
 #ifdef VECTOR
+-- base
 import Control.Monad (forM_)
 import Control.Monad.Primitive (PrimMonad (..))
 import Control.Monad.ST (ST, runST)
+import Data.Type.Equality ((:~:) (..))
+import Foreign.Storable (Storable)
+
+-- finite-typelits
 import Data.Finite
   ( combineProduct,
     separateProduct,
   )
-import Data.Type.Equality ((:~:) (..))
+
+-- typelits-witnesses
+import GHC.TypeLits.Compare (isLE)
+
+-- vector
 import qualified Data.Vector.Generic as VG
 import qualified Data.Vector.Generic.Mutable as VGM
+
+-- vector-sized
 import qualified Data.Vector.Generic.Mutable.Sized as VGMS
 import qualified Data.Vector.Generic.Sized as VGS
 import qualified Data.Vector.Mutable.Sized as VMS
@@ -154,10 +170,10 @@ import qualified Data.Vector.Storable.Sized as VSS
 import qualified Data.Vector.Unboxed.Mutable.Sized as VUMS
 import qualified Data.Vector.Unboxed.Sized as VUS
-import Foreign.Storable (Storable)
-import GHC.TypeLits.Compare (isLE)
 #endif
 
+--------------------------------------------------------------------------------
+
 -- | Witnesses an isomorphism between @a@ and some @(KnownNat n) => Finite n@.
 -- Effectively, a lawful instance of this shows that @a@ has exactly @n@
 -- (non-@_|_@) inhabitants, and that we have a bijection with 'fromFinite' and
@@ -677,13 +693,20 @@ 
 -- Helpers
 
-{-# INLINE combineProduct' #-}
-combineProduct' :: forall n m. (KnownNat n, KnownNat m) => (Finite n, Finite m) -> Finite (n * m)
-combineProduct' = fromIntegral . uncurry (+) . first ((natVal $ Proxy @m) *) . bimap @_ @_ @Natural @_ @Natural fromIntegral fromIntegral
+{-# INLINABLE combineProduct' #-}
+combineProduct' :: forall n m. (KnownNat m) => (Finite n, Finite m) -> Finite (n * m)
+combineProduct' ( Finite i, Finite j ) = Finite ( i * m + j )
+  where
+    m :: Integer
+    m = toInteger ( natVal' @m proxy# )
 
-{-# INLINE separateProduct' #-}
-separateProduct' :: forall n m. (KnownNat n, KnownNat m) => Finite (n * m) -> (Finite n, Finite m)
-separateProduct' = bimap (fromIntegral . (\x -> fromIntegral x `div` natVal @m Proxy)) (fromIntegral . (\x -> fromIntegral x `mod` natVal @m Proxy)) . join (,)
+{-# INLINABLE separateProduct' #-}
+separateProduct' :: forall n m. (KnownNat m) => Finite (n * m) -> (Finite n, Finite m)
+separateProduct' ( Finite a ) = ( Finite q, Finite r )
+  where
+    m, q, r :: Integer
+    m = toInteger ( natVal' @m proxy# )
+    ( q, r ) = a `quotRem` m
 
 {-# INLINE inc #-}
 inc :: (Num a) => a -> a