Zustandsmonaden

Wir betrachten noch einmal den Datentyp für blattbeschriftete Binärbäume

data Tree a = L a | Tree a :+:  Tree a

und wollen eine Funktion definieren, die die Knoten so eines Baums von links nach rechts durchnummeriert.

numberTree :: Tree a -> Tree (Int,a)

Beispiel (verkürzt):

ghci> numberTree ((L 'a') :+: (L 'b')) :+: (L 'c')
((L (1,'a')) :+: (L (2,'b'))) :+: (L (3,'c'))

Zur rekursiven Definition dieser Funktion über die Struktur von Binärbäumen benötigen wir einen zusätzlichen Parameter, der angibt, welche die nächste verfügbare Nummer ist. Wir könnten daher versuchen, die Funktion wie folgt zu definieren

numberTree t = numberTreeWithNum t 1

wobei numberTreeWithNum den Typ Tree a -> Int -> Tree (Int,a) hat. Beim Versuch, den rekursiven Fall von numberTreeWithNum zu definieren, bekommen wir aber das Problem, dass wir die Größe des linken Teilbaums kennen müssen um die nächste freie Nummer für den rechten zu berechnen. Statt den linken Teilbaum zweimal zu durchlaufen (einmal zur Nummerierung und einmal zur Berechnung der Größe) ist es besser, wenn unsere Hilfsfunktion nicht nur den nummerierten Baum sondern auch die nächste freie Nummer zurückgibt. Die nächste freie Nummer wird dadurch zu einer Art Zustand, der durch die Berechnung durchgereicht wird.

numberTreeWithState
  :: Tree a -> Int -> (Tree (Int,a), Int)

Mit dieser Funktion können wir numberTree definieren und müssen nur das erste Element des Ergebnisses selektieren, also die letzte freie Nummer ignorieren.

numberTree t = fst (numberTreeWithState t 1)

Unsere Hilfsfunktion definieren wir wie folgt. Ein Blatt verbracuht die aktuelle Nummer und liefert ihren Nachfolger im Ergebnis:

numberTreeWithState (L x) n = (L x,n+1)

Bei einem inneren Knoten nummerieren wir erst den linken Teilbaum, ergänzen die Beschriftung durch die dann nächste freie Nummer und nummerieren dann den rechten Teilbaum. Die nächste zu verwendende Nummer wird dabei vom linken in den rechten TEilbaum weiter geschoben.

