Optimized by using Chan instead of MVar

.gitignore

@@ -6,4 +6,5 @@ input
 bin
 dist
 lib
+share
 *.sublime-workspace

SudokuSolver.hs

@@ -30,6 +30,7 @@ where
 import qualified Data.Set as S
 import qualified Data.HashMap.Strict as M
 import Control.Concurrent (forkIO, newEmptyMVar, putMVar, takeMVar)
+import Control.Concurrent.Chan (newChan, writeChan, getChanContents)
 import Control.Monad (foldM, forM_, forM, (>=>))
 import Data.Bits (testBit, (.&.), complement, popCount, bit)
 import Data.Char (digitToInt, intToDigit, isDigit)
@@ -218,30 +219,39 @@ solveSudoku board
 -- Reads the puzzles from stdin and solves them
 main :: IO ()
 main = do
-  -- read the puzzles in chunks of 10
+  -- read the puzzles in chunks of 100
-  chunks <- fmap (chunksOf 10 . lines) getContents
+  chunks <- fmap (chunksOf 100 . lines) getContents
+  solChan <- newChan
+  done <- newEmptyMVar
+
+  -- print the solutions (or errors) and wait for all thread to finish
+  forkIO $ do
+    solutions <- getChanContents solChan
+    printSolutions solutions (length chunks)
+    putMVar done ()
 
   -- spawn a thread for each chunk
-  solutionsVs <- forM chunks $ \chunk -> do
+  forM_ chunks $ \chunk -> forkIO $ do
-    solutionsV <- newEmptyMVar
-    forkIO $ do
       -- for each line in the chunk, read it as a Sudoku board and solve it
       -- return solution as a string represented by showBoard if solvable else "Unsolvable"
       -- return an error if invalid board
-      solutions <- forM chunk $ \line -> do
+      forM_ chunk $ \line -> do
         start <- getCPUTime
         let sudoku = readBoard line
         case sudoku of
-          Nothing -> return $ "Invalid input sudoku: " ++ line
+          Nothing -> writeChan solChan $ "Invalid input sudoku: " ++ line
           Just board -> do
             let !res = solveSudoku board
             end <- getCPUTime
             let diff = fromIntegral (end - start) / (10 ^ 9) :: Double
 
-            return $ printf "%s -> %s [%0.3f ms]" line
+            let !sol = printf "%s -> %s [%0.3f ms]" line
-                       (maybe "Unsolvable" showBoard res) diff
+                         (maybe "Unsolvable" showBoard res) diff
-      putMVar solutionsV solutions
+            writeChan solChan sol
-    return solutionsV
+      writeChan solChan "DONE"
 
-  -- wait for all thread to finish and print the solutions (or errors)
+  takeMVar done
-  forM_ solutionsVs $ takeMVar >=> mapM_ putStrLn
+  where
+    printSolutions _ 0           = return ()
+    printSolutions ("DONE":xs) l = printSolutions xs (l - 1)
+    printSolutions (x:xs) l      = putStrLn x >> printSolutions xs l

rubyquiz.cabal

@@ -115,7 +115,7 @@ executable SudokuSolver
                       split == 0.2.1.*,
                       unordered-containers == 0.2.1.*
   main-is           : SudokuSolver.hs
-  ghc-options       : -threaded -rtsopts -main-is SudokuSolver
+  ghc-options       : -threaded -rtsopts -fllvm -main-is SudokuSolver
   default-language  : Haskell2010
 
 executable NumericMaze

rubyquiz.sublime-project

@@ -3,7 +3,7 @@
 	[
 		{
 			"path": "/home/abhinav/projects/rubyquiz",
-			"folder_exclude_patterns": ["bin", "dist"],
+			"folder_exclude_patterns": ["bin", "dist", "lib", "share"],
 			"file_exclude_patterns": ["*.hi", "*.o"]
 		}
 	]