Stream.hs

-- |
-- Module      : Control.Monad.Stream
-- Copyright   : Oleg Kiselyov
-- License     : PublicDomain
-- 
-- 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 ) where

import Control.Monad

-- |
-- 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 Nil         = []
runStream (Single x)  = [x]
runStream (Cons x xs) = x : runStream xs
runStream (Susp xs)   = runStream xs

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)

-- |
-- The class @MonadTimes@ defines an operation to compute the
-- cartesian product of the results of two monadic operations.  A
-- sequential default implementation is given in terms of @>>=@ but
-- specific instances can ovverride this definition to evaluate both
-- arguments in parallel or interleaved.
-- 
class Monad m => MonadTimes m
 where
  mtimes :: m a -> m b -> m (a,b)
  mtimes = liftM2 (,)

instance MonadTimes Stream
 where
  Nil       `mtimes` _         = Nil
  Single x  `mtimes` ys        = fmap (\y -> (x,y)) ys      -- or use liftM ?
  Cons x xs `mtimes` ys        = fmap (\y -> (x,y)) ys `mplus` (xs `mtimes` ys)
  _         `mtimes` Nil       = Nil
  Susp xs   `mtimes` Single y  = fmap (\x -> (x,y)) xs
  Susp xs   `mtimes` Cons y ys = fmap (\x -> (x,y)) xs `mplus` (xs `mtimes` ys)
  Susp xs   `mtimes` Susp ys   = suspended (xs `mtimes` ys)