diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,7 @@ +## 0.4 + +* Added `Natural`, `Integer` and `()` discrimination + ## 0.3 * Fixed a corner case where `conquer` would lie and return an empty equivalence class when fed no inputs. diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -4,7 +4,7 @@ [![Hackage](https://img.shields.io/hackage/v/discrimination.svg)](https://hackage.haskell.org/package/discrimination) [![Build Status](https://secure.travis-ci.org/ekmett/discrimination.png?branch=master)](http://travis-ci.org/ekmett/discrimination) This package provides linear time sorting, partitioning, and joins for a wide array of Haskell data types. This work is based on a -"final encoding" of the ideas presented in [multiple](http://www.diku.dk/hjemmesider/ansatte/henglein/papers/henglein2011a.pdf) [papers](http://www.diku.dk/hjemmesider/ansatte/henglein/papers/henglein2011c.pdf) and [talks](https://www.youtube.com/watch?v=sz9ZlZIRDAg) by [Fritz Henglein](http://www.diku.dk/hjemmesider/ansatte/henglein/). +"final encoding" of the ideas presented in [multiple](http://hjemmesider.diku.dk/~henglein/papers/henglein2011a.pdf) [papers](http://hjemmesider.diku.dk/~henglein/papers/henglein2011c.pdf) and [talks](https://www.youtube.com/watch?v=sz9ZlZIRDAg) by [Fritz Henglein](http://hjemmesider.diku.dk/~henglein). By adopting a final encoding we can enjoy many instances for standard classes, lawfully, without quotienting. diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/discrimination.cabal b/discrimination.cabal --- a/discrimination.cabal +++ b/discrimination.cabal @@ -1,6 +1,6 @@ name: discrimination category: Data, Sorting -version: 0.3 +version: 0.4 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE @@ -11,7 +11,7 @@ bug-reports: http://github.com/ekmett/discrimination/issues copyright: Copyright (C) 2014-2015 Edward A. Kmett build-type: Simple -tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1 +tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.2 synopsis: Fast generic linear-time sorting, joins and container construction. description: This package provides fast, generic, linear-time discrimination and sorting. @@ -45,12 +45,13 @@ build-depends: array >= 0.5 && < 0.6, base >= 4.8 && < 5, - containers >= 0.4 && < 0.6, + containers >= 0.4 && < 0.7, contravariant >= 1.3.1 && < 2, deepseq >= 1.3 && < 1.5, ghc-prim, hashable >= 1.2 && < 1.3, - primitive >= 0.6 && < 0.7, + integer-gmp, + primitive >= 0.6.4 && < 0.8, profunctors >= 5 && < 6, promises >= 0.2 && < 0.4, semigroups >= 0.16.2 && < 1, diff --git a/src/Data/Discrimination/Grouping.hs b/src/Data/Discrimination/Grouping.hs --- a/src/Data/Discrimination/Grouping.hs +++ b/src/Data/Discrimination/Grouping.hs @@ -12,6 +12,7 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE PartialTypeSignatures #-} {-# OPTIONS_GHC -fno-cse -fno-full-laziness #-} module Data.Discrimination.Grouping @@ -25,11 +26,13 @@ , runGroup -- * Internals , hashing + , word8s ) where import Control.Monad hiding (mapM_) import Control.Monad.Primitive import Control.Monad.ST +import Control.Monad.ST.Unsafe import Data.Complex import Data.Discrimination.Internal.WordMap as WordMap import Data.Foldable hiding (concat) @@ -41,12 +44,16 @@ import Data.Int import Data.Semigroup hiding (Any) import Data.Primitive.MutVar +import Data.Primitive.PrimArray import Data.Promise import Data.Proxy import Data.Ratio import Data.Typeable import Data.Void import Data.Word +import GHC.Integer.GMP.Internals +import GHC.Word +import Numeric.Natural import Prelude hiding (read, concat, mapM_) -- | Productive Stable Unordered Discriminator @@ -130,9 +137,8 @@ grouping = deciding (Proxy :: Proxy Grouping) grouping #endif -instance Grouping Void where - grouping = lose id - +instance Grouping Void where grouping = lose id +instance Grouping () where grouping = conquer instance Grouping Word8 where grouping = contramap fromIntegral groupingWord64 instance Grouping Word16 where grouping = contramap fromIntegral groupingWord64 instance Grouping Word32 where grouping = contramap fromIntegral groupingWord64 @@ -154,6 +160,17 @@ instance (Grouping a, Grouping b) => Grouping (Either a b) instance Grouping a => Grouping (Complex a) where grouping = divide (\(a :+ b) -> (a, b)) grouping grouping + +instance Grouping Integer where + grouping = contramap word8s grouping + +word8s :: Integer -> [Word8] +word8s i = runST $ unsafeIOToST $ do + p@(MutablePrimArray mba) :: MutablePrimArray RealWorld Word8 <- newPrimArray (fromIntegral $ W# (sizeInBaseInteger i 256#)) + _ <- exportIntegerToMutableByteArray i mba 0## 1# + primArrayToList <$> unsafeFreezePrimArray p + +instance Grouping Natural where grouping = contramap toInteger grouping #if __GLASGOW_HASKELL__ >= 800 instance Grouping a => Grouping (Ratio a) where diff --git a/src/Data/Discrimination/Sorting.hs b/src/Data/Discrimination/Sorting.hs --- a/src/Data/Discrimination/Sorting.hs +++ b/src/Data/Discrimination/Sorting.hs @@ -9,6 +9,7 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MonoLocalBinds #-} {-# OPTIONS_GHC -fno-cse -fno-full-laziness #-} module Data.Discrimination.Sorting ( Sort(..) @@ -56,6 +57,7 @@ import Data.Typeable import Data.Void import Data.Word +import Numeric.Natural import Prelude hiding (read, concat) -------------------------------------------------------------------------------- @@ -117,6 +119,15 @@ default sorting :: Deciding Sorting a => Sort a sorting = deciding (Proxy :: Proxy Sorting) sorting #endif + +instance Sorting () where + sorting = conquer + +instance Sorting Integer where + sorting = contramap word8s sorting + +instance Sorting Natural where + sorting = contramap toInteger sorting instance Sorting Word8 where sorting = contramap fromIntegral (sortingNat 256)