Control/Monad/Fix.hs

   1 {-# LANGUAGE CPP #-}
   2
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  Control.Monad.Fix
   6 -- Copyright   :  (c) Andy Gill 2001,
   7 --                (c) Oregon Graduate Institute of Science and Technology, 2002
   8 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   9 -- Maintainer  :  libraries@haskell.org
  10 -- Stability   :  experimental
  11 -- Portability :  portable
  12 --
  13 -- Monadic fixpoints.
  14 --
  15 -- For a detailed discussion, see Levent Erkok's thesis,
  16 -- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002.
  17 --
  18 -----------------------------------------------------------------------------
  19
  20 module Control.Monad.Fix (
  21         MonadFix(
  22            mfix -- :: (a -> m a) -> m a
  23          ),
  24         fix     -- :: (a -> a) -> a
  25   ) where
  26
  27 import Prelude
  28 import System.IO
  29 import Control.Monad.Instances ()
  30 import Data.Function (fix)
  31 #ifdef __HUGS__
  32 import Hugs.Prelude (MonadFix(mfix))
  33 #endif
  34 #if defined(__GLASGOW_HASKELL__)
  35 import GHC.ST
  36 #endif
  37
  38 #ifndef __HUGS__
  39 -- | Monads having fixed points with a \'knot-tying\' semantics.
  40 -- Instances of 'MonadFix' should satisfy the following laws:
  41 --
  42 -- [/purity/]
  43 --      @'mfix' ('return' . h)  =  'return' ('fix' h)@
  44 --
  45 -- [/left shrinking/ (or /tightening/)]
  46 --      @'mfix' (\\x -> a >>= \\y -> f x y)  =  a >>= \\y -> 'mfix' (\\x -> f x y)@
  47 --
  48 -- [/sliding/]
  49 --      @'mfix' ('Control.Monad.liftM' h . f)  =  'Control.Monad.liftM' h ('mfix' (f . h))@,
  50 --      for strict @h@.
  51 --
  52 -- [/nesting/]
  53 --      @'mfix' (\\x -> 'mfix' (\\y -> f x y))  =  'mfix' (\\x -> f x x)@
  54 --
  55 -- This class is used in the translation of the recursive @do@ notation
  56 -- supported by GHC and Hugs.
  57 class (Monad m) => MonadFix m where
  58         -- | The fixed point of a monadic computation.
  59         -- @'mfix' f@ executes the action @f@ only once, with the eventual
  60         -- output fed back as the input.  Hence @f@ should not be strict,
  61         -- for then @'mfix' f@ would diverge.
  62         mfix :: (a -> m a) -> m a
  63 #endif /* !__HUGS__ */
  64
  65 -- Instances of MonadFix for Prelude monads
  66
  67 -- Maybe:
  68 instance MonadFix Maybe where
  69     mfix f = let a = f (unJust a) in a
  70              where unJust (Just x) = x
  71                    unJust Nothing  = error "mfix Maybe: Nothing"
  72
  73 -- List:
  74 instance MonadFix [] where
  75     mfix f = case fix (f . head) of
  76                []    -> []
  77                (x:_) -> x : mfix (tail . f)
  78
  79 -- IO:
  80 instance MonadFix IO where
  81     mfix = fixIO
  82
  83 -- Prelude types with Monad instances in Control.Monad.Instances
  84
  85 instance MonadFix ((->) r) where
  86     mfix f = \ r -> let a = f a r in a
  87
  88 instance MonadFix (Either e) where
  89     mfix f = let a = f (unRight a) in a
  90              where unRight (Right x) = x
  91                    unRight (Left  _) = error "mfix Either: Left"
  92
  93 #if defined(__GLASGOW_HASKELL__)
  94 instance MonadFix (ST s) where
  95         mfix = fixST
  96 #endif
  97