[project @ 2003-02-17 15:13:09 by simonpj]

[ghc-base.git] / Control / Monad / Fix.hs

diff --git a/Control/Monad/Fix.hs b/Control/Monad/Fix.hs
index a596f44..6c9ac7f 100644 (file)
--- a/Control/Monad/Fix.hs
+++ b/Control/Monad/Fix.hs
@@ -1,23 +1,21 @@
 -----------------------------------------------------------------------------
--- 
+-- |
 -- 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 :  non-portable (reqruires multi-param type classes)
---
--- $Id: Fix.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
+-- Portability :  portable
 --
 -- 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.}
+--       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.
 --
 -----------------------------------------------------------------------------
 
@@ -29,10 +27,7 @@ module Control.Monad.Fix (
   ) where
 
 import Prelude
-
 import System.IO
-import Control.Monad.ST
-
 
 fix :: (a -> a) -> a
 fix f = let x = f x in x
@@ -40,16 +35,19 @@ fix f = let x = f x in x
 class (Monad m) => MonadFix m where
        mfix :: (a -> m a) -> m a
 
--- Perhaps these should live beside (the ST & IO) definition.
-instance MonadFix IO where
-       mfix = fixIO
-
-instance MonadFix (ST s) where
-       mfix = fixST
+-- 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