import IO
import Data.IORef
import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception

{- Slide 19 -}
main1 = do {putStrLn (reverse "yes");
            putStrLn "no" }

{- Slide 20 -} 
main2 = do { r <-newIORef 0;
            incR r;
            s <- readIORef r;
            print s }

incR :: IORef Int -> IO ()
incR r = do { v <- readIORef r;
              writeIORef r (v+1)}


{- Slide 21 -}
main3 = do { r <- newIORef 0;
             forkIO (incR r);        -- A race condition.  Depending on timing, final value of r can be 1 or 2.
             incR r;
--             threadDelay 0;
             s <- readIORef r;
             print s }

{- The code Slide 22 doesn't type check 
main4 = do { 
   r <- newIORef 0;
   forkIO (atomically (incR r));
   atomically (incR r);
   s <- readIORef r;
   print s }
-}


{- Slide 23 -}
incT :: TVar Int -> STM ()
incT r = do { v <- readTVar r;
              writeTVar r (v+1) } 

main5   = do { r <- atomically (newTVar 0);
               forkIO (atomically (incT r));
               atomically (incT r);   
               threadDelay 5;
               v <- atomically (readTVar r);
               print v }

{- Slide 25 -}
incT2 :: TVar Int -> STM ()
incT2 r = do { incT r; incT r }
 
main6 :: IO ()
main6 = do { r <- atomically (newTVar 0);
             forkIO (atomically (incT2 r));
             atomically (incT2 r);   
             threadDelay 5;
             v <- atomically (readTVar r);
             print v 
           }

{- Slide 28 -}
withdraw :: TVar Int -> Int -> STM ()
withdraw acc n = do {
   bal <- readTVar acc;
   if bal < n 
      then retry
      else writeTVar acc (bal-n) }

deposit :: TVar Int -> Int -> STM ()
deposit acc n = do {
  bal <- readTVar acc;
  writeTVar acc (bal + n) }

{- Slide 29 -}
withdraw2 a1 a2 =  atomically (do { withdraw a1 3;
                                    withdraw a2 7 })

{- Slide 31 -}
withdraw3 a1 a2 b = 
  atomically (do { 
    withdraw a1 3	
     `orElse` 
    withdraw a2 3; 
    deposit b 3 })

  
{- Slide 32 -}
transfer :: TVar Int -> TVar Int -> TVar Int -> STM ()
transfer a1 a2 b = do	
  { withdraw a1 3
     `orElse`
    withdraw a2 3;
    deposit b 3 }

transfer2 a1 a2 a3 a4 b = atomically
        (transfer a1 a2 b
		`orElse`
	 transfer a3 a4 b)

{- Slide 36 -}
newAccount :: STM (TVar Int)
newAccount = 
  do { v <- newTVar 0; 
       always (do { cts <- readTVar v;
                    return (cts >= 0) });
       return v }