Am Samstag, 28. Februar 2009 15:36 schrieb Andrew Wagner:
Ok, so this question of stacking state on top of state has come up several times lately. So I decided to whip up a small example. So here's a goofy little example of an abstract representation of a computer that can compute a value of type 'a'. The two states here are a value of type 'a', and a stack of functions of type (a->a) which can be applied to that value.
Nice.
Disclaimer: this code is only type-checked, not tested!
import Control.Monad.State
import Control.Moand (unless)
-- first, we'll rename the type, for convenience type Programmable a = StateT [a->a] (State a)
-- add a function to the stack of functions that can be applied -- notice that we just use the normal State functions when dealing -- with the first type of state add :: (a -> a) -> Programmable a () add f = modify (f:)
-- add a bunch of functions to the stack -- this time, notice that Programmable a is just a monad addAll :: [a -> a] -> Programmable a () addAll = mapM_ add
Be aware that this adds the functions in reverse order, an alternative is addAll = modify . (++) (addAll fs = modify (fs ++))
-- this applies a function directly to the stored state, bypassing the function stack -- notice that, to use State functions on the second type of state, we must use -- lift to get to that layer modify' :: (a -> a) -> Programmable a () modify' f = lift (modify f)
-- pop one function off the stack and apply it -- notice again the difference between modify' and modify. we use modify' to modify the value -- and modify to modify the function stack. This is again because of the order in which we wrapped -- the two states. If we were dealing with StateT a (State [a->a]), it would be the opposite. step :: Programmable a () step = do fs <- get let f = if (null fs) then id else (head fs) modify' f modify $ if (null fs) then id else (const (tail fs))
Last line could be modify (drop 1)
-- run the whole 'program' runAll :: Programmable a () runAll = do fs <- get if (null fs) then (return ()) else (step >> runAll)
runAll = do stop <- gets null unless stop (step >> runAll)