.gitlab/linters/check-version-number.sh

@@ -2,5 +2,5 @@
 
 set -e
 
-grep -e -q '\[[0-9]+\.[0-9]+\.[0-9]+\]' configure.ac ||
+grep -E -q '\[[0-9]+\.[0-9]+\.[0-9]+\]' configure.ac ||
   ( echo "error: configure.ac: GHC version number must have three components."; exit 1 )

CODEOWNERS

@@ -12,7 +12,7 @@
 
 # RTS-like things
 /rts/                             @bgamari @simonmar @osa1 @Phyx @angerman
-/rts/linker/                      @angerman @Phyx
+/rts/linker/                      @angerman @Phyx @simonmar
 /includes/                        @bgamari @simonmar @osa1
 
 # The compiler

README.md

 The Glasgow Haskell Compiler
 ============================
 
-[![Build Status](https://api.travis-ci.org/ghc/ghc.svg?branch=master)](http://travis-ci.org/ghc/ghc)
+[![pipeline status](https://gitlab.haskell.org/ghc/ghc/badges/master/pipeline.svg?style=flat)](https://gitlab.haskell.org/ghc/ghc/commits/master)
 
 This is the source tree for [GHC][1], a compiler and interactive
 environment for the Haskell functional programming language.

compiler/cmm/CmmExpr.hs

@@ -5,7 +5,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 
 module CmmExpr
-    ( CmmExpr(..), cmmExprType, cmmExprWidth, maybeInvertCmmExpr
+    ( CmmExpr(..), cmmExprType, cmmExprWidth, cmmExprAlignment, maybeInvertCmmExpr
     , CmmReg(..), cmmRegType, cmmRegWidth
     , CmmLit(..), cmmLitType
     , LocalReg(..), localRegType
@@ -43,6 +43,8 @@ import Unique
 import Data.Set (Set)
 import qualified Data.Set as Set
 
+import BasicTypes (Alignment, mkAlignment, alignmentOf)
+
 -----------------------------------------------------------------------------
 --              CmmExpr
 -- An expression.  Expressions have no side effects.
@@ -239,6 +241,13 @@ cmmLabelType dflags lbl
 cmmExprWidth :: DynFlags -> CmmExpr -> Width
 cmmExprWidth dflags e = typeWidth (cmmExprType dflags e)
 
+-- | Returns an alignment in bytes of a CmmExpr when it's a statically
+-- known integer constant, otherwise returns an alignment of 1 byte.
+-- The caller is responsible for using with a sensible CmmExpr
+-- argument.
+cmmExprAlignment :: CmmExpr -> Alignment
+cmmExprAlignment (CmmLit (CmmInt intOff _)) = alignmentOf (fromInteger intOff)
+cmmExprAlignment _                          = mkAlignment 1
 --------
 --- Negation for conditional branches
 

compiler/codeGen/StgCmmPrim.hs

@@ -2035,8 +2035,8 @@ doCopyByteArrayOp = emitCopyByteArray copy
   where
     -- Copy data (we assume the arrays aren't overlapping since
     -- they're of different types)
-    copy _src _dst dst_p src_p bytes =
-        emitMemcpyCall dst_p src_p bytes 1
+    copy _src _dst dst_p src_p bytes align =
+        emitMemcpyCall dst_p src_p bytes align
 
 -- | Takes a source 'MutableByteArray#', an offset in the source
 -- array, a destination 'MutableByteArray#', an offset into the
@@ -2050,22 +2050,26 @@ doCopyMutableByteArrayOp = emitCopyByteArray copy
     -- The only time the memory might overlap is when the two arrays
     -- we were provided are the same array!
     -- TODO: Optimize branch for common case of no aliasing.
-    copy src dst dst_p src_p bytes = do
+    copy src dst dst_p src_p bytes align = do
         dflags <- getDynFlags
         (moveCall, cpyCall) <- forkAltPair
-            (getCode $ emitMemmoveCall dst_p src_p bytes 1)
-            (getCode $ emitMemcpyCall  dst_p src_p bytes 1)
+            (getCode $ emitMemmoveCall dst_p src_p bytes align)
+            (getCode $ emitMemcpyCall  dst_p src_p bytes align)
         emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall
 
 emitCopyByteArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
-                      -> FCode ())
+                      -> Alignment -> FCode ())
                   -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
                   -> FCode ()
 emitCopyByteArray copy src src_off dst dst_off n = do
     dflags <- getDynFlags
+    let byteArrayAlignment = wordAlignment dflags
+        srcOffAlignment = cmmExprAlignment src_off
+        dstOffAlignment = cmmExprAlignment dst_off
+        align = minimum [byteArrayAlignment, srcOffAlignment, dstOffAlignment]
     dst_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags dst (arrWordsHdrSize dflags)) dst_off
     src_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags src (arrWordsHdrSize dflags)) src_off
-    copy src dst dst_p src_p n
+    copy src dst dst_p src_p n align
 
 -- | Takes a source 'ByteArray#', an offset in the source array, a
 -- destination 'Addr#', and the number of bytes to copy.  Copies the given
@@ -2075,7 +2079,7 @@ doCopyByteArrayToAddrOp src src_off dst_p bytes = do
     -- Use memcpy (we are allowed to assume the arrays aren't overlapping)
     dflags <- getDynFlags
     src_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags src (arrWordsHdrSize dflags)) src_off
-    emitMemcpyCall dst_p src_p bytes 1
+    emitMemcpyCall dst_p src_p bytes (mkAlignment 1)
 
 -- | Takes a source 'MutableByteArray#', an offset in the source array, a
 -- destination 'Addr#', and the number of bytes to copy.  Copies the given
@@ -2092,7 +2096,7 @@ doCopyAddrToByteArrayOp src_p dst dst_off bytes = do
     -- Use memcpy (we are allowed to assume the arrays aren't overlapping)
     dflags <- getDynFlags
     dst_p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags dst (arrWordsHdrSize dflags)) dst_off
-    emitMemcpyCall dst_p src_p bytes 1
+    emitMemcpyCall dst_p src_p bytes (mkAlignment 1)
 
 
 -- ----------------------------------------------------------------------------
@@ -2107,9 +2111,7 @@ doSetByteArrayOp ba off len c = do
     dflags <- getDynFlags
 
     let byteArrayAlignment = wordAlignment dflags -- known since BA is allocated on heap
-        offsetAlignment = case off of
-            CmmLit (CmmInt intOff _) -> alignmentOf (fromInteger intOff)
-            _ -> mkAlignment 1
+        offsetAlignment = cmmExprAlignment off
         align = min byteArrayAlignment offsetAlignment
 
     p <- assignTempE $ cmmOffsetExpr dflags (cmmOffsetB dflags ba (arrWordsHdrSize dflags)) off
@@ -2180,7 +2182,7 @@ doCopyArrayOp = emitCopyArray copy
     copy _src _dst dst_p src_p bytes =
         do dflags <- getDynFlags
            emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes)
-               (wORD_SIZE dflags)
+               (wordAlignment dflags)
 
 
 -- | Takes a source 'MutableArray#', an offset in the source array, a
@@ -2198,9 +2200,9 @@ doCopyMutableArrayOp = emitCopyArray copy
         dflags <- getDynFlags
         (moveCall, cpyCall) <- forkAltPair
             (getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes)
-             (wORD_SIZE dflags))
+             (wordAlignment dflags))
             (getCode $ emitMemcpyCall  dst_p src_p (mkIntExpr dflags bytes)
-             (wORD_SIZE dflags))
+             (wordAlignment dflags))
         emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall
 
 emitCopyArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
