diff options
| author | Sebastian Graf <sebastian.graf@kit.edu> | 2021-02-02 23:09:12 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-05 19:13:15 -0500 |
| commit | d4618aeb878edb1aed12bad05a19fe25fe3bf0d3 (patch) | |
| tree | 923e904c05fe356b72e0e04f2c842ea3e61e8494 | |
| parent | 792191e44f18130031a272c53459f91dea21bbd0 (diff) | |
| download | haskell-d4618aeb878edb1aed12bad05a19fe25fe3bf0d3.tar.gz | |
Mark both parameters of SimplM one-shot (#19302)
Just marking the `SimplTopEnv` parameter as one-shot was not enough to
eta-expand `simplExpr`.
Fixes #19302.
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Monad.hs | 9 |
1 files changed, 7 insertions, 2 deletions
diff --git a/compiler/GHC/Core/Opt/Simplify/Monad.hs b/compiler/GHC/Core/Opt/Simplify/Monad.hs index 4af454e381..0130fcf61e 100644 --- a/compiler/GHC/Core/Opt/Simplify/Monad.hs +++ b/compiler/GHC/Core/Opt/Simplify/Monad.hs @@ -64,7 +64,6 @@ newtype SimplM result -> IO (result, SimplCount)} -- We only need IO here for dump output, but since we already have it -- we might as well use it for uniques. - deriving (Functor) pattern SM :: (SimplTopEnv -> SimplCount -> IO (result, SimplCount)) @@ -75,7 +74,7 @@ pattern SM :: (SimplTopEnv -> SimplCount -- See Note [The one-shot state monad trick] in GHC.Utils.Monad pattern SM m <- SM' m where - SM m = SM' (oneShot m) + SM m = SM' (oneShot $ \env -> oneShot $ \ct -> m env ct) data SimplTopEnv = STE { st_flags :: DynFlags @@ -129,7 +128,10 @@ computeMaxTicks dflags size {-# INLINE thenSmpl #-} {-# INLINE thenSmpl_ #-} {-# INLINE returnSmpl #-} +{-# INLINE mapSmpl #-} +instance Functor SimplM where + fmap = mapSmpl instance Applicative SimplM where pure = returnSmpl @@ -140,6 +142,9 @@ instance Monad SimplM where (>>) = (*>) (>>=) = thenSmpl +mapSmpl :: (a -> b) -> SimplM a -> SimplM b +mapSmpl f m = thenSmpl m (returnSmpl . f) + returnSmpl :: a -> SimplM a returnSmpl e = SM (\_st_env sc -> return (e, sc)) |