numberTreeWithState (l :+: r) n =
  let (l',n1) = numberTreeWithState l n
      (r',n2) = numberTreeWithState r n1
   in (l' :+: r', n2)

Definitionen wie diese sind fehleranfällig, da man Variablen wie n1 und n2 leicht verwechseln kann, insbesondere, wenn unsere Bäume einen größeren Verzweigungsgrad aufweist. Das manuelle Auspacken und Weiterreichen des Zustands wird so bei größeren Programmen schnell unübersichtlich.

Die sequentielle Struktur dieses Programms (erst den linken Teilbaum nummerieren, dann den rechten), wirft die Frage auf, ob wir es nicht eleganter mit do-Notation implementieren können. Es folgt eine wünschenswerte monadische Variante unserer Hilfsfunktion, die einen Zustand mit Hilfe von Funktionen get und put manipuliert.

numberTreeState (L x) = do
  n <- get
  put (n+1)
  return (L (n,x)
numberTreeState (l :+: r) = do
  l' <- numberTreeState l
  r' <- numberTreeState r
  return (l' :+: r')

Können wir eine Monade definieren, die diese Definition erlaubt? Angenommen numberTreeState soll denselben Typ haben wie numberTreeWithState, dann müsste die return-Funktion den Typ a -> Int -> (a,Int) haben. Den Typkonstruktor IntState für die zugehörige Monade müssten wir dann so definieren:

type IntState a = Int -> (a,Int)

Der bind Operator hätte den Typ IntState a -> (a -> IntState b) -> IntState b. Außerdem haben wir Funktionen get und put verwendet, die in dem Fall folgende Typen haben müssten:

get :: IntState Int
put :: Int -> IntState ()

Zur Implementierung dieser und der monadischen Funktionen ist der konkrete Typ des Zustands (hier Int) unerheblich, wir können von diesem also abstrahieren. Außerdem definieren wir statt eines Typsynonyms einen neuen Typ mit newtype um Berechnungen in Zustandsmonaden von anderen Funktionen zu unterscheiden, die zufällig einen passenden Typ haben.

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

Zu diesem Typ definieren wir eine Funktion

runState :: State s a -> s -> (a,s)
runState (State f) = f

mit der man Berechnungen in Zustandsmonaden ausführen kann. Es gilt offensichtlich runState (State f) = f und für alle a :: State s a auch State (runState a) = a.

Wir geben nun eine Monad-Instanz für den Typkonstruktor State s an. Die return-Funktion lässt den Zustand unverändert und der bind-Operator reicht ihn durch sein erstes Argument in die Berechnung des zweiten.

instance Monad (State s) where
  return x = State (\s -> (x,s))

  a >>= f = State (\s -> let (x,s') = runState a s
                          in runState (f x) s')

An dieser Stelle programmieren wir vom prinzip genau einmal das Weiterschleifen des Zustands, wie in der Funktion numberTreeWithState in der Bind-Funktion.

Wir müssen nun zeigen, dass diese Implementierung die Monadengesetze erfüllt. return ist eine Links-Identität für bind:

   return x >>= f
 = State (\s ->
     let (x',s') = runState (return x) s
      in runState (f x') s')
 = State (\s ->
     let (x',s') = runState (State (\s -> (x,s))) s
      in runState (f x') s')
 = State (\s ->
     let (x',s') = (\s -> (x,s)) s
      in runState (f x') s')
 = State (\s ->
     let (x',s') = (x,s)
      in runState (f x') s')
 = State (\s -> runState (f x) s)
 = State (runState (f x))
 = f x

return ist auch eine Rechts-Identität für bind:

   a >>= return
 = State (\s -> let (x,s') = runState a s
                 in runState (return x) s')
 = State (\s -> let (x,s') = runState a s
                 in runState (State (\s -> (x,s))) s')
 = State (\s -> let (x,s') = runState a s
                 in (\s -> (x,s)) s')
 = State (\s -> let (x,s') = runState a s in (x,s'))
 = State (\s -> runState a s)
 = State (runState a)
 = a

Schließlich zeigen wir noch das Assoziativgesetz für den bind Operator.

  (a >>= f) >>= g
= State (\s -> let (x,s') = runState (a >>= f) s
                in runState (g x) s')
= State (\s ->
    let (x,s') = runState (State (\t ->
                  let (y,t') = runState a t
                   in runState (f y) t')) s
     in runState (g x) s')
= State (\s ->
    let (x,s') = (\t -> let (y,t') = runState a t
                         in runState (f y) t') s
     in runState (g x) s')
= State (\s ->
    let (x,s') = let (y,t') = runState a s
                  in runState (f y) t'
     in runState (g x) s')
= State (\s ->
    let (y,t') = runState a s
        (x,s') = runState (f y) t'
     in runState (g x) s')
= State (\s ->
    let (y,t') = runState a s
     in let (x,s') = runState (f y) t'
         in runState (g x) s')
= State (\s ->
    let (y,t') = runState a s
     in (\t -> let (x,s') = runState (f y) t
                in runState (g x) s') t')
= State (\s ->
    let (y,t') = runState a s
     in runState (State (\t ->
          let (x,s') = runState (f y) t
           in runState (g x) s')) t')
= State (\s -> let (y,t') = runState a s
                in runState (f y >>= g) t')
= a >>= \x -> f x >>= g

Es fehlen noch die Definitionen für get und put. Die get-Funktion lässt den Zustand unverändert und gibt ihn zusätzlich als erstes Argument des Ergebnispaares zurück.

get :: State s s
get = State (\s -> (s,s))

Die put-Funktion ignoriert den durchgereichten Zustand und ersetzt ihn durch den übergebenen.

put :: s -> State s ()
put s = State (\_ -> ((),s))

Mit diesen Definitionen können wir die Funktion numberTree nun unter Verwendung der monadischen Hilfsfunktion numberTreeState definieren:

numberTree :: Tree a -> Tree (Int,a)
numberTree t = fst (runState (numberTreeState t) 1)

Es stellt sich die Frage, ob die gezeigte Implementierung die einzig mögliche einer Zustandsmonade ist. Analog zur Verallgemeinerung der Listenmonade durch die MonadPlus Typklasse können wir die State s-Monade zu beliebigen Zustandsmonaden abstrahieren, indem wir die Schnittstelle in einer Typklasse spezifizieren.

Zustandsmonaden stellen neben den monadischen Operationen zwei Funktionen get und put zur Verfügung, die wir wie folgt in einer Typklasse abstrahieren können:

class Monad m => MonadState s m where
  get :: m s
  put :: s -> m ()

MonadState ist eine sogenannte Multi-Parameter-Typklasse, denn sowohl der Zustandstyp als auch der Monaden-Typkonstruktor sind Parameter von MonadState. Multi-Parameter-Klassen gehören nicht zum Haskell'98 Standard, können aber im GHC oder GHCi durch die Spracherweiterung MultiParamTypeClasses aktiviert werden. Um entsprechende Instanzen deklarieren zu können ist zusätzlich noch die Erweiterung FlexibleInstances notwendig.

Wir können den Typkonstruktor State s zu einer Instanz der Klasse MonadState s machen, indem wir die vorherigen Defnitionen von get und put in die Instanzdeklaration schreiben.

instance MonadState s (State s) where
  get   = State (\s -> (s,s))
  put s = State (\_ -> ((),s))

Wie bei MonadPlus können wir uns auch bei MonadState fragen, welche Gesetze für Zustandsmonaden erfüllt sein sollen. Zwei sinnvolle Gesetze sind zum Beispiel das Gesetz

get >>= put  =  return ()

welches besagt, dass das Setzen des Zustands auf den aktuellen Zustand keinen Effekt hat und das Gesetz

put s >> get  =  put s >> return s

welches besagt, dass get den zuvor gesetzten Zustand liefert und diesen nicht verändert.

Das folgende zeigt, dass unsere Implementierung diese Gesetze erfüllt.

  get >>= put
= State (\s ->
    let (x,s') = runState get s
     in runState (put x) s'
= State (\s ->
    let (x,s') = runState (State (\s -> (s,s))) s
     in runState (put x) s')
= State (\s ->
    let (x,s') = (s,s)
     in runState (put x) s')
= State (\s -> runState (put s) s)
= State (\s -> runState (State (\_ -> ((),s))) s)
= State (\s -> ((),s))
= return ()

Auch das zweite Gesetz gilt:

  put s >> get
= State (\t ->
    let (x,t') = runState (put s) t
     in runState get t')
= State (\t ->
    let (x,t') = runState (State (\_ -> ((),s))) t
     in runState get t')
= State (\t ->
    let (x,t') = ((),s)
     in runState (State (\s -> (s,s))) t')
= State (\t -> (s,s))
= State (\t -> let (x,t') = ((),s) in (s,t'))
= State (\t ->
    let (x,t') = runState (State (\_ -> ((),s))) t
     in runState (State (\s' -> (s,s'))) t'
= State (\t ->
    let (x,t') = runState (put s) t
     in runState (return s) t'
= put s >> return s

Durch die MonadState-Klasse kann die numberTreeState-Funktion in beliebigen Zustandsmonaden ausgeführt werden, denn sie hat den Typ

numberTreeState :: MonadState Int m => Tree a -> m (Tree (Int,a))

Bisher kennen wir keine anderen Zustandsmonaden, wir werden aber später alternative Implementierungen kennen lernen.

Implementierung einer besonderen Zustandsmonade: IO

Bisher haben wir viele Monaden selber implementiert. Was aber ist mit der IO-Monade? Können wir diese auch selber implementieren? Die Antwort ist ja! Die IO-Aktionen nehmen ebenfalls einenn Zustand, die Welt und liefern die veränderte Welt als veränderten Zustand in Kombination mit dem Ergebnis zurück. Wenn wir dies allerdings selbst implementieren, reicht es aus, eine "Dummy-Welt" zu verwenden, um die Arbeit der IO-Monade zu simulieren:

newtype MyIO a = MyIO World -> (a, World)
type    World  = ()

Wichtig ist aber, dass die Welt immer weitergereicht wird und zwischendurch keine neue Welt "erfunden" wird. Damit können wir die Monaden-Funktionen definieren als:

instance Monad MyIO where
  return x = MyIO \ w -> (x, w)

  (a >>= k) = MyIO \ w -> case a w of
                           (r, w') -> k r w'

"Die Welt" wird also durchgeschliffen, so dass die Aktion a ausgeführt werden muss bevor k ausgeführt werden kann! Beachte bei diesem Ansatz: Die Welt darf nicht dupliziert werden!

Anderer Ansatz: Die Sprache Clean stellt über das Uniqueness-Typsystem sicher, dass die Welt unique bleibt, also nicht dupliziert werden kann und gewährleistet so die Sequentialisierung. So ist es in Clean zwar möglich die Welt in Teile zu zerteilen, die dann unabhängig verwendet werden können; diese Teile können aber nicht wieder zusammengefügt werden.

Bei unserem Ansatz muss in den primitiven Funktionen die Umwandlung in und von C-Datenstrukturen durchgeführt werden, bevor die Welt zurückgegeben wird. Das Starten unserer IO-Monade geschieht durch Applikation auf ():

runIO :: MyIO() -> Int
runIO a = case a () of
            ((), ()) -> 42

Dabei ist der Rückgabetyp von runIO eigentlich egal, er ist im Laufzeitsystem verborgen.

Beachte: Für unsere eigene IO-Monade können wir auch folgende Operation definieren:

unsafePerformIO :: MyIO a -> a
unsafePerformIO a = case a () of
                      (r, _) -> r

Wir erfinden einfach eine neue Welt und verwenden diese zum Start einer neuer IO-Aktionen an einer beliebigen Programmstelle. Diese Funktion ist aber unsicher, da sie nicht referentiell transparent ist:

c :: String
c = unsafePerformIO getLine

Diese Konstante c kann bei jeder Programmausführung einen anderen Wert haben! Auch Haskell stellt die Funktion unsafePerformIO :: MyIO a -> a zur Verfügung. eine Verwendung in normalen Anwendungen ist aber wegen des Verlustes der referentiellen Transparenz unschön.

Bis jetzt enthält unsere IO-Monade noch keine Funktionen, die die Welt tatsächlich verändern. Um solche C-Funktionen einfach einzubinden, verwenden wir die vordefinierten aus der wirklichen IO-Monade. Durch die Verwendung von unsafePerformIO, können wir sie zunächst unsicher verwenden (wie ein C-Aufruf.

module MyIO where

import System.IO.Unsafe (unsafePerformIO)

Um mit unserer eigenen IO-Monade komfortabler arbeiten zu können, definieren wir sie erneut als Record:

-- Alternative Variante mit Records
newtype MyIO a = MyIO { unIO :: (World -> (a, World)) }

instance Monad MyIO where
  return x = MyIO (\ w -> (x, w))
  m >>= f  = MyIO (\ w -> case unIO m w of (r, w') -> unIO (f r) w')

runMyIO :: MyIO a -> a
runMyIO io = fst (unIO io ())

myPutStr

Zur Implementierung von myPutStr benutzen wir unsafePerformIO putStr. Ein erster Ansatz könnte wie folgt aussehen:

wrongPutStr :: String -> MyIO ()
wrongPutStr = return . unsafePerformIO . putStr

Wenn wir dies ausprobieren, geschieht aber folgendes:

*MyIO> runMyIO (wrongPutStr "hallo")
hallo()
*MyIO> runMyIO (wrongPutStr "hallo" >> return 42)
42

Warum wird beim zweiten Aufruf nichts ausgedruckt? Hierfür schauen wir uns die Formulierung ohne return an:

wrongPutStr2 :: String -> MyIO ()
wrongPutStr2 str = MyIO (\ w -> (unsafePerformIO (putStr str), w))

Bei dem zweiten Aufruf oben wird das Ergebnis von unsafePerformIO (putStr str) nicht betrachtet, daher wird dieser Ausdruck wegen Laziness also auch nicht ausgewertet!

Wie können wir die Ausgabe also "erzwingen"? Um zu erreichen, dass vor der Konstruktion des Rückgabetupels das unsafePerformIO (putStr str) auf jeden Fall ausgeführt wird, nutzen wir Pattern Matching auf den Unit-Konstruktor:

myPutStr :: String -> MyIO ()
myPutStr str = MyIO (\ w -> case unsafePerformIO (putStr str) of 
                             () -> ((), w))

Zur Konstruktion des Rückgabetupels muss das Ergebnis von unsafePerformIO (putStr str) nun zuerst gegen () gematcht und damit ausgewertet werden:

*MyIO> runMyIO (myPutStr "hallo" >> return 42)
hallo42

myGetLine

Für die Implementierung von myGetLine können wir genauso vorgehen:

myGetLine :: MyIO String
myGetLine = MyIO (\ w -> case unsafePerformIO getLine of
                          ""  -> ("" , w)
                          str -> (str, w))

Bei beiden Funktionen rufen wir nun unsafePerformIO auf und bringen das Ergebnis durch Pattern Matching in Kopfnormalform (Auswertung des äußersten Konstruktors), dies können wir auch in eine neue Funktion abstrahieren:

lift :: IO a -> MyIO a lift ioAct = MyIO ( w -> let res = unsafePerformIO ioAct in res seq (res , w))

myPutStr = lift . putStr myGetLine = lift getLine _~

seq ist dabei eine primitive Funktion die das erste Argument zur Kopfnormalform auswertet und dann das zweite Argument zurückgibt.

Als Anwendungsbeispiel wollen wir nun noch die Funktion revLines definieren, welche vom Benutzer mehrere Zeile einliest (bis ein Punkt eingegeben wird) und diese anschließend in umgekehrter Reihenfolge wieder ausgibt:

revLines :: MyIO ()
revLines = do
  line <- myGetLine
  if line == "."
    then return ()
    else revLines >> myPutStr (line ++ "\n")

Zum Schluss ein Test:

*MyIO> runMyIO revLines
unsafe
performs
IO
.
IO
performs
unsafe
()

In Haskell ist die IO-Monade genau so implementiert. Hierbei steht die Funkrion runIO dem Benutzer aber nicht zur verfügung, sondern wird vom System zum Start der toplevel IO-Funktion hinzugefügt. Hierdurch ist es nicht möglich in Unterberechnungen Seiteneffekt auszuführen.

Zusatzbemerkung

Zum besseren Verständnis schauen wir uns noch die beiden folgenden falschen Implementierungen von getLine an:

wrongGetLine :: MyIO String
wrongGetLine = return (unsafePerformIO getLine)

wrongGetLine2 :: MyIO String
wrongGetLine2 = MyIO (\w -> (unsafePerformIO getLine, w))

mit

*MyIO> runMyIO wrongGetLine
"abc
abc"
*MyIO> runMyIO wrongGetLine
"abc"
*MyIO> runMyIO wrongGetLine2
"abc
abc"
*MyIO> runMyIO wrongGetLine2
"abc
abc"

, hier sind wrongGetLine und wrongGetLine2 also nicht äquivalent. Der Grund wird deutlich wenn wir uns anschauen wie die beiden Ausdrücke übersetzt werden:

wrongGetLine :: MyIO String
wrongGetLine = let x = unsafePerformIO getLine in MyIO (\w -> (x, w))

wrongGetLine2 :: MyIO String
wrongGetLine2 = MyIO (\w -> let x = unsafePerformIO getLine in (x, w))

Im ersten Ausdruck wird x als Konstante erkannt und nur einmal berechnet, im zweiten Ausdruck ist x jedoch Teil des Rumpfes der Lambda-Abstraktion und damit potentiell von dem Argument w abhängig und wird daher bei jeder Applikation erneut ausgewertet.

Prinzipiell könnte der Compiler dies auch erkennen und den konstanten Ausdruck aus der Abstraktion herausziehen ("let-floating"), allerdings müsste der einmal ausgewertete Ausdruck dann im Speicher vorgehalten werden, sodass man sich im Prinzip bessere Laufzeit durch mehr Speicherverbrauch "erkauft." Daher muss diese Optimierung explizit aktiviert werden.