X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FMonad%2FFix.hs;h=ea481d826028c3429d1b61bb3b94dc72c09d6207;hb=7a73aaf70fefb4b30c9159f5d15035f8e9c6e114;hp=3a0be3275bfc8b7674805d46bd6bf745d29e80b4;hpb=6807371300c5b7860c7270686a1cca0a3ee80427;p=haskell-directory.git

diff --git a/Control/Monad/Fix.hs b/Control/Monad/Fix.hs
index 3a0be32..ea481d8 100644
--- a/Control/Monad/Fix.hs
+++ b/Control/Monad/Fix.hs
@@ -1,23 +1,17 @@
 -----------------------------------------------------------------------------
--- 
+-- |
 -- 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
 --
--- $Id: Fix.hs,v 1.4 2002/03/22 10:20:24 simonmar Exp $
+-- Monadic fixpoints.
 --
--- The Fix monad.
---
---	  Inspired by the paper:
---	  \em{Functional Programming with Overloading and
---	      Higher-Order Polymorphism},
---	    \A[HREF="http://www.cse.ogi.edu/~mpj"]{Mark P Jones},
---		  Advanced School of Functional Programming, 1995.}
+-- For a detailed discussion, see Levent Erkok's thesis,
+-- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002.
 --
 -----------------------------------------------------------------------------
 
@@ -30,20 +24,50 @@ module Control.Monad.Fix (
 
 import Prelude
 import System.IO
+import Control.Monad.Instances ()
+import Data.Function (fix)
 
-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