X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FMonad%2FFix.hs;h=a1309faccd41db6574dc8bd5f36297708d635b35;hb=41e8fba828acbae1751628af50849f5352b27873;hp=c1b4fe1320487eac29871886e1b0b3178e6af916;hpb=10e529099e84e0270da4228132e27f0adae638b5;p=ghc-base.git diff --git a/Control/Monad/Fix.hs b/Control/Monad/Fix.hs index c1b4fe1..a1309fa 100644 --- a/Control/Monad/Fix.hs +++ b/Control/Monad/Fix.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Fix @@ -29,6 +31,9 @@ import Data.Function (fix) #ifdef __HUGS__ import Hugs.Prelude (MonadFix(mfix)) #endif +#if defined(__GLASGOW_HASKELL__) +import GHC.ST +#endif #ifndef __HUGS__ -- | Monads having fixed points with a \'knot-tying\' semantics. @@ -75,5 +80,18 @@ instance MonadFix [] where instance MonadFix IO where mfix = fixIO +-- Prelude types with Monad instances in Control.Monad.Instances + instance MonadFix ((->) r) where mfix f = \ r -> let a = f a r in a + +instance MonadFix (Either e) where + mfix f = let a = f (unRight a) in a + where unRight (Right x) = x + unRight (Left _) = error "mfix Either: Left" + +#if defined(__GLASGOW_HASKELL__) +instance MonadFix (ST s) where + mfix = fixST +#endif +