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

@@ -15,6 +15,9 @@ import qualified Data.Vector
 import qualified Data.Vector.Unboxed
 import qualified Data.Vector.Unboxed.Mutable
 import qualified Data.STRef
+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'
@@ -26,6 +29,10 @@ data Cell = Fixed Data.Word.Word16
           | Possible 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]
 
@@ -197,10 +204,14 @@ solve grid = pruneGrid grid >>= solve'
 
 main :: IO ()
 main = do
-  inputs <- lines <$> getContents
+  grids <- lines <$> getContents
-  Control.Monad.forM_ inputs $ \input ->
+  let solutions = parMap readAndSolve grids
-    case readGrid input of
+  putStrLn $
-      Nothing   -> putStrLn "Invalid input"
+    show (length $ filter Data.Maybe.isJust solutions) ++ "/" ++ show (length grids) ++ " solved"
-      Just grid -> case solve grid of
+  where
-        Nothing    -> putStrLn "No solution found"
+    readAndSolve grid = case readGrid grid of
-        Just grid' -> putStrLn $ showGrid grid'
+      Nothing -> Nothing
+      Just b  -> solve b
+
+    chunkSize = 1000
+    parMap f = withStrategy (parBuffer chunkSize rdeepseq) . map f