diff options
-rw-r--r-- | docs/users_guide/9.4.1-notes.rst | 27 | ||||
-rw-r--r-- | docs/users_guide/editing-guide.rst | 33 | ||||
-rw-r--r-- | docs/users_guide/using-optimisation.rst | 56 | ||||
-rw-r--r-- | hadrian/src/Rules/BinaryDist.hs | 5 | ||||
-rw-r--r-- | libraries/base/GHC/Event/Windows.hsc | 5 | ||||
-rw-r--r-- | libraries/base/GHC/IO/Windows/Paths.hs | 2 | ||||
-rw-r--r-- | libraries/base/System/IO.hs | 24 | ||||
-rw-r--r-- | libraries/base/cbits/Win32Utils.c | 4 | ||||
-rw-r--r-- | rts/RtsStartup.c | 3 | ||||
-rw-r--r-- | rts/RtsSymbols.c | 3 | ||||
-rw-r--r-- | rts/include/rts/IOInterface.h | 1 | ||||
-rw-r--r-- | rts/win32/AsyncWinIO.c | 3 | ||||
-rw-r--r-- | rts/win32/ConsoleHandler.c | 2 | ||||
-rw-r--r-- | rts/win32/ConsoleHandler.h | 7 | ||||
-rw-r--r-- | rts/win32/ThrIOManager.c | 10 | ||||
-rw-r--r-- | rts/win32/ThrIOManager.h | 2 | ||||
-rw-r--r-- | testsuite/tests/profiling/should_compile/T20938.hs | 10 | ||||
-rw-r--r-- | testsuite/tests/profiling/should_compile/all.T | 1 | ||||
-rw-r--r-- | testsuite/tests/profiling/should_fail/all.T | 1 |
19 files changed, 159 insertions, 40 deletions
diff --git a/docs/users_guide/9.4.1-notes.rst b/docs/users_guide/9.4.1-notes.rst index 31f09fa6bc..5cb2736547 100644 --- a/docs/users_guide/9.4.1-notes.rst +++ b/docs/users_guide/9.4.1-notes.rst @@ -38,6 +38,33 @@ Compiler enabled the :extension:`UnboxedTuples` extension but didn't explicitly enable :extension:`UnboxedSums` will continue to work without changes. +- Constructed Product Result analysis (c.f. :ghc-flag:`-fcpr-anal`) has been + overhauled and will now unbox nestedly, if termination properties of the + function permit. This allows unboxing of constructed results returned by + ``IO`` actions. E.g.:: + + sumIO :: [Int] -> IO Int + sumIO [] = return 0 + sumIO (x:xs) = do + r <- sumIO xs + return $! x + r + + Note the use of ``$!``: Without it, GHC would be unable to see that evaluation + of ``r`` and ``x`` terminates (and rapidly, at that). An alternative would be to + evaluate both with a bang pattern or a ``seq``, but the ``return $! <res>`` + idiom should work more reliably and needs less thinking. + +- Demand analysis (cf. :ghc-flag:`-fstrictness`) now integrates a + Boxity Analysis that tracks whether a function needs a parameter boxed. If + that is the case, the worker/wrapper transformation (cf. + :ghc-flag:`-fworker-wrapper`) will not unbox that parameter, leading to less + reboxing in many cases. + + For reasons of backwards-compatible performance, you may find that the new + mechanism is too aggressive in a few cases (e.g., still unboxing a parameter + that is used boxed in a hot path). Do post a bug report with your example! + Then wrap the uses of the parameter in ``GHC.Exts.lazy`` for a short-term fix. + ``base`` library ~~~~~~~~~~~~~~~~ diff --git a/docs/users_guide/editing-guide.rst b/docs/users_guide/editing-guide.rst index 737abd3b2e..b4720e1a71 100644 --- a/docs/users_guide/editing-guide.rst +++ b/docs/users_guide/editing-guide.rst @@ -6,15 +6,15 @@ for the Glasgow Haskell Compiler. Even more than this, it at times serves (for better or for worse) as a de-facto language standard, being the sole non-academic reference for many widely used language extensions. -Since GHC 8.0, the User's Guide is authored in `ReStructuredText -<https://en.wikipedia.org/wiki/ReStructuredText>`__ (or ReST or RST, for short) +Since GHC 8.0, the User's Guide is authored in `reStructuredText +<https://en.wikipedia.org/wiki/ReStructuredText>`__ (or reST or RST, for short) a rich but light-weight mark-up language aimed at producing documentation. The -`Sphinx <http://sphinx-doc.org/>`__ tool is used to produce the final PDF and +`Sphinx <https://www.sphinx-doc.org/>`__ tool is used to produce the final PDF and HTML documentation. -This document (also written in ReST) serves as a brief introduction to ReST and to +This document (also written in reST) serves as a brief introduction to reST and to document the conventions used in the User's Guide. This document is *not* intended -to be a thorough guide to ReST. For this see the resources referenced +to be a thorough guide to reST. For this see the resources referenced `below <#references>`__. Basics @@ -91,7 +91,7 @@ The above would be rendered as, Headings ~~~~~~~~ -While ReST can accommodate a wide range of heading styles, we have standardized +While reST can accommodate a wide range of heading styles, we have standardized on this convention in the User's Guide, .. code-block:: rest @@ -141,7 +141,7 @@ Other languages Double-colon blocks are syntax-highlighted as Haskell by default. To avoid this use a ``.. code-block`` `directive -<http://sphinx-doc.org/markup/code.html#directive-code-block>`__ with explicit +<https://www.sphinx-doc.org/en/master/usage/restructuredtext/directives.html#directive-code-block>`__ with explicit language designation, .. code-block:: rest @@ -314,7 +314,7 @@ There are a number of admonitions types, * warning -.. _Admonitions: http://docutils.sourceforge.net/docs/ref/rst/directives.html#admonitions +.. _Admonitions: https://docutils.sourceforge.io/docs/ref/rst/directives.html#admonitions Documenting command-line options and GHCi commands -------------------------------------------------- @@ -420,16 +420,17 @@ user-substitutable tokens. In this document we use the convention, ``⟨subst⟩ (note that these are angle brackets, ``U+27E8`` and ``U+27E9``, not less-than/greater-than signs). +.. _references: -ReST reference materials +reST reference materials ------------------------ -* `Sphinx ReST Primer`_: A great place to start. -* `Sphinx extensions`_: How Sphinx extends ReST -* `ReST reference`_: When you really need the details. +* `Sphinx reST Primer`_: A great place to start. +* `Sphinx extensions`_: How Sphinx extends reST +* `reST reference`_: When you really need the details. * `Directives reference`_ -.. _Sphinx ReST Primer: http://sphinx-doc.org/rest.html -.. _ReST reference: http://docutils.sourceforge.net/docs/ref/rst/restructuredtext.html -.. _Sphinx extensions: http://sphinx-doc.org/markup/index.html -.. _Directives reference: http://docutils.sourceforge.net/docs/ref/rst/directives.html#code +.. _Sphinx reST Primer: https://www.sphinx-doc.org/en/master/usage/restructuredtext/basics.html +.. _reST reference: https://docutils.sourceforge.io/docs/ref/rst/restructuredtext.html +.. _Sphinx extensions: https://www.sphinx-doc.org/en/master/usage/extensions/index.html +.. _Directives reference: https://docutils.sourceforge.io/docs/ref/rst/directives.html#code diff --git a/docs/users_guide/using-optimisation.rst b/docs/users_guide/using-optimisation.rst index 37e4a4aae6..139031ad1c 100644 --- a/docs/users_guide/using-optimisation.rst +++ b/docs/users_guide/using-optimisation.rst @@ -247,7 +247,7 @@ by saying ``-fno-wombat``. :default: on Enables some control flow optimisations in the Cmm code - generator, merging basic blocks and avoiding jumps right after jumps. + generator, merging basic blocks and avoiding jumps right after jumps. .. ghc-flag:: -fasm-shortcutting :shortdesc: Enable shortcutting on assembly. Implied by :ghc-flag:`-O2`. @@ -319,14 +319,64 @@ by saying ``-fno-wombat``. block layout behaves the same as in 8.6 and earlier. .. ghc-flag:: -fcpr-anal - :shortdesc: Turn on CPR analysis in the demand analyser. Implied by :ghc-flag:`-O`. + :shortdesc: Turn on Constructed Product Result analysis. Implied by :ghc-flag:`-O`. :type: dynamic :reverse: -fno-cpr-anal :category: :default: on - Turn on CPR analysis in the demand analyser. + Turn on CPR analysis, which enables the worker/wrapper transformation (cf. + :ghc-flag:`-fworker-wrapper`) to unbox the result of a function, such as :: + + sum :: [Int] -> Int + sum [] = 0 + sum (x:xs) = x + sum xs + + CPR analysis will see that each code path produces a *constructed product* + such as ``I# 0#`` in the first branch (where ``GHC.Exts.I#`` is the data + constructor of ``Int``, boxing up the the primitive integer literal ``0#`` + of type ``Int#``) and optimise to :: + + sum xs = I# ($wsum xs) + $wsum [] = 0# + $wsum (I# x:xs) = x# +# $wsum xs + + and then ``sum`` can inline to potentially cancel away the ``I#`` box. + + Here's an example of the function that *does not* return a constructed product: :: + + f :: [Int] -> (Int -> Int) -> Int + f [] g = g 0 + f (x:xs) g = x + f xs g + + The expression ``g 0`` is not a constructed product, because we don't know + anything about ``g``. + + CPR analysis also works *nestedly*, for example :: + + sumIO :: [Int] -> IO Int + sumIO [] = return 0 + sumIO (x:xs) = do + r <- sumIO xs + return $! x + r + + Note the use of ``$!``: Without it, GHC would be unable to see that evaluation + of ``r`` and ``x`` terminates (and rapidly, at that). An alternative would be to + evaluate both with a bang pattern or a ``seq``, but the ``return $! <res>`` + idiom should work more reliably and needs less thinking. The above example + will be optimised to :: + + sumIO :: [Int] -> IO Int + sumIO xs = IO $ \s -> case $wsum xs s of + (# s', r #) -> (# s', I# r #) + $wsumIO :: [Int] -> (# RealWorld#, Int# #) + $wsumIO [] s = (# s, 0# #) + $wsumIO (I# x:xs) s = case $wsumIO xs of + (# s', r #) -> (# s', x +# r#) + + And the latter can inline ``sumIO`` and cancel away the ``I#`` constructor. + Unboxing the result of a ``State`` action should work similarly. .. ghc-flag:: -fcse :shortdesc: Enable common sub-expression elimination. Implied by :ghc-flag:`-O`. diff --git a/hadrian/src/Rules/BinaryDist.hs b/hadrian/src/Rules/BinaryDist.hs index 914039d9e8..7db11dddd0 100644 --- a/hadrian/src/Rules/BinaryDist.hs +++ b/hadrian/src/Rules/BinaryDist.hs @@ -234,6 +234,11 @@ bindistRules = do -- shipping it removeFile (bindistFilesDir -/- mingwStamp) + -- Include bash-completion script in binary distributions. We don't + -- currently install this but merely include it for the user's + -- reference. See #20802. + copyDirectory ("utils" -/- "completion") bindistFilesDir + -- These scripts are only necessary in the configure/install -- workflow which is not supported on windows. -- TODO: Instead of guarding against windows, we could offer the diff --git a/libraries/base/GHC/Event/Windows.hsc b/libraries/base/GHC/Event/Windows.hsc index dbca116212..973f25722b 100644 --- a/libraries/base/GHC/Event/Windows.hsc +++ b/libraries/base/GHC/Event/Windows.hsc @@ -1163,7 +1163,7 @@ io_mngr_loop _event mgr = go False exit <- case event_id of _ | event_id == io_MANAGER_WAKEUP -> return False - _ | event_id == io_MANAGER_DIE -> return True + _ | event_id == io_MANAGER_DIE -> c_ioManagerFinished >> return True 0 -> return False -- spurious wakeup _ -> do debugIO $ "handling console event: " ++ show (event_id `shiftR` 1) start_console_handler (event_id `shiftR` 1) @@ -1204,6 +1204,9 @@ foreign import ccall unsafe "getIOManagerEvent" -- in the RTS (ThrIOManager.c) foreign import ccall unsafe "readIOManagerEvent" -- in the RTS (ThrIOManager.c) c_readIOManagerEvent :: IO Word32 +foreign import ccall unsafe "ioManagerFinished" -- in the RTS (ThrIOManager.c) + c_ioManagerFinished :: IO () + foreign import ccall unsafe "rtsSupportsBoundThreads" threadedIOMgr :: Bool -- | Sleep for n ms diff --git a/libraries/base/GHC/IO/Windows/Paths.hs b/libraries/base/GHC/IO/Windows/Paths.hs index 851dc37508..c755996f22 100644 --- a/libraries/base/GHC/IO/Windows/Paths.hs +++ b/libraries/base/GHC/IO/Windows/Paths.hs @@ -30,7 +30,7 @@ import GHC.IO import Foreign.C.String import Foreign.Marshal.Alloc (free) -foreign import WINDOWS_CCONV safe "__hs_create_device_name" +foreign import ccall safe "__hs_create_device_name" c_GetDevicePath :: CWString -> IO CWString -- | This function converts Windows paths between namespaces. More specifically diff --git a/libraries/base/System/IO.hs b/libraries/base/System/IO.hs index 265507d970..f831df6cb4 100644 --- a/libraries/base/System/IO.hs +++ b/libraries/base/System/IO.hs @@ -231,13 +231,13 @@ import Foreign.C.Error import Foreign.C.String import Foreign.Ptr import Foreign.Marshal.Alloc +import Foreign.Marshal.Utils (with) import Foreign.Storable import GHC.IO.SubSystem import GHC.IO.Windows.Handle (openFileAsTemp) import GHC.IO.Handle.Windows (mkHandleFromHANDLE) import GHC.IO.Device as IODevice import GHC.Real (fromIntegral) -import Foreign.Marshal.Utils (new) #endif import Foreign.C.Types import System.Posix.Internals @@ -529,17 +529,17 @@ openTempFile' loc tmp_dir template binary mode let label = if null prefix then "ghc" else prefix withCWString tmp_dir $ \c_tmp_dir -> withCWString label $ \c_template -> - withCWString suffix $ \c_suffix -> do - c_ptr <- new nullPtr - res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix - c_ptr - if not res - then do errno <- getErrno - ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) - else do c_p <- peek c_ptr - filename <- peekCWString c_p - free c_p - handleResultsWinIO filename ((fromIntegral mode .&. o_EXCL) == o_EXCL) + withCWString suffix $ \c_suffix -> + with nullPtr $ \c_ptr -> do + res <- c_createUUIDTempFileErrNo c_tmp_dir c_template c_suffix c_ptr + if not res + then do errno <- getErrno + ioError (errnoToIOError loc errno Nothing (Just tmp_dir)) + else do c_p <- peek c_ptr + filename <- peekCWString c_p + free c_p + let flags = fromIntegral mode .&. o_EXCL + handleResultsWinIO filename (flags == o_EXCL) findTempNamePosix = do let label = if null prefix then "ghc" else prefix diff --git a/libraries/base/cbits/Win32Utils.c b/libraries/base/cbits/Win32Utils.c index f3dec0d98d..69d30339ba 100644 --- a/libraries/base/cbits/Win32Utils.c +++ b/libraries/base/cbits/Win32Utils.c @@ -183,10 +183,9 @@ bool __createUUIDTempFileErrNo (wchar_t* pathName, wchar_t* prefix, RPC_WSTR guidStr; if (UuidToStringW ((UUID*)&guid, &guidStr) != S_OK) goto fail; - /* We can't create a device path here since this path escapes the compiler so instead return a normal path and have openFile deal with it. */ - wchar_t* devName = malloc (sizeof (wchar_t) * wcslen (pathName)); + wchar_t* devName = malloc (sizeof (wchar_t) * (wcslen (pathName) + 1)); wcscpy (devName, pathName); int len = wcslen (devName) + wcslen (suffix) + wcslen (prefix) + wcslen (guidStr) + 3; @@ -204,6 +203,7 @@ bool __createUUIDTempFileErrNo (wchar_t* pathName, wchar_t* prefix, free (devName); RpcStringFreeW (&guidStr); + /* This should never happen because GUIDs are unique. But in case hell froze over let's check anyway. */ DWORD dwAttrib = GetFileAttributesW (*tempFileName); diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c index 86d5b2f2d9..07db7b7998 100644 --- a/rts/RtsStartup.c +++ b/rts/RtsStartup.c @@ -578,6 +578,9 @@ hs_exit_(bool wait_foreign) #if defined(mingw32_HOST_OS) if (is_io_mng_native_p()) hs_restoreConsoleCP(); + + /* Disable console signal handlers, we're going down!. */ + finiUserSignals (); #endif /* tear down statistics subsystem */ diff --git a/rts/RtsSymbols.c b/rts/RtsSymbols.c index f76573e3ae..ec771c27f2 100644 --- a/rts/RtsSymbols.c +++ b/rts/RtsSymbols.c @@ -377,13 +377,14 @@ extern char **environ; SymI_HasProto(unblockUserSignals) #else #define RTS_USER_SIGNALS_SYMBOLS \ - SymI_HasProto(registerIOCPHandle) \ + SymI_HasProto(registerIOCPHandle) \ SymI_HasProto(getOverlappedEntries) \ SymI_HasProto(completeSynchronousRequest) \ SymI_HasProto(registerAlertableWait) \ SymI_HasProto(sendIOManagerEvent) \ SymI_HasProto(readIOManagerEvent) \ SymI_HasProto(getIOManagerEvent) \ + SymI_HasProto(ioManagerFinished) \ SymI_HasProto(console_handler) #endif diff --git a/rts/include/rts/IOInterface.h b/rts/include/rts/IOInterface.h index 9a646cc5cf..fd625eda70 100644 --- a/rts/include/rts/IOInterface.h +++ b/rts/include/rts/IOInterface.h @@ -27,6 +27,7 @@ extern StgInt console_handler; void * getIOManagerEvent (void); HsWord32 readIOManagerEvent (void); void sendIOManagerEvent (HsWord32 event); +void ioManagerFinished (void); #else diff --git a/rts/win32/AsyncWinIO.c b/rts/win32/AsyncWinIO.c index cd370296a3..fa397c343d 100644 --- a/rts/win32/AsyncWinIO.c +++ b/rts/win32/AsyncWinIO.c @@ -144,7 +144,7 @@ There we initialize IO manager locale variables and. * call ioManagerStart() - * Creat a thread to execute "runner" + * Create a thread to execute "runner" We never truly shut down the IO Manager. While this means we might block forever on the IOPort if the IO Manager is no longer @@ -271,6 +271,7 @@ void shutdownAsyncWinIO(bool wait_threads) WaitForSingleObject (workerThread, INFINITE); } completionPortHandle = INVALID_HANDLE_VALUE; + CloseHandle (workerThread); workerThread = NULL; workerThreadId = 0; free (entries); diff --git a/rts/win32/ConsoleHandler.c b/rts/win32/ConsoleHandler.c index 05d15868eb..4af897bc54 100644 --- a/rts/win32/ConsoleHandler.c +++ b/rts/win32/ConsoleHandler.c @@ -57,7 +57,7 @@ freeSignalHandlers(void) { /* Do nothing */ } -/* Seems to be a bit of an orphan...where used? */ +/* Called in hs_exit to clean up resources. */ void finiUserSignals(void) { diff --git a/rts/win32/ConsoleHandler.h b/rts/win32/ConsoleHandler.h index bb7278abba..d22f10f16a 100644 --- a/rts/win32/ConsoleHandler.h +++ b/rts/win32/ConsoleHandler.h @@ -62,3 +62,10 @@ extern void startSignalHandlers(Capability *cap); extern int rts_waitConsoleHandlerCompletion(void); #endif /* THREADED_RTS */ + +/* + * Function: finiUserSignals() + * + * Tear down and shut down user signal processing. + */ +extern void finiUserSignals(void); diff --git a/rts/win32/ThrIOManager.c b/rts/win32/ThrIOManager.c index d614d49a0c..6bbf65a45f 100644 --- a/rts/win32/ThrIOManager.c +++ b/rts/win32/ThrIOManager.c @@ -161,3 +161,13 @@ ioManagerStart (void) rts_unlock(cap); } } + +/* + * Called to close the io_manager_event handle when the IO manager thread is + * terminating. + */ +void +ioManagerFinished(void) +{ + CloseHandle(io_manager_event); +} diff --git a/rts/win32/ThrIOManager.h b/rts/win32/ThrIOManager.h index a67bdde364..c7ecc76e9f 100644 --- a/rts/win32/ThrIOManager.h +++ b/rts/win32/ThrIOManager.h @@ -15,4 +15,4 @@ void ioManagerWakeup (void); void ioManagerDie (void); void ioManagerStart (void); - +void ioManagerFinished (void); diff --git a/testsuite/tests/profiling/should_compile/T20938.hs b/testsuite/tests/profiling/should_compile/T20938.hs new file mode 100644 index 0000000000..2937099923 --- /dev/null +++ b/testsuite/tests/profiling/should_compile/T20938.hs @@ -0,0 +1,10 @@ +{-# language MagicHash #-} + +-- We can't put code ticks between things which are required to be saturated +-- and their arguments. +module T20938 where + +import GHC.Exts + +foo x = ({-# SCC foo #-} tagToEnum#) x :: Bool + diff --git a/testsuite/tests/profiling/should_compile/all.T b/testsuite/tests/profiling/should_compile/all.T index a6a6d50c7c..a19a2fc49a 100644 --- a/testsuite/tests/profiling/should_compile/all.T +++ b/testsuite/tests/profiling/should_compile/all.T @@ -10,3 +10,4 @@ test('T14931', [only_ways(['normal']), req_profiling, unless(have_dynamic(), ski makefile_test, ['T14931']) test('T15108', [only_ways(['normal']), req_profiling], compile, ['-O -prof -fprof-auto']) test('T19894', [only_ways(['normal']), req_profiling, extra_files(['T19894'])], multimod_compile, ['Main', '-v0 -O2 -prof -fprof-auto -iT19894']) +test('T20938', [only_ways(['normal']), req_profiling, expect_broken(20938)], compile, ['-O -prof']) diff --git a/testsuite/tests/profiling/should_fail/all.T b/testsuite/tests/profiling/should_fail/all.T index 00a7a16025..fee8454050 100644 --- a/testsuite/tests/profiling/should_fail/all.T +++ b/testsuite/tests/profiling/should_fail/all.T @@ -1,4 +1,3 @@ test('proffail001', normal, compile_fail, ['-prof -fprof-cafs']) test('T17916', normal, compile_fail, ['']) - |