Copyright | (c) Andy Gill 2001 (c) Oregon Graduate Institute of Science and Technology 2002 |
---|---|
License | BSD-style (see the file libraries/base/LICENSE) |
Maintainer | libraries@haskell.org |
Stability | stable |
Portability | portable |
Safe Haskell | Safe |
Language | Haskell2010 |
Monadic fixpoints, used for desugaring of {-# LANGUAGE RecursiveDo #-}
.
Consider the generalized version of so-called repmin
(replace with minimum) problem:
accumulate elements of a container into a Monoid
and modify each element using the final accumulator.
repmin :: (Functor t, Foldable t, Monoid b) => (a -> b) -> (a -> b -> c) -> t a -> t c repmin f g as = fmap (`g` foldMap f as) as
The naive implementation as above makes two traversals. Can we do better and achieve the goal in a single pass? It's seemingly impossible, because we would have to know the future, but lazy evaluation comes to the rescue:
import Data.Traversable (mapAccumR) repmin :: (Traversable t, Monoid b) => (a -> b) -> (a -> b -> c) -> t a -> t c repmin f g as = let (b, cs) = mapAccumR (\acc a -> (f a <> acc, g a b)) mempty as in cs
How can we check that repmin
indeed traverses only once?
Let's run it on an infinite input:
>>>
import Data.Monoid (All(..))
>>>
take 3 $ repmin All (const id) ([True, True, False] ++ undefined)
[All {getAll = False},All {getAll = False},All {getAll = False}]
So far so good, but can we generalise g
to return a monadic value a -> b -> m c
?
The following does not work, complaining that b
is not in scope:
import Data.Traversable (mapAccumM) repminM :: (Traversable t, Monoid b, Monad m) => (a -> b) -> (a -> b -> m c) -> t a -> m (t c) repminM f g as = do (b, cs) <- mapAccumM (\acc a -> (f a <> acc,) $ g a b) mempty as pure cs
To solve the riddle, let's rewrite repmin
via fix
:
repmin :: (Traversable t, Monoid b) => (a -> b) -> (a -> b -> c) -> t a -> t c repmin f g as = snd $ fix $ \(b, cs) -> mapAccumR (\acc a -> (f a <> acc, g a b)) mempty as
Now we can replace fix
with mfix
to obtain the solution:
repminM :: (Traversable t, Monoid b, MonadFix m) => (a -> b) -> (a -> b -> m c) -> t a -> m (t c) repminM f g as = fmap snd $ mfix $ \(~(b, cs)) -> mapAccumM (\acc a -> (f a <> acc,) $ g a b) mempty as
For example,
>>>
import Data.Monoid (Sum(..))
>>>
repminM Sum (\a b -> print a >> pure (a + getSum b)) [3, 5, 2]
3 5 2 [13,15,12]
Incredibly, GHC is capable to do this transformation automatically,
when {-# LANGUAGE RecursiveDo #-} is enabled. Namely, the following
implementation of repminM
works (note mdo
instead of do
):
{-# LANGUAGE RecursiveDo #-} repminM :: (Traversable t, Monoid b, MonadFix m) => (a -> b) -> (a -> b -> m c) -> t a -> m (t c) repminM f g as = mdo (b, cs) <- mapAccumM (\acc a -> (f a <> acc,) $ g a b) mempty as pure cs
Further reading:
- GHC User’s Guide, The recursive do-notation.
- Haskell Wiki, MonadFix.
- Levent Erkök, Value recursion in monadic computations, Oregon Graduate Institute, 2002.
- Levent Erkök, John Launchbury, A recursive do for Haskell, Haskell '02, 29-37, 2002.
- Richard S. Bird, Using circular programs to eliminate multiple traversals of data, Acta Informatica 21, 239-250, 1984.
- Jasper Van der Jeugt, Lazy layout, 2023.
Documentation
class Monad m => MonadFix (m :: Type -> Type) where Source #
Monads having fixed points with a 'knot-tying' semantics.
Instances of MonadFix
should satisfy the following laws:
- Purity
mfix
(return
. h) =return
(fix
h)- Left shrinking (or Tightening)
mfix
(\x -> a >>= \y -> f x y) = a >>= \y ->mfix
(\x -> f x y)- Sliding
, for strictmfix
(liftM
h . f) =liftM
h (mfix
(f . h))h
.- Nesting
mfix
(\x ->mfix
(\y -> f x y)) =mfix
(\x -> f x x)
This class is used in the translation of the recursive do
notation
supported by GHC and Hugs.
Instances
MonadFix Complex Source # | Since: base-4.15.0.0 |
MonadFix First Source # | Since: base-4.9.0.0 |
MonadFix Last Source # | Since: base-4.9.0.0 |
MonadFix Max Source # | Since: base-4.9.0.0 |
MonadFix Min Source # | Since: base-4.9.0.0 |
MonadFix NonEmpty Source # | Since: base-4.9.0.0 |
MonadFix Identity Source # | Since: base-4.8.0.0 |
MonadFix First Source # | Since: base-4.8.0.0 |
MonadFix Last Source # | Since: base-4.8.0.0 |
MonadFix Down Source # | Since: base-4.12.0.0 |
MonadFix Dual Source # | Since: base-4.8.0.0 |
MonadFix Product Source # | Since: base-4.8.0.0 |
MonadFix Sum Source # | Since: base-4.8.0.0 |
MonadFix Par1 Source # | Since: base-4.9.0.0 |
MonadFix Q Source # | If the function passed to Since: ghc-internal-2.17.0.0 |
MonadFix IO Source # | Since: base-2.1 |
MonadFix Maybe Source # | Since: base-2.1 |
MonadFix Solo Source # | Since: base-4.15 |
MonadFix [] Source # | Since: base-2.1 |
Defined in GHC.Internal.Control.Monad.Fix | |
MonadFix (ST s) Source # | Since: base-2.1 |
MonadFix (Either e) Source # | Since: base-4.3.0.0 |
MonadFix (ST s) Source # | Since: base-2.1 |
Monoid a => MonadFix ((,) a) Source # | Since: base-4.21 |
Defined in GHC.Internal.Control.Monad.Fix | |
MonadFix f => MonadFix (Ap f) Source # | Since: base-4.12.0.0 |
MonadFix f => MonadFix (Alt f) Source # | Since: base-4.8.0.0 |
MonadFix f => MonadFix (Rec1 f) Source # | Since: base-4.9.0.0 |
(MonadFix f, MonadFix g) => MonadFix (Product f g) Source # | Since: base-4.9.0.0 |
(MonadFix f, MonadFix g) => MonadFix (f :*: g) Source # | Since: base-4.9.0.0 |
MonadFix ((->) r) Source # | Since: base-2.1 |
Defined in GHC.Internal.Control.Monad.Fix | |
MonadFix f => MonadFix (M1 i c f) Source # | Since: base-4.9.0.0 |
is the least fixed point of the function fix
ff
,
i.e. the least defined x
such that f x = x
.
When f
is strict, this means that because, by the definition of strictness,
f ⊥ = ⊥
and such the least defined fixed point of any strict function is ⊥
.
Examples
We can write the factorial function using direct recursion as
>>>
let fac n = if n <= 1 then 1 else n * fac (n-1) in fac 5
120
This uses the fact that Haskell’s let
introduces recursive bindings. We can
rewrite this definition using fix
,
Instead of making a recursive call, we introduce a dummy parameter rec
;
when used within fix
, this parameter then refers to fix
’s argument, hence
the recursion is reintroduced.
>>>
fix (\rec n -> if n <= 1 then 1 else n * rec (n-1)) 5
120
Using fix
, we can implement versions of repeat
as
and fix
.
(:)
cycle
as fix
.
(++)
>>>
take 10 $ fix (0:)
[0,0,0,0,0,0,0,0,0,0]
>>>
map (fix (\rec n -> if n < 2 then n else rec (n - 1) + rec (n - 2))) [1..10]
[1,1,2,3,5,8,13,21,34,55]