# LANGUAGE CPP #
-----------------------------------------------------------------------------
-- |
  Module       :   Control .  . Fix
  Copyright    :   ( c )   2001 ,
                 ( c ) Oregon Graduate Institute of Science and Technology , 2002
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- Maintainer  :  
-- Stability   :  experimental
-- Portability :  portable
--
  Monadic fixpoints .
--
  For a detailed discussion , see    thesis ,
  /Value Recursion in Monadic Computations/ , Oregon Graduate Institute , 2002 .
--
  20100405 , adapted for use in  :
--   fixIO not supported
--
-----------------------------------------------------------------------------

module Control.Monad.Fix (
        MonadFix(
           mfix -- :: (a -> m a) -> m a
         ),
        fix     -- :: (a -> a) -> a
  ) where

import Prelude
#ifdef __UHC__
import System.IO.Fix
#else
import System.IO
#endif
import Control.Monad.Instances ()
import Data.Function (fix)
#ifdef __HUGS__
import Hugs.Prelude (MonadFix(mfix))
#endif

#ifndef __HUGS__
-- | 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 .  ,
       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  should not be strict ,
        -- for then @'mfix' f@ would diverge.
        mfix :: (a -> m a) -> m a
#endif /* !__HUGS__ */

  Instances of MonadFix for Prelude monads

-- Maybe:
instance MonadFix Maybe where
    mfix f = let a = f (unJust a) in a
             where unJust (Just x) = x
                   unJust Nothing  = error "mfix Maybe: Nothing"

-- List:
instance MonadFix [] where
    mfix f = case fix (f . head) of
               []    -> []
               (x:_) -> x : mfix (tail . f)

  IO :
instance MonadFix IO where
    mfix = fixIO 

instance MonadFix ((->) r) where
    mfix f = \ r -> let a = f a r in a

---------------------------------------------------------------------------
 |
 License     :  BSD-style (see the file libraries/base/LICENSE)
 Maintainer  :  
 Stability   :  experimental
 Portability :  portable



   fixIO not supported

---------------------------------------------------------------------------
 :: (a -> m a) -> m a
 :: (a -> a) -> a
 | Monads having fixed points with a \'knot-tying\' semantics.

 [/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/]

 [/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
 | The fixed point of a monadic computation.
 for then @'mfix' f@ would diverge.
 Maybe:
 List:
# LANGUAGE CPP #
  Module       :   Control .  . Fix
  Copyright    :   ( c )   2001 ,
                 ( c ) Oregon Graduate Institute of Science and Technology , 2002
  Monadic fixpoints .
  For a detailed discussion , see    thesis ,
  /Value Recursion in Monadic Computations/ , Oregon Graduate Institute , 2002 .
  20100405 , adapted for use in  :

module Control.Monad.Fix (
        MonadFix(
         ),
  ) where

import Prelude
#ifdef __UHC__
import System.IO.Fix
#else
import System.IO
#endif
import Control.Monad.Instances ()
import Data.Function (fix)
#ifdef __HUGS__
import Hugs.Prelude (MonadFix(mfix))
#endif

#ifndef __HUGS__
  Instances of ' MonadFix ' should satisfy the following laws :
       @'mfix ' ( ' Control . Monad.liftM ' h . f )   =   ' Control . Monad.liftM ' h ( ' mfix ' ( f .  ,
       for strict @h@.
  supported by GHC and Hugs .
class (Monad m) => MonadFix m where
  @'mfix ' f@ executes the action @f@ only once , with the eventual
  output fed back as the input .   Hence  should not be strict ,
        mfix :: (a -> m a) -> m a
#endif /* !__HUGS__ */

  Instances of MonadFix for Prelude monads

instance MonadFix Maybe where
    mfix f = let a = f (unJust a) in a
             where unJust (Just x) = x
                   unJust Nothing  = error "mfix Maybe: Nothing"

instance MonadFix [] where
    mfix f = case fix (f . head) of
               []    -> []
               (x:_) -> x : mfix (tail . f)

  IO :
instance MonadFix IO where
    mfix = fixIO 

instance MonadFix ((->) r) where
    mfix f = \ r -> let a = f a r in a
