{-# OPTIONS -fglasgow-exts #-}
-- Eden Project, JB

-- Base module, importing PrimOps => exporting IO actions
-----------------------------------------------

module ParPrim 
    where

import GHC.Base
import GHC.IOBase

----------------------------------------------------------
-- IO wrappers for primitive operations:
--
-- all primitives are implemented out-of-line,
-- wrappers should all be of type * -> IO (...)
--
-- (eden implementation can work with unsafePerformIO)
---------

-- system information
{-# NOINLINE noPe #-}
noPe :: IO Int
noPe = IO ( \s -> case (noPe# s) of 
	               (# s',r #) -> (# s',I# r #)
	  )
{-# NOINLINE selfPe #-}
selfPe :: IO Int
selfPe = IO ( \s -> case (selfPe# s) of 
	                 (# s',r #) -> (# s',I# r #)
	    )

-- not for export, only abstract type visible outside
data ChanName' a = Chan Int# Int# Int#
                deriving Show

-- tweaking fork primop from concurrent haskell... (not returning threadID)
{-# NOINLINE fork #-}
fork :: IO () -> IO ()
fork action = IO (\s -> case (fork# action s) of 
                          (# s' , _ #) -> (# s' , () #)
                 )

-- creation of one placeholder and one new inport
{-# NOINLINE createC #-}
createC :: IO ( ChanName' a, a )
createC = IO (\s -> case (expectData# s) of 
                     (# s',id,p, bh #) -> case selfPe# s' of
                                            (# s'', pe #) ->
                                                (# s',(Chan pe p id, bh) #)
             )

-- TODO: wrap creation of several channels in RTS? (see eden5::createDC# )
--       (would save foreign call overhead, but hard-wire more into RTS)

{-# NOINLINE connectToPort #-}
connectToPort_ :: Int# -> Int# -> Int# -> IO ()
connectToPort_ pe proc id 
    = IO (\s -> case (connectToPort# pe proc id s) of
	                   s' -> (# s', () #)
	 )

connectToPort :: ChanName' a -> IO ()
connectToPort (Chan p proc id) = connectToPort_ p proc id

{- send modes implemented: 
       1 - connect (no graph needed)
       2 - stream  (list element)
       3 - single  (single value)
       4 - rFork   (receiver creates a thread, different ports)
 and additional payload (currently for rFork only) in high bits
-}
-- send modes for sendData
data Mode = Connect 
	  | Data
	  | Stream
	  | Instantiate Int

{-# NOINLINE sendData #-}
sendData :: Mode -> a -> IO ()
sendData mode d 
    = IO (\s -> case (sendData# m d s) of 
	                   s' -> (# s', () #)
	 )
      where (I# m) = decodeMode mode
	    decodeMode :: Mode -> Int
	    decodeMode Connect         = 1
	    decodeMode Data            = 2
	    decodeMode Stream          = 3
	    decodeMode (Instantiate _) = 4
	    decodeMode _ = error "sendData: no such mode"