diff --git a/src/Array.hs b/src/Array.hs index d0ea0f3..6716f99 100644 --- a/src/Array.hs +++ b/src/Array.hs @@ -198,7 +198,7 @@ copy_par src0 src_offset0 dst0 dst_offset0 len0 = copy_par' src0 src_offset0 dst then copy src src_offset dst dst_offset len else let !half = len `div` 2 !(src_l, src_r) = splitAt half src - !(dst_l, dst_r) = splitAt (len-half) dst + !(dst_l, dst_r) = splitAt half dst left = copy_par' src_l 0 dst_l 0 half right = copy_par' src_r 0 dst_r 0 (len-half) in left `par` right `pseq` append left right @@ -218,7 +218,7 @@ copy_par_m !src0 src_offset0 !dst0 dst_offset0 !len0 = copy_par_m' src0 src_offs else do let !half = len `div` 2 !(src_l, src_r) = splitAt half src - !(dst_l, dst_r) = splitAt (len-half) dst + !(dst_l, dst_r) = splitAt half dst !left_f <- P.spawn_$ copy_par_m' src_l 0 dst_l 0 half !right <- copy_par_m' src_r 0 dst_r 0 (len-half) !left <- P.get left_f diff --git a/src/DpsMergeSort4Par.hs b/src/DpsMergeSort4Par.hs index 8924847..e5aaf16 100644 --- a/src/DpsMergeSort4Par.hs +++ b/src/DpsMergeSort4Par.hs @@ -56,9 +56,9 @@ msortInplace src tmp = !(tmp3, tmp4) = splitMid tmpB !(((src1', tmp1'), (src2', tmp2')), ((src3', tmp3'), (src4', tmp4'))) = (msortInplace src1 tmp1 .||. msortInplace src2 tmp2) .||. - (msortInplace src3 tmp3 .||. msortInplace src4 tmp4) --- = tuple4 (msortInplace src1) tmp1 (msortInplace src2) tmp2 --- (msortInplace src3) tmp3 (msortInplace src4) tmp4 + (msortInplace src3 tmp3 .||. msortInplace src4 tmp4) +-- = (.||||.) (msortInplace src1 tmp1) (msortInplace src2 tmp2) +-- (msortInplace src3 tmp3) (msortInplace src4 tmp4) tmpA' = A.append tmp1' tmp2' tmpB' = A.append tmp3' tmp4' !((srcA'', tmpA''), (srcB'', tmpB'')) diff --git a/src/Par.hs b/src/Par.hs index 9b13935..6152d35 100644 --- a/src/Par.hs +++ b/src/Par.hs @@ -8,6 +8,7 @@ import Linear.Common import qualified Unsafe.Linear as Unsafe import Control.DeepSeq ( NFData(..) ) import GHC.Conc ( par, pseq ) +import qualified Control.Monad.Par as P -------------------------------------------------------------------------------- @@ -37,9 +38,39 @@ tuple4 f1 x f2 y f3 z f4 a = p `par` q `par` r `par` s `pseq` ((p,q), (r,s)) r = f3 z s = f4 a -{-# INLINE (.||.) #-} -(.||.) :: (NFData a, NFData b) => a -. b -. (a,b) -(.||.) = Unsafe.toLinear (\a -> Unsafe.toLinear (\b -> (a `par` b `pseq` (a,b)))) +{-# INLINABLE (.||.) #-} +(.||.) :: (NFData a) => a -. a -. (a,a) +--(.||.) = Unsafe.toLinear (\a -> Unsafe.toLinear (\b -> (a `par` b `pseq` (a,b)))) +(.||.) = Unsafe.toLinear (\a -> Unsafe.toLinear (\b -> P.runPar $ do + i <- P.new + j <- P.new + P.fork (P.put_ i a) + P.fork (P.put_ j b) + a' <- P.get i + b' <- P.get j + return (a', b') + )) + + +(.||||.) :: (NFData a) => a -. a -. a -. a -. ((a,a),(a,a)) +(.||||.) = Unsafe.toLinear (\a -> + Unsafe.toLinear (\b -> + Unsafe.toLinear (\c -> + Unsafe.toLinear (\d -> P.runPar $ do + i <- P.new + j <- P.new + k <- P.new + l <- P.new + P.fork (P.put_ i a) + P.fork (P.put_ j b) + P.fork (P.put_ k c) + P.fork (P.put_ l d) + a' <- P.get i + b' <- P.get j + c' <- P.get k + d' <- P.get l + return ((a', b'), (c', d')) + )))) {- tuple2 :: (NFData a, NFData b) => (a -> b) -> a -> (a -> b) -> a -> (b, b) @@ -88,4 +119,10 @@ tuple4 f x g y h z j w = ((f x, g y), (h z, j w)) {-@ (.||.) :: x:a -> y:b -> { tup:_ | x == fst tup && y = snd tup } @-} (.||.) :: a -. b -. (a,b) a .||. b = (a,b) + +{-@ (.||||.) :: x:a -> y:a -> z:a -> w:a + -> { tup:_ | x == fst (fst tup) && y == snd (fst tup) && + z == fst (snd tup) && w == snd (snd tup) } @-} +(.||||.) :: a -. a -. a -. a -. ((a,a),(a,a)) +(.||||.) a b c d = ((a, b), (c, d)) #endif