1 module State
    2 
    3 ( Sym, dosym
    4 , gensym, push
    5 )
    6 
    7 where
    8 
    9 
   10 -- state Monad ----------------------------------------------------
   11 
   12 data Sym s a = Sym (s -> (s, a))
   13 
   14 dosym :: Sym (Int, [s]) a -> (a, [s])
   15 -- start computation, show effect
   16 dosym (Sym f) = let ((_, x), r) = f (0, []) in (r, x)
   17 
   18 instance Functor (Sym s) where 
   19         fmap f (Sym s) = Sym (\ c -> 
   20                 let (d, a) = s c in (d, f a) )
   21 
   22 instance Monad (Sym s) where
   23     return x = Sym (\ c -> (c, x))
   24     Sym x >>= f = Sym (\ c -> 
   25 
   26 -- phorward state is this:
   27         let (d, r) = x c; Sym y = f r; (e, s) = y d in (e, s) )
   28 
   29 -- but we're using backward state (NOT)
   30 --      let (d, s) = y c; Sym y = f r; (e, r) = x d in (e, s) )
   31 
   32 -- used for symbol supply
   33 gensym :: Sym (Int, a) String
   34 gensym = Sym (\ (c,x) -> ((c+1,x), "$" ++ show c))
   35 
   36 -- remember a result
   37 push :: a -> Sym (b, [a]) ()
   38 push x = Sym ( \ (c, xs) -> ((c, x : xs), () ))
   39