{-# LANGUAGE Trustworthy #-}{-# LANGUAGE NoImplicitPrelude #-}------------------------------------------------------------------------------- |-- Module : Control.Monad.Fix-- Copyright : (c) Andy Gill 2001,-- (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 : portable---- Monadic fixpoints.---- For a detailed discussion, see Levent Erkok's thesis,-- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002.-------------------------------------------------------------------------------moduleControl.Monad.Fix(MonadFix (mfix ),fix )whereimportData.Either importData.Function (fix )importData.Maybe importGHC.Base (Monad ,error ,(. ))importGHC.List (head ,tail )importGHC.ST importSystem.IO -- | 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 . h))@,-- 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 @f@ should not be strict,-- for then @'mfix' f@ would diverge.mfix ::(a ->m a )->m a -- Instances of MonadFix for Prelude monadsinstanceMonadFix Maybe wheremfix f =leta =f (unJust a )ina whereunJust (Just x )=x unJustNothing =error "mfix Maybe: Nothing"instanceMonadFix []wheremfix f =casefix (f . head )of[]->[](x :_)->x :mfix (tail . f )instanceMonadFix IOwheremfix =fixIO instanceMonadFix ((->)r )wheremfix f =\r ->leta =f a r ina instanceMonadFix (Either e )wheremfix f =leta =f (unRight a )ina whereunRight (Right x )=x unRight(Left _)=error "mfix Either: Left"instanceMonadFix (ST s )wheremfix =fixST