Parallel pipeline (#2779)

This pr introduces parallelism in the pipeline to gain performance. I've
included benchmarks at the end.

- Closes #2750.

# Flags:
There are two new global flags:
1. `-N / --threads`. It is used to set the number of capabilities.
According to [GHC
documentation](https://hackage.haskell.org/package/base-4.20.0.0/docs/GHC-Conc.html#v:setNumCapabilities):
_Set the number of Haskell threads that can run truly simultaneously (on
separate physical processors) at any given time_. When compiling in
parallel, we create this many worker threads. The default value is `-N
auto`, which sets `-N` to half the number of logical cores, capped at 8.
2. `--dev-show-thread-ids`. When given, the thread id is printed in the
compilation progress log. E.g.

![image](https://github.com/anoma/juvix/assets/5511599/9359fae2-0be1-43e5-8d74-faa82cba4034)

# Parallel compilation
1. I've added `src/Parallel/ParallelTemplate.hs` which contains all the
concurrency related code. I think it is good to keep this code separated
from the actual compiler code.
2. I've added a progress log (only for the parallel driver) that outputs
a log of the compilation progress, similar to what stack/cabal do.

# Code changes:
1. I've removed the `setup` stage where we were registering
dependencies. Instead, the dependencies are registered when the
`pathResolver` is run for the first time. This way it is safer.
1. Now the `ImportTree` is needed to run the pipeline. Cycles are
detected during the construction of this tree, so I've removed `Reader
ImportParents` from the pipeline.
3. For the package pathresolver, we do not support parallelism yet (we
could add support for it in the future, but the gains will be small).
4. When `-N1`, the pipeline remains unchanged, so performance should be
the same as in the main branch (except there is a small performance
degradation due to adding the `-threaded` flag).
5. I've introduced `PipelineOptions`, which are options that are used to
pass options to the effects in the pipeline.
6. `PathResolver` constraint has been removed from the `upTo*` functions
in the pipeline due to being redundant.
7. I've added a lot of `NFData` instances. They are needed to force the
full evaluation of `Stored.ModuleInfo` in each of the threads.
2. The `Cache` effect uses
[`SharedState`](https://hackage.haskell.org/package/effectful-core-2.3.0.1/docs/Effectful-State-Static-Shared.html)
as opposed to
[`LocalState`](https://hackage.haskell.org/package/effectful-core-2.3.0.1/docs/Effectful-Writer-Static-Local.html).
Perhaps we should provide different versions.
3. I've added a `Cache` handler that accepts a setup function. The setup
is triggered when a miss is detected. It is used to lazily compile the
modules in parallel.

# Tests
1. I've adapted the smoke test suite to ignore the progress log in the
stderr.
5. I've had to adapt `tests/positive/Internal/Lambda.juvix`. Due to
laziness, a crash happening in this file was not being caught. The
problem is that in this file we have a lambda function with different
number of patterns in their clauses, which we currently do not support
(#1706).
6. I've had to comment out the definition
   ```
   x : Box ((A : Type) → A → A) := box λ {A a := a};
   ```
From the test as it was causing a crash
(#2247).
# Future Work
1. It should be investigated how much performance we lose by fully
evaluating the `Stored.ModuleInfo`, since some information in it will be
discarded. It may be possible to be more fine-grained when forcing
evaluation.
8. The scanning of imports to build the import tree is sequential. Now,
we build the import tree from the entry point module and only the
modules that are imported from it are in the tree. However, we have
discussed that at some point we should make a distinction between
`juvix` _the compiler_ and `juvix` _the build tool_. When using `juvix`
as a build tool it makes sense to typecheck/compile (to stored core) all
modules in the project. When/if we do this, scanning imports in all
modules in parallel becomes trivial.
9. The implementation of the `ParallelTemplate` uses low level
primitives such as
[forkIO](https://hackage.haskell.org/package/base-4.20.0.0/docs/Control-Concurrent.html#v:forkIO).
At some point it should be refactored to use safer functions from the
[`Effectful.Concurrent.Async`](https://hackage.haskell.org/package/effectful-2.3.0.0/docs/Effectful-Concurrent-Async.html)
module.
10. The number of cores and worker threads that we spawn is determined
by the command line. Ideally, we could use to import tree to compute an
upper bound to the ideal number of cores to use.
11. We could add an animation that displays which modules are being
compiled in parallel and which have finished being compiled.

# Benchmarks

On some benchmarks, I include the GHC runtime option
[`-A`](https://downloads.haskell.org/ghc/latest/docs/users_guide/runtime_control.html#rts-flag--A%20%E2%9F%A8size%E2%9F%A9),
which sometimes makes a good impact on performance. Thanks to
@paulcadman for pointing this out. I've figured a good combination of
`-N` and `-A` through trial and error (but this oviously depends on the
cpu and juvix projects).

## Typecheck the standard library
   
### Clean run (88% faster than main):
```
 hyperfine --warmup 1 --prepare 'juvix clean' 'juvix -N 4 typecheck Stdlib/Prelude.juvix +RTS -A33554432'  'juvix -N 4 typecheck Stdlib/Prelude.juvix' 'juvix-main typecheck Stdlib/Prelude.juvix'
Benchmark 1: juvix -N 4 typecheck Stdlib/Prelude.juvix +RTS -A33554432
  Time (mean ± σ):     444.1 ms ±   6.5 ms    [User: 1018.0 ms, System: 77.7 ms]
  Range (min … max):   432.6 ms … 455.9 ms    10 runs

Benchmark 2: juvix -N 4 typecheck Stdlib/Prelude.juvix
  Time (mean ± σ):     628.3 ms ±  23.9 ms    [User: 1227.6 ms, System: 69.5 ms]
  Range (min … max):   584.7 ms … 670.6 ms    10 runs

Benchmark 3: juvix-main typecheck Stdlib/Prelude.juvix
  Time (mean ± σ):     835.9 ms ±  12.3 ms    [User: 788.5 ms, System: 31.9 ms]
  Range (min … max):   816.0 ms … 853.6 ms    10 runs

Summary
  juvix -N 4 typecheck Stdlib/Prelude.juvix +RTS -A33554432 ran
    1.41 ± 0.06 times faster than juvix -N 4 typecheck Stdlib/Prelude.juvix
    1.88 ± 0.04 times faster than juvix-main typecheck Stdlib/Prelude.juvix
```
   
### Cached run (43% faster than main):
```
hyperfine --warmup 1 'juvix -N 4 typecheck Stdlib/Prelude.juvix +RTS -A33554432'  'juvix -N 4 typecheck Stdlib/Prelude.juvix' 'juvix-main typecheck Stdlib/Prelude.juvix'
Benchmark 1: juvix -N 4 typecheck Stdlib/Prelude.juvix +RTS -A33554432
  Time (mean ± σ):     241.3 ms ±   7.3 ms    [User: 538.6 ms, System: 101.3 ms]
  Range (min … max):   231.5 ms … 251.3 ms    11 runs

Benchmark 2: juvix -N 4 typecheck Stdlib/Prelude.juvix
  Time (mean ± σ):     235.1 ms ±  12.0 ms    [User: 405.3 ms, System: 87.7 ms]
  Range (min … max):   216.1 ms … 253.1 ms    12 runs

Benchmark 3: juvix-main typecheck Stdlib/Prelude.juvix
  Time (mean ± σ):     336.7 ms ±  13.3 ms    [User: 269.5 ms, System: 67.1 ms]
  Range (min … max):   316.9 ms … 351.8 ms    10 runs

Summary
  juvix -N 4 typecheck Stdlib/Prelude.juvix ran
    1.03 ± 0.06 times faster than juvix -N 4 typecheck Stdlib/Prelude.juvix +RTS -A33554432
    1.43 ± 0.09 times faster than juvix-main typecheck Stdlib/Prelude.juvix
```
## Typecheck the test suite of the containers library
At the moment this is the biggest juvix project that we have.

### Clean run (105% faster than main)
```
hyperfine --warmup 1 --prepare 'juvix clean' 'juvix -N 6 typecheck Main.juvix +RTS -A67108864' 'juvix -N 4 typecheck Main.juvix' 'juvix-main typecheck Main.juvix'
Benchmark 1: juvix -N 6 typecheck Main.juvix +RTS -A67108864
  Time (mean ± σ):      1.006 s ±  0.011 s    [User: 2.171 s, System: 0.162 s]
  Range (min … max):    0.991 s …  1.023 s    10 runs

Benchmark 2: juvix -N 4 typecheck Main.juvix
  Time (mean ± σ):      1.584 s ±  0.046 s    [User: 2.934 s, System: 0.149 s]
  Range (min … max):    1.535 s …  1.660 s    10 runs

Benchmark 3: juvix-main typecheck Main.juvix
  Time (mean ± σ):      2.066 s ±  0.010 s    [User: 1.939 s, System: 0.089 s]
  Range (min … max):    2.048 s …  2.077 s    10 runs

Summary
  juvix -N 6 typecheck Main.juvix +RTS -A67108864 ran
    1.57 ± 0.05 times faster than juvix -N 4 typecheck Main.juvix
    2.05 ± 0.03 times faster than juvix-main typecheck Main.juvix
```

### Cached run (54% faster than main)
```
hyperfine --warmup 1 'juvix -N 6 typecheck Main.juvix +RTS -A33554432'  'juvix -N 4 typecheck Main.juvix' 'juvix-main typecheck Main.juvix'
Benchmark 1: juvix -N 6 typecheck Main.juvix +RTS -A33554432
  Time (mean ± σ):     551.8 ms ±  13.2 ms    [User: 1419.8 ms, System: 199.4 ms]
  Range (min … max):   535.2 ms … 570.6 ms    10 runs

Benchmark 2: juvix -N 4 typecheck Main.juvix
  Time (mean ± σ):     636.7 ms ±  17.3 ms    [User: 1006.3 ms, System: 196.3 ms]
  Range (min … max):   601.6 ms … 655.3 ms    10 runs

Benchmark 3: juvix-main typecheck Main.juvix
  Time (mean ± σ):     847.2 ms ±  58.9 ms    [User: 710.1 ms, System: 126.5 ms]
  Range (min … max):   731.1 ms … 890.0 ms    10 runs

Summary
  juvix -N 6 typecheck Main.juvix +RTS -A33554432 ran
    1.15 ± 0.04 times faster than juvix -N 4 typecheck Main.juvix
    1.54 ± 0.11 times faster than juvix-main typecheck Main.juvix
```

app/App.hs

@@ -152,24 +152,15 @@ getEntryPoint' RunAppIOArgs {..} inputFile = do
   set entryPointStdin estdin <$> entryPointFromGlobalOptionsPre root (mainFile ^. pathPath) opts
 
 runPipelineEither ::
-  (Members '[EmbedIO, TaggedLock, App] r, EntryPointOptions opts) =>
+  (Members '[EmbedIO, TaggedLock, ProgressLog, App] r, EntryPointOptions opts) =>
   opts ->
   Maybe (AppPath File) ->
   Sem (PipelineEff r) a ->
   Sem r (Either JuvixError (ResolverState, PipelineResult a))
-runPipelineEither opts input_ p = do
+runPipelineEither opts input_ p = runPipelineOptions $ do
   args <- askArgs
   entry <- applyOptions opts <$> getEntryPoint' args input_
-  runIOEither entry p
-
-runPipelineSetupEither ::
-  (Members '[EmbedIO, TaggedLock, App] r) =>
-  Sem (PipelineEff' r) a ->
-  Sem r (Either JuvixError (ResolverState, a))
-runPipelineSetupEither p = do
-  args <- askArgs
-  entry <- getEntryPointStdin' args
-  runIOEitherPipeline entry p
+  runIOEither entry (inject p)
 
 getEntryPointStdin' :: (Members '[EmbedIO, TaggedLock] r) => RunAppIOArgs -> Sem r EntryPoint
 getEntryPointStdin' RunAppIOArgs {..} = do
@@ -217,49 +208,86 @@ runPipelineTermination ::
   Maybe (AppPath File) ->
   Sem (Termination ': PipelineEff r) a ->
   Sem r (PipelineResult a)
-runPipelineTermination input_ p = do
-  r <- runPipelineEither () input_ (evalTermination iniTerminationState p) >>= fromRightJuvixError
+runPipelineTermination input_ p = ignoreProgressLog $ do
+  r <- runPipelineEither () input_ (evalTermination iniTerminationState (inject p)) >>= fromRightJuvixError
   return (snd r)
 
+appRunProgressLog :: (Members '[EmbedIO, App] r) => Sem (ProgressLog ': r) a -> Sem r a
+appRunProgressLog m = do
+  g <- askGlobalOptions
+  let opts =
+        ProgressLogOptions
+          { _progressLogOptionsUseColors = not (g ^. globalNoColors),
+            _progressLogOptionsShowThreadId = g ^. globalDevShowThreadIds
+          }
+  if
+      | g ^. globalOnlyErrors -> ignoreProgressLog m
+      | otherwise -> runProgressLogIO opts m
+
 runPipelineNoOptions ::
   (Members '[App, EmbedIO, TaggedLock] r) =>
   Maybe (AppPath File) ->
   Sem (PipelineEff r) a ->
   Sem r a
 runPipelineNoOptions = runPipeline ()
 
+runPipelineProgress ::
+  (Members '[App, EmbedIO, ProgressLog, TaggedLock] r, EntryPointOptions opts) =>
+  opts ->
+  Maybe (AppPath File) ->
+  Sem (PipelineEff r) a ->
+  Sem r a
+runPipelineProgress opts input_ p = do
+  r <- runPipelineEither opts input_ (inject p) >>= fromRightJuvixError
+  return (snd r ^. pipelineResult)
+
 runPipeline ::
   (Members '[App, EmbedIO, TaggedLock] r, EntryPointOptions opts) =>
   opts ->
   Maybe (AppPath File) ->
   Sem (PipelineEff r) a ->
   Sem r a
-runPipeline opts input_ p = do
-  r <- runPipelineEither opts input_ p >>= fromRightJuvixError
-  return (snd r ^. pipelineResult)
+runPipeline opts input_ =
+  appRunProgressLog
+    . runPipelineProgress opts input_
+    . inject
 
 runPipelineHtml ::
   (Members '[App, EmbedIO, TaggedLock] r) =>
   Bool ->
   Maybe (AppPath File) ->
   Sem r (InternalTypedResult, [InternalTypedResult])
-runPipelineHtml bNonRecursive input_
-  | bNonRecursive = do
-      r <- runPipelineNoOptions input_ upToInternalTyped
-      return (r, [])
-  | otherwise = do
-      args <- askArgs
-      entry <- getEntryPoint' args input_
-      runPipelineHtmlEither entry >>= fromRightJuvixError
-
-runPipelineEntry :: (Members '[App, EmbedIO, TaggedLock] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r a
-runPipelineEntry entry p = do
-  r <- runIOEither entry p >>= fromRightJuvixError
+runPipelineHtml bNonRecursive input_ =
+  appRunProgressLog $
+    if
+        | bNonRecursive -> do
+            r <- runPipelineNoOptions input_ upToInternalTyped
+            return (r, [])
+        | otherwise -> do
+            args <- askArgs
+            entry <- getEntryPoint' args input_
+            runReader defaultPipelineOptions (runPipelineHtmlEither entry) >>= fromRightJuvixError
+
+runPipelineOptions :: (Members '[App] r) => Sem (Reader PipelineOptions ': r) a -> Sem r a
+runPipelineOptions m = do
+  g <- askGlobalOptions
+  let opt =
+        defaultPipelineOptions
+          { _pipelineNumThreads = g ^. globalNumThreads
+          }
+  runReader opt m
+
+runPipelineEntry :: (Members '[App, ProgressLog, EmbedIO, TaggedLock] r) => EntryPoint -> Sem (PipelineEff r) a -> Sem r a
+runPipelineEntry entry p = runPipelineOptions $ do
+  r <- runIOEither entry (inject p) >>= fromRightJuvixError
   return (snd r ^. pipelineResult)
 
-runPipelineSetup :: (Members '[App, EmbedIO, TaggedLock] r) => Sem (PipelineEff' r) a -> Sem r a
-runPipelineSetup p = do
-  r <- runPipelineSetupEither p >>= fromRightJuvixError
+runPipelineSetup :: (Members '[App, EmbedIO, Reader PipelineOptions, TaggedLock] r) => Sem (PipelineEff' r) a -> Sem r a
+-- runPipelineSetup p = ignoreProgressLog $ do -- TODO restore
+runPipelineSetup p = appRunProgressLog $ do
+  args <- askArgs
+  entry <- getEntryPointStdin' args
+  r <- runIOEitherPipeline entry (inject p) >>= fromRightJuvixError
   return (snd r)
 
 newline :: (Member App r) => Sem r ()

app/Commands/Dependencies/Update.hs

@@ -2,7 +2,8 @@ module Commands.Dependencies.Update where
 
 import Commands.Base
 import Juvix.Compiler.Pipeline.Loader.PathResolver
-import Juvix.Compiler.Pipeline.Setup
 
 runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => Sem r ()
-runCommand = runPipelineSetup (entrySetup (set dependenciesConfigForceUpdateLockfile True defaultDependenciesConfig))
+runCommand = do
+  let opts = set (pipelineDependenciesConfig . dependenciesConfigForceUpdateLockfile) True defaultPipelineOptions
+  runReader opts . runPipelineSetup $ return ()

app/Commands/Dev/Core/FromConcrete.hs

@@ -14,7 +14,7 @@ import Juvix.Compiler.Core.Translation
 runCommand :: forall r. (Members '[EmbedIO, TaggedLock, App] r) => CoreFromConcreteOptions -> Sem r ()
 runCommand coreOpts = do
   gopts <- askGlobalOptions
-  md <- (^. coreResultModule) <$> runPipelineNoOptions (Just (coreOpts ^. coreFromConcreteInputFile)) upToCore
+  md <- (^. coreResultModule) <$> ignoreProgressLog (runPipelineProgress () (Just (coreOpts ^. coreFromConcreteInputFile)) upToCore)
   path :: Path Abs File <- fromAppPathFile (coreOpts ^. coreFromConcreteInputFile)
   let r =
         run

app/Commands/Dev/Highlight.hs

@@ -6,7 +6,7 @@ import Juvix.Compiler.Concrete.Data.Highlight qualified as Highlight
 import Juvix.Compiler.Pipeline.Run
 
 runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => HighlightOptions -> Sem r ()
-runCommand HighlightOptions {..} = do
+runCommand HighlightOptions {..} = ignoreProgressLog . runPipelineOptions $ do
   entry <- getEntryPoint (Just _highlightInputFile)
   inputFile <- fromAppPathFile _highlightInputFile
   hinput <-

app/Commands/Dev/ImportTree/Print.hs

@@ -3,23 +3,22 @@ module Commands.Dev.ImportTree.Print where
 import Commands.Base
 import Commands.Dev.ImportTree.Print.Options
 import Juvix.Compiler.Concrete.Print
-import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error
 import Juvix.Compiler.Pipeline.Loader.PathResolver
-import Juvix.Compiler.Pipeline.Setup
-import Juvix.Parser.Error
+import Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree
 
 runCommand :: (Members '[EmbedIO, App, TaggedLock] r) => PrintOptions -> Sem r ()
-runCommand PrintOptions {..} = do
-  inputFile <- mapM fromAppPathFile _printInputFile
-  runPipelineSetup $
-    do
-      entrySetup defaultDependenciesConfig
-      tree <-
-        runReader _printScanStrategy
-          . mapError (JuvixError @ParserError)
-          . mapError (JuvixError @ScoperError)
-          $ mkImportTree inputFile
-      renderStdOut (ppOutDefaultNoComments tree)
-      when _printStats $ do
-        let stats = mkImportTreeStats tree
-        renderStdOut (ppOutDefaultNoComments stats)
+runCommand PrintOptions {..} = runReader opts . runPipelineSetup $ do
+  tree <- case _printInputFile of
+    Nothing -> ask
+    Just appInputFile -> do
+      inputFile <- fromAppPathFile appInputFile
+      mkImportTree (Just inputFile)
+  renderStdOut (ppOutDefaultNoComments tree)
+  when _printStats $ do
+    let stats = mkImportTreeStats tree
+    renderStdOut (ppOutDefaultNoComments stats)
+  where
+    opts =
+      defaultPipelineOptions
+        { _pipelineImportStrategy = _printScanStrategy
+        }

app/Commands/Dev/ImportTree/ScanFile.hs

@@ -2,7 +2,7 @@ module Commands.Dev.ImportTree.ScanFile where
 
 import Commands.Base
 import Commands.Dev.ImportTree.ScanFile.Options
-import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error
+import Juvix.Compiler.Concrete.Print
 import Juvix.Compiler.Concrete.Translation.ImportScanner
 import Juvix.Compiler.Concrete.Translation.ImportScanner.Base
 
@@ -14,5 +14,6 @@ runCommand ScanFileOptions {..} =
     $ do
       scanRes <- fromAppPathFile _scanFileFile >>= scanFileImports
       forM_ (scanRes ^. scanResultImports) $ \impor -> do
-        renderStdOut (prettyText impor)
+        opts <- askGenericOptions
+        renderStdOut (ppOutNoComments opts impor)
         newline

app/Commands/Eval.hs

@@ -9,7 +9,7 @@ import Juvix.Extra.Strings qualified as Str
 runCommand :: (Members '[EmbedIO, TaggedLock, App] r) => EvalOptions -> Sem r ()
 runCommand opts@EvalOptions {..} = do
   gopts <- askGlobalOptions
-  Core.CoreResult {..} <- runPipelineNoOptions _evalInputFile upToCore
+  Core.CoreResult {..} <- ignoreProgressLog (runPipelineProgress () _evalInputFile upToCore)
   let r =
         run
           . runReader (project gopts)

app/Commands/Format.hs

@@ -103,5 +103,5 @@ runScopeFileApp = interpret $ \case
             { _pathPath = mkPrepath (toFilePath p),
               _pathIsInput = False
             }
-    runPipelineNoOptions (Just appFile) upToScoping
-  ScopeStdin e -> runPipelineEntry e upToScoping
+    ignoreProgressLog (runPipelineProgress () (Just appFile) upToScoping)
+  ScopeStdin e -> ignoreProgressLog (runPipelineEntry e upToScoping)

app/Commands/Repl.hs

@@ -117,7 +117,7 @@ loadEntryPoint ep = do
           }
   State.modify (set replStateContext (Just newCtx))
   let epPath :: Maybe (Path Abs File) = ep ^. entryPointModulePath
-  whenJust epPath $ \path -> liftIO (putStrLn [i|OK loaded: #{toFilePath path}|])
+  whenJust epPath $ \path -> liftIO (putStrLn [i|OK loaded: #{toFilePath @String path}|])
 
 reloadFile :: String -> Repl ()
 reloadFile _ = replGetContext >>= loadEntryPoint . (^. replContextEntryPoint)

app/CommonOptions.hs

@@ -2,12 +2,14 @@
 module CommonOptions
   ( module CommonOptions,
     module Juvix.Prelude,
+    module Parallel.ProgressLog,
     module Options.Applicative,
   )
 where
 
 import Control.Exception qualified as GHC
 import Data.List.NonEmpty qualified as NonEmpty
+import GHC.Conc
 import Juvix.Compiler.Concrete.Translation.ImportScanner
 import Juvix.Compiler.Core.Data.TransformationId.Parser qualified as Core
 import Juvix.Compiler.Pipeline.EntryPoint
@@ -17,6 +19,7 @@ import Juvix.Data.Field
 import Juvix.Prelude
 import Juvix.Prelude as Juvix
 import Options.Applicative
+import Parallel.ProgressLog
 import System.Process
 import Text.Read (readMaybe)
 import Prelude (show)
@@ -53,6 +56,22 @@ parseInputFiles exts' = do
 parseInputFile :: FileExt -> Parser (AppPath File)
 parseInputFile = parseInputFiles . NonEmpty.singleton
 
+numThreadsOpt :: ReadM NumThreads
+numThreadsOpt = eitherReader readNumThreads
+
+parseNumThreads :: Parser NumThreads
+parseNumThreads = do
+  option
+    numThreadsOpt
+    ( long "threads"
+        <> short 'N'
+        <> metavar "THREADS"
+        <> value defaultNumThreads
+        <> showDefault
+        <> help "Number of physical threads to run"
+        <> completer (listCompleter (Juvix.show NumThreadsAuto : [Juvix.show j | j <- [1 .. numCapabilities]]))
+    )
+
 parseProgramInputFile :: Parser (AppPath File)
 parseProgramInputFile = do
   _pathPath <-
@@ -301,5 +320,8 @@ optRegTransformationIds = optTransformationIds Reg.parseTransformations Reg.comp
 class EntryPointOptions a where
   applyOptions :: a -> EntryPoint -> EntryPoint
 
+instance EntryPointOptions (EntryPoint -> EntryPoint) where
+  applyOptions = id
+
 instance EntryPointOptions () where
   applyOptions () = id

app/GlobalOptions.hs

@@ -24,8 +24,10 @@ data GlobalOptions = GlobalOptions
     _globalNoCoverage :: Bool,
     _globalNoStdlib :: Bool,
     _globalUnrollLimit :: Int,
+    _globalNumThreads :: NumThreads,
     _globalFieldSize :: Maybe Natural,
-    _globalOffline :: Bool
+    _globalOffline :: Bool,
+    _globalDevShowThreadIds :: Bool
   }
   deriving stock (Eq, Show)
 
@@ -57,6 +59,7 @@ defaultGlobalOptions :: GlobalOptions
 defaultGlobalOptions =
   GlobalOptions
     { _globalNoColors = False,
+      _globalNumThreads = defaultNumThreads,
       _globalShowNameIds = False,
       _globalOnlyErrors = False,
       _globalNoTermination = False,
@@ -67,6 +70,7 @@ defaultGlobalOptions =
       _globalNoStdlib = False,
       _globalUnrollLimit = defaultUnrollLimit,
       _globalFieldSize = Nothing,
+      _globalDevShowThreadIds = False,
       _globalOffline = False
     }
 
@@ -140,6 +144,12 @@ parseGlobalFlags = do
       ( long "show-name-ids"
           <> help "[DEV] Show the unique number of each identifier when pretty printing"
       )
+  _globalDevShowThreadIds <-
+    switch
+      ( long "dev-show-thread-ids"
+          <> help "[DEV] Show the thread id when compiling a module"
+      )
+  _globalNumThreads <- parseNumThreads
   return GlobalOptions {..}
 
 parseBuildDir :: Mod OptionFields (Prepath Dir) -> Parser (AppPath Dir)

app/Main.hs

@@ -3,6 +3,7 @@ module Main (main) where
 import App
 import CommonOptions
 import Data.String.Interpolate (i)
+import GHC.Conc qualified as GHC
 import GlobalOptions
 import Juvix.Compiler.Pipeline.Root
 import TopCommand
@@ -13,6 +14,7 @@ main = do
   let parserPreferences = prefs showHelpOnEmpty
   invokeDir <- getCurrentDir
   (_runAppIOArgsGlobalOptions, cli) <- customExecParser parserPreferences descr
+  numThreads (_runAppIOArgsGlobalOptions ^. globalNumThreads) >>= GHC.setNumCapabilities
   mbuildDir <- mapM (prepathToAbsDir invokeDir) (_runAppIOArgsGlobalOptions ^? globalBuildDir . _Just . pathPath)
   mainFile <- topCommandInputPath cli
   mapM_ checkMainFile mainFile

package.yaml

@@ -92,6 +92,7 @@ dependencies:
   - singletons == 3.0.*
   - singletons-base == 3.3.*
   - singletons-th == 3.3.*
+  - stm == 2.5.*
   - Stream == 0.4.*
   - string-interpolate == 0.3.*
   - template-haskell == 2.21.*
@@ -179,7 +180,6 @@ executables:
       - polysemy == 1.9.*
     verbatim:
       default-language: GHC2021
-
   juvix:
     main: Main.hs
     source-dirs: app
@@ -193,6 +193,17 @@ executables:
       - string-interpolate == 0.3.*
     verbatim:
       default-language: GHC2021
+    ghc-options:
+      - -threaded
+      # We enable rtsopts because we've found that tweaking the -A flag can lead
+      # to great performance gains. However, GHC's decumentation warns that
+      # enabling this may cause security problems: "...can be used to write logging
+      # data to arbitrary files under the security context of the running
+      # program..."
+      - -rtsopts
+      # We set -N1 to avoid spending time in thread initialization. We manually
+      # set the number of cores we want to use through the juvix -N global flag.
+      - -with-rtsopts=-N1
     when:
       - condition: flag(static)
         ld-options: