[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Minor doc fixes
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Sun Apr 23 15:19:31 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
038bb031 by Krzysztof Gogolewski at 2023-04-21T18:03:04-04:00
Minor doc fixes
- Add docs/index.html to .gitignore.
It is created by ./hadrian/build docs, and it was the only file
in Hadrian's templateRules not present in .gitignore.
- Mention that MultiWayIf supports non-boolean guards
- Remove documentation of optdll - removed in 2007, 763daed95
- Fix markdown syntax
- - - - -
e826cdb2 by amesgen at 2023-04-21T18:03:44-04:00
User's guide: DeepSubsumption is implied by Haskell{98,2010}
- - - - -
a058e004 by PHO at 2023-04-23T11:19:22-04:00
Implement executablePath for Solaris and make getBaseDir less platform-dependent
Use base-4.17 executablePath when possible, and fall back on
getExecutablePath when it's not available. The sole reason why getBaseDir
had #ifdef's was apparently that getExecutablePath wasn't reliable, and we
could reduce the number of CPP conditionals by making use of
executablePath instead.
Also export executablePath on js_HOST_ARCH.
- - - - -
9e083c0b by tocic at 2023-04-23T11:19:22-04:00
Fix doc typos in libraries/base
- - - - -
16 changed files:
- .gitignore
- docs/users_guide/exts/control.rst
- docs/users_guide/exts/multiway_if.rst
- docs/users_guide/javascript.rst
- docs/users_guide/phases.rst
- docs/users_guide/using-warnings.rst
- libraries/base/Control/Concurrent/MVar.hs
- libraries/base/Control/Exception/Base.hs
- libraries/base/Control/Monad.hs
- libraries/base/Data/Complex.hs
- libraries/base/Data/List.hs
- libraries/base/Data/OldList.hs
- libraries/base/System/Environment.hs
- libraries/base/System/Environment/ExecutablePath.hsc
- libraries/base/Text/Read/Lex.hs
- libraries/ghc-boot/GHC/BaseDir.hs
Changes:
=====================================
.gitignore
=====================================
@@ -115,6 +115,7 @@ _darcs/
/compiler/ghc.cabal.old
/distrib/configure.ac
/distrib/ghc.iss
+/docs/index.html
/docs/man
/docs/users_guide/.log
/docs/users_guide/users_guide
=====================================
docs/users_guide/exts/control.rst
=====================================
@@ -98,6 +98,7 @@ Language extensions can be controlled (i.e. allowed or not) in two ways:
* :extension:`CUSKs`
* :extension:`DatatypeContexts`
+ * :extension:`DeepSubsumption`
* :extension:`DoAndIfThenElse`
* :extension:`EmptyDataDecls`
* :extension:`FieldSelectors`
@@ -120,6 +121,7 @@ Language extensions can be controlled (i.e. allowed or not) in two ways:
* :extension:`CUSKs`
* :extension:`DatatypeContexts`
+ * :extension:`DeepSubsumption`
* :extension:`FieldSelectors`
* :extension:`ImplicitPrelude`
* :extension:`MonomorphismRestriction`
=====================================
docs/users_guide/exts/multiway_if.rst
=====================================
@@ -51,3 +51,11 @@ except that the semi-colons between guards in a multi-way if are
optional. So it is not necessary to line up all the guards at the same
column; this is consistent with the way guards work in function
definitions and case expressions.
+
+Note that multi-way if supports guards other than boolean conditions: ::
+
+ if | parseNumbers settings
+ , Just (exponent, mantissa) <- decomposeNumber str
+ , let (integralPart, fractionPart) = parse mantissa
+ , integralPart >= 0 = ...
+ | otherwise = ...
=====================================
docs/users_guide/javascript.rst
=====================================
@@ -1,4 +1,4 @@
-.. _ffi-javascript
+.. _ffi-javascript:
FFI and the JavaScript Backend
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
@@ -23,7 +23,7 @@ look like:
js_add :: Int -> Int -> Int
JSVal
-^^^^^
+~~~~~
The JavaScript backend has a concept of an untyped 'plain' JavaScript
value, under the guise of the type ``JSVal``. Values having this type
@@ -47,7 +47,7 @@ It also contains functions for working with objects:
* ``getProp :: JSVal -> String -> JSVal`` - object field access
JavaScript FFI Types
-^^^^^^^^^^^^^^^^^^^^
+~~~~~~~~~~~~~~~~~~~~
Some types are able to be used directly in the type signatures of foreign
exports, without conversion to a ``JSVal``. We saw in the first example
@@ -75,7 +75,7 @@ for the Haskell `Bool` type:
type_error :: Bool -> Bool
JavaScript Callbacks
-^^^^^^^^^^^^^^^^^^^^
+~~~~~~~~~~~~~~~~~~~~
The JavaScript execution model is based around callback functions, and
GHC's JavaScript backend implements these as a type in order to support
@@ -146,7 +146,7 @@ passed as an ``Int`` to a ``Callback`` that accepts a ``JSVal``:
releaseCallback add3
Callbacks as Foreign Exports
-^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
JavaScript callbacks allow for a sort of FFI exports via FFI imports. To do
this, a global JavaScript variable is set, and that global variable can then
=====================================
docs/users_guide/phases.rst
=====================================
@@ -247,13 +247,6 @@ the following flags:
Pass ⟨option⟩ to the linker when merging object files. In the case of a
standard ``ld``-style linker this should generally include the ``-r`` flag.
-.. ghc-flag:: -optdll ⟨option⟩
- :shortdesc: pass ⟨option⟩ to the DLL generator
- :type: dynamic
- :category: phase-options
-
- Pass ⟨option⟩ to the DLL generator.
-
.. ghc-flag:: -optwindres ⟨option⟩
:shortdesc: pass ⟨option⟩ to ``windres``.
:type: dynamic
=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -2358,7 +2358,7 @@ of ``-W(no-)*``.
:since: 9.6.1
- As explained in :ref:`undecidable_instances`, when using
+ As explained in :ref:`undecidable-instances`, when using
:extension:`UndecidableInstances` it is possible for GHC to construct
non-terminating evidence for certain superclass constraints.
=====================================
libraries/base/Control/Concurrent/MVar.hs
=====================================
@@ -37,7 +37,7 @@
-- than 'GHC.Conc.STM'. They are appropriate for building synchronization
-- primitives and performing simple interthread communication; however
-- they are very simple and susceptible to race conditions, deadlocks or
--- uncaught exceptions. Do not use them if you need perform larger
+-- uncaught exceptions. Do not use them if you need to perform larger
-- atomic operations such as reading from multiple variables: use 'GHC.Conc.STM'
-- instead.
--
=====================================
libraries/base/Control/Exception/Base.hs
=====================================
@@ -223,7 +223,7 @@ onException io what = io `catch` \e -> do _ <- what
-- handle. Similarly, closing a socket (from \"network\" package) is also
-- uninterruptible under similar conditions. An example of an interruptible
-- action is 'killThread'. Completion of interruptible release actions can be
--- ensured by wrapping them in in 'uninterruptibleMask_', but this risks making
+-- ensured by wrapping them in 'uninterruptibleMask_', but this risks making
-- the program non-responsive to @Control-C@, or timeouts. Another option is to
-- run the release action asynchronously in its own thread:
--
=====================================
libraries/base/Control/Monad.hs
=====================================
@@ -101,11 +101,11 @@ import GHC.Num ( (-) )
--
-- ==== __Examples__
--
--- Common uses of 'guard' include conditionally signaling an error in
+-- Common uses of 'guard' include conditionally signalling an error in
-- an error monad and conditionally rejecting the current choice in an
-- 'Alternative'-based parser.
--
--- As an example of signaling an error in the error monad 'Maybe',
+-- As an example of signalling an error in the error monad 'Maybe',
-- consider a safe division function @safeDiv x y@ that returns
-- 'Nothing' when the denominator @y@ is zero and @'Just' (x \`div\`
-- y)@ otherwise. For example:
=====================================
libraries/base/Data/Complex.hs
=====================================
@@ -104,13 +104,13 @@ cis theta = cos theta :+ sin theta
-- | The function 'polar' takes a complex number and
-- returns a (magnitude, phase) pair in canonical form:
--- the magnitude is nonnegative, and the phase in the range @(-'pi', 'pi']@;
+-- the magnitude is non-negative, and the phase in the range @(-'pi', 'pi']@;
-- if the magnitude is zero, then so is the phase.
{-# SPECIALISE polar :: Complex Double -> (Double,Double) #-}
polar :: (RealFloat a) => Complex a -> (a,a)
polar z = (magnitude z, phase z)
--- | The nonnegative magnitude of a complex number.
+-- | The non-negative magnitude of a complex number.
{-# SPECIALISE magnitude :: Complex Double -> Double #-}
magnitude :: (RealFloat a) => Complex a -> a
magnitude (x:+y) = scaleFloat k
=====================================
libraries/base/Data/List.hs
=====================================
@@ -124,7 +124,7 @@ module Data.List
, partition
-- * Indexing lists
- -- | These functions treat a list @xs@ as a indexed collection,
+ -- | These functions treat a list @xs@ as an indexed collection,
-- with indices ranging from 0 to @'length' xs - 1 at .
, (!?)
=====================================
libraries/base/Data/OldList.hs
=====================================
@@ -124,7 +124,7 @@ module Data.OldList
, partition
-- * Indexing lists
- -- | These functions treat a list @xs@ as a indexed collection,
+ -- | These functions treat a list @xs@ as an indexed collection,
-- with indices ranging from 0 to @'length' xs - 1 at .
, (!?)
=====================================
libraries/base/System/Environment.hs
=====================================
@@ -19,9 +19,7 @@ module System.Environment
(
getArgs,
getProgName,
-#if !defined(javascript_HOST_ARCH)
executablePath,
-#endif
getExecutablePath,
getEnv,
lookupEnv,
=====================================
libraries/base/System/Environment/ExecutablePath.hsc
=====================================
@@ -18,9 +18,7 @@
module System.Environment.ExecutablePath
( getExecutablePath
-##if !defined(javascript_HOST_ARCH)
, executablePath
-##endif
) where
##if defined(javascript_HOST_ARCH)
@@ -28,6 +26,9 @@ module System.Environment.ExecutablePath
getExecutablePath :: IO FilePath
getExecutablePath = return "a.jsexe"
+executablePath :: Maybe (IO (Maybe FilePath))
+executablePath = Nothing
+
##else
-- The imports are purposely kept completely disjoint to prevent edits
@@ -47,6 +48,12 @@ import Data.List (isSuffixOf)
import Foreign.C
import Foreign.Marshal.Array
import System.Posix.Internals
+#elif defined(solaris2_HOST_OS)
+import Control.Exception (catch, throw)
+import Foreign.C
+import Foreign.Marshal.Array
+import System.IO.Error (isDoesNotExistError)
+import System.Posix.Internals
#elif defined(freebsd_HOST_OS) || defined(netbsd_HOST_OS)
import Control.Exception (catch, throw)
import Foreign.C
@@ -101,7 +108,7 @@ getExecutablePath :: IO FilePath
--
-- If the operating system provides a reliable way to determine the current
-- executable, return the query action, otherwise return @Nothing at . The action
--- is defined on FreeBSD, Linux, MacOS, NetBSD, and Windows.
+-- is defined on FreeBSD, Linux, MacOS, NetBSD, Solaris, and Windows.
--
-- Even where the query action is defined, there may be situations where no
-- result is available, e.g. if the executable file was deleted while the
@@ -171,9 +178,9 @@ executablePath = Just (fmap Just getExecutablePath `catch` f)
| otherwise = throw e
--------------------------------------------------------------------------------
--- Linux
+-- Linux / Solaris
-#elif defined(linux_HOST_OS)
+#elif defined(linux_HOST_OS) || defined(solaris2_HOST_OS)
foreign import ccall unsafe "readlink"
c_readlink :: CString -> CString -> CSize -> IO CInt
@@ -190,6 +197,7 @@ readSymbolicLink file =
c_readlink s buf 4096
peekFilePathLen (buf,fromIntegral len)
+# if defined(linux_HOST_OS)
getExecutablePath = readSymbolicLink $ "/proc/self/exe"
executablePath = Just (check <$> getExecutablePath) where
@@ -200,6 +208,18 @@ executablePath = Just (check <$> getExecutablePath) where
check s | "(deleted)" `isSuffixOf` s = Nothing
| otherwise = Just s
+# elif defined(solaris2_HOST_OS)
+getExecutablePath = readSymbolicLink "/proc/self/path/a.out"
+
+executablePath = Just ((Just <$> getExecutablePath) `catch` f)
+ where
+ -- readlink(2) fails with ENOENT when the executable has been deleted,
+ -- even though the symlink itself still exists according to readdir(3).
+ f e | isDoesNotExistError e = pure Nothing
+ | otherwise = throw e
+
+#endif
+
--------------------------------------------------------------------------------
-- FreeBSD / NetBSD
=====================================
libraries/base/Text/Read/Lex.hs
=====================================
@@ -112,7 +112,7 @@ numberToFixed _ _ = Nothing
-- space problems in #5688
-- Ways this is conservative:
-- * the floatRange is in base 2, but we pretend it is in base 10
--- * we pad the floateRange a bit, just in case it is very small
+-- * we pad the floatRange a bit, just in case it is very small
-- and we would otherwise hit an edge case
-- * We only worry about numbers that have an exponent. If they don't
-- have an exponent then the Rational won't be much larger than the
=====================================
libraries/ghc-boot/GHC/BaseDir.hs
=====================================
@@ -12,7 +12,11 @@
-- installation location at build time. ghc-pkg also can expand those variables
-- and so needs the top dir location to do that too.
-module GHC.BaseDir where
+module GHC.BaseDir
+ ( expandTopDir
+ , expandPathVar
+ , getBaseDir
+ ) where
import Prelude -- See Note [Why do we import Prelude here?]
@@ -20,11 +24,9 @@ import Data.List (stripPrefix)
import Data.Maybe (listToMaybe)
import System.FilePath
--- Windows
-#if defined(mingw32_HOST_OS)
-import System.Environment (getExecutablePath)
--- POSIX
-#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS)
+#if MIN_VERSION_base(4,17,0)
+import System.Environment (executablePath)
+#else
import System.Environment (getExecutablePath)
#endif
@@ -43,17 +45,27 @@ expandPathVar var value str
expandPathVar var value (x:xs) = x : expandPathVar var value xs
expandPathVar _ _ [] = []
+#if !MIN_VERSION_base(4,17,0)
+-- Polyfill for base-4.17 executablePath
+executablePath :: Maybe (IO (Maybe FilePath))
+executablePath = Just (Just <$> getExecutablePath)
+#elif !MIN_VERSION_base(4,18,0) && defined(js_HOST_ARCH)
+-- executablePath is missing from base < 4.18.0 on js_HOST_ARCH
+executablePath :: Maybe (IO (Maybe FilePath))
+executablePath = Nothing
+#endif
+
-- | Calculate the location of the base dir
getBaseDir :: IO (Maybe String)
#if defined(mingw32_HOST_OS)
-getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath
+getBaseDir = maybe (pure Nothing) ((((</> "lib") . rootDir) <$>) <$>) executablePath
where
-- locate the "base dir" when given the path
-- to the real ghc executable (as opposed to symlink)
-- that is running this function.
rootDir :: FilePath -> FilePath
rootDir = takeDirectory . takeDirectory . normalise
-#elif defined(darwin_HOST_OS) || defined(linux_HOST_OS) || defined(freebsd_HOST_OS) || defined(openbsd_HOST_OS) || defined(netbsd_HOST_OS)
+#else
-- on unix, this is a bit more confusing.
-- The layout right now is something like
--
@@ -65,14 +77,15 @@ getBaseDir = Just . (\p -> p </> "lib") . rootDir <$> getExecutablePath
-- As such, we first need to find the absolute location to the
-- binary.
--
--- getExecutablePath will return (3). One takeDirectory will
+-- executablePath will return (3). One takeDirectory will
-- give use /lib/ghc-X.Y.Z/bin, and another will give us (4).
--
-- This of course only works due to the current layout. If
-- the layout is changed, such that we have ghc-X.Y.Z/{bin,lib}
-- this would need to be changed accordingly.
--
-getBaseDir = Just . (\p -> p </> "lib") . takeDirectory . takeDirectory <$> getExecutablePath
-#else
-getBaseDir = return Nothing
+getBaseDir = maybe (pure Nothing) ((((</> "lib") . rootDir) <$>) <$>) executablePath
+ where
+ rootDir :: FilePath -> FilePath
+ rootDir = takeDirectory . takeDirectory
#endif
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2de6d8747f7804b2bb5e421d858d8bd432f55cbe...9e083c0b704dc3c5574fcb5fce534fbdd43f3729
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2de6d8747f7804b2bb5e421d858d8bd432f55cbe...9e083c0b704dc3c5574fcb5fce534fbdd43f3729
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230423/35bd566d/attachment-0001.html>
More information about the ghc-commits
mailing list