1 files changed, 491 insertions, 0 deletions

diff --git a/ws2015/ffp/blaetter/10/FFP_U10_STM.hs b/ws2015/ffp/blaetter/10/FFP_U10_STM.hs
new file mode 100755
index 0000000..9a99e86
--- /dev/null
+++ b/ws2015/ffp/blaetter/10/FFP_U10_STM.hs
@@ -0,0 +1,491 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- Fortgeschrittene Funktionale Programmierung, 
+--   LMU, TCS, Wintersemester 2015/16
+--   Steffen Jost, Alexander Isenko
+--
+-- Übungsblatt 10. 23.12.2015
+--
+-- Thema: Software Transactional Memory
+--
+-- Hinweis:
+--   Heute gibt es nur eine größere Aufgabe!
+--   Wer damit fertig ist, sollte im Anschluß zuvor
+--   übersprunge Aufgaben behandeln.
+--
+--   Für diese Übung reicht auch ein Rechner mit einem Kern.
+--
+
+
+-- A10-1 The Santa Claus problem
+--
+-- Heute wollen wir uns von Haskell ganz nebenläufig
+-- in eine weihnachtliche Stimmung versetzen lassen:
+--
+-- Der Weihnachtsmann schläft friedlich am Nordpol.
+-- Er läßt sich jedoch nur in zwei Situationen wecken:
+--  1) Alle seine 9 Rentiere sind bereits aus dem Karibik-Urlaub
+--     zurückgekommen. Dann ist es bereits höchste Zeit,
+--     diese an den Schlitten zu binden und die Geschenke
+--     auzuliefern, denn die Rentiere möchten möglichst viel Zeit
+--     in der Karibik verbringen und kommen ungern früher als
+--     nötig zum Nordpol zurück. (Deswegen beeilen sich die
+--     Rentiere auch so beim Ausliefern aller Geschenke!)
+--  2) Einige seiner elf Elfen haben Probleme mit
+--     Innovationsmanagement oder Fertigungstechnik
+--     für die Produktion der Geschenke und verlangen
+--     ein Executive Meeting.
+--     Da die Elfen immer irgendwelche Probleme haben,
+--     läßt sich der Weihnachtsmann nur wecken, wenn
+--     mindestens 3 Elfen nach einem Meeting verlangen;
+--     Falls nur ein oder zwei Elfen ein Gesprächsbedürfnis
+--     hegen, so müssen diese ruhig und erfurchtsvoll im
+--     Vorzimmmer abwarten.
+--     Da andererseits Meetings mit mehr als 3 Elfen
+--     absolut unproduktiv sind, müssen alle Elfen ab dem
+--     vierten ebenfalls warten, bis der Weihnachtsmann das
+--     vorherige Meeting beendet hat (waren es z.B. insgesamt
+--     5 Elfen, dann müssen der vierte und fünfte Elf natürlich
+--     erneut auf einen sechsten Elfen warten).
+-- Der Weihnachtsmann beendet immer zuerst eine angefangene Aufgabe,
+-- bevor er eine neue Aufgabe beginnt.
+-- Treten beide Ereignisse gleichzeitig ein, so gibt er den Rentieren
+-- den Vorrang, da die Geschenke ja pünktlich ausgeliefert werden müssen.
+--
+-- Diese Problem wollen wir in Haskell mithilfe der
+-- Implementationstechnik "Software Transactional Memory"
+-- modellieren.
+--
+--
+-- Diese Aufgabenstellung stammt aus "A new excercise in concurrency"
+-- von John A. Trono, SIGCSE Bulletin, 26:8-10, 1994.
+--
+-- Eine elegante Lösung dieses Problems unter Verwendung von
+-- Software Transactional Memory wird detailliert behandelt von
+-- Simon Peyton Jones im Kapitel "Beautiful Concurrency"
+-- aus dem Buch "Beautiful Code" von Greg Wilson und Andy Oram, O'Reilly, 2007.
+--
+--
+-- Das Gerüst in dieser Datei macht bereits einige Vorschläge,
+-- doch Sie dürfen ALLES ABÄNDERN, z.B. zusätzliche Funktionsargumente
+-- zum Übergeben von TVars werden vermutlich notwendig sein, etc.
+--
+-- Versuchen Sie zuerst einmal, Santa & die Rentiere
+-- zu synchronisieren und deaktivieren Sie die Elfen.
+--
+-- Die zentrale Frage lautet:
+--   Wie viele TVars welcher Art werden gebraucht?
+--
+-- Am Ende dieser Datei befinden sich weitere Hinweise.
+-- Schauen Sie dort nach, falls Sie nicht weiter wissen.
+--
+
+
+
+module Main where
+
+
+import Data.List
+import Control.Concurrent.STM
+import Control.Concurrent
+import Control.Monad
+import System.Random
+import System.IO
+
+import Control.DeepSeq
+import qualified Data.Set as Set
+import           Data.Set        (Set)
+
+
+newtype ElfId = Elf Integer
+              deriving (Num, Enum, Show, Eq, Ord, NFData)
+newtype RaindeerId = Raindeer Integer
+                   deriving (Num, Enum, Show, Eq, Ord, NFData)
+
+data GroupState id = GroupState
+                     { waiting :: TVar [id]
+                     , working :: TVar (Set id)
+                     }
+
+data State = State
+             { elfs :: GroupState ElfId
+             , raindeers :: GroupState RaindeerId
+             , outChan :: Chan String
+             }
+
+initState :: IO State
+initState = State
+            <$> initGroupState
+            <*> initGroupState
+            <*> newChan
+            
+initGroupState :: IO (GroupState a)
+initGroupState = GroupState
+                 <$> newTVarIO []
+                 <*> newTVarIO Set.empty
+
+
+main :: IO ()
+main = initState >>= main'
+
+main' :: State -> IO ()
+main' state@(State{..}) = do
+  mapM_ (forkIO . elf state) [1..11]
+  mapM_ (forkIO . rentier state) [1..9]
+  forkIO $ santa state
+
+  hSetBuffering stdin NoBuffering
+  forkIO $ forever $ readChan outChan >>= putStrLn
+
+  mloop
+  where
+    mloop = getChar >>= flip unless mloop . (== 'q')
+
+
+
+santa :: State -> IO ()
+santa State{..} = forever . join . atomically $ deliver `orElse` meeting
+  where
+    deliver = do
+      check . (>= 9) . length =<< readTVar (waiting raindeers)
+      mapM_ (flip setWorking raindeers) =<< readTVar (waiting raindeers)
+      return $ do
+        writeChan outChan "Ho! Ho! Ho! Hüja Rentiere!"
+        atomically $ check . Set.null =<< readTVar (working raindeers)
+    meeting = do
+      check . (>= 3) . length =<< readTVar (waiting elfs)
+      mapM_ (flip setWorking elfs) =<< take 3 <$> readTVar (waiting elfs)
+      return $ do
+        writeChan outChan "Ho! Ho! Ho! Besprechung eröffnet!"
+        atomically $ check . Set.null =<< readTVar (working elfs)
+
+
+
+elf :: State -> ElfId -> IO ()
+elf State{..} eid = forever $ do
+  writeChan outChan $ show eid ++ " arbeitet."
+  randomDelay 6
+  writeChan outChan $ show eid ++ " ist traurig."
+
+  atomically $ setWaiting eid elfs
+  atomically $ check =<< isWorking eid elfs
+
+  writeChan outChan $ show eid ++ " hat Besprechung."
+  randomDelay 1
+  writeChan outChan $ show eid ++ " hat Besprechung verlassen."
+  atomically $ unregister eid elfs
+
+
+
+rentier :: State -> RaindeerId -> IO ()
+rentier State{..} rid = forever $ do
+  writeChan outChan $ show rid ++ " ist im Urlaub."
+  randomDelay 8
+  writeChan outChan $ show rid ++ " ist zurück."
+
+  atomically $ setWaiting rid raindeers
+  atomically $ check =<< isWorking rid raindeers
+
+  writeChan outChan $ show rid ++ " liefert Geschenke."
+  randomDelay 2
+  writeChan outChan $ show rid ++ " ist fertig mit ausliefern."
+  atomically $ unregister rid raindeers
+
+
+
+--------------------
+-- Hilfsfunktionen
+--------------------
+
+randomDelay :: Int -> IO ()
+-- Delay for a random time between 1 and n * 500,000 microseconds
+randomDelay n = do
+  let t = n * 500000
+  waitTime <- getStdRandom (randomR (1, t))
+  threadDelay waitTime
+
+snoc :: a -> [a] -> [a]
+snoc = flip (++) . pure
+
+setWaiting :: (Ord id, NFData id) => id -> GroupState id -> STM ()
+setWaiting id st@(GroupState{..}) = unregister id st >> modifyTVar' waiting (snoc id $!!)
+
+setWorking :: (Ord id, NFData id) => id -> GroupState id -> STM ()
+setWorking id st@(GroupState{..}) = unregister id st >> modifyTVar' working (Set.insert id $!!)
+
+isWorking :: (Ord id, NFData id) => id -> GroupState id -> STM Bool
+isWorking id GroupState{..} = Set.member id <$> readTVar working
+
+unregister :: (Ord id, NFData id) => id -> GroupState id -> STM ()
+unregister id GroupState{..} = do
+  modifyTVar' waiting (filter (/= id) $!!)
+  modifyTVar' working (Set.delete id $!!)
+
+{- Eventuell nützliche Funktion aus Modul Control.Monad.STM:
+
+check :: Bool -> STM ()
+check b = if b then return () else retry
+
+-}
+
+
+
+
+
+----------------------------------------------------------------
+-- WEITERE HINWEISE:
+----------------------------------------------------------------
+
+
+
+{-
+  * Beide Quellen zur Aufgabe finden sich problemlos im Internet,
+  unter anderem auch im Haskell Center auf fpcomplete.com.
+  Die elegante Lösung von Simon Peyton Jones ist auf einem sehr hohen
+  Abstraktionsniveau, welches wir vermutlich nicht auf Anhieb in der
+  Übung erreichen können.
+
+  Natürlich ist es schön und vermeidet Fehler, wenn man zum Beispiel
+  den ähnlichen Code für Rentiere und Elfe mit einer generischen
+  Funktion abhandeln kann, aber für den Anfang is es okay, spezielleren
+  Code zu schreiben, so lange dieser korrekt ist.
+  Gemeinsamkeiten im Code kann man hinterher immer noch Erkennen
+  und generalisieren.
+
+  Unser Lösungsvorschlag im UniworX wird daher auch eine weniger elegante
+  Version zeigen. Es wird jedoch ausdrücklich empfohlen, hinterher
+  einmal auch die kürzere Lösung von Simon Peyton Jones durchzudenken.
+-}
+
+
+
+{-
+  * Die Grundidee ist wie folgt:
+
+  Jedes Rentier/Elf durchläuft folgende Endlosschleife:
+    1. Eigene Arbeit erledigen (durch Aufruf an "randomDelay" symbolisiert)
+    2. Bereitschaft an Weihnachtsmann Prozess signalisieren
+    3. Warten, bis Weihnachtsmann Startzeichen gibt.
+    4. Arbeit mit Weihnachtsmann erledigen (durch Aufruf an "randomDelay" symbolisiert)
+    5. Weihnachtsmann das Ende der eigenen Arbeit signalisieren
+
+  Der Weihnachtsmann (bzw. dessen PA, da der Weihnachtsmann
+  selbst ja eigentlich schläft), prüft ständig ob genug
+  Rentiere oder Elfen seine Aufmerksamkeit verlangen, und
+  gibt ggf. den entsprechenden Rentieren/Elfen das Startsignal.
+  Danach wartet er darauf, dass diese noch das Ende der jeweiligen Aufgabe signalisieren.
+-}
+
+
+
+{-
+  Signalisieren soll ausschließlich über TVars erfolgen,
+  warten kann mit retry oder check (siehe Hilfsfunktionen) realisiert werden.
+-}
+
+
+
+{-
+  Die Antowrt auf die Frage, wie viele TVars welcher Art gebraucht werden,
+  kann ganz unterschiedlich beantwortet werden.
+
+  Zum Beispiel verwendet unser Lösungsvorschlag mehrere globale TVars,
+  während die Lösung von Simon Peyton Jones nur 2 in einem
+  speziellen Datentyp verpackte TVars verwendet, welche auf weitere,
+  je nach Aufgabe dynamisch angelegte, TVars verweisen.
+-}
+
+
+
+{-
+
+Beispielausgabe mit vielen Extra-Ausgaben an der Konsole zum Verständnis des Ablaufs:
+
+
+Elf 21 ist traurig. Wartezimmer vorher: 0
+Elf 16 ist traurig. Wartezimmer vorher: 1
+Elf 11 ist traurig. Wartezimmer vorher: 2
+Ho! Ho! Ho! Besprechung eröffnet [21,16,11] !
+Elf 21 hat Besprechung.
+Elf 16 hat Besprechung.
+Elf 11 hat Besprechung.
+Rentier 8 ist zurück. Vorher im Stall: 0
+Elf 20 ist traurig. Wartezimmer vorher: 0
+Elf 13 ist traurig. Wartezimmer vorher: 1
+Rentier 7 ist zurück. Vorher im Stall: 1
+Ho! Ho! Ho! Besprechung vorbei!
+Rentier 6 ist zurück. Vorher im Stall: 2
+Elf 14 ist traurig. Wartezimmer vorher: 2
+Elf 11 ist traurig. Wartezimmer vorher: 3
+Elf 17 ist traurig. Wartezimmer vorher: 4
+Elf 15 ist traurig. Wartezimmer vorher: 5
+Ho! Ho! Ho! Besprechung eröffnet [20,13,14] !
+Elf 20 hat Besprechung.
+Elf 13 hat Besprechung.
+Elf 14 hat Besprechung.
+Rentier 2 ist zurück. Vorher im Stall: 3
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [11,17,15] !
+Elf 11 hat Besprechung.
+Elf 17 hat Besprechung.
+Elf 15 hat Besprechung.
+Elf 14 ist traurig. Wartezimmer vorher: 0
+Elf 13 ist traurig. Wartezimmer vorher: 1
+Elf 17 ist traurig. Wartezimmer vorher: 2
+Elf 19 ist traurig. Wartezimmer vorher: 3
+Elf 16 ist traurig. Wartezimmer vorher: 4
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [14,13,17] !
+Elf 14 hat Besprechung.
+Elf 13 hat Besprechung.
+Elf 17 hat Besprechung.
+Elf 18 ist traurig. Wartezimmer vorher: 2
+Elf 21 ist traurig. Wartezimmer vorher: 3
+Elf 12 ist traurig. Wartezimmer vorher: 4
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [19,16,18] !
+Elf 19 hat Besprechung.
+Elf 16 hat Besprechung.
+Elf 18 hat Besprechung.
+Rentier 9 ist zurück. Vorher im Stall: 4
+Rentier 3 ist zurück. Vorher im Stall: 5
+Elf 20 ist traurig. Wartezimmer vorher: 2
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [21,12,20] !
+Elf 21 hat Besprechung.
+Elf 12 hat Besprechung.
+Elf 20 hat Besprechung.
+Rentier 5 ist zurück. Vorher im Stall: 6
+Elf 15 ist traurig. Wartezimmer vorher: 0
+Rentier 4 ist zurück. Vorher im Stall: 7
+Ho! Ho! Ho! Besprechung vorbei!
+Rentier 1 ist zurück. Vorher im Stall: 8
+Elf 12 ist traurig. Wartezimmer vorher: 1
+Elf 20 ist traurig. Wartezimmer vorher: 2
+Ho! Ho! Ho! Hüja Rentiere [1,4,5,3,9,2,6,7,8] !
+Rentier 8 liefert Geschenke.
+Rentier 7 liefert Geschenke.
+Rentier 6 liefert Geschenke.
+Rentier 2 liefert Geschenke.
+Rentier 9 liefert Geschenke.
+Rentier 3 liefert Geschenke.
+Rentier 5 liefert Geschenke.
+Rentier 4 liefert Geschenke.
+Rentier 1 liefert Geschenke.
+Elf 17 ist traurig. Wartezimmer vorher: 3
+Elf 21 ist traurig. Wartezimmer vorher: 4
+Elf 11 ist traurig. Wartezimmer vorher: 5
+Elf 13 ist traurig. Wartezimmer vorher: 6
+Ho! Ho! Ho! Was für ein Fest!
+Ho! Ho! Ho! Besprechung eröffnet [15,12,20] !
+Elf 15 hat Besprechung.
+Elf 12 hat Besprechung.
+Elf 20 hat Besprechung.
+Rentier 6 ist zurück. Vorher im Stall: 0
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [17,21,11] !
+Elf 17 hat Besprechung.
+Elf 21 hat Besprechung.
+Elf 11 hat Besprechung.
+Elf 14 ist traurig. Wartezimmer vorher: 1
+Ho! Ho! Ho! Besprechung vorbei!
+Elf 19 ist traurig. Wartezimmer vorher: 2
+Elf 16 ist traurig. Wartezimmer vorher: 3
+Rentier 9 ist zurück. Vorher im Stall: 1
+Elf 18 ist traurig. Wartezimmer vorher: 4
+Ho! Ho! Ho! Besprechung eröffnet [13,14,19] !
+Elf 13 hat Besprechung.
+Elf 14 hat Besprechung.
+Elf 19 hat Besprechung.
+Elf 17 ist traurig. Wartezimmer vorher: 2
+Elf 12 ist traurig. Wartezimmer vorher: 3
+Rentier 3 ist zurück. Vorher im Stall: 2
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [16,18,17] !
+Elf 16 hat Besprechung.
+Elf 18 hat Besprechung.
+Elf 17 hat Besprechung.
+Elf 11 ist traurig. Wartezimmer vorher: 1
+Rentier 5 ist zurück. Vorher im Stall: 3
+Elf 14 ist traurig. Wartezimmer vorher: 2
+Elf 18 ist traurig. Wartezimmer vorher: 3
+Rentier 1 ist zurück. Vorher im Stall: 4
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [12,11,14] !
+Elf 12 hat Besprechung.
+Elf 11 hat Besprechung.
+Elf 14 hat Besprechung.
+Elf 15 ist traurig. Wartezimmer vorher: 1
+Elf 19 ist traurig. Wartezimmer vorher: 2
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [18,15,19] !
+Elf 18 hat Besprechung.
+Elf 15 hat Besprechung.
+Elf 19 hat Besprechung.
+Elf 21 ist traurig. Wartezimmer vorher: 0
+Rentier 8 ist zurück. Vorher im Stall: 5
+Rentier 2 ist zurück. Vorher im Stall: 6
+Elf 17 ist traurig. Wartezimmer vorher: 1
+Rentier 7 ist zurück. Vorher im Stall: 7
+Elf 13 ist traurig. Wartezimmer vorher: 2
+Elf 20 ist traurig. Wartezimmer vorher: 3
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [21,17,13] !
+Elf 21 hat Besprechung.
+Elf 17 hat Besprechung.
+Elf 13 hat Besprechung.
+Rentier 4 ist zurück. Vorher im Stall: 8
+Elf 16 ist traurig. Wartezimmer vorher: 1
+Elf 12 ist traurig. Wartezimmer vorher: 2
+Elf 19 ist traurig. Wartezimmer vorher: 3
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Hüja Rentiere [4,7,2,8,1,5,3,9,6] !
+Rentier 6 liefert Geschenke.
+Rentier 9 liefert Geschenke.
+Rentier 3 liefert Geschenke.
+Rentier 5 liefert Geschenke.
+Rentier 1 liefert Geschenke.
+Rentier 8 liefert Geschenke.
+Rentier 2 liefert Geschenke.
+Rentier 7 liefert Geschenke.
+Rentier 4 liefert Geschenke.
+Elf 17 ist traurig. Wartezimmer vorher: 4
+Elf 13 ist traurig. Wartezimmer vorher: 5
+Ho! Ho! Ho! Was für ein Fest!
+Ho! Ho! Ho! Besprechung eröffnet [20,16,12] !
+Elf 20 hat Besprechung.
+Elf 16 hat Besprechung.
+Elf 12 hat Besprechung.
+Rentier 3 ist zurück. Vorher im Stall: 0
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [19,17,13] !
+Elf 19 hat Besprechung.
+Elf 17 hat Besprechung.
+Elf 13 hat Besprechung.
+Rentier 5 ist zurück. Vorher im Stall: 1
+Elf 11 ist traurig. Wartezimmer vorher: 0
+Elf 16 ist traurig. Wartezimmer vorher: 1
+Rentier 4 ist zurück. Vorher im Stall: 2
+Elf 15 ist traurig. Wartezimmer vorher: 2
+Elf 14 ist traurig. Wartezimmer vorher: 3
+Elf 18 ist traurig. Wartezimmer vorher: 4
+Rentier 6 ist zurück. Vorher im Stall: 3
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [11,16,15] !
+Elf 11 hat Besprechung.
+Elf 16 hat Besprechung.
+Elf 15 hat Besprechung.
+Elf 21 ist traurig. Wartezimmer vorher: 2
+Elf 12 ist traurig. Wartezimmer vorher: 3
+Ho! Ho! Ho! Besprechung vorbei!
+Ho! Ho! Ho! Besprechung eröffnet [14,18,21] !
+Elf 14 hat Besprechung.
+Elf 18 hat Besprechung.
+Elf 21 hat Besprechung.
+Elf 14 ist traurig. Wartezimmer vorher: 1
+Rentier 2 ist zurück. Vorher im Stall: 4
+Ho! Ho! Ho! Besprechung vorbei!
+q
+
+-}