osa1

Go channel examples ported to Haskell

April 8, 2013 - Tagged as: haskell, en.

I’ve been skimming over gotour recently. I think it’s great introduction to language; it’s short, but concise and it shows some of the interesting features of language.

Last part of the tour is about goroutines and channels. My concurrent programming experience is very limited, and since Haskell is my favorite language, I decided to port goroutine examples to Haskell as a learning exercise.

Any criticism would be appreciated.

62 - Goroutines

This is a very basic example of a program creating two threads and printing some strings.

module Main where

import Control.Concurrent
import Control.Monad

say :: String -> IO ()
say s = forM_ [1..5] $ \ _ -> do
  threadDelay 100000
  putStrLn s

main :: IO ()
main = do
  forkIO $ say "world"
  say "hello"

63 - Channels

Simple channels example

module Main where

import Control.Concurrent

sum' :: [Int] -> Chan Int -> IO ()
sum' ints chan = writeChan chan (sum ints)
-- alternative, `pointfree` style: 
-- sum' = flip writeChan . sum

main :: IO ()
main = do
  let lst = [7, 2, 8, -9, 4, 0]
  chan <- newChan
  let (l1, l2) = splitAt (floor $ fromIntegral (length lst) / 2) lst
  forkIO $ sum' l1 chan
  forkIO $ sum' l2 chan
  x <- readChan chan
  y <- readChan chan
  putStrLn $ unwords [ show x, show y, show $ x + y ]

64 - Buffered Channels

This is where porting started getting tricky. Haskell channels are basically linked lists, and do not have length or size. In order to get a similar effect, I created a new channel type:

{-# LANGUAGE NamedFieldPuns #-}
module Main where

import Control.Concurrent

-- Buffered chan
data BChan a = BChan { chan :: Chan a, size :: MVar Int, limit :: Int }

newBChan :: Int -> IO (BChan a)
newBChan bufsize = do
  chan <- newChan
  bvar <- newMVar 0
  return BChan{chan=chan, size=bvar, limit=bufsize}

readBChan :: BChan a -> IO a
readBChan BChan{chan, size, limit} = do
  ret <- readChan chan
  modifyMVar_ size $ \i -> return (i-1)
  return ret

writeBChan :: BChan a -> a -> IO ()
writeBChan bchan@BChan{chan, size, limit} val = do
  size' <- readMVar size
  if size' == limit
    then do
      threadDelay 100000
      writeBChan bchan val
    else do
      modifyMVar_ size $ \i -> return (i+1)
      writeChan chan val

main :: IO ()
main = do
  chan <- newBChan 2
  writeBChan chan 1
  writeBChan chan 2

  v1 <- readBChan chan
  print v1

  v2 <- readBChan chan
  print v2

Here one difference is that Haskell doesn’t fail with a “deadlock!!” error when an extra writeBChan operation is added(or one of them is removed), but just waits forever(like in a real deadlock :-P ). I wonder whether there is a way to get an exception like that, it’s awesome.

65 - Range and Close

Same as above, Haskell channels are not working like Go channels. I had to simulate Go channels’ behavior.

{-# LANGUAGE NamedFieldPuns, MultiWayIf #-}
module Main where

import Control.Concurrent
import Control.Monad (liftM)

-- Closable channel
data CChan a = CChan (MVar ([a], Int, Bool))

newCChan :: IO (CChan a)
newCChan = liftM CChan (newMVar ([], 0, False))

readCChan :: CChan a -> IO (Maybe a)
readCChan (CChan mvar) = do
  (contents, size, closed) <- takeMVar mvar
  if | size == 0 && not closed -> do
         putMVar mvar (contents, size, closed)
         readCChan (CChan mvar)
     | size == 0 -> do
         putMVar mvar (contents, size, closed)
         return Nothing
     | otherwise -> do
         let r = head contents
         putMVar mvar (tail contents, size-1, closed)
         return $ Just r

writeCChan :: CChan a -> a -> IO ()
writeCChan (CChan mvar) val = do
  (contents, size, closed) <- takeMVar mvar
  if closed
    then error "writing to a closed chan"
    else putMVar mvar (val : contents, size+1, closed)

forChan_ :: CChan a -> (a -> IO ()) -> IO ()
forChan_ cchan f = do
  v <- readCChan cchan
  case v of
    Nothing -> return ()
    Just v' -> f v' >> forChan_ cchan f

closeCChan :: CChan a -> IO ()
closeCChan (CChan mvar) =
    modifyMVar_ mvar $ \(contents, size, closed) -> return (contents, size, True)

fib :: Int -> CChan Int -> IO ()
fib i chan = do
    iter i 0 1
    closeCChan chan
  where iter 1 x y = writeCChan chan x
        iter n x y = do
          writeCChan chan x
          iter (n-1) y (x+y)

main :: IO ()
main = do
  chan <- newCChan
  forkIO $ fib 10 chan
  forChan_ chan print

This example still doesn’t quite work like Go code. This is because I used a stack instead of a queue. It should be trivial to fix this code though.

66 - Select and 67 - Default Selection

Now this is hard. In 66, example program listens multiple channels, and runs some code when any of the channels is ready. If multiple channels are ready at the same time, one of them is chosen randomly. 67 is similar, only difference is when none of the channels are ready, some default action is taken.

I’m actually not sure if it’s implementable with Haskell Chans, isEmptyChan :: Chan a -> IO Bool is deprecated, and users are directed to TChans(I think it’s mostly same as a Chan, but working on STM).

Anyway, that’s it for now. I’ll go learn(pun intended) some STM, why we need them and what’s different about them, and then maybe I can implement this last two examples.