From 4b8a8a0426da70f42932aacf97001da56db67107 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Tue, 2 Feb 2021 23:09:12 +0100 Subject: 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. --- compiler/GHC/Core/Opt/Simplify/Monad.hs | 9 +++++++-- 1 file 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)) -- cgit v1.2.1