module Main where

import Data.Typeable
import Data.IORef
import Control.Concurrent
import Control.Monad.Trans

import ExecutionContext

-- --------------------------------------------------------------------
-- Source of unique natural numbers
-- --------------------------------------------------------------------

data UniqueNaturalSource 
   = UniqueNaturalSource (IORef Integer) deriving (Typeable)

mkUniqueNaturalSource :: IO UniqueNaturalSource
mkUniqueNaturalSource =
   do
      ioRef <- newIORef 1
      return (UniqueNaturalSource ioRef)

getNextNatural :: XIO Integer
getNextNatural =
   do
      (UniqueNaturalSource ioRef) <- lookupWithRegister mkUniqueNaturalSource
      liftIO $ atomicModifyIORef ioRef (\ i -> (i+1,i))

-- --------------------------------------------------------------------
-- A little test program
-- --------------------------------------------------------------------

main :: IO ()
main =
   runWithEmptyContext $ do
      let
         p =
            do
               n <- getNextNatural
               liftIO $ putStrLn (show n)

      -- put in lots of forkIO's to make things interesting.
      let
         testNumbers i =
            do
               liftIO $ putStrLn ("Numbers starting at " ++ show i)
               wait <- liftIO $ newEmptyMVar

               liftIO2 forkIO (
                  do
                     p
                     p
                     p
                     liftIO2 forkIO (
                        do
                           p
                           liftIO2 forkIO (
                              do
                                 p
                                 liftIO $ putMVar wait () 
                              )
                           return ()
                        )
                     return ()
                  )
               liftIO $ takeMVar wait
      -- print 5 numbers beginning at 1.
      testNumbers 1
      -- print 5 numbers beginning at 1 again, with a new dictionary.
      withEmptyContext (testNumbers 1)

      -- print 5 numbers beginning at 6, still using the old dictionary
      testNumbers 6