Adds parallelism

package.yaml

@@ -15,6 +15,8 @@ dependencies:
 - base >= 4.7 && < 5
 - containers
 - vector
+- parallel
+- deepseq
 
 executables:
   sudoku:
@@ -22,6 +24,9 @@ executables:
     source-dirs:         src
     ghc-options:
     - -O2
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
     dependencies:
     - split
 

src/Sudoku.hs

@@ -13,6 +13,9 @@ import qualified Data.Foldable
 import qualified Data.Vector
 import Data.Vector ((!))
 import qualified Data.Vector.Mutable
+import qualified Data.Maybe
+import qualified Control.DeepSeq
+import Control.Parallel.Strategies (withStrategy, rdeepseq, parBuffer)
 
 fixM :: (Eq t, Monad m) => (t -> m t) -> t -> m t
 fixM f x = f x >>= \x' -> if x' == x then return x else fixM f x'
@@ -24,6 +27,10 @@ data Cell = Fixed {-# UNPACK #-} !Data.Word.Word16
           | Possible {-# UNPACK #-} !Data.Word.Word16
           deriving (Show, Eq)
 
+instance Control.DeepSeq.NFData Cell where
+  rnf (Fixed w)    = Control.DeepSeq.rnf w
+  rnf (Possible w) = Control.DeepSeq.rnf w
+
 type Grid = Data.Vector.Vector Cell
 type CellIxs = [Int]
 
@@ -210,10 +217,14 @@ solve grid = pruneGrid grid >>= solve'
 
 main :: IO ()
 main = do
-  inputs <- lines <$> getContents
-  Control.Monad.forM_ inputs $ \input ->
-    case readGrid input of
-      Nothing   -> putStrLn "Invalid input"
-      Just grid -> case solve grid of
-        Nothing    -> putStrLn "No solution found"
-        Just grid' -> putStrLn $ showGrid grid'
+  grids <- lines <$> getContents
+  let solutions = parMap readAndSolve grids
+  putStrLn $
+    show (length $ filter Data.Maybe.isJust solutions) ++ "/" ++ show (length grids) ++ " solved"
+  where
+    readAndSolve grid = case readGrid grid of
+      Nothing -> Nothing
+      Just b  -> solve b
+
+    chunkSize = 1000
+    parMap f = withStrategy (parBuffer chunkSize rdeepseq) . map f