[Haskell-cafe] Stacking State on State.....
wren ng thornton
wren at freegeek.org
Sun Mar 1 04:07:08 EST 2009
Phil wrote:
| After some googling it looked like the answer may be Monad Transformers.
| Specifically we could add a StateT transform for our Box Muller state
to our
| VanDerCorput State Monad.
| Google didn¹t yield a direct answer here so I¹m not even sure if my
| thinking is correct,
Ignoring Daniel Fischer's astute observation that you can generalize the
idea to directly describe the stream ;) The sample code you're looking
for is:
> {-# LANGUAGE GeneralizedNewtypeDeriving #-}
> import Control.Monad.State
>
>
> newtype VanDerCorput a = VDC (State Int a)
> deriving Monad
>
> runVDC :: VanDerCorput a -> a
> runVDC (VDC sa) = evalState sa 1
>
> getVDC :: VanDerCorput Int
> getVDC = VDC $ do x <- get
> put (f x)
> return x
> where
> f = (1+)
>
>
> newtype BoxMuller a = BM (StateT (Maybe Int) VanDerCorput a)
> deriving Monad
>
> runBM :: BoxMuller a -> a
> runBM (BM vsa) = runVDC (evalStateT vsa Nothing)
>
> getBM :: BoxMuller Int
> getBM = BM $ do saved <- get
> case saved of
> Just x -> put Nothing >> return x
> Nothing -> do a <- lift getVDC
> b <- lift getVDC
> put (Just (f a b))
> return (g a b)
> where
> -- or whatever...
> f = const
> g = const id
--
Live well,
~wren
More information about the Haskell-Cafe
mailing list