-- |
-- Module : Control.Monad.Fix
-- Copyright : (c) Andy Gill 2001,
--- (c) Oregon Graduate Institute of Science and Technology, 2001
--- License : BSD-style (see the file libraries/core/LICENSE)
---
+-- (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
--
--- The Fix monad.
+-- Monadic fixpoints.
+--
+-- For a detailed discussion, see Levent Erkok's thesis,
+-- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002.
--
--- Inspired by the paper
--- /Functional Programming with Overloading and
--- Higher-Order Polymorphism/,
--- Mark P Jones (<http://www.cse.ogi.edu/~mpj>)
--- Advanced School of Functional Programming, 1995.
-----------------------------------------------------------------------------
module Control.Monad.Fix (
import Prelude
import System.IO
+import Control.Monad.Instances ()
+-- | @'fix' f@ is the least fixed point of the function @f@,
+-- i.e. the least defined @x@ such that @f x = x@.
fix :: (a -> a) -> a
fix f = let x = f x in x
+-- | 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/]
+-- @'mfix' ('Control.Monad.liftM' h . f) = 'Control.Monad.liftM' h ('mfix' (f . h))@,
+-- for strict @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.
class (Monad m) => MonadFix m where
+ -- | The fixed point of a monadic computation.
+ -- @'mfix' f@ executes the action @f@ only once, with the eventual
+ -- output fed back as the input. Hence @f@ should not be strict,
+ -- for then @'mfix' f@ would diverge.
mfix :: (a -> m a) -> m a
+-- Instances of MonadFix for Prelude monads
+
+-- Maybe:
instance MonadFix Maybe where
- mfix f = let
- a = f $ case a of
- Just x -> x
- _ -> error "empty mfix argument"
- in a
+ mfix f = let a = f (unJust a) in a
+ where unJust (Just x) = x
+
+-- List:
+instance MonadFix [] where
+ mfix f = case fix (f . head) of
+ [] -> []
+ (x:_) -> x : mfix (tail . f)
+-- IO:
instance MonadFix IO where
- mfix = fixIO
+ mfix = fixIO
+instance MonadFix ((->) r) where
+ mfix f = \ r -> let a = f a r in a