@@ -2247,7 +2249,7 @@ doCopySmallArrayOp = emitCopySmallArray copy
     copy _src _dst dst_p src_p bytes =
         do dflags <- getDynFlags
            emitMemcpyCall dst_p src_p (mkIntExpr dflags bytes)
-               (wORD_SIZE dflags)
+               (wordAlignment dflags)
 
 
 doCopySmallMutableArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> WordOff
@@ -2261,9 +2263,9 @@ doCopySmallMutableArrayOp = emitCopySmallArray copy
         dflags <- getDynFlags
         (moveCall, cpyCall) <- forkAltPair
             (getCode $ emitMemmoveCall dst_p src_p (mkIntExpr dflags bytes)
-             (wORD_SIZE dflags))
+             (wordAlignment dflags))
             (getCode $ emitMemcpyCall  dst_p src_p (mkIntExpr dflags bytes)
-             (wORD_SIZE dflags))
+             (wordAlignment dflags))
         emit =<< mkCmmIfThenElse (cmmEqWord dflags src dst) moveCall cpyCall
 
 emitCopySmallArray :: (CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr -> ByteOff
@@ -2328,7 +2330,7 @@ emitCloneArray info_p res_r src src_off n = do
               (mkIntExpr dflags (arrPtrsHdrSizeW dflags)) src_off)
 
     emitMemcpyCall dst_p src_p (mkIntExpr dflags (wordsToBytes dflags n))
