[Git][ghc/ghc][wip/one-shot] Use the one-shot trick for UM and RewriteM functors

[Krzysztof Gogolewski (@monoidal)]

Krzysztof Gogolewski pushed to branch wip/one-shot at Glasgow Haskell Compiler / GHC


Commits:
8b16101f by Krzysztof Gogolewski at 2023-05-25T20:01:36+02:00
Use the one-shot trick for UM and RewriteM functors

As described in Note [The one-shot state monad trick],
we shouldn't use derived Functor instances for monads using
one-shot. This was done for most of them, but UM and RewriteM
were missed.

- - - - -


2 changed files:

- compiler/GHC/Core/Unify.hs
- compiler/GHC/Tc/Solver/Rewrite.hs


Changes:

=====================================
compiler/GHC/Core/Unify.hs
=====================================
@@ -1430,13 +1430,16 @@ data UMState = UMState
 newtype UM a
   = UM' { unUM :: UMState -> UnifyResultM (UMState, a) }
     -- See Note [The one-shot state monad trick] in GHC.Utils.Monad
-  deriving (Functor)
 
 pattern UM :: (UMState -> UnifyResultM (UMState, a)) -> UM a
 -- See Note [The one-shot state monad trick] in GHC.Utils.Monad
 pattern UM m <- UM' m
   where
     UM m = UM' (oneShot m)
+{-# COMPLETE UM #-}
+
+instance Functor UM where
+  fmap f (UM m) = UM (\s -> fmap (\(s', v) -> (s', f v)) (m s))
 
 instance Applicative UM where
       pure a = UM (\s -> pure (s, a))


=====================================
compiler/GHC/Tc/Solver/Rewrite.hs
=====================================
@@ -56,7 +56,6 @@ import qualified GHC.Data.List.Infinite as Inf
 -- | The 'RewriteM' monad is a wrapper around 'TcS' with a 'RewriteEnv'
 newtype RewriteM a
   = RewriteM { runRewriteM :: RewriteEnv -> TcS a }
-  deriving (Functor)
 
 -- | Smart constructor for 'RewriteM', as describe in Note [The one-shot state
 -- monad trick] in "GHC.Utils.Monad".
@@ -73,6 +72,9 @@ instance Applicative RewriteM where
   pure x = mkRewriteM $ \_ -> pure x
   (<*>) = ap
 
+instance Functor RewriteM where
+  fmap f (RewriteM x) = mkRewriteM $ \env -> fmap f (x env)
+
 instance HasDynFlags RewriteM where
   getDynFlags = liftTcS getDynFlags
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b16101fe5d045b1e2406f277150a2e247e94827

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8b16101fe5d045b1e2406f277150a2e247e94827
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230525/fd1be7f3/attachment-0001.html>