New 'computeP' function to compute an image in parallel.

README.md

@@ -1,5 +1,5 @@
-*Friday* is an image processing library for Haskell. It has been designed to be
-fast, generic and type-safe.
+*friday* is an image processing framework for Haskell. It has been designed to
+build fast, generic and type-safe image processing algorithms.
 
 *friday* also provide some simple computer vision features such as edge
 detection or histogram processing.
@@ -10,9 +10,27 @@ Except for I/Os, *friday* is entirely written in Haskell.
 
 # Features
 
-The library uses FFI calls to the *DevIL* image library (written in C) to read
-images from a wide variety of formats, including BMP, JPG, PNG, GIF, ICO and
-PSD.
+The four distinguishing features of this image library are:
+
+* A reliance on a strongly typed programming language to detect programming
+  errors directly at compile time.
+* The ability to fuse image transformations.
+  For example, if one wishes to apply a rotation on a resized image, he can
+  use *friday* and the *Haskell* compiler to generate a single loop that will
+  automatically combine the resizing and the rotating operations into a single
+  algorithm, removing the need to store the intermediate resized image.
+* The ability to automatically parallelize algorithms to use multiple
+  processors.
+  The library is able to parallelize upon request image transformations, even
+  these which have been generated by the fusion mechanism.
+* Being extremely generic. One who wants to create new algorithms, new
+  pixel color-spaces or new ways to store an image will be able to reuse the 
+  advanced type checking features and both the fusion and automatic
+  parallelization mechanisms.
+
+The library is more like a set of *building blocks to write image processing
+algorithms in a functional programming style* than a collection of image
+processing algorithms.
 
 The library currently supports four color-spaces: RGB, RGBA, HSV and gray-scale
 images. Images can be converted between these color-spaces.

changelog

@@ -1,5 +1,8 @@
 -*-change-log-*-
 
+v0.2.2.0 June 2015
+ * New 'computeP' function to compute an image in parallel.
+
 v0.2.1.2 May 2015
  * Add test modules under `other-modules`.
 

friday.cabal

@@ -2,7 +2,7 @@ name:                   friday
 --                      +-+------- breaking API changes
 --                      | | +----- non-breaking API additions
 --                      | | | +--- code changes with no API change
-version:                0.2.1.2
+version:                0.2.2.0
 synopsis:               A functional image processing library for Haskell.
 homepage:               https://github.com/RaphaelJ/friday
 license:                LGPL-3
@@ -38,6 +38,8 @@ stability:              Experimental
 build-type:             Simple
 cabal-version:          >= 1.10
 
+extra-source-files:     changelog
+
 source-repository       head
     type:               git
     location:           https://github.com/RaphaelJ/friday
@@ -58,10 +60,11 @@ library
                         Vision.Image.HSV.Type
                         Vision.Image.Interpolate
                         Vision.Image.Mutable
+                        Vision.Image.Parallel
                         Vision.Image.RGBA
                         Vision.Image.RGBA.Specialize
                         Vision.Image.RGBA.Type
-                        Vision.Image.RGB
+                        Vision.Image.RGB 
                         Vision.Image.RGB.Specialize
                         Vision.Image.RGB.Type
                         Vision.Image.Threshold

src/Vision/Image.hs

@@ -20,6 +20,7 @@ module Vision.Image (
     , module Vision.Image.HSV
     , module Vision.Image.Interpolate
     , module Vision.Image.Mutable
+    , module Vision.Image.Parallel
     , module Vision.Image.RGB
     , module Vision.Image.RGBA
     , module Vision.Image.Threshold
@@ -34,6 +35,7 @@ import Vision.Image.Filter
 import Vision.Image.HSV
 import Vision.Image.Interpolate
 import Vision.Image.Mutable
+import Vision.Image.Parallel
 import Vision.Image.RGB
 import Vision.Image.RGBA
 import Vision.Image.Threshold

src/Vision/Image/Parallel.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE BangPatterns
+           , FlexibleContexts #-}
+
+module Vision.Image.Parallel (computeP) where
+
+import Control.Concurrent (
+    forkIO, getNumCapabilities, newEmptyMVar, putMVar, takeMVar)
+import Control.Monad.ST (ST, stToIO)
+import Data.Vector (enumFromN, forM, forM_)
+import Foreign.Storable (Storable)
+import System.IO.Unsafe (unsafePerformIO)
+
+import Vision.Image.Class (MaskedImage (..), Image (..), (!))
+import Vision.Image.Type (Manifest (..))
+import Vision.Image.Mutable (MutableManifest, linearWrite, new, unsafeFreeze)
+import Vision.Primitive (Z (..), (:.) (..), ix2)
+
+
+-- | Parallel version of 'compute'.
+--
+-- Computes the value of an image into a manifest representation in parallel.
+--
+-- The monad ensures that the image is fully evaluated before continuing.
+computeP :: (Monad m, Image i, Storable (ImagePixel i))
+        => i -> m (Manifest (ImagePixel i))
+computeP !src =
+    return $! unsafePerformIO $ do
+        dst <- stToIO newManifest
+
+        -- Forks 'nCapabilities' threads.
+        childs <- forM (enumFromN 0 nCapabilities) $ \c -> do
+            child <- newEmptyMVar
+
+            _ <- forkIO $ do
+                let nLines | c == 0    = nLinesPerThread + remain
+                           | otherwise = nLinesPerThread
+
+                stToIO $ fillFromN dst (c * nLinesPerThread) nLines
+
+                -- Sends a signal to the main thread.
+                putMVar child ()
+
+            return child
+
+        -- Waits for all threads to finish.
+        forM_ childs takeMVar
+
+        stToIO $ unsafeFreeze dst
+  where
+    !size@(Z :. h :. w) = shape src
+
+    !nCapabilities = unsafePerformIO getNumCapabilities
+
+    !(nLinesPerThread, remain) = h `quotRem` nCapabilities
+
+    -- Computes 'n' lines starting at 'from' of the image.
+    fillFromN !dst !from !n =
+        forM_ (enumFromN from n) $ \y -> do
+            let !lineOffset = y * w
+            forM_ (enumFromN 0 w) $ \x -> do
+                let !offset = lineOffset + x
+                    !val    = src ! (ix2 y x)
+                linearWrite dst offset val
+
+    newManifest :: Storable p => ST s (MutableManifest p s)
+    newManifest = new size
+{-# INLINE computeP #-}