-        (wORD_SIZE dflags)
+        (wordAlignment dflags)
 
     emit $ mkAssign (CmmLocal res_r) (CmmReg arr)
 
@@ -2365,7 +2367,7 @@ emitCloneSmallArray info_p res_r src src_off n = do
               (mkIntExpr dflags (smallArrPtrsHdrSizeW dflags)) src_off)
 
     emitMemcpyCall dst_p src_p (mkIntExpr dflags (wordsToBytes dflags n))
-        (wORD_SIZE dflags)
+        (wordAlignment dflags)
 
     emit $ mkAssign (CmmLocal res_r) (CmmReg arr)
 
@@ -2493,19 +2495,19 @@ doCasByteArray res mba idx idx_ty old new = do
 -- Helpers for emitting function calls
 
 -- | Emit a call to @memcpy@.
-emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
+emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
 emitMemcpyCall dst src n align = do
     emitPrimCall
         [ {-no results-} ]
-        (MO_Memcpy align)
+        (MO_Memcpy (alignmentBytes align))
         [ dst, src, n ]
 
 -- | Emit a call to @memmove@.
-emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> Int -> FCode ()
+emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
 emitMemmoveCall dst src n align = do
     emitPrimCall
         [ {- no results -} ]
-        (MO_Memmove align)
+        (MO_Memmove (alignmentBytes align))
         [ dst, src, n ]
 
 -- | Emit a call to @memset@.  The second argument must fit inside an

compiler/coreSyn/CoreLint.hs

