[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: ghc-internal: @since for backtraceDesired
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Aug 6 10:47:21 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
48f8fdd5 by Rodrigo Mesquita at 2024-08-06T06:45:28-04:00
ghc-internal: @since for backtraceDesired
Fixes point 1 in #25052
- - - - -
47273161 by Rodrigo Mesquita at 2024-08-06T06:45:28-04:00
ghc-internal: No trailing whitespace in exceptions
Fixes #25052
- - - - -
7eeb04f0 by Andreas Klebinger at 2024-08-06T06:45:29-04:00
Add since annotation for -fkeep-auto-rules.
This partially addresses #25082.
- - - - -
04367c98 by Andreas Klebinger at 2024-08-06T06:45:29-04:00
Mention `-fkeep-auto-rules` in release notes.
It was added earlier but hadn't appeared in any release notes yet.
Partially addresses #25082.
- - - - -
2bdc5ef4 by Vladislav Zavialov at 2024-08-06T06:45:29-04:00
docs: Update info on RequiredTypeArguments
Add a section on "types in terms" that were implemented in 8b2f70a202
and remove the now outdated suggestion of using `type` for them.
- - - - -
8 changed files:
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/exts/required_type_arguments.rst
- docs/users_guide/using-optimisation.rst
- libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
- testsuite/tests/driver/T13914/T13914.stdout
- + testsuite/tests/exceptions/T25052.hs
- + testsuite/tests/exceptions/T25052.stdout
- + testsuite/tests/exceptions/all.T
Changes:
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -109,6 +109,10 @@ Compiler
This enables people to write their own custom assertion functions.
See :ref:`assertions`.
+- The flag :ghc-flag:`-fkeep-auto-rules` that forces GHC to keep auto generated
+ specialization rules was added. It was actually added ghc-9.10.1 already but
+ mistakenly not mentioned in the 9.10.1 changelog.
+
- Fixed a bug that caused GHC to panic when using the aarch64 ncg and -fregs-graph
on certain programs. (#24941)
=====================================
docs/users_guide/exts/required_type_arguments.rst
=====================================
@@ -262,15 +262,36 @@ Outside a required type argument, it is illegal to use ``type``:
r4 = type Int -- illegal use of ‘type’
-Finally, there are types that require the ``type`` keyword only due to
-limitations of the current implementation::
+Types in terms
+~~~~~~~~~~~~~~
- a1 = f (type (Int -> Bool)) -- function type
- a2 = f (type (Read T => T)) -- constrained type
- a3 = f (type (forall a. a)) -- universally quantified type
- a4 = f (type (forall a. Read a => String -> a)) -- a combination of the above
+**Since:** GHC 9.12
-This restriction will be relaxed in a future release of GHC.
+:extension:`RequiredTypeArguments` extends the grammar of term-level
+expressions with syntax that is typically found only in types:
+
+* function types: ``a -> b``, ``a ⊸ b``, ``a %m -> b``
+* constrained types: ``ctx => t``
+* universally quantified types: ``forall tvs. t``, ``forall tvs -> t``
+
+These so-called "types in terms" make it possible to pass any types as required
+type arguments::
+
+ a1 = f (Int -> Bool) -- function type
+ a2 = f (Int %1 -> String) -- linear function type
+ a3 = f (Read T => T) -- constrained type
+ a4 = f (forall a. a) -- universally quantified type
+ a5 = f (forall a. Read a => String -> a) -- a combination of the above
+
+A few limitations apply:
+
+* The ``*`` syntax of :extension:`StarIsType` is not available due to a
+ conflict with the multiplication operator.
+ What to do instead: use ``Type`` from the ``Data.Kind`` module.
+
+* The ``'`` syntax of :extension:`DataKinds` is not available due to a conflict
+ with :extension:`TemplateHaskell` name quotation.
+ What to do instead: simply omit the ``'``.
Effect on implicit quantification
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -664,10 +664,11 @@ as such you shouldn't need to set any of them explicitly. A flag
:category:
:default: off
+ :since: 9.10.1
The type-class specialiser and call-pattern specialisation both
generate so-called "auto" RULES. These rules are usually exposed
- to importing modules in the interface file. But an auto rule is the
+ to importing modules in the interface file. But when an auto rule is the
sole reason for keeping a function alive, both the rule and the function
are discarded, by default. That reduces code bloat, but risks the same
function being specialised again in an importing module.
=====================================
libraries/ghc-internal/src/GHC/Internal/Exception/Type.hs
=====================================
@@ -45,6 +45,7 @@ module GHC.Internal.Exception.Type
, underflowException
) where
+import GHC.Internal.Data.OldList (intersperse)
import GHC.Internal.Data.Maybe
import GHC.Internal.Data.Typeable (Typeable, TypeRep, cast)
import qualified GHC.Internal.Data.Typeable as Typeable
@@ -196,6 +197,7 @@ class (Typeable e, Show e) => Exception e where
displayException :: e -> String
displayException = show
+ -- | @since base-4.20.0.0
backtraceDesired :: e -> Bool
backtraceDesired _ = True
@@ -212,11 +214,14 @@ instance Exception SomeException where
fromException = Just
backtraceDesired (SomeException e) = backtraceDesired e
displayException (SomeException e) =
- displayException e
- ++ displayTypeInfo (Typeable.typeOf e)
- ++ "\n\n"
- ++ (displayContext ?exceptionContext)
+ case displayContext ?exceptionContext of
+ "" -> msg
+ dc -> msg ++ "\n\n" ++ dc
where
+ msg =
+ displayException e
+ ++ displayTypeInfo (Typeable.typeOf e)
+
displayTypeInfo :: TypeRep -> String
displayTypeInfo rep =
mconcat
@@ -231,10 +236,9 @@ instance Exception SomeException where
tyCon = Typeable.typeRepTyCon rep
displayContext :: ExceptionContext -> String
-displayContext (ExceptionContext anns0) = go anns0
+displayContext (ExceptionContext anns0) = mconcat $ intersperse "\n" $ map go anns0
where
- go (SomeExceptionAnnotation ann : anns) = displayExceptionAnnotation ann ++ "\n" ++ go anns
- go [] = ""
+ go (SomeExceptionAnnotation ann) = displayExceptionAnnotation ann
newtype NoBacktrace e = NoBacktrace e
deriving (Show)
=====================================
testsuite/tests/driver/T13914/T13914.stdout
=====================================
@@ -17,7 +17,6 @@ HasCallStack backtrace:
throwIO, called at libraries/ghc-internal/src/GHC/Internal/IO/Exception.hs:453:5 in ghc-internal:GHC.Internal.IO.Exception
assert, called at main.hs:3:8 in main:Main
-
With -fignore-asserts
[1 of 2] Compiling Main ( main.hs, main.o ) [Optimisation flags changed]
[2 of 2] Linking main [Objects changed]
=====================================
testsuite/tests/exceptions/T25052.hs
=====================================
@@ -0,0 +1,8 @@
+import Control.Exception
+
+main :: IO ()
+main = do
+ let msg = "no trailing whitespace"
+ fail msg `catch` \(e :: SomeException) -> do
+ putStrLn (displayException e)
+
=====================================
testsuite/tests/exceptions/T25052.stdout
=====================================
@@ -0,0 +1,5 @@
+user error (no trailing whitespace)
+
+Package: ghc-internal
+Module: GHC.Internal.IO.Exception
+Type: IOException
=====================================
testsuite/tests/exceptions/all.T
=====================================
@@ -0,0 +1,2 @@
+test('T25052', normal, compile_and_run, [''])
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ad1b70d1c4dad7a3e0c5e623fed728ee54b7546...2bdc5ef4bb4bfcf618bd8b902b5e71785bc075cb
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3ad1b70d1c4dad7a3e0c5e623fed728ee54b7546...2bdc5ef4bb4bfcf618bd8b902b5e71785bc075cb
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/20240806/62756325/attachment-0001.html>
More information about the ghc-commits
mailing list