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

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu Jun 1 14:57:50 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
5d415bfd by Krzysztof Gogolewski at 2023-06-01T10:57:31-04: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/5d415bfd1cd3894919bf07474846835aacb3a975

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5d415bfd1cd3894919bf07474846835aacb3a975
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/20230601/e3bd75ee/attachment-0001.html>


More information about the ghc-commits mailing list