Nebenläufigkeit in Haskell
> module Concurrent where
> import Prelude hiding (putStr)
> import Control.Concurrent
> import Control.Concurrent.MVar
> import Control.Parallel
> import Control.Monad
> import Data.List
> import Data.String
> import Control.Exception.Base
> import Data.ByteString (putStr)
> import Network.Socket
> import System.IO hiding (putStr)
> t1 = do
> putStr$fromString "young"
> t1
> t2 = forever$putStr$fromString "young"
> t3 = do
> forever$print "young"
> putStr$fromString "fertig"
> t4 = do
> forever$ do
> putStr$fromString "young"
> threadDelay 1000000
> putStr$fromString "fertig"
forkIO :: IO () -> IO ThreadId
> t5 = do
> forkIO$forever$ do
> putStr$fromString "young"
> threadDelay 1000000
> putStr$fromString "fertig"
[1 of 1] Compiling Concurrent ( solution/Concurrent.lhs, interpreted )
Ok, one module loaded.
*Concurrent> t5
youngfertig*Concurrent> youngyoungyoungyoungyoungyoung
> t6 = do
> forkIO$forever$ do
> putStr$fromString "young"
> threadDelay 1000000
> forkIO$forever$ do
> putStr$fromString "forever"
> threadDelay 1500000
> putStr$fromString "los gehts!"
[1 of 1] Compiling Concurrent ( solution/Concurrent.lhs, interpreted )
Ok, one module loaded.
*Concurrent> t6
los gehts!youngforever*Concurrent> youngforeveryoungforeveryoungyoungforeveryoung
newEmptyMVar :: IO (MVar a)
newMVar :: a -> IO (MVar a)
> t7 = do
> v <- newMVar 0
> forkIO$ rep v "A" 1000000
> rep v "B" 2000000
> rep v x delay = forever$ do
> s <- takeMVar v
> putMVar v (s+1)
> print (x++show s)
> threadDelay delay
> needsTwo v1 v2 xs = do
> _ <- takeMVar v1
> putStr$fromString xs
> putStr$fromString ": I have one of the resources\n"
> threadDelay 1000000
> _ <- takeMVar v2
> print xs
> putMVar v1 ()
> putMVar v2 ()
> deadlock = do
> v1 <- newMVar ()
> v2 <- newMVar ()
> forkIO$ needsTwo v1 v2 "eins"
> needsTwo v2 v1 "zwei"
panitz@px1:~/00021Concurrent$ ghci solution/Concurrent.lhs
GHCi, version 8.6.5: http://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling Concurrent ( solution/Concurrent.lhs, interpreted )
Ok, one module loaded.
*Concurrent> deadlock
eins: I have one of the resources
zwei: I have one of the resources
*** Exception: thread blocked indefinitely in an MVar operation
*Concurrent>
> fib n
> |n<2 = n
> |otherwise = fib (n-2)+fib (n-1)
> tack function = do
> v1 <- newEmptyMVar
> forkIO (function v1)
> putStr$fromString "Warte auf Fibonacci\n"
> r <- (takeMVar v1)::IO Int
> putStr$fromString "Variable mit Ergebnis ausgelesen\n"
> putStr$fromString ("Ergebnis: ")
> putStr$fromString$show r
> putStr$fromString ("\nfertig!\n")
> fib1 n v = do
> putMVar v (fib n)
> putStr$fromString "fib1 ist fertig\n"
*Concurrent> tack$ fib1 35
Warte auf Fibonacci
Variable mit Ergebnis ausgelesen
Ergebnis:
fib1 ist fertig
9227465
fertig!
> fib2 n v = do
> r <- evaluate$fib n
> putMVar v r
> putStr$fromString "fib2 ist fertig\n"
*Concurrent> tack$ fib2 35
Warte auf Fibonacci
fib2 ist fertig
Variable mit Ergebnis ausgelesen
Ergebnis: 9227465
fertig!
> mvfib n
> |n<=1 =return n
> |otherwise = do
> v1 <- newEmptyMVar
> forkIO (fib2 (n-1) v1)
> x2 <- evaluate$fib (n-2)
> x1 <- takeMVar v1
> return (x1+x2)
import System.Environment(getArgs)
import Concurrent
main = do
(inp1:_) <- getArgs
r<-mvfib $read inp1
print r
00021Concurrent$ ghc -threaded -rtsopts Concurrent.lhs MVFib.hs
[1 of 2] Compiling Concurrent ( Concurrent.lhs, Concurrent.o )
[2 of 2] Compiling Main ( MVFib.hs, MVFib.o )
Linking MVFib ...
00021Concurrent$ time ./MVFib 42
fib2 ist fertig
267914296
real 0m43,364s
user 0m43,277s
sys 0m0,076s
00021Concurrent$ time ./MVFib 42 +RTS -N2
fib2 ist fertig
267914296
real 0m34,895s
user 0m55,897s
sys 0m0,859s
> pfib d n
> |n<=1 = n
> |d<=0 = fib n
> |otherwise
> = let
> x1 = fib (n-2)
> x2 = pfib (d-1) (n-1)
> in x1 `par` x2 `pseq` x1+x2
import System.Environment(getArgs)
import Concurrent
main = do
(inp1:d:_) <- getArgs
print$pfib (read d)$read inp1
00021Concurrent$ time ./PFib 42 4
267914296
real 0m46,114s
user 0m46,057s
sys 0m0,104s
00021Concurrent$ time ./PFib 42 4 +RTS -N4
267914296
real 0m30,792s
user 1m28,086s
sys 0m1,795s
> chanT = do
> c1 <- newChan
> c2 <- dupChan c1
> forkIO$readFrom "eins" c1
> forkIO$readFrom "zwei" c2
> writeTo 1 c1
> readFrom name c = forever$do
> n <- readChan c
> putStr$fromString (name++": "++show n++"\n")
> writeTo n c = do
> writeChan c n
> threadDelay 1000000
> writeTo (n+1) c
*Concurrent> chanT
zwei: 1
eins: 1
eins: 2
zwei: 2
> startChatServer = do
> sock <- socket AF_INET Stream defaultProtocol
> bind sock (SockAddrInet 4242 (tupleToHostAddress (127,0,0,1)))
> listen sock 2
> chan <- newChan
> forever$ do
> con <- accept sock
> forkIO (verbindung con chan)
> verbindung (sock, _) chan = do
> hdl <- socketToHandle sock ReadWriteMode
> hPutStrLn hdl "Bitte einen Chatnamen eingeben?"
> name <- hGetLine hdl
> writeChan chan ("> " ++ (init name) ++ " ist neu imm Chat.")
> commLine <- dupChan chan
> forkIO $ forever$ do
> line <- readChan commLine
> hPutStrLn hdl line
> forever$ do
> line <- hGetLine hdl
> writeChan chan ((init name) ++ ": " ++ line)
00021Concurrent$ ghci solution/Concurrent.lhs
GHCi, version 8.6.5: http://www.haskell.org/ghc/ :? for help
[1 of 1] Compiling Concurrent ( solution/Concurrent.lhs, interpreted )
Ok, one module loaded.
*Concurrent> startChatServer
panitz@px1:~$ telnet localhost 4242
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
Bitte einen Chatnamen eingeben?
Bernd
--> Klaus ist neu imm Chat.
hallo Klaus
Bernd: hallo Klaus
Klaus: Hallo Bernd
panitz@px1:~$ telnet localhost 4242
Trying 127.0.0.1...
Connected to localhost.
Escape character is '^]'.
Bitte einen Chatnamen eingeben?
Klaus
Bernd: hallo Klaus
Hallo Bernd
Klaus: Hallo Bernd
lhs
You are not logged in and therefore you cannot submit a solution.
Subato
