-- | -- Module : Control.Monad.Stream -- Copyright : Oleg Kiselyov, Sebastian Fischer -- License : BSD3 -- -- Maintainer : Sebastian Fischer (sebf@informatik.uni-kiel.de) -- Stability : experimental -- Portability : portable -- -- This Haskell library provides an implementation of the MonadPlus -- type class that enumerates results of a non-deterministic -- computation by interleaving subcomputations in a way that has -- usually much better memory performance than other strategies with -- the same termination properties. -- -- By using supensions in strategic positions, the user can ensure -- that the search does not diverge if there are remaining -- non-deterministic results. -- -- More information is available on the authors website: -- <http://okmij.org/ftp/Computation/monads.html#fair-bt-stream> -- -- Warning: @Stream@ is only a monad when the results of @runStream@ -- are interpreted as a multiset, i.e., a valid transformation -- according to the monad laws may change the order of the results. -- module Control.Monad.Stream ( Stream, suspended, runStream, toList ) where import Control.Monad import Control.Applicative import Control.Monad.Logic import Data.Foldable import Data.Traversable import Prelude hiding (foldr) -- | -- Results of non-deterministic computations of type @Stream a@ can be -- enumerated efficiently. -- data Stream a = Nil | Single a | Cons a (Stream a) | Susp (Stream a) instance Functor Stream where fmap _ Nil = Nil fmap f (Single x) = Single (f x) fmap f (Cons x xs) = Cons (f x) (fmap f xs) fmap f (Susp xs) = Susp (fmap f xs) -- | -- Suspensions can be used to ensure fairness. -- suspended :: Stream a -> Stream a suspended = Susp -- | -- The function @runStream@ enumerates the results of a -- non-deterministic computation. -- runStream :: Stream a -> [a] runStream = toList {-# DEPRECATED runStream "use toList" #-} instance Monad Stream where return = Single Nil >>= _ = Nil Single x >>= f = f x Cons x xs >>= f = f x `mplus` suspended (xs >>= f) Susp xs >>= f = suspended (xs >>= f) fail _ = Nil instance MonadPlus Stream where mzero = Nil Nil `mplus` ys = suspended ys -- suspending Single x `mplus` ys = Cons x ys Cons x xs `mplus` ys = Cons x (ys `mplus` xs) -- interleaving xs `mplus` Nil = xs Susp xs `mplus` Single y = Cons y xs Susp xs `mplus` Cons y ys = Cons y (xs `mplus` ys) Susp xs `mplus` Susp ys = suspended (xs `mplus` ys) instance Applicative Stream where pure = Single Nil <*> _ = Nil Single f <*> xs = fmap f xs Cons f fs <*> xs = fmap f xs <|> (xs <**> fs) Susp fs <*> xs = suspended (xs <**> fs) instance Alternative Stream where empty = Nil (<|>) = mplus instance MonadLogic Stream where (>>-) = (>>=) interleave = mplus msplit Nil = return Nothing msplit (Single x) = return $ Just (x, Nil) msplit (Cons x xs) = return $ Just (x, suspended xs) msplit (Susp xs) = suspended $ msplit xs instance Foldable Stream where foldMap = foldMapDefault instance Traversable Stream where traverse _ Nil = pure Nil traverse f (Single x) = Single <$> f x traverse f (Cons x xs) = Cons <$> f x <*> traverse f xs traverse f (Susp xs) = Susp <$> traverse f xs