X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FMonad.lhs;h=3d491c254d3b13be3e80d3cf04cc68ceebacbc72;hb=df318cbdc37897c4c73839ff97414b518ec268f5;hp=1421209e2eaedbdb15ca583a7c28ac9d60f1dd53;hpb=7862e46a731194bde883386791914d94f3365c0a;p=ghc-hetmet.git

diff --git a/ghc/lib/std/Monad.lhs b/ghc/lib/std/Monad.lhs
index 1421209..3d491c2 100644
--- a/ghc/lib/std/Monad.lhs
+++ b/ghc/lib/std/Monad.lhs
@@ -1,121 +1,178 @@
+% -----------------------------------------------------------------------------
+% $Id: Monad.lhs,v 1.13 2001/05/18 16:54:05 simonmar Exp $
 %
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The University of Glasgow, 1994-2000
 %
+
 \section[Monad]{Module @Monad@}
 
 \begin{code}
 {-# OPTIONS -fno-implicit-prelude #-}
 
-module Monad (
-    Functor(..), 
-    Monad(..), MonadZero(..), MonadPlus(..),
-
-    -- Prelude monad functions
-    accumulate, sequence, 
-    mapM, mapM_, guard, filter, concat, applyM,
-
-    -- Standard Monad interface:
-    join,           -- :: (Monad m) => m (m a) -> m a
-    mapAndUnzipM,   -- :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
-    zipWithM,       -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
-    zipWithM_,	    -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
-    foldM,          -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a 
-    when,           -- :: (Monad m) => Bool -> m () -> m ()
-    unless,         -- :: (Monad m) => Bool -> m () -> m ()
-    ap,             -- :: (Monad m) => (m (a -> b)) -> (m a) -> m b
-    liftM, liftM2,  
-    liftM3, liftM4, 
-    liftM5
-  ) where
+module Monad 
+    ( MonadPlus (   -- class context: Monad
+	  mzero     -- :: (MonadPlus m) => m a
+	, mplus     -- :: (MonadPlus m) => m a -> m a -> m a
+	)
+    , join          -- :: (Monad m) => m (m a) -> m a
+    , guard         -- :: (MonadPlus m) => Bool -> m ()
+    , when          -- :: (Monad m) => Bool -> m () -> m ()
+    , unless        -- :: (Monad m) => Bool -> m () -> m ()
+    , ap            -- :: (Monad m) => m (a -> b) -> m a -> m b
+    , msum          -- :: (MonadPlus m) => [m a] -> m a
+    , filterM       -- :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
+    , mapAndUnzipM  -- :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
+    , zipWithM      -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
+    , zipWithM_     -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
+    , foldM         -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a 
+    
+    , liftM         -- :: (Monad m) => (a -> b) -> (m a -> m b)
+    , liftM2        -- :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)
+    , liftM3        -- :: ...
+    , liftM4        -- :: ...
+    , liftM5        -- :: ...
+
+    , Monad((>>=), (>>), return, fail)
+    , Functor(fmap)
+
+    , mapM          -- :: (Monad m) => (a -> m b) -> [a] -> m [b]
+    , mapM_         -- :: (Monad m) => (a -> m b) -> [a] -> m ()
+    , sequence      -- :: (Monad m) => [m a] -> m [a]
+    , sequence_     -- :: (Monad m) => [m a] -> m ()
+    , (=<<)         -- :: (Monad m) => (a -> m b) -> m a -> m b
+    ) where
 
 import PrelList
-import PrelTup
+import PrelMaybe
 import PrelBase
+
+infixr 1 =<<
 \end{code}
 
 %*********************************************************
 %*							*
-\subsection{Functions mandated by the Prelude}
+\subsection{Prelude monad functions}
 %*							*
 %*********************************************************
 
 \begin{code}
-accumulate      :: Monad m => [m a] -> m [a] 
-accumulate []     = return []
-accumulate (m:ms) = do { x <- m; xs <- accumulate ms; return (x:xs) }
+{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-}
+(=<<)           :: Monad m => (a -> m b) -> m a -> m b
+f =<< x		= x >>= f
+
+sequence       :: Monad m => [m a] -> m [a] 
+{-# INLINE sequence #-}
+sequence ms = foldr k (return []) ms
+	    where
+	      k m m' = do { x <- m; xs <- m'; return (x:xs) }
 
