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 | experimental |
Portability | portable |
Safe Haskell | Trustworthy |
Language | Haskell2010 |
Monadic fixpoints.
For a detailed discussion, see Levent Erkok's thesis, Value Recursion in Monadic Computations, Oregon Graduate Institute, 2002.
Documentation
class Monad m => MonadFix m 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 [] # | Since: base-2.1 |
Defined in Control.Monad.Fix | |
MonadFix Maybe # | Since: base-2.1 |
MonadFix IO # | Since: base-2.1 |
MonadFix Par1 # | Since: base-4.9.0.0 |
MonadFix NonEmpty # | Since: base-4.9.0.0 |
MonadFix Down # | Since: base-4.12.0.0 |
MonadFix Product # | Since: base-4.8.0.0 |
MonadFix Sum # | Since: base-4.8.0.0 |
MonadFix Dual # | Since: base-4.8.0.0 |
MonadFix Last # | Since: base-4.8.0.0 |
MonadFix First # | Since: base-4.8.0.0 |
MonadFix Identity # | Since: base-4.8.0.0 |
MonadFix Option # | Since: base-4.9.0.0 |
MonadFix Last # | Since: base-4.9.0.0 |
MonadFix First # | Since: base-4.9.0.0 |
MonadFix Max # | Since: base-4.9.0.0 |
MonadFix Min # | Since: base-4.9.0.0 |
MonadFix (Either e) # | Since: base-4.3.0.0 |
MonadFix (ST s) # | Since: base-2.1 |
MonadFix (ST s) # | Since: base-2.1 |
MonadFix f => MonadFix (Rec1 f) # | Since: base-4.9.0.0 |
MonadFix f => MonadFix (Alt f) # | Since: base-4.8.0.0 |
MonadFix f => MonadFix (Ap f) # | Since: base-4.12.0.0 |
MonadFix ((->) r :: Type -> Type) # | Since: base-2.1 |
Defined in Control.Monad.Fix | |
(MonadFix f, MonadFix g) => MonadFix (f :*: g) # | Since: base-4.9.0.0 |
(MonadFix f, MonadFix g) => MonadFix (Product f g) # | Since: base-4.9.0.0 |
MonadFix f => MonadFix (M1 i c f) # | 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
.
For example, 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
,
>>>
fix (\rec n -> if n <= 1 then 1 else n * rec (n-1)) 5
120
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.