Skip to content

Commit

Permalink
Use GHC2024 and GHC2021 extensions
Browse files Browse the repository at this point in the history
  • Loading branch information
harendra-kumar committed Feb 21, 2025
1 parent 99d0790 commit 4eb198d
Show file tree
Hide file tree
Showing 21 changed files with 194 additions and 69 deletions.
6 changes: 6 additions & 0 deletions benchmark/Streamly/Benchmark/Data/Array.hs
Original file line number Diff line number Diff line change
Expand Up @@ -5,13 +5,19 @@
#include "Streamly/Benchmark/Data/Array/CommonImports.hs"

import Control.DeepSeq (deepseq)
#if __GLASGOW_HASKELL__ >= 810
import Data.Kind (Type)
#endif

import qualified Streamly.Internal.Data.Array as IA
import qualified GHC.Exts as GHC

-- import qualified Streamly.Data.Array as A
import qualified Streamly.Internal.Data.Array as A

#if __GLASGOW_HASKELL__ >= 810
type Stream :: Type -> Type
#endif
type Stream = A.Array

#include "Streamly/Benchmark/Data/Array/Common.hs"
Expand Down
6 changes: 6 additions & 0 deletions benchmark/Streamly/Benchmark/Data/MutArray.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,9 @@
import Control.DeepSeq (NFData(..))
import Control.Monad.IO.Class (MonadIO)
import Data.Functor ((<&>))
#if __GLASGOW_HASKELL__ >= 810
import Data.Kind (Type)
#endif
import System.Random (randomRIO)
import Prelude
( IO
Expand Down Expand Up @@ -52,6 +55,9 @@ import qualified Streamly.Internal.Data.Stream as Stream
import Test.Tasty.Bench
import Streamly.Benchmark.Common hiding (benchPureSrc)

#if __GLASGOW_HASKELL__ >= 810
type Stream :: Type -> Type
#endif
type Stream = MutArray

instance NFData (MutArray a) where
Expand Down
42 changes: 25 additions & 17 deletions benchmark/streamly-benchmarks.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -69,10 +69,23 @@ flag use-prelude
-------------------------------------------------------------------------------

common default-extensions
default-language: Haskell2010

-- GHC2024 may include more extensions than we are actually using, see the
-- full list below. We enable this to ensure that we are able to compile
-- with this i.e. there is no interference by other extensions.
if impl(ghc >= 9.10)
default-language: GHC2024

if impl(ghc >= 9.2) && impl(ghc < 9.10)
default-language: GHC2021

if impl(ghc >= 8.10)
default-extensions: StandaloneKindSignatures

-- In GHC 2024
default-extensions:
BangPatterns
CApiFFI
CPP
ConstraintKinds
DeriveDataTypeable
DeriveGeneric
Expand All @@ -84,29 +97,20 @@ common default-extensions
InstanceSigs
KindSignatures
LambdaCase
MagicHash
MultiParamTypeClasses
PatternSynonyms
RankNTypes
RecordWildCards
ScopedTypeVariables
TupleSections
TypeApplications
TypeFamilies
TypeOperators
ViewPatterns

-- MonoLocalBinds, enabled by TypeFamilies, causes performance
-- regressions. Disable it. This must come after TypeFamilies,
-- otherwise TypeFamilies will enable it again.
NoMonoLocalBinds

-- UndecidableInstances -- Does not show any perf impact
-- UnboxedTuples -- interferes with (#.)
-- Not in GHC2024
CPP
MagicHash
RecordWildCards

common compile-options
import: default-extensions
default-language: Haskell2010

if flag(use-streamly-core)
cpp-options: -DUSE_STREAMLY_CORE
Expand Down Expand Up @@ -229,7 +233,7 @@ library
common bench-options
import: compile-options, optimization-options, bench-depends
include-dirs: .
ghc-options: -rtsopts
ghc-options: -rtsopts -with-rtsopts "-t"
if flag(limit-build-mem)
ghc-options: +RTS -M512M -RTS
build-depends: streamly-benchmarks == 0.0.0
Expand All @@ -239,7 +243,7 @@ common bench-options-threaded
import: compile-options, optimization-options, bench-depends
-- -threaded and -N2 is important because some GC and space leak issues
-- trigger only with these options.
ghc-options: -threaded -rtsopts -with-rtsopts "-N2"
ghc-options: -threaded -rtsopts -with-rtsopts "-t -N2"
if flag(limit-build-mem)
ghc-options: +RTS -M512M -RTS
build-depends: streamly-benchmarks == 0.0.0
Expand Down Expand Up @@ -313,6 +317,10 @@ benchmark Data.Fold.Window
type: exitcode-stdio-1.0
hs-source-dirs: Streamly/Benchmark/Data/Fold
main-is: Window.hs
-- MonoLocalBinds increases the memory requirement from 400MB to 1000MB,
-- observed on macOS.
if flag(limit-build-mem)
ghc-options: +RTS -M1000M -RTS

benchmark Data.MutArray
import: bench-options
Expand Down
6 changes: 6 additions & 0 deletions core/src/Streamly/Internal/Data/IORef.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,6 +39,9 @@ where
#include "inline.hs"

import Control.Monad.IO.Class (MonadIO(..))
#if __GLASGOW_HASKELL__ >= 810
import Data.Kind (Type)
#endif
import Data.Proxy (Proxy(..))
import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)
import Streamly.Internal.Data.Unbox (Unbox(..), sizeOf)
Expand All @@ -47,6 +50,9 @@ import qualified Streamly.Internal.Data.MutByteArray.Type as MBA
import qualified Streamly.Internal.Data.Stream.Type as D

-- | An 'IORef' holds a single 'Unbox'-able value.
#if __GLASGOW_HASKELL__ >= 810
type IORef :: Type -> Type
#endif
newtype IORef a = IORef MutByteArray

-- | Create a new 'IORef'.
Expand Down
1 change: 1 addition & 0 deletions core/src/Streamly/Internal/Data/Parser.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoMonoLocalBinds #-}
-- |
-- Module : Streamly.Internal.Data.Parser
-- Copyright : (c) 2020 Composewell Technologies
Expand Down
1 change: 1 addition & 0 deletions core/src/Streamly/Internal/Data/Parser/Type.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE NoMonoLocalBinds #-}
-- |
-- Module : Streamly.Internal.Data.Parser.ParserD.Type
-- Copyright : (c) 2020 Composewell Technologies
Expand Down
9 changes: 9 additions & 0 deletions core/src/Streamly/Internal/Data/Pipe/Type.hs
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,9 @@ where
-- import Control.Arrow (Arrow(..))
import Control.Category (Category(..))
import Data.Functor ((<&>))
#if __GLASGOW_HASKELL__ >= 810
import Data.Kind (Type)
#endif
import Fusion.Plugin.Types (Fuse(..))
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Scanr (Scanr(..))
Expand Down Expand Up @@ -146,6 +149,9 @@ instance Functor m => Functor (Pipe m a) where
-------------------------------------------------------------------------------

{-# ANN type ComposeConsume Fuse #-}
#if __GLASGOW_HASKELL__ >= 810
type ComposeConsume :: Type -> Type -> Type -> Type
#endif
data ComposeConsume csL psL csR =
ComposeConsume csL csR

Expand Down Expand Up @@ -614,6 +620,9 @@ filter f = filterM (return Prelude.. f)
-- that.

{-# ANN type FromFoldConsume Fuse #-}
#if __GLASGOW_HASKELL__ >= 810
type FromFoldConsume :: Type -> Type -> Type
#endif
data FromFoldConsume s x = FoldConsumeInit | FoldConsumeGo s

{-# ANN type FromFoldProduce Fuse #-}
Expand Down
9 changes: 9 additions & 0 deletions core/src/Streamly/Internal/Data/Stream/Type.hs
Original file line number Diff line number Diff line change
Expand Up @@ -172,6 +172,9 @@ import Control.Monad.IO.Class (MonadIO(..))
import Data.Foldable (Foldable(foldl'), fold, foldr)
import Data.Functor (($>))
import Data.Functor.Identity (Identity(..))
#if __GLASGOW_HASKELL__ >= 810
import Data.Kind (Type)
#endif
import Data.Maybe (fromMaybe)
import Data.Semigroup (Endo(..))
import Fusion.Plugin.Types (Fuse(..))
Expand Down Expand Up @@ -1837,6 +1840,9 @@ foldIterateBfs = undefined

-- s = stream state, fs = fold state
{-# ANN type FoldManyPost Fuse #-}
#if __GLASGOW_HASKELL__ >= 810
type FoldManyPost :: Type -> Type -> Type -> Type -> Type
#endif
data FoldManyPost s fs b a
= FoldManyPostStart s
| FoldManyPostLoop s fs
Expand Down Expand Up @@ -1918,6 +1924,9 @@ foldManySepBy :: -- Monad m =>
foldManySepBy _f1 _f2 = undefined

{-# ANN type FoldMany Fuse #-}
#if __GLASGOW_HASKELL__ >= 810
type FoldMany :: Type -> Type -> Type -> Type -> Type
#endif
data FoldMany s fs b a
= FoldManyStart s
| FoldManyFirst fs s
Expand Down
9 changes: 9 additions & 0 deletions core/src/Streamly/Internal/Data/StreamK/Type.hs
Original file line number Diff line number Diff line change
Expand Up @@ -164,6 +164,9 @@ import Control.Monad.IO.Class (MonadIO(..))
import Data.Foldable (Foldable(foldl'), fold, foldr)
import Data.Function (fix)
import Data.Functor.Identity (Identity(..))
#if __GLASGOW_HASKELL__ >= 810
import Data.Kind (Type)
#endif
import Data.Maybe (fromMaybe)
import Data.Semigroup (Endo(..))
import GHC.Exts (IsList(..), IsString(..), oneShot)
Expand Down Expand Up @@ -233,12 +236,18 @@ mkStream
mkStream = MkStream

-- | A terminal function that has no continuation to follow.
#if __GLASGOW_HASKELL__ >= 810
type StopK :: (Type -> Type) -> Type
#endif
type StopK m = forall r. m r -> m r

-- | A monadic continuation, it is a function that yields a value of type "a"
-- and calls the argument (a -> m r) as a continuation with that value. We can
-- also think of it as a callback with a handler (a -> m r). Category
-- theorists call it a codensity type, a special type of right kan extension.
#if __GLASGOW_HASKELL__ >= 810
type YieldK :: (Type -> Type) -> Type -> Type
#endif
type YieldK m a = forall r. (a -> m r) -> m r

_wrapM :: Monad m => m a -> YieldK m a
Expand Down
13 changes: 7 additions & 6 deletions core/src/Streamly/Internal/FileSystem/File.hs
Original file line number Diff line number Diff line change
Expand Up @@ -95,6 +95,7 @@ where

import Control.Monad.Catch (MonadCatch)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Kind (Type)
import Data.Word (Word8)
import System.IO (Handle, openFile, IOMode(..), hClose)
import Prelude hiding (read)
Expand Down Expand Up @@ -204,15 +205,15 @@ usingFile3 = UF.bracketIO before after
-- /Pre-release/
--
{-# INLINABLE putChunk #-}
putChunk :: FilePath -> Array a -> IO ()
putChunk :: forall (a :: Type). FilePath -> Array a -> IO ()
putChunk file arr = SIO.withFile file WriteMode (`FH.putChunk` arr)

-- | append an array to a file.
--
-- /Pre-release/
--
{-# INLINABLE writeAppendArray #-}
writeAppendArray :: FilePath -> Array a -> IO ()
writeAppendArray :: forall (a :: Type). FilePath -> Array a -> IO ()
writeAppendArray file arr = SIO.withFile file AppendMode (`FH.putChunk` arr)

-------------------------------------------------------------------------------
Expand Down Expand Up @@ -369,7 +370,7 @@ readShared = undefined
-------------------------------------------------------------------------------

{-# INLINE fromChunksMode #-}
fromChunksMode :: (MonadIO m, MonadCatch m)
fromChunksMode :: forall m (a :: Type). (MonadIO m, MonadCatch m)
=> IOMode -> FilePath -> Stream m (Array a) -> m ()
fromChunksMode mode file xs = S.fold drain $
withFile file mode (\h -> S.mapM (FH.putChunk h) xs)
Expand All @@ -379,7 +380,7 @@ fromChunksMode mode file xs = S.fold drain $
-- /Pre-release/
--
{-# INLINE fromChunks #-}
fromChunks :: (MonadIO m, MonadCatch m)
fromChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m)
=> FilePath -> Stream m (Array a) -> m ()
fromChunks = fromChunksMode WriteMode

Expand Down Expand Up @@ -431,7 +432,7 @@ write = toHandleWith A.defaultChunkSize
--
-- /Pre-release/
{-# INLINE writeChunks #-}
writeChunks :: (MonadIO m, MonadCatch m)
writeChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m)
=> FilePath -> Fold m (Array a) ()
writeChunks path = Fold step initial extract final
where
Expand Down Expand Up @@ -487,7 +488,7 @@ write = writeWith defaultChunkSize
-- /Pre-release/
--
{-# INLINE writeAppendChunks #-}
writeAppendChunks :: (MonadIO m, MonadCatch m)
writeAppendChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m)
=> FilePath -> Stream m (Array a) -> m ()
writeAppendChunks = fromChunksMode AppendMode

Expand Down
10 changes: 6 additions & 4 deletions core/src/Streamly/Internal/FileSystem/Handle.hs
Original file line number Diff line number Diff line change
Expand Up @@ -121,6 +121,7 @@ where
import Control.Exception (assert)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Function ((&))
import Data.Kind (Type)
import Data.Maybe (isNothing, fromJust)
import Data.Word (Word8)
import Streamly.Internal.Data.Unbox (Unbox)
Expand Down Expand Up @@ -373,7 +374,7 @@ read = A.concat . readChunks
-- | Write an 'Array' to a file handle.
--
{-# INLINABLE putChunk #-}
putChunk :: MonadIO m => Handle -> Array a -> m ()
putChunk :: forall m (a :: Type). MonadIO m => Handle -> Array a -> m ()
putChunk _ arr | byteLength arr == 0 = return ()
putChunk h arr = A.unsafePinnedAsPtr arr $ \ptr byteLen ->
liftIO $ hPutBuf h ptr byteLen
Expand All @@ -392,7 +393,8 @@ putChunk h arr = A.unsafePinnedAsPtr arr $ \ptr byteLen ->
-- >>> putChunks h = Stream.fold (Fold.drainBy (Handle.putChunk h))
--
{-# INLINE putChunks #-}
putChunks :: MonadIO m => Handle -> Stream m (Array a) -> m ()
putChunks :: forall m (a :: Type). MonadIO m =>
Handle -> Stream m (Array a) -> m ()
putChunks h = S.fold (FL.drainMapM (putChunk h))

-- XXX AS.compact can be written idiomatically in terms of foldMany, just like
Expand Down Expand Up @@ -437,14 +439,14 @@ putBytes = putBytesWith defaultChunkSize
-- writeChunks h = Fold.drainBy (Handle.putChunk h)
--
{-# INLINE writeChunks #-}
writeChunks :: MonadIO m => Handle -> Fold m (Array a) ()
writeChunks :: forall m (a :: Type). MonadIO m => Handle -> Fold m (Array a) ()
writeChunks h = FL.drainMapM (putChunk h)

-- | Like writeChunks but uses the experimental 'Refold' API.
--
-- /Internal/
{-# INLINE chunkWriter #-}
chunkWriter :: MonadIO m => Refold m Handle (Array a) ()
chunkWriter :: forall m (a :: Type). MonadIO m => Refold m Handle (Array a) ()
chunkWriter = Refold.drainBy putChunk

-- | @writeChunksWith bufsize handle@ writes a stream of arrays
Expand Down
Loading

0 comments on commit 4eb198d

Please sign in to comment.