-sequence        :: Monad m => [m a] -> m () 
-sequence        =  foldr (>>) (return ())
+sequence_        :: Monad m => [m a] -> m () 
+{-# INLINE sequence_ #-}
+sequence_ ms     =  foldr (>>) (return ()) ms
 
 mapM            :: Monad m => (a -> m b) -> [a] -> m [b]
-mapM f as       =  accumulate (map f as)
+{-# INLINE mapM #-}
+mapM f as       =  sequence (map f as)
 
 mapM_           :: Monad m => (a -> m b) -> [a] -> m ()
-mapM_ f as      =  sequence (map f as)
+{-# INLINE mapM_ #-}
+mapM_ f as      =  sequence_ (map f as)
+\end{code}
+
+%*********************************************************
+%*							*
+\subsection{Monadic classes: @MonadPlus@}
+%*							*
+%*********************************************************
+
+
+\begin{code}
+class Monad m => MonadPlus m where
+   mzero :: m a
+   mplus :: m a -> m a -> m a
 
-guard           :: MonadZero m => Bool -> m ()
-guard p         =  if p then return () else zero
+instance MonadPlus [] where
+   mzero = []
+   mplus = (++)
+
+instance MonadPlus Maybe where
+   mzero = Nothing
+
+   Nothing `mplus` ys  = ys
+   xs      `mplus` _ys = xs
+\end{code}
+
+
+%*********************************************************
+%*							*
+\subsection{Functions mandated by the Prelude}
+%*							*
+%*********************************************************
+
+\begin{code}
+guard           :: (MonadPlus m) => Bool -> m ()
+guard True      =  return ()
+guard False     =  mzero
 
 -- This subsumes the list-based filter function.
 
-{-# SPECIALISE filter :: (a -> Bool) -> [a] -> [a] #-}
-filter          :: MonadZero m => (a -> Bool) -> m a -> m a
-filter p        =  applyM (\x -> if p x then return x else zero)
+filterM          :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
+filterM _ []     =  return []
+filterM p (x:xs) =  do
+   flg <- p x
+   ys  <- filterM p xs
+   return (if flg then x:ys else ys)
 
 -- This subsumes the list-based concat function.
 
-{-# SPECIALISE concat :: [[a]] -> [a] #-}
-concat          :: MonadPlus m => [m a] -> m a
-concat          =  foldr (++) zero
- 
-{-# SPECIALISE applyM :: (a -> [b]) -> [a] -> [b] #-}
-applyM          :: Monad m => (a -> m b) -> m a -> m b
-applyM f x      =  x >>= f
+msum        :: MonadPlus m => [m a] -> m a
+{-# INLINE msum #-}
+msum        =  foldr mplus mzero
 \end{code}
 
 
 %*********************************************************
-%*							*
+%							*
 \subsection{Other monad functions}
 %*							*
 %*********************************************************
 
 \begin{code}
-join             :: (Monad m) => m (m a) -> m a
-join x           = x >>= id
+join              :: (Monad m) => m (m a) -> m a
+join x            =  x >>= id
 
-mapAndUnzipM     :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
-mapAndUnzipM f xs = accumulate (map f xs) >>= return . unzip
+mapAndUnzipM      :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
+mapAndUnzipM f xs =  sequence (map f xs) >>= return . unzip
 
-zipWithM         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
-zipWithM f xs ys = accumulate (zipWith f xs ys)
+zipWithM          :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
+zipWithM f xs ys  =  sequence (zipWith f xs ys)
 
-zipWithM_ :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
-zipWithM_ f xs ys = sequence (zipWith f xs ys)
+zipWithM_         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
+zipWithM_ f xs ys =  sequence_ (zipWith f xs ys)
 
-foldM            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
-foldM f a []     = return a
-foldM f a (x:xs) = f a x >>= \fax -> foldM f fax xs
+foldM             :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
+foldM _ a []      =  return a
+foldM f a (x:xs)  =  f a x >>= \fax -> foldM f fax xs
 
-unless 		 :: (Monad m) => Bool -> m () -> m ()
-unless p s 	 =  if p then return () else s
+unless            :: (Monad m) => Bool -> m () -> m ()
+unless p s        =  if p then return () else s
 
-when 		 :: (Monad m) => Bool -> m () -> m ()
-when p s	 =  if p then s else return ()
+when              :: (Monad m) => Bool -> m () -> m ()
+when p s          =  if p then s else return ()
 
-ap :: (Monad m) => m (a->b) -> m a -> m b
-ap = liftM2 ($)
+ap                :: (Monad m) => m (a -> b) -> m a -> m b
+ap                =  liftM2 id
 
-liftM	:: (Monad m) => (a1 -> r) -> m a1 -> m r
-liftM2	:: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
-liftM3	:: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
-liftM4	:: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
-liftM5	:: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
+liftM   :: (Monad m) => (a1 -> r) -> m a1 -> m r
+liftM2  :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
+liftM3  :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
+liftM4  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
+liftM5  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
 
-liftM f m1	        = do { x1 <- m1; return (f x1) }
-liftM2 f m1 m2 		= do { x1 <- m1; x2 <- m2; return (f x1 x2) }
-liftM3 f m1 m2 m3 	= do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }
-liftM4 f m1 m2 m3 m4	= do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }
+liftM f m1              = do { x1 <- m1; return (f x1) }
+liftM2 f m1 m2          = do { x1 <- m1; x2 <- m2; return (f x1 x2) }
+liftM3 f m1 m2 m3       = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }
+liftM4 f m1 m2 m3 m4    = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }
 liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) }
 
 \end{code}