Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Use GHC2024 and GHC2021 extensions #2994

Merged
merged 1 commit into from
Feb 21, 2025
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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 ()
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why is this important? Can we ignore this using -Wno-?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It is an error, not a warning.

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
Loading