A sketch of what types for an ST + Par + MVector combination

forksplit_sketch.hs

{-# LANGUAGE RankNTypes, GeneralizedNewtypeDeriving, CPP #-}

import Data.Vector.Mutable as MV
import qualified  Data.Vector as V -- ((!), freeze)
import Control.Monad.ST
import Control.Monad.Primitive
import Prelude hiding (read)


type Splitter a = a -> (a,a)
--class Splitter a v where 
--  split :: 

-- newtype Par s a = Par (ST s a)
--    deriving (Monad, PrimMonad)
#define Par ST

-- forkSplit :: (Splitter a) -> a -> (forall s . a -> Par s a) -> 
--              (Par s' a)
-- forkSplit = undefined

----------------------------------------------------------------------------------------------------

-- The problem with this approach is that the universal quantification
-- on the *return* value doesn't count, and the input MVector has a
-- universal s.  Nothing prevents s == s'' here.
forkSplit1 :: MVector s t -> (forall s' . MVector s' t -> Par s' ())
                         -> (forall s'' . Par s'' (MVector s'' t))
forkSplit1 = undefined

----------------------------------------------------------------------------------------------------

-- This version is similar to runST.
-- First we take a completely encapsulated computation that will
-- generate our initial MVector:
--forkSplit2 :: (forall s   . Par s (MVector s t)) -> 

----------------------------------------------------------------------------------------------------
-- Fork/join version, include the barrier:

forkSplit2 :: (MVector s t) -> 
              -- Left child computation:
              (forall s'  . MVector s'  t -> Par s' ()) ->
              -- Right child computation:
              (forall s'' . MVector s'' t -> Par s'' ()) ->
              -- Only if we have a BARRIER is it safe to use the vector after this
              -- point.... Or we could leave the barrier to the user by returning an IVar.
              Par s () 
forkSplit2 = undefined


----------------------------------------------------------------------------------------------------
-- Generalized fork/join version:

-- We're including TWO type arguments for the type constructor here to
-- match MVector.  We could have multiple classes based on the kind of
-- tc.  That's awful ugly.
class SplittableST tc where 
  split :: tc s t -> (tc s t, tc s t)

-- This is not what we want... ultimately an extra argument needs to
-- be passed that says HOW to split.
instance SplittableST MVector where
  -- If we split an odd length we are forced to produce uneven "halves":
  split mv = (slice 0 half mv,
              slice half (half+carry) mv)
    where (half, carry) = quotRem len 2 
          len = MV.length mv 

-- How do we take products conveniently?
-- instance (SplittableST ta, SplittableST tb) => SplittableST (ta :X: tb)

forkSplit3 :: SplittableST tc => 
              (tc s t) -> 
              -- Left child computation:
              (forall s'  . tc s' t  -> Par s' ()) ->
              -- Right child computation:
              (forall s'' . tc s'' t -> Par s'' ()) ->
              -- Only if we have a BARRIER is it safe to use the vector after this
              -- point.... Or we could leave the barrier to the user by returning an IVar.
              Par s () 
forkSplit3 = undefined


----------------------------------------------------------------------------------------------------

-- In this version we simply take the splitter as an argument:
--forkSplit4 :: (tc s t -> (tc s t, tc s t)) ->           -- ^ Splitter 
forkSplit4 :: Splitter (tc s t) ->                      -- ^ Splitter 
              (tc s t) ->                               -- ^ Data to be split              
              (forall s'  . tc s' t  -> Par s' ()) ->   -- ^ Left child computation
              (forall s'' . tc s'' t -> Par s'' ()) ->  -- ^ Right child computation
              Par s () 
              -- Only if we have a BARRIER is it safe to use the vector after this
              -- point.... Or we could leave the barrier to the user by returning an IVar.
forkSplit4 = undefined

----------------------------------------------------------------------------------------------------


t1 :: Par s Float
t1 = do vec <- V.thaw$ V.enumFromN 1.1 10 
        write vec 5 99.9
        
        forkSplit1 vec $ \ left -> 
          do return ()
        -- We must prevent THIS unless there is a barrier:
        write vec 5 101.1
             
        forkSplit2 vec 
          (\left  -> do return ())
          (\right -> do return ())
        -- Barrier.. vec is modified but safe to use again:

        read vec 0 


------------------------------------------------------------
-- How about splitting two vectors at once?
        
-- Here's an unsatisfying way to do it:        

data VecPair s t = VP (MVector s t) (MVector s t)
instance SplittableST VecPair where
   split (VP v1 v2) = (VP v1L v2L, VP v1R v2R)
    where
     (v1L,v1R) = split v1
     (v2L,v2R) = split v2
     
t2 :: Par s (Float,Float)
t2 = do vecA <- V.thaw$ V.enumFromN 1.1 10 
        vecB <- V.thaw$ V.enumFromN 100.1 10 
        
        forkSplit3 -- (\ (VP a b) -> undefined) 
                   (VP vecA vecB)
          (\ (VP aL bL) -> do return ())
          (\ (VP aR bR) -> do return ())

        a' <- read vecA 0 
        b' <- read vecB 0 
        return (a', b')