diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +0.1.2 +----- + +- Mark modules as explicitly Safe or Unsafe +- Bump lower bounds +- Drop dependency on base-compat +- More efficient conversion to DList + 0.1.1 ----- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,29 +5,36 @@ This is a fork of a [`dlist`](http://hackage.haskell.org/package/dlist) package. ``` -benchmarking append 1000/List -time 27.66 ms (27.30 ms .. 28.01 ms) - 0.999 R² (0.999 R² .. 1.000 R²) -mean 28.39 ms (28.21 ms .. 28.58 ms) -std dev 391.5 μs (311.7 μs .. 510.3 μs) +benchmarking right-append/List +time 13.63 ms (13.36 ms .. 14.04 ms) + 0.997 R² (0.994 R² .. 0.999 R²) +mean 13.60 ms (13.49 ms .. 13.76 ms) +std dev 332.4 μs (240.8 μs .. 409.5 μs) -benchmarking append 1000/NonEmpty -time 33.67 ms (33.01 ms .. 34.27 ms) - 0.999 R² (0.999 R² .. 1.000 R²) -mean 34.07 ms (33.90 ms .. 34.29 ms) -std dev 419.3 μs (308.9 μs .. 549.3 μs) +benchmarking right-append/NonEmpty +time 31.87 ms (25.83 ms .. 35.97 ms) + 0.927 R² (0.890 R² .. 0.969 R²) +mean 23.76 ms (21.98 ms .. 26.23 ms) +std dev 4.648 ms (3.053 ms .. 5.538 ms) +variance introduced by outliers: 78% (severely inflated) -benchmarking append 1000/DList -time 57.46 μs (56.95 μs .. 58.12 μs) - 0.999 R² (0.998 R² .. 0.999 R²) -mean 57.98 μs (57.61 μs .. 58.41 μs) -std dev 1.398 μs (1.115 μs .. 1.871 μs) -variance introduced by outliers: 22% (moderately inflated) +benchmarking right-append/DList +time 38.18 μs (38.09 μs .. 38.32 μs) + 1.000 R² (0.999 R² .. 1.000 R²) +mean 38.18 μs (38.03 μs .. 38.46 μs) +std dev 667.8 ns (325.0 ns .. 1.164 μs) +variance introduced by outliers: 13% (moderately inflated) -benchmarking append 1000/NonEmptyDList -time 90.37 μs (89.09 μs .. 91.44 μs) - 0.999 R² (0.998 R² .. 0.999 R²) -mean 89.31 μs (88.61 μs .. 89.96 μs) -std dev 2.244 μs (1.763 μs .. 2.988 μs) +benchmarking right-append/NonEmptyDList +time 33.58 μs (33.30 μs .. 33.89 μs) + 0.999 R² (0.999 R² .. 1.000 R²) +mean 33.86 μs (33.67 μs .. 34.14 μs) +std dev 801.9 ns (616.6 ns .. 1.240 μs) variance introduced by outliers: 22% (moderately inflated) + +benchmarking right-append/DNonEmpty +time 79.79 μs (79.60 μs .. 80.10 μs) + 1.000 R² (1.000 R² .. 1.000 R²) +mean 80.52 μs (80.23 μs .. 80.92 μs) +std dev 1.162 μs (757.0 ns .. 1.795 μs) ``` diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,29 +1,78 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 800 && MIN_VERSION_dlist(1,0,0) +#define DNONEMPTY 1 +#endif + +module Main (main) where + import Criterion.Main import Prelude () import Prelude.Compat -import Data.List (foldl') -import Data.Foldable (toList) -import Data.Semigroup (Semigroup (..)) import Data.DList.Instances () +import Data.Foldable (toList) +import Data.List (foldl') +import Data.Semigroup (Semigroup (..)) -import qualified Data.List.NonEmpty as NE -import qualified Data.DList as DList +import qualified Data.DList as DList import qualified Data.DList.NonEmpty as NEDList +import qualified Data.List.NonEmpty as NE -sum' :: (Semigroup (f Int), Foldable f) => Int -> f Int -> Int -sum' m x = foldl' (+) 0 $ toList $ go x m +#ifdef DNONEMPTY +import qualified Data.DList.DNonEmpty as DNonEmpty +#endif + +sumRight :: (Semigroup (f Int), Foldable f) => Int -> f Int -> Int +sumRight m x = foldl' (+) 0 $ toList $ go x m where go y n | n <= 0 = y | otherwise = go (y <> x) (n - 1) +sumLeft :: (Semigroup (f Int), Foldable f) => Int -> f Int -> Int +sumLeft m x = foldl' (+) 0 $ toList $ go x m + where + go y n | n <= 0 = y + | otherwise = go (x <> y) (n - 1) + +sumTree :: (Semigroup (f Int), Foldable f) => Int -> f Int -> Int +sumTree m x = foldl' (+) 0 $ toList $ go m + where + go n | n <= 0 = x + | otherwise = let y = go (n - 1) in y <> y + main :: IO () main = defaultMain - [ bgroup "append 1000" - [ bench "List" $ whnf (sum' 1000) $ [1,2,3,4,5] - , bench "NonEmpty" $ whnf (sum' 1000) $ 1 NE.:| [2,3,4,5] - , bench "DList" $ whnf (sum' 1000) $ DList.fromList [1,2,3,4,5] - , bench "NonEmptyDList" $ whnf (sum' 1000) $ NEDList.fromNonEmpty $ 1 NE.:| [2,3,4,5] + -- left append is fast + [ bgroup "left-append" + [ bench "List" $ whnf (sumLeft 1024) $ [1,2,3,4,5] + , bench "NonEmpty" $ whnf (sumLeft 1024) $ 1 NE.:| [2,3,4,5] + , bench "DList" $ whnf (sumLeft 1024) $ DList.fromList [1,2,3,4,5] + , bench "NonEmptyDList" $ whnf (sumLeft 1024) $ NEDList.fromNonEmpty $ 1 NE.:| [2,3,4,5] +#ifdef DNONEMPTY + , bench "DNonEmpty" $ whnf (sumLeft 1024) $ DNonEmpty.fromNonEmpty $ 1 NE.:| [2,3,4,5] +#endif + ] + + -- naive right append is quadratic for list + , bgroup "right-append" + [ bench "List" $ whnf (sumRight 1024) $ [1,2,3,4,5] + , bench "NonEmpty" $ whnf (sumRight 1024) $ 1 NE.:| [2,3,4,5] + , bench "DList" $ whnf (sumRight 1024) $ DList.fromList [1,2,3,4,5] + , bench "NonEmptyDList" $ whnf (sumRight 1024) $ NEDList.fromNonEmpty $ 1 NE.:| [2,3,4,5] +#ifdef DNONEMPTY + , bench "DNonEmpty" $ whnf (sumRight 1024) $ DNonEmpty.fromNonEmpty $ 1 NE.:| [2,3,4,5] +#endif + ] + + -- not sure what to expect + , bgroup "tree" + [ bench "List" $ whnf (sumTree 10) $ [1,2,3,4,5] + , bench "NonEmpty" $ whnf (sumTree 10) $ 1 NE.:| [2,3,4,5] + , bench "DList" $ whnf (sumTree 10) $ DList.fromList [1,2,3,4,5] + , bench "NonEmptyDList" $ whnf (sumTree 10) $ NEDList.fromNonEmpty $ 1 NE.:| [2,3,4,5] +#ifdef DNONEMPTY + , bench "DNonEmpty" $ whnf (sumTree 10) $ DNonEmpty.fromNonEmpty $ 1 NE.:| [2,3,4,5] +#endif ] ] diff --git a/dlist-nonempty.cabal b/dlist-nonempty.cabal --- a/dlist-nonempty.cabal +++ b/dlist-nonempty.cabal @@ -1,6 +1,6 @@ -name: dlist-nonempty -version: 0.1.1 -synopsis: Non-empty difference lists +name: dlist-nonempty +version: 0.1.2 +synopsis: Non-empty difference lists description: Difference lists are a list-like type supporting O(1) append. This is particularly useful for efficient logging and pretty printing (e.g. with the @@ -10,75 +10,106 @@ > NonEmptyDList a ≅ [a] -> NonEmpty a . For empty variant, @DList@, see . -category: Data -license: BSD3 -license-file: LICENSE -author: Don Stewart, Oleg Grenrus -maintainer: Oleg Grenrus -copyright: 2006-2009 Don Stewart, 2013-2016 Sean Leather, 2017 Oleg Grenrus -homepage: https://github.com/phadej/dlist-nonempty -bug-reports: https://github.com/phadej/dlist-nonempty/issues -extra-source-files: README.md CHANGELOG.md -build-type: Simple -cabal-version: >=1.10 + +category: Data +license: BSD3 +license-file: LICENSE +author: Don Stewart, Oleg Grenrus +maintainer: Oleg Grenrus +copyright: + 2006-2009 Don Stewart, 2013-2016 Sean Leather, 2017 Oleg Grenrus + +homepage: https://github.com/phadej/dlist-nonempty +bug-reports: https://github.com/phadej/dlist-nonempty/issues +extra-source-files: + CHANGELOG.md + README.md + +build-type: Simple +cabal-version: >=1.10 tested-with: - GHC==7.4.2, - GHC==7.6.3, - GHC==7.8.4, - GHC==7.10.3, - GHC==8.0.2, - GHC==8.2.1 + GHC ==7.4.2 + || ==7.6.3 + || ==7.8.4 + || ==7.10.3 + || ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.5 + || ==8.8.4 + || ==8.10.7 + || ==9.0.2 + || ==9.2.5 + || ==9.4.4 source-repository head - type: git - location: git://github.com/phadej/dlist-nonempty.git + type: git + location: git://github.com/phadej/dlist-nonempty.git +flag semigroupoids + description: Build with semigroupoids dependency + manual: True + default: True + library - default-language: Haskell2010 - hs-source-dirs: src + default-language: Haskell2010 + hs-source-dirs: src build-depends: - base >=4.5 && <4.11, - base-compat >=0.9.1 && <0.10, - deepseq >=1.1 && <2, - dlist >=0.8 && <0.9, - semigroupoids >=5.1 && <5.3 - if !impl(ghc >= 8.0) - build-depends: - semigroups >=0.18.2 && <0.19 - other-extensions: CPP - exposed-modules: Data.DList.NonEmpty - Data.DList.NonEmpty.Unsafe - other-modules: Data.DList.NonEmpty.Internal - ghc-options: -Wall - if impl(ghc >= 8.0) - ghc-options: -Wcompat + base >=4.5 && <4.18 + , deepseq >=1.3 && <1.5 + , dlist >=1.0 && <1.1 + if flag(semigroupoids) + build-depends: semigroupoids >=5.1 && <5.4 + + if !impl(ghc >=8.0) + build-depends: semigroups >=0.18.2 && <0.21 + + other-extensions: CPP + exposed-modules: + Data.DList.NonEmpty + Data.DList.NonEmpty.Unsafe + + other-modules: + Data.DList.NonEmpty.Internal + DListUnsafe + + if impl(ghc >=7.8) + other-modules: GhcIsList + + ghc-options: -Wall + + if impl(ghc >=8.0) + ghc-options: -Wcompat + test-suite test - default-language: Haskell2010 - type: exitcode-stdio-1.0 - main-is: Main.hs - hs-source-dirs: tests - other-modules: OverloadedStrings - build-depends: dlist-nonempty, - base, - Cabal, - QuickCheck >= 2.9 && < 2.11, - quickcheck-instances - if !impl(ghc >= 8.0) - build-depends: - semigroups >=0.18.2 && <0.19 + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: tests + other-modules: OverloadedStrings + build-depends: + base + , Cabal + , dlist-nonempty + , QuickCheck >=2.9 && <2.15 + , quickcheck-instances + if !impl(ghc >=8.0) + build-depends: semigroups + benchmark bench - default-language: Haskell2010 - type: exitcode-stdio-1.0 - main-is: Main.hs - hs-source-dirs: bench - build-depends: base, - base-compat, - dlist, - dlist-nonempty, - dlist-instances, - criterion >= 1.1.4.0 && <1.3 - if !impl(ghc >= 8.0) - build-depends: - semigroups >=0.18.2 && <0.19 + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: bench + build-depends: + base + , base-compat + , criterion >=1.1.4.0 && <1.7 + , dlist + , dlist-instances + , dlist-nonempty + + if !impl(ghc >=8.0) + build-depends: semigroups diff --git a/src/DListUnsafe.hs b/src/DListUnsafe.hs new file mode 100644 --- /dev/null +++ b/src/DListUnsafe.hs @@ -0,0 +1,5 @@ +{-# LANGUAGE Trustworthy #-} +-- We export DList implementation from Trustworthy module +-- so the Internal module can stay Safe. +module DListUnsafe (DList (..)) where +import Data.DList.Unsafe(DList (UnsafeDList, unsafeApplyDList)) diff --git a/src/Data/DList/NonEmpty.hs b/src/Data/DList/NonEmpty.hs --- a/src/Data/DList/NonEmpty.hs +++ b/src/Data/DList/NonEmpty.hs @@ -1,7 +1,8 @@ {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE PatternSynonyms, ViewPatterns #-} +{-# LANGUAGE PatternSynonyms #-} #endif +{-# LANGUAGE Safe #-} -- | Non-empty difference lists: a data structure for /O(1)/ append on non-empty lists. module Data.DList.NonEmpty diff --git a/src/Data/DList/NonEmpty/Internal.hs b/src/Data/DList/NonEmpty/Internal.hs --- a/src/Data/DList/NonEmpty/Internal.hs +++ b/src/Data/DList/NonEmpty/Internal.hs @@ -3,32 +3,35 @@ #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE PatternSynonyms, ViewPatterns #-} #endif +{-# LANGUAGE Safe #-} -- | Non-empty difference lists: a data structure for /O(1)/ append on non-empty lists. module Data.DList.NonEmpty.Internal where -import Prelude () -import Prelude.Compat hiding (concat, foldr, map, head, tail, replicate) +import Prelude (Eq (..), Ord (..), Read (..), Show (..), showParen, showString, Int, Maybe (..), Char, otherwise, (-), ($), (.), (++), Functor (..), Monad (..)) +import Control.Applicative (Applicative (..)) +import Data.Foldable (Foldable) +import Data.Traversable (Traversable (..)) import Control.DeepSeq (NFData (..)) -import Control.Monad +import Control.Monad (ap) import Data.Function (on) import Data.List.NonEmpty (NonEmpty (..)) -import Data.Monoid (Endo (..)) +import Data.Monoid (Endo (..), mconcat) import Data.Semigroup (Semigroup(..)) import Data.String (IsString(..)) import qualified Data.List as List import qualified Data.List.NonEmpty as NE import qualified Data.Foldable as F -import qualified Data.DList as DList --- semigroupoids +#ifdef MIN_VERSION_semigroupoids import Data.Functor.Apply (Apply (..)) import Data.Functor.Bind (Bind (..)) import Data.Functor.Alt (Alt (..)) import qualified Data.Semigroup.Foldable as SF import qualified Data.Semigroup.Traversable as ST +#endif #ifdef __GLASGOW_HASKELL__ @@ -36,13 +39,16 @@ readListPrecDefault) #if __GLASGOW_HASKELL__ >= 708 -import GHC.Exts (IsList) -- This is for the IsList methods, which conflict with fromList, toList: -import qualified GHC.Exts +import GhcIsList (IsList) +import qualified GhcIsList #endif #endif +-- This interface can be used wrong. +import DListUnsafe (DList(UnsafeDList)) + -- | A difference list is a function that, given a list, returns the original -- contents of the difference list prepended to the given list. -- @@ -56,7 +62,7 @@ -- | Convert a dlist to a non-empty list toNonEmpty :: NonEmptyDList a -> NonEmpty a -toNonEmpty = ($[]) . unNEDL +toNonEmpty = ($ []) . unNEDL {-# INLINE toNonEmpty #-} -- | Convert a dlist to a list @@ -67,17 +73,19 @@ -- | Convert to 'DList'. -- -- /Note:/ @dlist@ doesn't expose internals, so this have to go through list. -toDList :: NonEmptyDList a -> DList.DList a -toDList = DList.fromList . toList +toDList :: NonEmptyDList a -> DList a +toDList = UnsafeDList . toEndo' {-# INLINE toDList #-} -- | Convert to representation of 'DList'. toEndo :: NonEmptyDList a -> Endo [a] -toEndo ne = Endo (NE.toList . unNEDL ne) +toEndo = Endo . toEndo' +{-# INLINE toEndo #-} -- | Convert to representation of 'DList'. toEndo' :: NonEmptyDList a -> [a] -> [a] toEndo' = appEndo . toEndo +{-# INLINE toEndo' #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708 -- | A unidirectional pattern synonym using 'toList' in a view pattern and @@ -254,6 +262,7 @@ -- semigroupoids ------------------------------------------------------------------------------- +#ifdef MIN_VERSION_semigroupoids instance Apply NonEmptyDList where (<.>) = (<*>) instance Bind NonEmptyDList where (>>-) = (>>=) @@ -269,3 +278,4 @@ instance Alt NonEmptyDList where () = append +#endif diff --git a/src/Data/DList/NonEmpty/Unsafe.hs b/src/Data/DList/NonEmpty/Unsafe.hs --- a/src/Data/DList/NonEmpty/Unsafe.hs +++ b/src/Data/DList/NonEmpty/Unsafe.hs @@ -6,6 +6,7 @@ -- >>> nedl <> nedl -- fromNonEmpty (1 :| [2]) -- +{-# LANGUAGE Unsafe #-} module Data.DList.NonEmpty.Unsafe (NonEmptyDList (..)) where import Data.DList.NonEmpty.Internal diff --git a/src/GhcIsList.hs b/src/GhcIsList.hs new file mode 100644 --- /dev/null +++ b/src/GhcIsList.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} +#if MIN_VERSION_base(4,17,0) +{-# LANGUAGE Safe #-} +#else +{-# LANGUAGE Trustworthy #-} +#endif +module GhcIsList ( + IsList (..), +) where + +#if MIN_VERSION_base(4,17,0) +import GHC.IsList (IsList (..)) +#else +import GHC.Exts (IsList (..)) +#endif