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