module Main where

import HOrc;
import Control.Concurrent;
import List;


{--
 - Class Pair (ok, an ADT) that can store a pair of values.
 - Pairs are created empty. Elements are placed in the tuple with putPair. 
 - When, and only when) both positions are filled with a value, putPair publishes them as 
 - normal Haskell pair. 
--}
type Pair a b = MVar (Maybe a, Maybe b)

newPair :: Action (Pair a b)
newPair = liftIO $ newMVar (Nothing,Nothing)

putPair :: Pair a b -> Either a b -> Action (a,b)
putPair p m = liftMaybe $
				do {
					(a,b) <- takeMVar p;
					(a',b') <- return $ either (\x -> (Just x,b)) (\x -> (a,Just x)) m;
					putMVar p (a',b');
					return (do{x<-a';y<- b'; return (x,y)});
				}
				

{--
 - Parallel split. In the split <f,g> there is no interdependence between the 
 - operations of f and g. They can be run in parallel.
 - The split only publishes after both components are done; it doubles as a 
 - synchronization primitive.
--}
osplit :: (a -> Action b, a -> Action c) -> a -> Action (b,c)
osplit (f,g) a = do { p <- newPair;
					c <- (f a >>= olet . Left ) `mplus` (g a >>= olet . Right);	
					putPair p c;
				}


oprod :: (a -> Action b, c -> Action d) -> (a,c) -> Action (b,d)
oprod (f,g) = osplit (f . fst, g . snd)

{--
 - Eithers cannot be parallelized -- unless you do some sort of 
 - proactive computation. The orc version is just a curried(?) version of the existing either in Haskell 
--}

oeither :: (a -> Action c, b -> Action c) -> Either a b -> Action c
oeither (f,g) = either f g 

osum :: (a -> Action c, b -> Action d) -> Either a b -> Action (Either c d)
osum (f,g) =  oeither (\x -> f x >>= olet . Left ,\x -> g x >>= olet . Right)


{-- 
 - An hylomorphism with BTRee as the intermediate structure. 
 - Given that we're computing in the HOrc domain: id = olet.
 - Parallelization only occurs between the recursive calls.
 - Obvious example: quicksort. 
 - Equally obvious improvement: reduce the level of recursivity 
 - (and consequently parallelization) so that no more than #CPU threads are active 
 - or otherwise most work is done creating and destructing threads;
 - start by defining the intermediate structure as "Node a b = Either [a] (a,b b).
--}

type Node a b = Either () (a,(b, b))

hyloTree :: (a -> Action (Node b a)) -> (Node b c-> Action c) -> a -> Action c
hyloTree a c x = a x>>= osum (olet, oprod (olet,oprod (hyloTree a c,hyloTree a c))) >>= c

oqsort :: (Ord a) => [a] -> Action [a]
oqsort = hyloTree a c
	where a [] = olet $ Left ();
		  a (x:xs) =  olet $ Right (x,partition (<x) xs);
		  c = oeither ((olet . (const [])),(\(a,(b,c)) -> olet $! (b ++ (a:c))))




hT a c = c . either (Left) (Right . prod id (prod (hT a c) (hT a c))) . a
	where prod f g = \(x,y) ->  (f x,g y);
 
sqsort :: (Ord a) => [a] -> [a]	
sqsort = hT a c 
	where a [] = Left ();
		  a (x:xs) =  Right (x,partition (<x) xs);
		  c = either (const []) (\(a,(b,c)) -> (b ++ (a:c)))


main :: IO ()
main = run (oqsort [1..10000] >>= oprint)