diff options
| author | Sebastian Graf <sebastian.graf@kit.edu> | 2021-02-02 23:09:12 +0100 |
|---|---|---|
| committer | Sebastian Graf <sebastian.graf@kit.edu> | 2021-02-02 23:10:58 +0100 |
| commit | 4b8a8a0426da70f42932aacf97001da56db67107 (patch) | |
| tree | 346361c40e543ab64eae40f85c54d8ef6afe5cd5 | |
| parent | ddbdec4128f0e6760c8c7a19344f2f2a7a3314bf (diff) | |
| download | haskell-wip/T19302.tar.gz | |
Mark both parameters of SimplM one-shot (#19302)wip/T19302
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)) |