[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 6 commits: users guide: Add glossary
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed May 17 21:11:59 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
0451bdc9 by Ben Gamari at 2023-05-16T21:31:40-04:00
users guide: Add glossary
Currently this merely explains the meaning of "technology preview" in
the context of released features.
- - - - -
0ba52e4e by Ben Gamari at 2023-05-16T21:31:40-04:00
Update glossary.rst
- - - - -
3d23060c by Ben Gamari at 2023-05-16T21:31:40-04:00
Use glossary directive
- - - - -
2972fd66 by Sylvain Henry at 2023-05-16T21:32:20-04:00
JS: fix getpid (fix #23399)
- - - - -
eeea0ce0 by Matthew Pickering at 2023-05-17T17:11:41-04:00
Use setSrcSpan rather than setLclEnv in solveForAll
In subsequent MRs (#23409) we want to remove the TcLclEnv argument from
a CtLoc. This MR prepares us for that by removing the one place where
the entire TcLclEnv is used, by using it more precisely to just set the
contexts source location.
Fixes #23390
- - - - -
14b690ed by Torsten Schmits at 2023-05-17T17:11:53-04:00
Update the users guide paragraph on -O in GHCi
In relation to #23056
- - - - -
9 changed files:
- compiler/GHC/Tc/Solver/Canonical.hs
- compiler/GHC/Tc/Solver/Monad.hs
- docs/users_guide/ghci.rst
- + docs/users_guide/glossary.rst
- docs/users_guide/index.rst
- libraries/base/System/Posix/Internals.hs
- + libraries/base/tests/System/T23399.hs
- + libraries/base/tests/System/T23399.stdout
- libraries/base/tests/System/all.T
Changes:
=====================================
compiler/GHC/Tc/Solver/Canonical.hs
=====================================
@@ -53,6 +53,7 @@ import GHC.Data.Bag
import Data.Maybe ( isJust )
import qualified Data.Semigroup as S
+import GHC.Tc.Utils.Monad (getLclEnvLoc)
{-
************************************************************************
@@ -876,8 +877,8 @@ solveForAll :: CtEvidence -> [TyVar] -> TcThetaType -> PredType -> ExpansionFuel
solveForAll ev@(CtWanted { ctev_dest = dest, ctev_rewriters = rewriters, ctev_loc = loc })
tvs theta pred _fuel
= -- See Note [Solving a Wanted forall-constraint]
- setLclEnv (ctLocEnv loc) $
- -- This setLclEnv is important: the emitImplicationTcS uses that
+ setSrcSpan (getLclEnvLoc $ ctLocEnv loc) $
+ -- This setSrcSpan is important: the emitImplicationTcS uses that
-- TcLclEnv for the implication, and that in turn sets the location
-- for the Givens when solving the constraint (#21006)
do { let empty_subst = mkEmptySubst $ mkInScopeSet $
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -57,7 +57,7 @@ module GHC.Tc.Solver.Monad (
getSolvedDicts, setSolvedDicts,
getInstEnvs, getFamInstEnvs, -- Getting the environments
- getTopEnv, getGblEnv, getLclEnv, setLclEnv,
+ getTopEnv, getGblEnv, getLclEnv, setSrcSpan,
getTcEvBindsVar, getTcLevel,
getTcEvTyCoVars, getTcEvBindsMap, setTcEvBindsMap,
tcLookupClass, tcLookupId, tcLookupTyCon,
@@ -194,6 +194,7 @@ import Data.IORef
import Data.List ( mapAccumL )
import Data.Foldable
import qualified Data.Semigroup as S
+import GHC.Types.SrcLoc
#if defined(DEBUG)
import GHC.Types.Unique.Set (nonDetEltsUniqSet)
@@ -1398,8 +1399,8 @@ getGblEnv = wrapTcS $ TcM.getGblEnv
getLclEnv :: TcS TcLclEnv
getLclEnv = wrapTcS $ TcM.getLclEnv
-setLclEnv :: TcLclEnv -> TcS a -> TcS a
-setLclEnv env = wrap2TcS (TcM.setLclEnv env)
+setSrcSpan :: RealSrcSpan -> TcS a -> TcS a
+setSrcSpan ss = wrap2TcS (TcM.setSrcSpan (RealSrcSpan ss mempty))
tcLookupClass :: Name -> TcS Class
tcLookupClass c = wrapTcS $ TcM.tcLookupClass c
=====================================
docs/users_guide/ghci.rst
=====================================
@@ -3546,41 +3546,19 @@ The interpreter can't load modules with foreign export declarations!
Unfortunately not. We haven't implemented it yet. Please compile any
offending modules by hand before loading them into GHCi.
-:ghc-flag:`-O` doesn't work with GHCi!
+:ghc-flag:`-O` is ineffective in GHCi!
.. index::
single: optimization; and GHCi
- For technical reasons, the bytecode compiler doesn't interact well
- with one of the optimisation passes, so we have disabled
- optimisation when using the interpreter. This isn't a great loss:
- you'll get a much bigger win by compiling the bits of your code that
- need to go fast, rather than interpreting them with optimisation
- turned on.
+ Before GHC 9.8, optimizations were considered too unstable to be used with
+ the bytecode interpreter.
+ This restriction has been lifted, but is still regarded as experimental and
+ guarded by :ghc-flag:`-funoptimized-core-for-interpreter`, which is enabled
+ by default.
+ In order to use optimizations, run: ::
-Modules using unboxed tuples or sums will automatically enable :ghc-flag:`-fobject-code`
-
- .. index::
- single: unboxed tuples, sums; and GHCi
-
- The bytecode interpreter doesn't support most uses of unboxed tuples or
- sums, so GHCi will automatically compile these modules, and all modules
- they depend on, to object code instead of bytecode.
-
- GHCi checks for the presence of unboxed tuples and sums in a somewhat
- conservative fashion: it simply checks to see if a module enables the
- :extension:`UnboxedTuples` or :extension:`UnboxedSums` language extensions.
- It is not always the case that code which enables :extension:`UnboxedTuples`
- or :extension:`UnboxedSums` requires :ghc-flag:`-fobject-code`, so if you
- *really* want to compile
- :extension:`UnboxedTuples`/:extension:`UnboxedSums`-using code to
- bytecode, you can do so explicitly by enabling the :ghc-flag:`-fbyte-code`
- flag. If you do this, do note that bytecode interpreter will throw an error
- if it encounters unboxed tuple/sum–related code that it cannot handle.
-
- Incidentally, the previous point, that :ghc-flag:`-O` is
- incompatible with GHCi, is because the bytecode compiler can't
- deal with unboxed tuples or sums.
+ ghci -fno-unoptimized-core-for-interpreter -O
Concurrent threads don't carry on running when GHCi is waiting for input.
This should work, as long as your GHCi was built with the
=====================================
docs/users_guide/glossary.rst
=====================================
@@ -0,0 +1,13 @@
+Glossary
+========
+
+.. glossary::
+ technology preview
+
+ GHC will occassionally ship features advertised as being in a *technology
+ preview* state. Such features are generally opt-in in nature (e.g. new
+ language extensions) and may have various shortcomings. These may include
+ known bugs (which we will try to document), lacking optimisation, and
+ unhandled interactions with other language features. As such, behavior
+ of such features may change in the future. However, we do expect features
+ to converge to non-preview state over the course of a few GHC major releases.
=====================================
docs/users_guide/index.rst
=====================================
@@ -27,6 +27,7 @@ Contents:
wasm
bugs
eventlog-formats
+ glossary
editing-guide
=====================================
libraries/base/System/Posix/Internals.hs
=====================================
@@ -499,7 +499,7 @@ foreign import javascript interruptible "(($1,$2_1,$2_2,$c) => { return h$base_f
c_ftruncate :: CInt -> FileOffset -> IO CInt
foreign import javascript interruptible "(($1_1,$1_2,$c) => { return h$base_unlink($1_1,$1_2,$c); })"
c_unlink :: CString -> IO CInt
-foreign import javascript unsafe "(() => { return h$base_getpid; })"
+foreign import javascript unsafe "h$base_getpid"
c_getpid :: IO CPid
-- foreign import ccall unsafe "HsBase.h fork"
-- c_fork :: IO CPid
=====================================
libraries/base/tests/System/T23399.hs
=====================================
@@ -0,0 +1,9 @@
+module Main where
+
+import System.Posix.Internals
+
+main = do
+ r <- c_getpid
+ -- #23399: JS backend wasn't returning a valid JS number as a CPid hence
+ -- "read" would fail because the string was "0\0" (not a number, NUL byte)
+ print ((read (show r) :: Int) /= -1)
=====================================
libraries/base/tests/System/T23399.stdout
=====================================
@@ -0,0 +1 @@
+True
=====================================
libraries/base/tests/System/all.T
=====================================
@@ -8,3 +8,4 @@ test('system001', [js_broken(22349), when(opsys("mingw32"), skip), req_process],
compile_and_run, [''])
test('Timeout001', js_broken(22261), compile_and_run, [''])
test('T16466', normal, compile_and_run, [''])
+test('T23399', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25e5400381d7656a862578172bd7f1497af41d88...14b690edc8c8883e04a7632a6e73b8aace099497
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/25e5400381d7656a862578172bd7f1497af41d88...14b690edc8c8883e04a7632a6e73b8aace099497
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/20230517/e610b456/attachment-0001.html>
More information about the ghc-commits
mailing list