Code V12

Dateiinhalt

-- Zustandsmonade zu Fuss

import Control.Monad

-- Erstmal festlegen, was unser Zustand sein soll und wie wir
-- darauf operieren. Hier: Drei globale Integer Variablen
data Name = VarX | VarY | VarZ 
type Wert = Integer 
type State = (Integer, Integer, Integer)

leseVar :: Name -> State -> Wert
leseVar VarX (x,_,_) = x
leseVar VarY (_,y,_) = y
leseVar VarZ (_,_,z) = z

schreibeVar :: Name -> Wert -> State -> State
schreibeVar VarX wert (x,y,z) = (wert,y,z)
schreibeVar VarY wert (x,y,z) = (x,wert,z)
schreibeVar VarZ wert (x,y,z) = (x,y,wert)

newState :: State
newState = (0,0,0)

-- Soweit hat das nichst mit Monaden zu tun.
-- Machen wir nun eine Monade zur Berechnung in einem State.
-- Dazu brauchen wir erstmal einen Typkonstruktor, der 
-- in die Monaden Typklasse aufgenommen werden kann:

newtype Env a = Env (State -> (a, State))

instance Monad Env where
  -- return :: a -> Env a
  return x = Env $ \state -> (x,state)
  
  -- (>>=) :: Env a -> (a -> Env b) -> Env b
  (>>=) (Env actA) f = Env $ \state0 -> 
                        let (a,state1) = actA state0
                            (Env actB) = f a
                        in actB state1 
  
-- Jetzt kommen die monadischen Operationen  
getVar :: Name -> Env Wert
getVar name = Env $ \state -> 
                let wert = leseVar name state
                in (wert,state)                    

putVar :: Name -> Wert -> Env ()
putVar name wert = Env $ \state0 -> 
                    let state1  = schreibeVar name wert state0
                    in ((),state1)

-- Stein des Anstosses: initialen Zustand in die Monade hereingeben                   
runState :: State -> Env a -> (a, State)
runState state (Env f) = f state
                    
                    
-- Anwendungsdemos:                    
demo1 :: Env Wert
demo1 = do
          putVar VarX 42
          putVar VarY 69
          x <- getVar VarX 
          putVar VarX $ x + 2
          getVar VarX
          
demo2 :: Env Wert
demo2 = do
  putVar VarY 2
  putVar VarX 1
  forM [1..8] (\w -> do
                 x <- getVar VarX
                 y <- getVar VarY
                 putVar VarX $ x * y -- x := x*y -- x *= y
              )
  getVar VarX  
          
-- Demos ausführen:          
runDemo1 = runState newState demo1
runDemo2 = fst $ runState newState demo2