Add ghc flag -jsemwip/ghc-jsem-8.10

7 files changed, 301 insertions, 22 deletions

diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index e007355b91..7a5d5ac226 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -202,7 +202,7 @@ necessary to the stack to accommodate it (e.g. 2).
 
 module CmmParse ( parseCmmFile ) where
 
-import GhcPrelude
+import GhcPrelude as Prelude
 
 import GHC.StgToCmm.ExtCode
 import CmmCallConv
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index b8186d2fa1..a731d7413f 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -289,6 +289,7 @@ Library
         PprCmmDecl
         PprCmmExpr
         Bitmap
+        MakeSem
         GHC.Platform.Regs
         GHC.Platform.ARM
         GHC.Platform.ARM64
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 03bb5292da..92f1b65b90 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -990,6 +990,7 @@ data DynFlags = DynFlags {
   parMakeCount          :: Maybe Int,   -- ^ The number of modules to compile in parallel
                                         --   in --make mode, where Nothing ==> compile as
                                         --   many in parallel as there are CPUs.
+  parMakeSemaphore      :: Maybe FilePath, -- ^ TODO
 
   enableTimeStats       :: Bool,        -- ^ Enable RTS timing statistics?
   ghcHeapSize           :: Maybe Int,   -- ^ The heap size to set.
@@ -1973,6 +1974,7 @@ defaultDynFlags mySettings llvmConfig =
         strictnessBefore        = [],
 
         parMakeCount            = Just 1,
+        parMakeSemaphore        = Nothing,
 
         enableTimeStats         = False,
         ghcHeapSize             = Nothing,
@@ -3013,6 +3015,7 @@ dynamic_flags_deps = [
                  -- result of getNumProcessors
   , make_ord_flag defFlag "instantiated-with"   (sepArg setUnitIdInsts)
   , make_ord_flag defFlag "this-component-id"   (sepArg setComponentId)
+  , make_ord_flag defGhcFlag "jsem" (sepArg $ \x d -> d { parMakeSemaphore = Just x })
 
     -- RTS options -------------------------------------------------------------
   , make_ord_flag defFlag "H"           (HasArg (\s -> upd (\d ->
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 6599da07f4..b9397ff31e 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -69,6 +69,7 @@ import Util
 import qualified GHC.LanguageExtensions as LangExt
 import NameEnv
 import FileCleanup
+import MakeSem
 
 import Data.Either ( rights, partitionEithers )
 import qualified Data.Map as Map
@@ -79,7 +80,6 @@ import qualified FiniteMap as Map ( insertListWith )
 import Control.Concurrent ( forkIOWithUnmask, killThread )
 import qualified GHC.Conc as CC
 import Control.Concurrent.MVar
-import Control.Concurrent.QSem
 import Control.Exception
 import Control.Monad
 import Control.Monad.Trans.Except ( ExceptT(..), runExceptT, throwE )
@@ -95,7 +95,7 @@ import System.FilePath
 import System.IO        ( fixIO )
 import System.IO.Error  ( isDoesNotExistError )
 
-import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities )
+import GHC.Conc ( getNumProcessors)
 
 label_self :: String -> IO ()
 label_self thread_name = do
@@ -875,7 +875,9 @@ checkStability hpt sccs all_home_mods =
  - IORef) to save space.
  -
  - Instead of immediately outputting messages to the standard handles, all
- - compilation output is deferred to a per-module TQueue. A QSem is used to
+ - compilation output is deferred to a per-module TQueue.
+TODO Doug update
+A QSem is used to
  - limit the number of workers that are compiling simultaneously.
  -
  - Meanwhile, the main thread sequentially loops over all the modules in the
@@ -956,23 +958,8 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
     -- module successfully gets compiled, its HMI is pruned from the old HPT.
     old_hpt_var <- liftIO $ newIORef old_hpt
 
-    -- What we use to limit parallelism with.
-    par_sem <- liftIO $ newQSem n_jobs
 
-
-    let updNumCapabilities = liftIO $ do
-            n_capabilities <- getNumCapabilities
-            n_cpus <- getNumProcessors
-            -- Setting number of capabilities more than
-            -- CPU count usually leads to high userspace
-            -- lock contention. #9221
-            let n_caps = min n_jobs n_cpus
-            unless (n_capabilities /= 1) $ setNumCapabilities n_caps
-            return n_capabilities
-    -- Reset the number of capabilities once the upsweep ends.
-    let resetNumCapabilities orig_n = liftIO $ setNumCapabilities orig_n
-
-    gbracket updNumCapabilities resetNumCapabilities $ \_ -> do
+    withMakeSem n_jobs (parMakeSemaphore dflags) $ \par_sem -> do
 
     -- Sync the global session with the latest HscEnv once the upsweep ends.
     let finallySyncSession io = io `gfinally` do
@@ -1147,7 +1134,7 @@ parUpsweep_one
     -- ^ The messager
     -> (HscEnv -> IO ())
     -- ^ The callback for cleaning up intermediate files
-    -> QSem
+    -> MakeSem
     -- ^ The semaphore for limiting the number of simultaneous compiles
     -> MVar HscEnv
     -- ^ The MVar that synchronizes updates to the global HscEnv
@@ -1256,7 +1243,7 @@ parUpsweep_one mod home_mod_map comp_graph_loops lcl_dflags mHscMessage cleanup
         let logger err = printBagOfErrors lcl_dflags (srcErrorMessages err)
 
         -- Limit the number of parallel compiles.
-        let withSem sem = bracket_ (waitQSem sem) (signalQSem sem)
+        let withSem sem = bracket_ (waitMakeSem sem) (signalMakeSem sem)
         mb_mod_info <- withSem par_sem $
             handleSourceError (\err -> do logger err; return Nothing) $ do
                 -- Have the ModSummary and HscEnv point to our local log_action
diff --git a/compiler/main/MakeSem.hs b/compiler/main/MakeSem.hs
new file mode 100644
index 0000000000..f44088b5dd
--- /dev/null
+++ b/compiler/main/MakeSem.hs
@@ -0,0 +1,66 @@
+-- |
+
+module MakeSem where
+
+import GhcPrelude
+
+import System.Posix.Semaphore
+import System.Posix.Files (stdFileMode)
+--import qualified Control.Monad.Catch as MC
+import Exception
+
+import Data.Foldable
+import Control.Monad.IO.Class
+import Control.Monad (unless)
+import Control.Concurrent.MVar
+import Control.Concurrent.QSem
+
+import GHC.Conc ( getNumProcessors, getNumCapabilities, setNumCapabilities )
+
+-- TODO tidy + add windows constructor
+data MakeSem = LocalSem QSem | GlobalSem (Maybe (MVar Int)) Semaphore
+
+waitMakeSem :: MonadIO m => MakeSem -> m ()
+waitMakeSem s = liftIO $ case s of
+  LocalSem qsem -> waitQSem qsem
+  GlobalSem mb_num_running_mv sem -> do
+    semWait sem
+    for_ mb_num_running_mv $ \mv -> modifyMVar_ mv $ \i -> do
+      n_cpus <- getNumProcessors
+      setNumCapabilities $ (i + 1) `min` n_cpus
+      pure (i + 1)
+
+
+signalMakeSem :: MonadIO m => MakeSem -> m ()
+signalMakeSem s = liftIO $ case s of
+  LocalSem qsem -> signalQSem qsem
+  GlobalSem mb_num_running_mv sem -> do
+    semPost sem
+    for_ mb_num_running_mv $ \mv -> modifyMVar_ mv $ \i -> do
+      setNumCapabilities $ (i - 1) `max` 1
+      pure (i - 1)
+
+
+withMakeSem :: (ExceptionMonad m) => Int -> Maybe FilePath -> (MakeSem -> m a) -> m a
+withMakeSem n_jobs mb_global_sem action = do
+  n_capabilities <- liftIO getNumCapabilities
+  case mb_global_sem of
+    Just sem_path -> do
+      -- TODO this can fail. We need a reasonable error message
+      (mv, sem) <- liftIO $ do
+        sem <- semOpen sem_path (OpenSemFlags { semCreate = True, semExclusive = False }) stdFileMode n_jobs
+        mv <- if n_capabilities /= 1 then pure Nothing else fmap Just $ newMVar 0
+        pure (mv, sem)
+      action (GlobalSem mv sem)
+    Nothing -> do
+      let resetNumCapabilities orig_n = liftIO $ setNumCapabilities orig_n
+          updNumCapabilities = liftIO $ do
+            n_cpus <- getNumProcessors
+              -- Setting number of capabilities more than
+              -- CPU count usually leads to high userspace
+              -- lock contention. #9221
+            let n_caps = min n_jobs n_cpus
+            unless (n_capabilities /= 1) $ setNumCapabilities n_caps
+            return n_capabilities
+      sem <- liftIO $ newQSem n_jobs
+      gbracket updNumCapabilities resetNumCapabilities  $ \_ -> action (LocalSem sem)
diff --git a/docs/users_guide/9.2.1-notes.rst b/docs/users_guide/9.2.1-notes.rst
new file mode 100644
index 0000000000..4b36e580f0
--- /dev/null
+++ b/docs/users_guide/9.2.1-notes.rst
@@ -0,0 +1,214 @@
+.. _release-9-2-1:
+
+Version 9.2.1
+==============
+
+Language
+~~~~~~~~
+
+* :extension:`ImpredicativeTypes`: Finally, polymorphic types have become first class!
+  GHC 9.2 includes a full implementation of the Quick Look approach to type inference for
+  impredicative types, as described in in the paper
+  `A quick look at impredicativity
+  <https://www.microsoft.com/en-us/research/publication/a-quick-look-at-impredicativity/>`__
+  (Serrano et al, ICFP 2020).  More information here: :ref:`impredicative-polymorphism`.
+  This replaces the old (undefined, flaky) behaviour of the :extension:`ImpredicativeTypes` extension.
+
+* Kind inference for data/newtype instance declarations is slightly
+  more restrictive than before.  See the user manual :ref:`kind-inference-data-family-instances`.
+  This is a breaking change, albeit a fairly obscure one that corrects a specification bug.
+
+* GHC is stricter about checking for out-of-scope type variables on the
+  right-hand sides of associated type family instances that are not bound on
+  the left-hand side. As a result, some programs that were accidentally
+  accepted in previous versions of GHC will now be rejected, such as this
+  example: ::
+
+      class Funct f where
+        type Codomain f
+      instance Funct ('KProxy :: KProxy o) where
+        type Codomain 'KProxy = NatTr (Proxy :: o -> Type)
+
+  Where: ::
+
+      data Proxy (a :: k) = Proxy
+      data KProxy (t :: Type) = KProxy
+      data NatTr (c :: o -> Type)
+
+  GHC will now reject the ``o`` on the right-hand side of the ``Codomain``
+  instance as being out of scope, as it does not meet the requirements for
+  being explicitly bound (as it is not mentioned on the left-hand side) nor
+  implicitly bound (as it is not mentioned in an *outermost* kind signature,
+  as required by :ref:`scoping-class-params`). This program can be repaired in
+  a backwards-compatible way by mentioning ``o`` on the left-hand side: ::
+
+      instance Funct ('KProxy :: KProxy o) where
+        type Codomain ('KProxy @o) = NatTr (Proxy :: o -> Type)
+        -- Alternatively,
+        -- type Codomain ('KProxy :: KProxy o) = NatTr (Proxy :: o -> Type)
+
+* Previously, ``-XUndecidableInstances`` accidentally implied ``-XFlexibleContexts``.
+  This is now fixed, but it means that some programs will newly require
+  ``-XFlexibleContexts``.
+
+* Various records-related extensions have been improved:
+
+  - A new extension :extension:`NoFieldSelectors` hides record field selector
+    functions, so it is possible to define top-level bindings with the same names.
+
+  - The :extension:`DisambiguateRecordFields` extension now works for updates.
+    An update ``expr { field = value }`` will be accepted if there is a single
+    field called ``field`` in scope, regardless of whether there are non-fields
+    in scope with the same name.
+
+  - The :extension:`DuplicateRecordFields` extension now applies to fields in
+    record pattern synonyms.  In particular, it is possible for a single module
+    to define multiple pattern synonyms using the same field names.
+
+Compiler
+~~~~~~~~
+
+- New :ghc-flag:`-Wredundant-bang-patterns` flag that enables checks for "dead" bangs.
+  For instance, given this program: ::
+
+      f :: Bool -> Bool
+      f True = False
+      f !x   = x
+
+  GHC would report that the bang on ``x`` is redundant and can be removed
+  since the argument was already forced in the first equation. For more
+  details see :ghc-flag:`-Wredundant-bang-patterns`.
+
+- New :ghc-flag:`-finline-generics` and
+  :ghc-flag:`-finline-generics-aggressively` flags for improving performance of
+  generics-based algorithms.
+
+  For more details see :ghc-flag:`-finline-generics` and
+  :ghc-flag:`-finline-generics-aggressively`.
+
+- GHCi's ``:kind!`` command now expands through type synonyms in addition to type
+  families. See :ghci-cmd:`:kind`.
+
+- GHC now supports a flag, :ghc-flag:`-fprof-callers=⟨name⟩`, for requesting
+  that the compiler automatically insert cost-centres on all call-sites of
+  the named function.
+
+GHCi
+~~~~
+
+- GHCi's :ghci-cmd:`:edit` command now looks for an editor in
+  the :envvar:`VISUAL` environment variable before
+  :envvar:`EDITOR`, following UNIX convention.
+  (:ghc-ticket:`19030`)
+
+- GHC now follows by default the XDG Base Directory Specification. If
+  ``$HOME/.ghc`` is found it will fallback to the old paths to give you
+  time to migrate. This fallback will be removed in three releases.
+
+Runtime system
+~~~~~~~~~~~~~~
+
+- The heap profiler now has proper treatment of pinned ``ByteArray#``\ s. Such
+  heap objects will now be correctly attributed to their appropriate cost
+  centre instead of merely being lumped into the ``PINNED`` category.
+  Moreover, we now correctly account for the size of the array, meaning that
+  space lost to fragmentation is no longer counted as live data.
+
+
+
+- The ``-xt`` RTS flag has been removed. Now STACK and TSO closures are always
+  included in heap profiles. Tooling can choose to filter out these closure types
+`  if necessary.
+
+
+- ``Void#`` is now a type synonym for the unboxed tuple ``(# #)``.
+  Code using ``Void#`` now has to enable :extension:`UnboxedTuples`.
+
+``ghc`` library
+~~~~~~~~~~~~~~~
+
+- There is a significant refactoring in the solver; any type-checker plugins
+  will have to be updated, as GHC no longer uses flattening skolems or
+  flattening metavariables.
+
+- Type checker plugins which work with the natural numbers now
+  should use ``naturalTy`` kind instead of ``typeNatKind``, which has been removed.
+
+- The ``con_args`` field of ``ConDeclGADT`` has been renamed to ``con_g_args``.
+  This is because the type of ``con_g_args`` is now different from the type of
+  the ``con_args`` field in ``ConDeclH98``: ::
+
+    data ConDecl pass
+      = ConDeclGADT
+          { ...
+          , con_g_args :: HsConDeclGADTDetails pass -- ^ Arguments; never infix
+          , ...
+          }
+
+      | ConDeclH98
+          { ...
+          , con_args :: HsConDeclH98Details pass -- ^ Arguments; can be infix
+          , ...
+          }
+
+  Where: ::
+
+    -- Introduced in GHC 9.2; was called `HsConDeclDetails` in previous versions of GHC
+    type HsConDeclH98Details pass
+       = HsConDetails (HsScaled pass (LBangType pass)) (XRec pass [LConDeclField pass])
+
+    -- Introduced in GHC 9.2
+    data HsConDeclGADTDetails pass
+       = PrefixConGADT [HsScaled pass (LBangType pass)]
+       | RecConGADT (XRec pass [LConDeclField pass])
+
+  Unlike Haskell98-style constructors, GADT constructors cannot be declared
+  using infix syntax, which is why ``HsConDeclGADTDetails`` lacks an
+  ``InfixConGADT`` constructor.
+
+  As a result of all this, the ``con_args`` field is now partial, so using
+  ``con_args`` as a top-level field selector is discouraged.
+
+``base`` library
+~~~~~~~~~~~~~~~~
+
+- It's possible now to promote the ``Natural`` type: ::
+
+    data Coordinate = Mk2D Natural Natural
+    type MyCoordinate = Mk2D 1 10
+
+  The separate kind ``Nat`` is removed and now it is just a type synonym for
+  ``Natural``. As a consequence, one must enable ``TypeSynonymInstances``
+  in order to define instances for ``Nat``.
+
+  The ``Numeric`` module receives ``showBin`` and ``readBin`` to show and
+  read integer numbers in binary.
+
+- ``Char`` gets type-level support by analogy with strings and natural numbers.
+  We extend the ``GHC.TypeLits`` module with these built-in type-families: ::
+
+    type family CmpChar (a :: Char) (b :: Char) :: Ordering
+    type family ConsSymbol (a :: Char) (b :: Symbol) :: Symbol
+    type family UnconsSymbol (a :: Symbol) :: Maybe (Char, Symbol)
+
+  and with the type class ``KnownChar`` (and such additional functions as ``charVal`` and ``charVal'``): ::
+
+    class KnownChar (n :: Char)
+
+    charVal :: forall n proxy. KnownChar n => proxy n -> Char
+    charVal' :: forall n. KnownChar n => Proxy# n -> Char
+
+- On POSIX, ``System.IO.openFile`` can no longer leak a file descriptor if it
+  is interrupted by an asynchronous exception (#19114, #19115).
+
+- There's a new binding ``GHC.Exts.considerAccessible``. It's equivalent to
+  ``True`` and allows the programmer to turn off pattern-match redundancy
+  warnings for particular clauses, like the third one here ::
+
+    g :: Bool -> Int
+    g x = case (x, x) of
+      (True,  True)  -> 1
+      (False, False) -> 2
+      (True,  False) | considerAccessible -> 3 -- No warning!
+
+- TODO Doug Add -jsem flag
diff --git a/docs/users_guide/using.rst b/docs/users_guide/using.rst
index 9812c455e6..efcb2dc7ef 100644
--- a/docs/users_guide/using.rst
+++ b/docs/users_guide/using.rst
@@ -521,6 +521,14 @@ search path (see :ref:`search-path`).
     number of processors. Note that compilation of a module may not begin
     until its dependencies have been built.
 
+.. ghc-flag:: -jsem ⟨sem⟩
+    :shortdesc: When compiling with :ghc-flag:`--make` and :ghc-flag:`-j[⟨n⟩]` limit
+        parallelism with the semaphore ⟨sem⟩ in parallel.
+    :type: dynamic
+    :category: misc
+
+    TODO Doug We will create the semaphore but we won't destory it.
+
 .. _eval-mode:
 
 Expression evaluation mode