diff options
| author | Sylvain Henry <sylvain@haskus.fr> | 2020-08-09 17:21:06 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2020-08-13 21:09:15 -0400 |
| commit | 8a51b2ab7433c06bddca9699b0dfd8ab1d11879b (patch) | |
| tree | d19b75be8232ab5cd538fd1a8f58c09ea2acdd6d | |
| parent | ffc0d578ea22de02a68c64c094602701e65d8895 (diff) | |
| download | haskell-8a51b2ab7433c06bddca9699b0dfd8ab1d11879b.tar.gz | |
Make IOEnv monad one-shot (#18202)
On CI (x86_64-linux-deb9-hadrian, compile_time/bytes_allocated):
T10421 -1.8% (threshold: +/- 1%)
T10421a -1.7% (threshold: +/- 1%)
T12150 -4.9% (threshold: +/- 2%)
T12227 -1.6 (threshold: +/- 1%)
T12425 -1.5% (threshold: +/- 1%)
T12545 -3.8% (threshold: +/- 1%)
T12707 -3.0% (threshold: +/- 1%)
T13035 -3.0% (threshold: +/- 1%)
T14683 -10.3% (threshold: +/- 2%)
T3064 -6.9% (threshold: +/- 2%)
T4801 -4.3% (threshold: +/- 2%)
T5030 -2.6% (threshold: +/- 2%)
T5321FD -3.6% (threshold: +/- 2%)
T5321Fun -4.6% (threshold: +/- 2%)
T5631 -19.7% (threshold: +/- 2%)
T5642 -13.0% (threshold: +/- 2%)
T783 -2.7 (threshold: +/- 2%)
T9020 -11.1 (threshold: +/- 2%)
T9961 -3.4% (threshold: +/- 2%)
T1969 (compile_time/bytes_allocated) -2.2% (threshold: +/-1%)
T1969 (compile_time/max_bytes_used) +24.4% (threshold: +/-20%)
Additionally on other CIs:
haddock.Cabal -10.0% (threshold: +/- 5%)
haddock.compiler -9.5% (threshold: +/- 5%)
haddock.base (max bytes used) +24.6% (threshold: +/- 15%)
T10370 (max bytes used, i386) +18.4% (threshold: +/- 15%)
Metric Decrease:
T10421
T10421a
T12150
T12227
T12425
T12545
T12707
T13035
T14683
T3064
T4801
T5030
T5321FD
T5321Fun
T5631
T5642
T783
T9020
T9961
haddock.Cabal
haddock.compiler
Metric Decrease 'compile_time/bytes allocated':
T1969
Metric Increase 'compile_time/max_bytes_used':
T1969
T10370
haddock.base
| -rw-r--r-- | compiler/GHC/Data/IOEnv.hs | 12 |
1 files changed, 11 insertions, 1 deletions
diff --git a/compiler/GHC/Data/IOEnv.hs b/compiler/GHC/Data/IOEnv.hs index 5478af0eee..439f101ecc 100644 --- a/compiler/GHC/Data/IOEnv.hs +++ b/compiler/GHC/Data/IOEnv.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DerivingVia #-} +{-# LANGUAGE PatternSynonyms #-} -- -- (c) The University of Glasgow 2002-2006 -- @@ -48,16 +49,25 @@ import Control.Monad.Trans.Reader import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) import GHC.Utils.Monad import Control.Applicative (Alternative(..)) +import GHC.Exts( oneShot ) ---------------------------------------------------------------------- -- Defining the monad type ---------------------------------------------------------------------- -newtype IOEnv env a = IOEnv (env -> IO a) +newtype IOEnv env a = IOEnv' (env -> IO a) deriving (Functor) deriving (MonadThrow, MonadCatch, MonadMask, MonadIO) via (ReaderT env IO) +-- See Note [The one-shot state monad trick] in GHC.Utils.Monad +pattern IOEnv :: forall env a. (env -> IO a) -> IOEnv env a +pattern IOEnv m <- IOEnv' m + where + IOEnv m = IOEnv' (oneShot m) + +{-# COMPLETE IOEnv #-} + unIOEnv :: IOEnv env a -> (env -> IO a) unIOEnv (IOEnv m) = m |