Add --jobs option to gbc

When compiling multiple .bond files at once, the `--jobs=[NUM]` command
line option can be used to specify how many jobs should be run
concurrently. When used without arguments, the default is to run as many
jobs as there are processors. The option also accepts negative numbers
to specify fewer jobs than the number of processors. Often the optimal
performance is achieved by leaving one or more cores for other processes
on the machine.

compiler/Main.hs

@@ -13,6 +13,8 @@ import Data.Monoid
 import Control.Monad
 import Control.Monad.Reader
 import Control.Monad.Loops (firstM)
+import Control.Concurrent.Async
+import GHC.Conc (getNumProcessors, setNumCapabilities)
 import qualified Data.Text.Lazy.IO as L
 import Bond.Parser
 import Bond.Template.Util
@@ -31,11 +33,21 @@ main :: IO()
 main = do
     args <- getArgs
     options <- (if null args then withArgs ["--help"] else id) getOptions
+    setJobs $ jobs options
     case options of
         Cpp {..}    -> cppCodegen options
         Cs {..}     -> csCodegen options
         _           -> print options
 
+setJobs Nothing = return ()
+setJobs (Just n)
+    | n > 0 = setNumCapabilities n
+    | otherwise = do
+        numProc <- getNumProcessors
+        setNumCapabilities $ max 1 (numProc + n)
+
+concurrentlyFor_ = (void .) . flip mapConcurrently
+
 cppCodegen :: Options -> IO()
 cppCodegen (Cpp {..}) = do
     aliasMapping <- parseAliasMapping using
@@ -44,7 +56,7 @@ cppCodegen (Cpp {..}) = do
             Nothing -> cppTypeMapping
             Just a -> cppCustomAllocTypeMapping a
     let mappingContext = newMappingContext typeMapping aliasMapping namespaceMapping []
-    forM_ files $ codeGen output_dir import_dir mappingContext $ 
+    concurrentlyFor_ files $ codeGen output_dir import_dir mappingContext $
         [ reflection_h
         , types_cpp
         , types_h header enum_header allocator
@@ -68,7 +80,7 @@ csCodegen (Cs {..}) = do
     namespaceMapping <- parseNamespaceMapping namespace
     let typeMapping = if collection_interfaces then csInterfaceTypeMapping else csTypeMapping
     let mappingContext = newMappingContext typeMapping aliasMapping namespaceMapping []
-    forM_ files $ codeGen output_dir import_dir mappingContext 
+    concurrentlyFor_ files $ codeGen output_dir import_dir mappingContext 
         [ types_cs readonly_properties fields
         ]
 

compiler/Options.hs

@@ -30,6 +30,7 @@ data Options
         , allocator :: Maybe String
         , apply :: [ApplyOptions]
         , apply_attribute :: Maybe String
+        , jobs :: Maybe Int
         }
     | Cs 
         { files :: [FilePath]
@@ -40,6 +41,7 @@ data Options
         , collection_interfaces :: Bool
         , readonly_properties :: Bool
         , fields :: Bool
+        , jobs :: Maybe Int
         }
       deriving (Show, Data, Typeable)
 
@@ -54,6 +56,7 @@ cpp = Cpp
     , allocator = def &= typ "ALLOCATOR" &= help "Generate types using the specified  allocator"
     , apply = def &= typ "PROTOCOL" &= help "Generate Apply function overloads for the specified protocol only; supported protocols: compact, fast and simple"
     , apply_attribute = def &= typ "ATTRIBUTE" &= help "Prefix the declarations of Apply functions with the specified C++ attribute/declspec"
+    , jobs = def &= opt "0" &= typ "NUM" &= help "Run NUM jobs simultaneously (or '$ncpus' if no NUM is not given)"
     } &= 
     name "c++" &=    
     help "Generate C++ code" 

compiler/cabal_build.cmake

@@ -33,7 +33,7 @@ if (error)
 endif()
 
 execute_process (
-    COMMAND ${Haskell_CABAL_EXECUTABLE} build     --with-ghc=${Haskell_GHC_EXECUTABLE} --ghc-option=-O2 --jobs --builddir=${output_dir}
+    COMMAND ${Haskell_CABAL_EXECUTABLE} build     --with-ghc=${Haskell_GHC_EXECUTABLE} --ghc-option=-O2 --ghc-option=-threaded --jobs --builddir=${output_dir}
     WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}
     RESULT_VARIABLE error)
 

compiler/gbc.cabal

@@ -58,4 +58,5 @@ executable gbc
                     cmdargs >= 0.10.10,
                     mtl >= 2.1,
                     directory >= 1.1,
+                    async >= 2.0.1.0,
                     monad-loops >= 0.4