From 3bc43b689c1177ddeca6ea012aa74728f2b121c7 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 23 Dec 2015 20:46:07 +0100 Subject: FFP 10 --- ws2015/ffp/blaetter/10/FFP_U10_STM.hs | 491 ++++++++++++++++++++++++++++++++++ 1 file changed, 491 insertions(+) create mode 100755 ws2015/ffp/blaetter/10/FFP_U10_STM.hs (limited to 'ws2015') 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 + +-} -- cgit v1.2.3