packages feed

Parallel-Arrows-Definition (empty) → 0.1.1.0

raw patch · 12 files changed

+689/−0 lines, 12 filesdep +basedep +deepseqdep +splitsetup-changed

Dependencies added: base, deepseq, split

Files

+ LICENSE.md view
@@ -0,0 +1,23 @@+[The MIT License (MIT)][]++Copyright (c) 2017 Martin Braun++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.++[The MIT License (MIT)]: https://opensource.org/licenses/MIT
+ Parallel-Arrows-Definition.cabal view
@@ -0,0 +1,47 @@+-- This file has been generated from package.yaml by hpack version 0.20.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: cd21f0b9dc6ae149e8b7990e5d2d7354f4538432d348ae7e0489d387bdcbff5f++name:           Parallel-Arrows-Definition+version:        0.1.1.0+synopsis:       Multithreaded evaluation using Arrows.+description:    Arrows are a suitable abstraction for parallel programming. This package offers a general interface for parallelizing Arrows. This package however only contains the interface and code written against it must be used with a backend such as @Parallel-Arrows-Multicore@, @Parallel-Arrows-ParMonad@, @Parallel-Arrows-Eden@ in order to have any parallel speedup. This package also contains some parallel skeletons such as variants of parMap and some topology skeletons.+                For more info see check out the paper at https://arxiv.org/abs/1801.02216+category:       Parallelism,Arrows+homepage:       https://github.com/s4ke/Parrows#readme+bug-reports:    https://github.com/s4ke/Parrows/issues+maintainer:     Martin Braun+license:        MIT+license-file:   LICENSE.md+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    package.yaml+    stack.yaml++source-repository head+  type: git+  location: https://github.com/s4ke/Parrows++library+  hs-source-dirs:+      src/main+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5.0+    , deepseq+    , split+  exposed-modules:+      Parrows.Definition+      Parrows.Dummy+      Parrows.Dummy.Simple+      Parrows.Future+      Parrows.Skeletons.Map+      Parrows.Skeletons.Topology+      Parrows.Util+  other-modules:+      Paths_Parallel_Arrows_Definition+  default-language: Haskell2010
+ Setup.hs view
@@ -0,0 +1,7 @@+-- This script is used to build and install your package. Typically you don't+-- need to change it. The Cabal documentation has more information about this+-- file: <https://www.haskell.org/cabal/users-guide/installing-packages.html>.+import qualified Distribution.Simple++main :: IO ()+main = Distribution.Simple.defaultMain
+ package.yaml view
@@ -0,0 +1,32 @@+# This YAML file describes your package. Stack will automatically generate a+# Cabal file when you run `stack build`. See the hpack website for help with+# this file: <https://github.com/sol/hpack>.+category: Parallelism,Arrows+description:+  Arrows are a suitable abstraction for parallel programming.+  This package offers a general interface for parallelizing Arrows.+  This package however only contains the interface and code written against it+  must be used with a backend such as @Parallel-Arrows-Multicore@,+  @Parallel-Arrows-ParMonad@, @Parallel-Arrows-Eden@ in order to have any parallel speedup.+  This package also contains some parallel skeletons such as variants of parMap+  and some topology skeletons.++  For more info see check out the paper at https://arxiv.org/abs/1801.02216+extra-source-files:+- package.yaml+- stack.yaml+ghc-options: -Wall+github: s4ke/Parrows+library:+  dependencies:+  - base >= 4.7 && < 5.0+  - deepseq+  - split+  source-dirs: src/main+license: MIT+license-file: LICENSE.md+maintainer: Martin Braun+name: Parallel-Arrows-Definition+synopsis: Multithreaded evaluation using Arrows.++version: '0.1.1.0'
+ src/main/Parrows/Definition.hs view
@@ -0,0 +1,82 @@+{-+The MIT License (MIT)++Copyright (c) 2016-2017 Martin Braun++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+-}+{-# LANGUAGE CPP                   #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Parrows.Definition where++import           Parrows.Util++import           Control.Arrow++import           Data.Either+import           Data.List.Split++--infixr 3 `|***|`+--infixr 3 `|&&&|`+--infixr 3 `|>>>|`++type NumCores = Int+type ChunkSize = Int++class (Arrow arr) => ArrowParallel arr a b conf where+    parEvalN :: conf -> [arr a b] -> arr [a] [b]++class ArrowParallel arr a b conf => ArrowLoopParallel arr a b conf where+    loopParEvalN :: conf -> [arr a b] -> arr [a] [b]+    postLoopParEvalN :: conf -> [arr a b] -> arr [a] [b]++-- parallel versions of (***) and (&&&)++(|***|) :: (ArrowChoice arr, ArrowParallel arr (Either a c) (Either b d) ()) => arr a b -> arr c d -> arr (a, c) (b, d)+(|***|) = parEval2 ()++(|&&&|) :: (ArrowChoice arr, ArrowParallel arr (Either a a) (Either b c) ()) => arr a b -> arr a c -> arr a (b, c)+(|&&&|) f g = arr (\a -> (a, a)) >>> f |***| g++-- some really basic sugar++(...) :: (Arrow arr) => [arr a b] -> arr b c -> [arr a c]+(...) parr f = map (>>> f) parr++-- spawns the first n arrows to be evaluated in parallel. this works for infinite lists of arrows as well+parEvalNLazy :: (ArrowParallel arr a b conf, ArrowChoice arr) => conf -> ChunkSize -> [arr a b] -> arr [a] [b]+parEvalNLazy conf chunkSize fs =+               -- chunk the functions, feed the function chunks into parEvalN, chunk the input accordingly+               -- evaluate the function chunks in parallel and concat the input to a single list again+               arr (chunksOf chunkSize) >>>+               evalN fchunks >>>+               arr concat+               where+                fchunks = map (parEvalN conf) (chunksOf chunkSize fs)++-- evaluate two functions with different types in parallel+parEval2 :: (ArrowChoice arr, ArrowParallel arr (Either a c) (Either b d) conf) => conf -> arr a b -> arr c d -> arr (a, c) (b, d)+parEval2 conf f g =+           arr Left *** (arr Right >>> arr return) >>>+           arr (uncurry (:)) >>>+           parEvalN conf (replicate 2 (f +++ g)) >>>+           arr partitionEithers >>>+           arr head *** arr head
+ src/main/Parrows/Dummy.hs view
@@ -0,0 +1,64 @@+{-+The MIT License (MIT)++Copyright (c) 2016-2017 Martin Braun++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances  #-}+module Parrows.Dummy(+  Strategy,+  Conf(..),+  defaultConf,+  stratToConf,+  module Parrows.Definition,+  module Parrows.Future,+  module Control.DeepSeq+) where++import           Parrows.Definition+import           Parrows.Future+import           Parrows.Util++import           Control.Arrow+import           Control.DeepSeq++type Strategy a = a -> a++data Conf a = Conf (Strategy a)++defaultConf :: (NFData b) => [arr a b] -> Conf b+defaultConf fs = stratToConf fs force++stratToConf :: [arr a b] -> Strategy b -> Conf b+stratToConf _ strat = Conf strat++instance (ArrowChoice arr) => ArrowParallel arr a b (Conf b) where+    parEvalN (Conf strat) fs = evalN (map (>>> arr strat) fs)++instance (ArrowChoice arr, ArrowParallel arr a b (Conf b)) => ArrowLoopParallel arr a b (Conf b) where+    loopParEvalN _ = evalN+    postLoopParEvalN = parEvalN++instance Future BasicFuture a (Conf a) where+    put _ = put'+    get _ = get'
+ src/main/Parrows/Dummy/Simple.hs view
@@ -0,0 +1,43 @@+{-+The MIT License (MIT)++Copyright (c) 2016-2017 Martin Braun++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Parrows.Dummy.Simple where++import Parrows.Dummy+import Control.Arrow++instance (NFData b, ArrowChoice arr, ArrowParallel arr a b (Conf b)) => ArrowParallel arr a b () where+    parEvalN _ fs = parEvalN (defaultConf fs) fs++instance (NFData b, ArrowChoice arr, ArrowParallel arr a b (), ArrowLoopParallel arr a b (Conf b)) => ArrowLoopParallel arr a b () where+    loopParEvalN _ fs = loopParEvalN (defaultConf fs) fs+    postLoopParEvalN _  fs = postLoopParEvalN (defaultConf fs) fs++instance Future BasicFuture b () where+    put _ = put'+    get _ = get'
+ src/main/Parrows/Future.hs view
@@ -0,0 +1,57 @@+{-+The MIT License (MIT)++Copyright (c) 2016-2017 Martin Braun++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE UndecidableInstances   #-}+module Parrows.Future where++import           Control.Arrow+import           Control.DeepSeq+import           Parrows.Definition++class Future fut a conf | a conf -> fut where+    put :: (Arrow arr) => conf -> arr a (fut a)+    get :: (Arrow arr) => conf -> arr (fut a) a++data BasicFuture a = BF a++put' :: (Arrow arr) => arr a (BasicFuture a)+put' = arr BF++get' :: (Arrow arr) => arr (BasicFuture a) a+get' = arr (\(~(BF a)) -> a)++instance NFData a => NFData (BasicFuture a) where+    rnf (BF a) = rnf a++liftFut :: (Arrow arr, Future fut a conf, Future fut b conf) => conf -> arr a b -> arr (fut a) (fut b)+liftFut conf f = get conf >>> f >>> put conf++unliftFut :: (Arrow arr, Future fut a conf, Future fut b conf) => conf -> arr (fut a) (fut b) -> arr a b+unliftFut conf f = put conf >>> f >>> get conf++parEvalNFut :: (ArrowParallel arr (fut a) (fut b) conf, Future fut a conf, Future fut b conf) => conf -> [arr a b] -> arr [fut a] [fut b]+parEvalNFut conf fs = parEvalN conf $ map (liftFut conf) fs
+ src/main/Parrows/Skeletons/Map.hs view
@@ -0,0 +1,68 @@+{-+The MIT License (MIT)++Copyright (c) 2016-2017 Martin Braun++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Parrows.Skeletons.Map where++import           Control.Arrow++import           Parrows.Definition+import           Parrows.Util++import           Data.List.Split++-- some map skeletons++parMap :: (ArrowParallel arr a b conf) => conf -> arr a b -> arr [a] [b]+parMap conf f = parEvalN conf (repeat f)++-- contrary to parMap this schedules chunks of a given size (parMap has "chunks" of length = 1) to be+-- evaluated on the same thread+parMapStream :: (ArrowParallel arr a b conf, ArrowChoice arr) => conf -> ChunkSize -> arr a b -> arr [a] [b]+parMapStream conf chunkSize f = parEvalNLazy conf chunkSize (repeat f)++-- similar to parMapStream, but divides the input list by the given number+farm :: (ArrowParallel arr a b conf, ArrowParallel arr [a] [b] conf, ArrowChoice arr) => conf -> NumCores -> arr a b -> arr [a] [b]+farm conf numCores f = unshuffle numCores >>>+                       parEvalN conf (repeat (mapArr f)) >>>+                       shuffle++-- farm and parMapStream combined. divide the input list and inside work in chunks+farmChunk :: (ArrowParallel arr a b conf, ArrowParallel arr [a] [b] conf, ArrowChoice arr) => conf -> ChunkSize -> NumCores -> arr a b -> arr [a] [b]+farmChunk conf chunkSize numCores f = unshuffle numCores >>>+                                      parEvalNLazy conf chunkSize (repeat (mapArr f)) >>>+                                      shuffle++-- this does not completely adhere to Google's definition of Map Reduce as it+-- the mapping function does not allow for "reordering" of the output+-- The original Google version can be found at https://de.wikipedia.org/wiki/MapReduce+parMapReduceDirect :: (ArrowParallel arr (b, [a]) b conf, ArrowChoice arr) => conf -> ChunkSize -> arr a b -> arr (b, b) b -> arr (b, [a]) b+parMapReduceDirect conf chunkSize mapfn foldfn =+                                   arr fst &&& nodeMapReduce >>> foldlArr foldfn+                                   where+                                     nodeMapReduce = arr repeat *** arr (chunksOf chunkSize) >>>+                                        arr (uncurry zip) >>>+                                        parMap conf (second (mapArr mapfn) >>> foldlArr foldfn)
+ src/main/Parrows/Skeletons/Topology.hs view
@@ -0,0 +1,110 @@+{-+The MIT License (MIT)++Copyright (c) 2016-2017 Martin Braun++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Parrows.Skeletons.Topology where++import           Control.Arrow++import           Parrows.Definition+import           Parrows.Future+import           Parrows.Util++-- Ports of Control.Parallel.Eden.Topology to Parrows:+-- edenskel-2.0.0.2 and the paper:+-- http://www.mathematik.uni-marburg.de/~eden/paper/edenCEFP.pdf++(|>>>|) :: (ArrowLoop arr, ArrowChoice arr,+            ArrowLoopParallel arr (fut (([a], [b]), [c])) (fut (([a], [b]), [c])) (),+            Future fut (([a], [b]), [c]) ()) =>+            arr a b -> arr b c -> arr a c+(|>>>|) = pipe2 ()++pipe2 :: (ArrowLoop arr, ArrowChoice arr,+            ArrowLoopParallel arr (fut (([a], [b]), [c])) (fut (([a], [b]), [c])) conf,+            Future fut (([a], [b]), [c]) conf) =>+            conf -> arr a b -> arr b c -> arr a c+pipe2 conf f g =+    (arr return &&& arr (const [])) &&& arr (const []) >>>+    pipe conf (replicate 2 (unify f g)) >>>+    arr snd >>>+    arr head+    where+        unify :: (ArrowChoice arr) => arr a b -> arr b c -> arr (([a], [b]), [c]) (([a], [b]), [c])+        unify f' g' = (mapArr f' *** mapArr g') *** arr (const []) >>> arr (\((b, c), a) -> ((a, b), c))++pipe :: (ArrowLoop arr, ArrowLoopParallel arr (fut a) (fut a) conf, Future fut a conf) => conf -> [arr a a] -> arr a a+pipe conf fs = unliftFut conf (pipeSimple conf (map (liftFut conf) fs))++pipeSimple :: (ArrowLoop arr, ArrowLoopParallel arr a a conf) => conf -> [arr a a] -> arr a a+pipeSimple conf fs =+    loop (arr snd &&&+        (arr (uncurry (:) >>> lazy) >>> loopParEvalN conf fs)) >>>+    arr last++ring :: (Future fut r conf,+    ArrowLoop arr,+    ArrowLoopParallel arr (i, fut r) (o, fut r) conf,+    ArrowLoopParallel arr o o conf) =>+    conf -> arr (i, r) (o, r) -> arr [i] [o]+ring conf f =+    loop (second (rightRotate >>> lazy) >>>+        arr (uncurry zip) >>>+        loopParEvalN conf (repeat (second (get conf) >>> f >>> second (put conf))) >>>+        arr unzip) >>>+    postLoopParEvalN conf (repeat (arr id))++--TODO: check whether this exchanges the futures the same way as Eden does it+torus :: (Future fut a conf, Future fut b conf,+      ArrowLoop arr, ArrowChoice arr,+      ArrowLoopParallel arr (c, fut a, fut b) (d, fut a, fut b) conf,+      ArrowLoopParallel arr [d] [d] conf) =>+      conf -> arr (c, a, b) (d, a, b) -> arr [[c]] [[d]]+torus conf f =+    loop (second ((mapArr rightRotate >>> lazy) *** (arr rightRotate >>> lazy)) >>>+        arr (uncurry3 (zipWith3 lazyzip3)) >>>+        arr length &&& (shuffle >>> loopParEvalN conf (repeat (ptorus conf f))) >>>+        arr (uncurry unshuffle) >>>+        arr (map unzip3) >>> arr unzip3 >>> threetotwo) >>>+    postLoopParEvalN conf (repeat (arr id))++uncurry3 :: (a -> b -> c -> d) -> (a, (b, c)) -> d+uncurry3 f (a, (b, c)) = f a b c++lazyzip3 :: [a] -> [b] -> [c] -> [(a, b, c)]+lazyzip3 as bs cs = zip3 as (lazy bs) (lazy cs)++ptorus :: (Arrow arr, Future fut a conf, Future fut b conf) =>+          conf ->+          arr (c, a, b) (d, a, b) ->+          arr (c, fut a, fut b) (d, fut a, fut b)+ptorus conf f = arr (\ ~(c, a, b) -> (c, get conf a, get conf b)) >>> f >>> arr (\ ~(d, a, b) -> (d, put conf a, put conf b))++threetotwo :: (Arrow arr) => arr (a, b, c) (a, (b, c))+threetotwo = arr $ \ ~(a, b, c) -> (a, (b, c))++twotothree :: (Arrow arr) => arr (a, (b, c)) (a, b, c)+twotothree = arr $ \ ~(a, (b, c)) -> (a, b, c)
+ src/main/Parrows/Util.hs view
@@ -0,0 +1,90 @@+{-+The MIT License (MIT)++Copyright (c) 2016-2017 Martin Braun++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.+-}+module Parrows.Util where++import           Control.Arrow++import           Data.List++--import Control.DeepSeq++zipWithArr :: ArrowChoice arr => arr (a, b) c -> arr ([a], [b]) [c]+zipWithArr zipFn = arr (uncurry zip) >>> mapArr zipFn++evalN :: (ArrowChoice arr) => [arr a b] -> arr [a] [b]+evalN (f:fs) = arr listcase >>>+         arr (const []) ||| (f *** evalN fs >>> arr (uncurry (:)))+         where listcase []     = Left ()+               listcase (x:xs) = Right (x,xs)+evalN [] = arr (const [])++-- inspiration from http://www.cse.chalmers.se/~rjmh/afp-arrows.pdf+mapArr :: ArrowChoice arr => arr a b -> arr [a] [b]+mapArr = evalN . repeat++-- fold on Arrows inspired by mapArr+foldlArr :: (ArrowChoice arr) => arr (b, a) b -> arr (b, [a]) b+foldlArr f = arr listcase >>>+             arr fst ||| (arr unassoc >>> first f >>> foldlArr f)+             where listcase (b, [])     = Left (b, [])+                   listcase (b, x:xs) = Right (b, (x,xs))+++-- from Eden, ported to Arrows:+rightRotate :: (Arrow arr) => arr [a] [a]+rightRotate = arr $ \list -> case list of [] -> []+                                          xs -> last xs : init xs++assoc :: ((a, b), c) -> (a,(b,c))+assoc ((a,b),c) = (a,(b,c))++unassoc :: (a,(b,c)) -> ((a, b), c)+unassoc (a,(b,c)) = ((a,b),c)++-- From Eden:++-- okay. (from: https://hackage.haskell.org/package/edenskel-2.1.0.0/docs/src/Control-Parallel-Eden-Auxiliary.html#unshuffle)+unshuffle :: (Arrow arr) => Int -> arr [a] [[a]]+unshuffle n = arr (\xs -> [takeEach n (drop i xs) | i <- [0..n-1]])++takeEach :: Int -> [a] -> [a]+takeEach _ []     = []+takeEach n (x:xs) = x : takeEach n (drop (n-1) xs)++-- | Simple shuffling - inverse to round robin distribution+shuffle :: (Arrow arr) => arr [[a]] [a]+shuffle = arr (concat . transpose)++-- | A lazy list is an infinite stream+lazy :: (Arrow arr) => arr [a] [a]+lazy = arr (\ ~(x:xs) -> x : lazy xs)++{-data Lazy a = Lazy a++mkLazy :: (Arrow arr) => arr a (Lazy a)+mkLazy = arr (\a -> Lazy a)++unLazy :: (Arrow arr) => arr (Lazy a) a+unLazy = arr(\(Lazy a) -> a)-}
+ stack.yaml view
@@ -0,0 +1,66 @@+# This file was automatically generated by 'stack init'+#+# Some commonly used options have been documented as comments in this file.+# For advanced use and comprehensive documentation of the format, please see:+# http://docs.haskellstack.org/en/stable/yaml_configuration/++# Resolver to choose a 'specific' stackage snapshot or a compiler version.+# A snapshot resolver dictates the compiler version and the set of packages+# to be used for project dependencies. For example:+#+# resolver: lts-3.5+# resolver: nightly-2015-09-21+# resolver: ghc-7.10.2+# resolver: ghcjs-0.1.0_ghc-7.10.2+# resolver:+#  name: custom-snapshot+#  location: "./custom-snapshot.yaml"+resolver: lts-7.1++# User packages to be built.+# Various formats can be used as shown in the example below.+#+# packages:+# - some-directory+# - https://example.com/foo/bar/baz-0.0.2.tar.gz+# - location:+#    git: https://github.com/commercialhaskell/stack.git+#    commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a+# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a+#   extra-dep: true+#  subdirs:+#  - auto-update+#  - wai+#+# A package marked 'extra-dep: true' will only be built if demanded by a+# non-dependency (i.e. a user package), and its test suites and benchmarks+# will not be run. This is useful for tweaking upstream packages.+packages:+- '.'+# Dependency packages to be pulled from upstream that are not in the resolver+# (e.g., acme-missiles-0.3)+extra-deps: []++# Override default flag values for local packages and extra-deps+flags: {}++# Extra package databases containing global packages+extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true+#+# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: ">=1.1"+#+# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64+#+# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]+#+# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor