{-# LANGUAGE Trustworthy #-}{-# LANGUAGE NoImplicitPrelude #-}{-# LANGUAGE TypeOperators #-}-- For head in instance MonadFix []{-# OPTIONS_GHC -Wno-x-partial #-}------------------------------------------------------------------------------- |-- Module : GHC.Internal.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 : stable-- Portability : portable---- Monadic fixpoints.---- For a detailed discussion, see Levent Erkok's thesis,-- /Value Recursion in Monadic Computations/, Oregon Graduate Institute, 2002.-------------------------------------------------------------------------------moduleGHC.Internal.Control.Monad.Fix (MonadFix (mfix ),fix )whereimportGHC.Internal.Data.Either importGHC.Internal.Data.Function (fix )importGHC.Internal.Data.Maybe importGHC.Internal.Data.Monoid (Monoid ,Dual (..),Sum (..),Product (..),First (..),Last (..),Alt (..),Ap (..))importGHC.Internal.Data.Ord (Down (..))importGHC.Internal.Data.Tuple (Solo (..),snd )importGHC.Internal.Base (Monad ,NonEmpty (..),errorWithoutStackTrace ,(.) )importGHC.Internal.Generics importGHC.Internal.List (head ,drop )importGHC.Internal.Control.Monad.ST.Imp importGHC.Internal.System.IO -- | Monads having fixed points with a \'knot-tying\' semantics.-- Instances of 'MonadFix' should satisfy the following laws:---- [Purity]-- @'mfix' ('Control.Monad.return' . h) = 'Control.Monad.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 monads-- | @since base-4.15instanceMonadFix Solo wheremfix :: forall a. (a -> Solo a) -> Solo a
mfix a -> Solo a
f =leta :: Solo a
a =a -> Solo a
f (Solo a -> a
forall {a}. Solo a -> a
unSolo Solo a
a )inSolo a
a whereunSolo :: Solo a -> a
unSolo (MkSolo a
x )=a
x -- | @since base-4.21instanceMonoid a =>MonadFix ((,)a )where-- See the CLC proposal thread for discussion and proofs of the laws: https://github.com/haskell/core-libraries-committee/issues/238mfix :: forall a. (a -> (a, a)) -> (a, a)
mfix a -> (a, a)
f =leta :: (a, a)
a =a -> (a, a)
f ((a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
a )in(a, a)
a -- | @since base-2.01instanceMonadFix Maybe wheremfix :: forall a. (a -> Maybe a) -> Maybe a
mfix a -> Maybe a
f =leta :: Maybe a
a =a -> Maybe a
f (Maybe a -> a
forall {a}. Maybe a -> a
unJust Maybe a
a )inMaybe a
a whereunJust :: Maybe a -> a
unJust (Just a
x )=a
x unJust Maybe a
Nothing =[Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"mfix Maybe: Nothing"-- | @since base-2.01instanceMonadFix []wheremfix :: forall a. (a -> [a]) -> [a]
mfix a -> [a]
f =case([a] -> [a]) -> [a]
forall a. (a -> a) -> a
fix (a -> [a]
f (a -> [a]) -> ([a] -> a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. HasCallStack => [a] -> a
head )of[]->[](a
x : [a]
_)->a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> [a]) -> [a]
forall a. (a -> [a]) -> [a]
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
1([a] -> [a]) -> (a -> [a]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [a]
f )-- | @since base-4.9.0.0instanceMonadFix NonEmpty wheremfix :: forall a. (a -> NonEmpty a) -> NonEmpty a
mfix a -> NonEmpty a
f =case(NonEmpty a -> NonEmpty a) -> NonEmpty a
forall a. (a -> a) -> a
fix (a -> NonEmpty a
f (a -> NonEmpty a) -> (NonEmpty a -> a) -> NonEmpty a -> NonEmpty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> a
forall {a}. NonEmpty a -> a
neHead )of~(a
x :| [a]
_)->a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| (a -> [a]) -> [a]
forall a. (a -> [a]) -> [a]
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (NonEmpty a -> [a]
forall {a}. NonEmpty a -> [a]
neTail (NonEmpty a -> [a]) -> (a -> NonEmpty a) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> NonEmpty a
f )whereneHead :: NonEmpty a -> a
neHead ~(a
a :| [a]
_)=a
a neTail :: NonEmpty a -> [a]
neTail ~(a
_:| [a]
as )=[a]
as -- | @since base-2.01instanceMonadFix IO wheremfix :: forall a. (a -> IO a) -> IO a
mfix =(a -> IO a) -> IO a
forall a. (a -> IO a) -> IO a
fixIO -- | @since base-2.01instanceMonadFix ((->)r )wheremfix :: forall a. (a -> r -> a) -> r -> a
mfix a -> r -> a
f =\r
r ->leta :: a
a =a -> r -> a
f a
a r
r ina
a -- | @since base-4.3.0.0instanceMonadFix (Either e )wheremfix :: forall a. (a -> Either e a) -> Either e a
mfix a -> Either e a
f =leta :: Either e a
a =a -> Either e a
f (Either e a -> a
forall {a} {b}. Either a b -> b
unRight Either e a
a )inEither e a
a whereunRight :: Either a b -> b
unRight (Right b
x )=b
x unRight (Left a
_)=[Char] -> b
forall a. [Char] -> a
errorWithoutStackTrace [Char]
"mfix Either: Left"-- | @since base-2.01instanceMonadFix (ST s )wheremfix :: forall a. (a -> ST s a) -> ST s a
mfix =(a -> ST s a) -> ST s a
forall a s. (a -> ST s a) -> ST s a
fixST -- Instances of Data.Monoid wrappers-- | @since base-4.8.0.0instanceMonadFix Dual wheremfix :: forall a. (a -> Dual a) -> Dual a
mfix a -> Dual a
f =a -> Dual a
forall a. a -> Dual a
Dual ((a -> a) -> a
forall a. (a -> a) -> a
fix (Dual a -> a
forall a. Dual a -> a
getDual (Dual a -> a) -> (a -> Dual a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Dual a
f ))-- | @since base-4.8.0.0instanceMonadFix Sum wheremfix :: forall a. (a -> Sum a) -> Sum a
mfix a -> Sum a
f =a -> Sum a
forall a. a -> Sum a
Sum ((a -> a) -> a
forall a. (a -> a) -> a
fix (Sum a -> a
forall a. Sum a -> a
getSum (Sum a -> a) -> (a -> Sum a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Sum a
f ))-- | @since base-4.8.0.0instanceMonadFix Product wheremfix :: forall a. (a -> Product a) -> Product a
mfix a -> Product a
f =a -> Product a
forall a. a -> Product a
Product ((a -> a) -> a
forall a. (a -> a) -> a
fix (Product a -> a
forall a. Product a -> a
getProduct (Product a -> a) -> (a -> Product a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Product a
f ))-- | @since base-4.8.0.0instanceMonadFix First wheremfix :: forall a. (a -> First a) -> First a
mfix a -> First a
f =Maybe a -> First a
forall a. Maybe a -> First a
First ((a -> Maybe a) -> Maybe a
forall a. (a -> Maybe a) -> Maybe a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (First a -> Maybe a
forall a. First a -> Maybe a
getFirst (First a -> Maybe a) -> (a -> First a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> First a
f ))-- | @since base-4.8.0.0instanceMonadFix Last wheremfix :: forall a. (a -> Last a) -> Last a
mfix a -> Last a
f =Maybe a -> Last a
forall a. Maybe a -> Last a
Last ((a -> Maybe a) -> Maybe a
forall a. (a -> Maybe a) -> Maybe a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Last a -> Maybe a
forall a. Last a -> Maybe a
getLast (Last a -> Maybe a) -> (a -> Last a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Last a
f ))-- | @since base-4.8.0.0instanceMonadFix f =>MonadFix (Alt f )wheremfix :: forall a. (a -> Alt f a) -> Alt f a
mfix a -> Alt f a
f =f a -> Alt f a
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt ((a -> f a) -> f a
forall a. (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Alt f a -> f a
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt f a -> f a) -> (a -> Alt f a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Alt f a
f ))-- | @since base-4.12.0.0instanceMonadFix f =>MonadFix (Ap f )wheremfix :: forall a. (a -> Ap f a) -> Ap f a
mfix a -> Ap f a
f =f a -> Ap f a
forall {k} (f :: k -> *) (a :: k). f a -> Ap f a
Ap ((a -> f a) -> f a
forall a. (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Ap f a -> f a
forall {k} (f :: k -> *) (a :: k). Ap f a -> f a
getAp (Ap f a -> f a) -> (a -> Ap f a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Ap f a
f ))-- Instances for GHC.Generics-- | @since base-4.9.0.0instanceMonadFix Par1 wheremfix :: forall a. (a -> Par1 a) -> Par1 a
mfix a -> Par1 a
f =a -> Par1 a
forall p. p -> Par1 p
Par1 ((a -> a) -> a
forall a. (a -> a) -> a
fix (Par1 a -> a
forall p. Par1 p -> p
unPar1 (Par1 a -> a) -> (a -> Par1 a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Par1 a
f ))-- | @since base-4.9.0.0instanceMonadFix f =>MonadFix (Rec1 f )wheremfix :: forall a. (a -> Rec1 f a) -> Rec1 f a
mfix a -> Rec1 f a
f =f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 ((a -> f a) -> f a
forall a. (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Rec1 f a -> f a
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1 (Rec1 f a -> f a) -> (a -> Rec1 f a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rec1 f a
f ))-- | @since base-4.9.0.0instanceMonadFix f =>MonadFix (M1 i c f )wheremfix :: forall a. (a -> M1 i c f a) -> M1 i c f a
mfix a -> M1 i c f a
f =f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 ((a -> f a) -> f a
forall a. (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (M1 i c f a -> f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 (M1 i c f a -> f a) -> (a -> M1 i c f a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> M1 i c f a
f ))-- | @since base-4.9.0.0instance(MonadFix f ,MonadFix g )=>MonadFix (f :*: g )wheremfix :: forall a. (a -> (:*:) f g a) -> (:*:) f g a
mfix a -> (:*:) f g a
f =((a -> f a) -> f a
forall a. (a -> f a) -> f a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((:*:) f g a -> f a
forall {f :: * -> *} {g :: * -> *} {p}. (:*:) f g p -> f p
fstP ((:*:) f g a -> f a) -> (a -> (:*:) f g a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (:*:) f g a
f ))f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: ((a -> g a) -> g a
forall a. (a -> g a) -> g a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix ((:*:) f g a -> g a
forall {f :: * -> *} {g :: * -> *} {p}. (:*:) f g p -> g p
sndP ((:*:) f g a -> g a) -> (a -> (:*:) f g a) -> a -> g a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (:*:) f g a
f ))wherefstP :: (:*:) f g p -> f p
fstP (f p
a :*: g p
_)=f p
a sndP :: (:*:) f g p -> g p
sndP (f p
_:*: g p
b )=g p
b -- Instances for Data.Ord-- | @since base-4.12.0.0instanceMonadFix Down wheremfix :: forall a. (a -> Down a) -> Down a
mfix a -> Down a
f =a -> Down a
forall a. a -> Down a
Down ((a -> a) -> a
forall a. (a -> a) -> a
fix (Down a -> a
forall a. Down a -> a
getDown (Down a -> a) -> (a -> Down a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Down a
f ))