@@ -2080,7 +2080,7 @@ defaultLintFlags = LF { lf_check_global_ids = False
 newtype LintM a =
    LintM { unLintM ::
             LintEnv ->
-            WarnsAndErrs ->           -- Error and warning messages so far
+            WarnsAndErrs ->           -- Warning and error messages so far
             (Maybe a, WarnsAndErrs) } -- Result and messages (if any)
 
 type WarnsAndErrs = (Bag MsgDoc, Bag MsgDoc)
@@ -2189,10 +2189,13 @@ data LintLocInfo
   | InCo   Coercion     -- Inside a coercion
 
 initL :: DynFlags -> LintFlags -> InScopeSet
-       -> LintM a -> WarnsAndErrs    -- Errors and warnings
+       -> LintM a -> WarnsAndErrs    -- Warnings and errors
 initL dflags flags in_scope m
   = case unLintM m env (emptyBag, emptyBag) of
-      (_, errs) -> errs
+      (Just _, errs) -> errs
+      (Nothing, errs@(_, e)) | not (isEmptyBag e) -> errs
+                             | otherwise -> pprPanic ("Bug in Lint: a failure occurred " ++
+                                                      "without reporting an error message") empty
   where
     env = LE { le_flags = flags
              , le_subst = mkEmptyTCvSubst in_scope

compiler/nativeGen/X86/CodeGen.hs

@@ -1767,12 +1767,11 @@ genCCall
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
--- Unroll memcpy calls if the source and destination pointers are at
--- least DWORD aligned and the number of bytes to copy isn't too
+-- Unroll memcpy calls if the number of bytes to copy isn't too
 -- large.  Otherwise, call C's memcpy.
-genCCall dflags is32Bit (PrimTarget (MO_Memcpy align)) _
+genCCall dflags _ (PrimTarget (MO_Memcpy align)) _
          [dst, src, CmmLit (CmmInt n _)] _
-    | fromInteger insns <= maxInlineMemcpyInsns dflags && align .&. 3 == 0 = do
+    | fromInteger insns <= maxInlineMemcpyInsns dflags = do
         code_dst <- getAnyReg dst
         dst_r <- getNewRegNat format
         code_src <- getAnyReg src
@@ -1785,7 +1784,9 @@ genCCall dflags is32Bit (PrimTarget (MO_Memcpy align)) _
     -- instructions per move.
     insns = 2 * ((n + sizeBytes - 1) `div` sizeBytes)
 
-    format = if align .&. 4 /= 0 then II32 else (archWordFormat is32Bit)
+    maxAlignment = wordAlignment dflags -- only machine word wide MOVs are supported
+    effectiveAlignment = min (alignmentOf align) maxAlignment
+    format = intFormat . widthFromBytes $ alignmentBytes effectiveAlignment
 
     -- The size of each move, in bytes.
     sizeBytes :: Integer

compiler/typecheck/TcCanonical.hs

@@ -1015,7 +1015,7 @@ can_eq_nc_forall ev eq_rel s1 s2
             -- Done: unify phi1 ~ phi2
             go [] subst bndrs2
               = ASSERT( null bndrs2 )
-                unify loc (eqRelRole eq_rel) phi1' (substTy subst phi2)
+                unify loc (eqRelRole eq_rel) phi1' (substTyUnchecked subst phi2)
 
             go _ _ _ = panic "cna_eq_nc_forall"  -- case (s:ss) []
 

compiler/typecheck/TcSigs.hs

@@ -515,7 +515,7 @@ tcInstSig hs_sig@(PartialSig { psig_hs_ty = hs_ty
                              , sig_inst_skols = tv_prs
                              , sig_inst_wcs   = wcs
                              , sig_inst_wcx   = wcx
-                             , sig_inst_theta = substTys subst theta
+                             , sig_inst_theta = substTysUnchecked subst theta
                              , sig_inst_tau   = substTyUnchecked  subst tau }
        ; traceTc "End partial sig }" (ppr inst_sig)
        ; return inst_sig }

compiler/types/OptCoercion.hs

@@ -118,8 +118,8 @@ optCoercion' env co
         (Pair in_ty1  in_ty2,  in_role)  = coercionKindRole co
         (Pair out_ty1 out_ty2, out_role) = coercionKindRole out_co
     in
-    ASSERT2( substTy env in_ty1 `eqType` out_ty1 &&
-             substTy env in_ty2 `eqType` out_ty2 &&
+    ASSERT2( substTyUnchecked env in_ty1 `eqType` out_ty1 &&
+             substTyUnchecked env in_ty2 `eqType` out_ty2 &&
              in_role == out_role
            , text "optCoercion changed types!"
              $$ hang (text "in_co:") 2 (ppr co)

compiler/types/Type.hs

@@ -1044,7 +1044,7 @@ piResultTys ty orig_args@(arg:args)
     init_subst = mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes (ty:orig_args))
 
     go :: TCvSubst -> Type -> [Type] -> Type
-    go subst ty [] = substTy subst ty
+    go subst ty [] = substTyUnchecked subst ty
 
     go subst ty all_args@(arg:args)
       | Just ty' <- coreView ty

docs/users_guide/8.10.1-notes.rst

@@ -61,10 +61,11 @@ Compiler
   :ghc-flag:`-Wredundant-record-wildcards`  which warn users when they have
   redundant or unused uses of a record wildcard match.
 
-- Calls to `memset` are now unrolled more aggressively and the
-  produced code is more efficient on `x86_64` with added support for
-  64-bit `MOV`s. In particular, `setByteArray#` calls that were not
-  optimized before, now will be. See :ghc-ticket:`16052`.
+- Calls to `memset` and `memcpy` are now unrolled more aggressively
+  and the produced code is more efficient on `x86_64` with added
+  support for 64-bit `MOV`s. In particular, `setByteArray#` and
+  `copyByteArray#` calls that were not optimized before, now will
+  be. See :ghc-ticket:`16052`.
 
 Runtime system
 ~~~~~~~~~~~~~~

hadrian/hadrian.cabal

@@ -66,6 +66,7 @@ executable hadrian
                        , Rules.Nofib
                        , Rules.Program
                        , Rules.Register
+                       , Rules.Rts
                        , Rules.Selftest
                        , Rules.SimpleTargets
                        , Rules.SourceDist
@@ -121,7 +122,7 @@ executable hadrian
     build-depends:       base                 >= 4.8     && < 5
                        , Cabal                >= 3.0     && < 3.1
                        , containers           >= 0.5     && < 0.7
-                       , directory            >= 1.2     && < 1.4
+                       , directory            >= 1.3.1.0 && < 1.4
                        , extra                >= 1.4.7
                        , filepath
                        , mtl                  == 2.2.*

hadrian/src/Hadrian/Utilities.hs

@@ -16,8 +16,9 @@ module Hadrian.Utilities (
     BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource,
 
     -- * File system operations
-    copyFile, copyFileUntracked, fixFile, makeExecutable, moveFile, removeFile,
-    createDirectory, copyDirectory, moveDirectory, removeDirectory,
+    copyFile, copyFileUntracked, createFileLinkUntracked, fixFile,
+    makeExecutable, moveFile, removeFile, createDirectory, copyDirectory,
+    moveDirectory, removeDirectory,
 
     -- * Diagnostic info
     UseColour (..), Colour (..), ANSIColour (..), putColoured,
@@ -288,6 +289,14 @@ infixl 1 <&>
 isGeneratedSource :: FilePath -> Action Bool
 isGeneratedSource file = buildRoot <&> (`isPrefixOf` file)
 
+-- | Link a file tracking the source. Create the target directory if missing.
+createFileLinkUntracked :: FilePath -> FilePath -> Action ()
+createFileLinkUntracked linkTarget link = do
+    let dir = takeDirectory linkTarget
+    liftIO $ IO.createDirectoryIfMissing True dir
+    putProgressInfo =<< renderCreateFileLink linkTarget link
+    quietly . liftIO $ IO.createFileLink linkTarget link
+
 -- | Copy a file tracking the source. Create the target directory if missing.
 copyFile :: FilePath -> FilePath -> Action ()
 copyFile source target = do
@@ -460,8 +469,12 @@ renderAction what input output = do
     return $ case progressInfo of
         None    -> ""
         Brief   -> "| " ++ what ++ ": " ++ i ++ " => " ++ o
-        Normal  -> renderBox [ what, "     input: " ++ i, " => output: " ++ o ]
-        Unicorn -> renderUnicorn [ what, "     input: " ++ i, " => output: " ++ o ]
+        Normal  -> renderBox [ what
+                             , "     input: " ++ i
+                             , " => output: " ++ o ]
+        Unicorn -> renderUnicorn [ what
+                                 , "     input: " ++ i
+                                 , " => output: " ++ o ]
   where
     i = unifyPath input
     o = unifyPath output
@@ -478,6 +491,24 @@ renderActionNoOutput what input = do
   where
     i = unifyPath input
 
+-- | Render creating a file link.
+renderCreateFileLink :: String -> FilePath -> Action String
+renderCreateFileLink linkTarget link' = do
+    progressInfo <- userSetting Brief
+    let what = "Creating file link"
+        linkString = link ++ " -> " ++ linkTarget
+    return $ case progressInfo of
+        None    -> ""
+        Brief   -> "| " ++ what ++ ": " ++ linkString
+        Normal  -> renderBox [ what
+                             , "      link name: " ++ link
+                             , " -> link target: " ++ linkTarget ]
+        Unicorn -> renderUnicorn [ what
+                                 , "      link name: " ++ link
+                                 , " -> link target: " ++ linkTarget ]
+    where
+        link = unifyPath link'
+
 -- | Render the successful build of a program.
 renderProgram :: String -> String -> String -> String
 renderProgram name bin synopsis = renderBox $

hadrian/src/Rules.hs

@@ -21,6 +21,7 @@ import qualified Rules.Libffi
 import qualified Rules.Library
 import qualified Rules.Program
 import qualified Rules.Register
+import qualified Rules.Rts
 import qualified Rules.SimpleTargets
 import Settings
 import Target
@@ -158,6 +159,7 @@ buildRules = do
     Rules.Gmp.gmpRules
     Rules.Libffi.libffiRules
     Rules.Library.libraryRules
+    Rules.Rts.rtsRules
     packageRules
 
 oracleRules :: Rules ()

hadrian/src/Rules/BinaryDist.hs

@@ -97,7 +97,7 @@ other, the install script:
 bindistRules :: Rules ()
 bindistRules = do
     root <- buildRootRules
-    phony "binary-dist" $ do
+    phony "binary-dist-dir" $ do
         -- We 'need' all binaries and libraries
         targets <- mapM pkgTarget =<< stagePackages Stage1
         need targets
@@ -150,6 +150,16 @@ bindistRules = do
                    , "ghci-script", "haddock", "hpc", "hp2ps", "hsc2hs"
                    , "runghc"]
 
+
+    phony "binary-dist" $ do
+
+        need ["binary-dist-dir"]
+
+        version        <- setting ProjectVersion
+        targetPlatform <- setting TargetPlatformFull
+
+        let ghcVersionPretty = "ghc-" ++ version ++ "-" ++ targetPlatform
+
         -- Finally, we create the archive <root>/bindist/ghc-X.Y.Z-platform.tar.xz
         tarPath <- builderPath (Tar Create)
         cmd [Cwd $ root -/- "bindist"] tarPath

hadrian/src/Rules/Register.hs

@@ -8,6 +8,7 @@ import Hadrian.Haskell.Cabal
 import Oracles.Setting
 import Packages
 import Rules.Gmp
+import Rules.Rts
 import Settings
 import Target
 import Utilities
@@ -117,6 +118,9 @@ buildConf _ context@Context {..} conf = do
     Cabal.copyPackage context
     Cabal.registerPackage context
 
+    -- | Dynamic RTS library files need symlinks (Rules.Rts.rtsRules).
+    when (package == rts) (needRtsSymLinks stage ways)
+
     -- The above two steps produce an entry in the package database, with copies
     -- of many of the files we have build, e.g. Haskell interface files. We need
     -- to record this side effect so that Shake can cache these files too.

hadrian/src/Rules/Rts.hs

+module Rules.Rts (rtsRules, needRtsSymLinks) where
+
+import Packages (rts)
+import Hadrian.Utilities
+import Settings.Builders.Common
+
+-- | Dynamic RTS library files need symlinks without the dummy version number.
+-- This is for backwards compatibility (the old make build system omitted the
+-- dummy version number).
+-- This rule has priority 2 to override the general rule for generating share
+-- library files (see Rules.Library.libraryRules).
+rtsRules :: Rules ()
+rtsRules = priority 2 $ do
+    root <- buildRootRules
+    [ root -/- "//libHSrts_*-ghc*.so",
+      root -/- "//libHSrts_*-ghc*.dylib",
+      root -/- "//libHSrts-ghc*.so",
+      root -/- "//libHSrts-ghc*.dylib"]
+      |%> \ rtsLibFilePath' -> createFileLinkUntracked
+            (addRtsDummyVersion $ takeFileName rtsLibFilePath')
+            rtsLibFilePath'
+
+-- Need symlinks generated by rtsRules.
+needRtsSymLinks :: Stage -> [Way] -> Action ()
+needRtsSymLinks stage rtsWays
+    = forM_ (filter (wayUnit Dynamic) rtsWays) $ \ way -> do
+        let ctx = Context stage rts way
+        libPath     <- libPath ctx
+        distDir     <- distDir stage
+        rtsLibFile  <- takeFileName <$> pkgLibraryFile ctx
+        need [removeRtsDummyVersion (libPath </> distDir </> rtsLibFile)]
+
+prefix, versionlessPrefix :: String
+versionlessPrefix = "libHSrts"
+prefix = versionlessPrefix ++ "-1.0"
+
+-- removeRtsDummyVersion "a/libHSrts-1.0-ghc1.2.3.4.so"
+--                    == "a/libHSrts-ghc1.2.3.4.so"
+removeRtsDummyVersion :: FilePath -> FilePath
+removeRtsDummyVersion = replaceLibFilePrefix prefix versionlessPrefix
+
+-- addRtsDummyVersion "a/libHSrts-ghc1.2.3.4.so"
+--                 == "a/libHSrts-1.0-ghc1.2.3.4.so"
+addRtsDummyVersion :: FilePath -> FilePath
+addRtsDummyVersion = replaceLibFilePrefix versionlessPrefix prefix
+
+replaceLibFilePrefix :: String -> String -> FilePath -> FilePath
+replaceLibFilePrefix oldPrefix newPrefix oldFilePath = let
+    oldFileName = takeFileName oldFilePath
+    newFileName = maybe
+        (error $ "Expected RTS library file to start with " ++ oldPrefix)
+        (newPrefix ++)
+        (stripPrefix oldPrefix oldFileName)
+    in replaceFileName oldFilePath newFileName
\ No newline at end of file

libraries/base/System/Timeout.hs

@@ -16,7 +16,7 @@
 --
 -------------------------------------------------------------------------------
 
-module System.Timeout ( timeout ) where
+module System.Timeout ( Timeout, timeout ) where
 
 #if !defined(mingw32_HOST_OS)
 import Control.Monad
@@ -35,7 +35,11 @@ import Data.Unique         (Unique, newUnique)
 -- interrupt the running IO computation when the timeout has
 -- expired.
 
-newtype Timeout = Timeout Unique deriving Eq -- ^ @since 4.0
+-- | An exception thrown to a thread by 'timeout' to interrupt a timed-out
+-- computation.
+--
+-- @since 4.0
+newtype Timeout = Timeout Unique deriving Eq
 
 -- | @since 4.0
 instance Show Timeout where
@@ -67,20 +71,25 @@ instance Exception Timeout where
 -- another thread.
 --
 -- A tricky implementation detail is the question of how to abort an @IO@
--- computation. This combinator relies on asynchronous exceptions internally.
--- The technique works very well for computations executing inside of the
--- Haskell runtime system, but it doesn't work at all for non-Haskell code.
--- Foreign function calls, for example, cannot be timed out with this
--- combinator simply because an arbitrary C function cannot receive
--- asynchronous exceptions. When @timeout@ is used to wrap an FFI call that
--- blocks, no timeout event can be delivered until the FFI call returns, which
--- pretty much negates the purpose of the combinator. In practice, however,
--- this limitation is less severe than it may sound. Standard I\/O functions
--- like 'System.IO.hGetBuf', 'System.IO.hPutBuf', Network.Socket.accept, or
--- 'System.IO.hWaitForInput' appear to be blocking, but they really don't
--- because the runtime system uses scheduling mechanisms like @select(2)@ to
--- perform asynchronous I\/O, so it is possible to interrupt standard socket
--- I\/O or file I\/O using this combinator.
+-- computation. This combinator relies on asynchronous exceptions internally
+-- (namely throwing the computation the 'Timeout' exception).  The technique
+-- works very well for computations executing inside of the Haskell runtime
+-- system, but it doesn't work at all for non-Haskell code.  Foreign function
+-- calls, for example, cannot be timed out with this combinator simply because
+-- an arbitrary C function cannot receive asynchronous exceptions. When
+-- @timeout@ is used to wrap an FFI call that blocks, no timeout event can be
+-- delivered until the FFI call returns, which pretty much negates the purpose
+-- of the combinator. In practice, however, this limitation is less severe than
+-- it may sound. Standard I\/O functions like 'System.IO.hGetBuf',
+-- 'System.IO.hPutBuf', Network.Socket.accept, or 'System.IO.hWaitForInput'
+-- appear to be blocking, but they really don't because the runtime system uses
+-- scheduling mechanisms like @select(2)@ to perform asynchronous I\/O, so it
+-- is possible to interrupt standard socket I\/O or file I\/O using this
+-- combinator.
+---
+-- Note that 'timeout' cancels the computation by throwing it the 'Timeout'
+-- exception. Consequently blanket exception handlers (e.g. catching
+-- 'SomeException') within the computation will break the timeout behavior.
 timeout :: Int -> IO a -> IO (Maybe a)
 timeout n f
     | n <  0    = fmap Just f

libraries/ghc-prim/GHC/Classes.hs

@@ -331,6 +331,10 @@ instance Ord TyCon where
 -- 7. @min x y == if x <= y then x else y@ = 'True'
 -- 8. @max x y == if x >= y then x else y@ = 'True'
 --
+-- Note that (7.) and (8.) do /not/ require 'min' and 'max' to return either of
+-- their arguments. The result is merely required to /equal/ one of the
+-- arguments in terms of '(==)'.
+--
 -- Minimal complete definition: either 'compare' or '<='.
 -- Using 'compare' can be more efficient for complex types.
 --