[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 9 commits: Make UnsafeSNat et al. into pattern synonyms
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri May 31 04:08:43 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
d10a1c65 by Matthew Craven at 2024-05-30T23:35:48-04:00
Make UnsafeSNat et al. into pattern synonyms
...so that they do not cause coerce to bypass the nominal
role on the corresponding singleton types when they are imported.
See Note [Preventing unsafe coercions for singleton types] and
the discussion at #23478.
This also introduces unsafeWithSNatCo (and analogues for Char
and Symbol) so that users can still access the dangerous coercions
that importing the real constructors would allow, but only in a
very localized way.
- - - - -
0958937e by Cheng Shao at 2024-05-30T23:36:25-04:00
hadrian: build C/C++ with split sections when enabled
When split sections is enabled, ensure -fsplit-sections is passed to
GHC as well when invoking GHC to compile C/C++; and pass
-ffunction-sections -fdata-sections to gcc/clang when compiling C/C++
with the hadrian Cc builder. Fixes #23381.
- - - - -
02b1f91e by Cheng Shao at 2024-05-30T23:36:25-04:00
driver: build C/C++ with -ffunction-sections -fdata-sections when split sections is enabled
When -fsplit-sections is passed to GHC, pass -ffunction-sections
-fdata-sections to gcc/clang when building C/C++. Previously,
-fsplit-sections was only respected by the NCG/LLVM backends, but not
the unregisterised backend; the GHC driver did not pass
-fdata-sections and -ffunction-sections to the C compiler, which
resulted in excessive executable sizes.
Fixes #23381.
-------------------------
Metric Decrease:
size_hello_artifact
size_hello_unicode
-------------------------
- - - - -
fd47e2e3 by Cheng Shao at 2024-05-30T23:37:00-04:00
testsuite: mark process005 as fragile on JS
- - - - -
485c3d2a by Matthew Pickering at 2024-05-31T00:08:20-04:00
Add -Wderiving-typeable to -Wall
Deriving `Typeable` does nothing, and it hasn't done for a long while.
There has also been a warning for a long while which warns you about
uselessly deriving it but it wasn't enabled in -Wall.
Fixes #24784
- - - - -
4ec10207 by Matthew Pickering at 2024-05-31T00:08:20-04:00
docs: Fix formatting of changelog entries
- - - - -
f915f6a8 by Preetham Gujjula at 2024-05-31T00:08:26-04:00
docs: Fix link to injective type families paper
Closes #24863
- - - - -
2fed2d88 by Ben Gamari at 2024-05-31T00:08:27-04:00
ghc-internal: Fix package description
The previous description was inherited from `base` and was inappropriate
for `ghc-internal`. Also fix the maintainer and bug reporting fields.
Closes #24906.
- - - - -
8f3697ea by Cheng Shao at 2024-05-31T00:08:27-04:00
compiler: remove ArchWasm32 special case in cmmDoCmmSwitchPlans
This patch removes special consideration for ArchWasm32 in
cmmDoCmmSwitchPlans, which means the compiler will now disable
cmmImplementSwitchPlans for wasm unreg backend, just like unreg
backend of other targets. We enabled it in the past to workaround some
compile-time panic in older versions of LLVM, but those panics are no
longer present, hence no need to keep this workaround.
- - - - -
22 changed files:
- compiler/GHC/Driver/Config/Cmm.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Iface/Ext/Ast.hs
- compiler/GHC/Iface/Ext/Types.hs
- compiler/GHC/JS/JStg/Syntax.hs
- compiler/GHC/JS/Syntax.hs
- compiler/GHC/Types/FieldLabel.hs
- docs/users_guide/9.12.1-notes.rst
- docs/users_guide/exts/type_families.rst
- docs/users_guide/using-warnings.rst
- hadrian/src/Settings/Builders/SplitSections.hs
- hadrian/src/Settings/Warnings.hs
- libraries/ghc-internal/ghc-internal.cabal
- libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs
- libraries/ghc-internal/src/GHC/Internal/JS/Prim.hs
- libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
- libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
- testsuite/tests/ghci/scripts/T9181.stdout
- testsuite/tests/process/all.T
- testsuite/tests/warnings/should_compile/DerivingTypeable.stderr
- utils/haddock/haddock-api/src/Haddock/Types.hs
Changes:
=====================================
compiler/GHC/Driver/Config/Cmm.hs
=====================================
@@ -22,7 +22,6 @@ initCmmConfig dflags = CmmConfig
, cmmGenStackUnwindInstr = debugLevel dflags > 0
, cmmExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags
, cmmDoCmmSwitchPlans = not (backendHasNativeSwitch (backend dflags))
- || platformArch platform == ArchWasm32
, cmmSplitProcPoints = not (backendSupportsUnsplitProcPoints (backend dflags))
|| not (platformTablesNextToCode platform)
|| usingInconsistentPicReg
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -1345,7 +1345,8 @@ minusWallOpts
Opt_WarnRedundantRecordWildcards,
Opt_WarnIncompleteUniPatterns,
Opt_WarnIncompletePatternsRecUpd,
- Opt_WarnIncompleteExportWarnings
+ Opt_WarnIncompleteExportWarnings,
+ Opt_WarnDerivingTypeable
]
-- | Things you get with -Weverything, i.e. *all* known warnings flags
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -487,6 +487,13 @@ runCcPhase cc_phase pipe_env hsc_env location input_fn = do
, not $ target32Bit (targetPlatform dflags)
]
+ -- if -fsplit-sections is enabled, we should also
+ -- build with these flags.
+ ++ (if gopt Opt_SplitSections dflags &&
+ platformOS (targetPlatform dflags) /= OSDarwin
+ then ["-ffunction-sections", "-fdata-sections"]
+ else [])
+
-- Stub files generated for foreign exports references the runIO_closure
-- and runNonIO_closure symbols, which are defined in the base package.
-- These symbols are imported into the stub.c file via RtsAPI.h, and the
=====================================
compiler/GHC/Iface/Ext/Ast.hs
=====================================
@@ -470,7 +470,7 @@ data PScoped a = PS (Maybe Span)
Scope -- ^ use site of the pattern
Scope -- ^ pattern to the right of a, not including a
a
- deriving (Typeable, Data) -- Pattern Scope
+ deriving (Data) -- Pattern Scope
{- Note [TyVar Scopes]
~~~~~~~~~~~~~~~~~~~
=====================================
compiler/GHC/Iface/Ext/Types.hs
=====================================
@@ -34,7 +34,7 @@ import qualified Data.Array as A
import qualified Data.Map as M
import qualified Data.Set as S
import Data.ByteString ( ByteString )
-import Data.Data ( Typeable, Data )
+import Data.Data ( Data )
import Data.Semigroup ( Semigroup(..) )
import Data.Word ( Word8 )
import Control.Applicative ( (<|>) )
@@ -668,7 +668,7 @@ data Scope
= NoScope
| LocalScope Span
| ModuleScope
- deriving (Eq, Ord, Typeable, Data)
+ deriving (Eq, Ord, Data)
instance Outputable Scope where
ppr NoScope = text "NoScope"
=====================================
compiler/GHC/JS/JStg/Syntax.hs
=====================================
@@ -105,7 +105,7 @@ data JStgStat
| BreakStat (Maybe JsLabel) -- ^ Break
| ContinueStat (Maybe JsLabel) -- ^ Continue
| FuncStat !Ident [Ident] JStgStat -- ^ an explicit function definition
- deriving (Eq, Typeable, Generic)
+ deriving (Eq, Generic)
-- | A Label used for 'JStgStat', specifically 'BreakStat', 'ContinueStat' and of
-- course 'LabelStat'
@@ -144,7 +144,7 @@ data JStgExpr
| UOpExpr UOp JStgExpr -- ^ Unary Expressions
| IfExpr JStgExpr JStgExpr JStgExpr -- ^ If-expression
| ApplExpr JStgExpr [JStgExpr] -- ^ Application
- deriving (Eq, Typeable, Generic)
+ deriving (Eq, Generic)
instance Outputable JStgExpr where
ppr x = case x of
@@ -265,7 +265,7 @@ data JVal
| JBool Bool -- ^ A Boolean
| JHash (UniqMap FastString JStgExpr) -- ^ A JS HashMap: @{"foo": 0}@
| JFunc [Ident] JStgStat -- ^ A function
- deriving (Eq, Typeable, Generic)
+ deriving (Eq, Generic)
--------------------------------------------------------------------------------
-- Operators
@@ -296,7 +296,7 @@ data Op
| LOrOp -- ^ Logical Or: ||
| InstanceofOp -- ^ @instanceof@
| InOp -- ^ @in@
- deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)
+ deriving (Show, Eq, Ord, Enum, Data, Generic)
instance NFData Op
@@ -315,7 +315,7 @@ data UOp
| PostIncOp -- ^ Postfix Increment: @x++@
| PreDecOp -- ^ Prefix Decrement: @--x@
| PostDecOp -- ^ Postfix Decrement: @x--@
- deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)
+ deriving (Show, Eq, Ord, Enum, Data, Generic)
instance NFData UOp
@@ -324,7 +324,7 @@ data AOp
= AssignOp -- ^ Vanilla Assignment: =
| AddAssignOp -- ^ Addition Assignment: +=
| SubAssignOp -- ^ Subtraction Assignment: -=
- deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)
+ deriving (Show, Eq, Ord, Enum, Data, Generic)
instance NFData AOp
=====================================
compiler/GHC/JS/Syntax.hs
=====================================
@@ -129,7 +129,7 @@ data JStat
| BreakStat (Maybe JLabel) -- ^ Break
| ContinueStat (Maybe JLabel) -- ^ Continue
| FuncStat !Ident [Ident] JStat -- ^ an explicit function definition
- deriving (Eq, Typeable, Generic)
+ deriving (Eq, Generic)
-- | A Label used for 'JStat', specifically 'BreakStat', 'ContinueStat' and of
-- course 'LabelStat'
@@ -168,7 +168,7 @@ data JExpr
| UOpExpr UOp JExpr -- ^ Unary Expressions
| IfExpr JExpr JExpr JExpr -- ^ If-expression
| ApplExpr JExpr [JExpr] -- ^ Application
- deriving (Eq, Typeable, Generic)
+ deriving (Eq, Generic)
-- * Useful pattern synonyms to ease programming with the deeply embedded JS
-- AST. Each pattern wraps @UOp@ and @Op@ into a @JExpr at s to save typing and
@@ -274,7 +274,7 @@ data JVal
| JBool Bool -- ^ A Boolean
| JHash (UniqMap FastString JExpr) -- ^ A JS HashMap: @{"foo": 0}@
| JFunc [Ident] JStat -- ^ A function
- deriving (Eq, Typeable, Generic)
+ deriving (Eq, Generic)
--------------------------------------------------------------------------------
@@ -307,7 +307,7 @@ data Op
| LOrOp -- ^ Logical Or: ||
| InstanceofOp -- ^ @instanceof@
| InOp -- ^ @in@
- deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)
+ deriving (Show, Eq, Ord, Enum, Data, Generic)
instance NFData Op
@@ -326,7 +326,7 @@ data UOp
| PostIncOp -- ^ Postfix Increment: @x++@
| PreDecOp -- ^ Prefix Decrement: @--x@
| PostDecOp -- ^ Postfix Decrement: @x--@
- deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)
+ deriving (Show, Eq, Ord, Enum, Data, Generic)
instance NFData UOp
@@ -335,7 +335,7 @@ data AOp
= AssignOp -- ^ Vanilla Assignment: =
| AddAssignOp -- ^ Addition Assignment: +=
| SubAssignOp -- ^ Subtraction Assignment: -=
- deriving (Show, Eq, Ord, Enum, Data, Typeable, Generic)
+ deriving (Show, Eq, Ord, Enum, Data, Generic)
instance NFData AOp
=====================================
compiler/GHC/Types/FieldLabel.hs
=====================================
@@ -99,7 +99,7 @@ instance Uniquable FieldLabelString where
data DuplicateRecordFields
= DuplicateRecordFields -- ^ Fields may be duplicated in a single module
| NoDuplicateRecordFields -- ^ Fields must be unique within a module (the default)
- deriving (Show, Eq, Typeable, Data)
+ deriving (Show, Eq, Data)
instance Binary DuplicateRecordFields where
put_ bh f = put_ bh (f == DuplicateRecordFields)
@@ -118,7 +118,7 @@ instance NFData DuplicateRecordFields where
data FieldSelectors
= FieldSelectors -- ^ Selector functions are available (the default)
| NoFieldSelectors -- ^ Selector functions are not available
- deriving (Show, Eq, Typeable, Data)
+ deriving (Show, Eq, Data)
instance Binary FieldSelectors where
put_ bh f = put_ bh (f == FieldSelectors)
=====================================
docs/users_guide/9.12.1-notes.rst
=====================================
@@ -39,24 +39,26 @@ Compiler
~~~~~~~~
- Constructor ``PluginProv`` of type ``UnivCoProvenance``, relevant
-for typing plugins, gets an extra ``DCoVarSet`` argument.
-The argument is intended to contain the in-scope coercion variables
-that the the proof represented by the coercion makes use of.
-See ``Note [The importance of tracking free coercion variables]``
-in ``GHC.Core.TyCo.Rep``, :ref:`constraint-solving-with-plugins`
-and the migration guide.
+ for typing plugins, gets an extra ``DCoVarSet`` argument.
+ The argument is intended to contain the in-scope coercion variables
+ that the the proof represented by the coercion makes use of.
+ See ``Note [The importance of tracking free coercion variables]``
+ in ``GHC.Core.TyCo.Rep``, :ref:`constraint-solving-with-plugins`
+ and the migration guide.
-- The flag `-fprof-late` will no longer prevent top level constructors from being statically allocated.
+- The flag :ghc-flag:`-fprof-late` will no longer prevent top level constructors from being statically allocated.
- It used to be the case that we would add a cost centre for bindings like `foo = Just bar`.
- This turned the binding into a caf that would allocate the constructor on first evaluation.
+ It used to be the case that we would add a cost centre for bindings like ``foo = Just bar``.
+ This turned the binding into a CAF that would allocate the constructor on first evaluation.
- However without the cost centre `foo` can be allocated at compile time. This reduces code-bloat and
+ However without the cost centre ``foo`` can be allocated at compile time. This reduces code-bloat and
reduces overhead for short-running applications.
- The tradeoff is that calling `whoCreated` on top level value definitions like `foo` will be less informative.
+ The tradeoff is that calling ``whoCreated`` on top level value definitions like ``foo`` will be less informative.
-- A new flag ``-fexpose-overloaded-unfoldings`` has been added providing a lightweight alternative to ``-fexpose-all-unfoldings``.
+- A new flag :ghc-flag:`-fexpose-overloaded-unfoldings` has been added providing a lightweight alternative to :ghc-flag:`-fexpose-all-unfoldings`.
+
+- :ghc-flag:`-Wderiving-typeable` has been added to :ghc-flag:`-Wall`.
GHCi
~~~~
=====================================
docs/users_guide/exts/type_families.rst
=====================================
@@ -1166,7 +1166,7 @@ extension. This extension implies ``-XTypeFamilies``.
For full details on injective type families refer to the Haskell Symposium
2015 paper `Injective type families for
-Haskell <https://ics.p.lodz.pl/~stolarek/_media/pl:research:stolarek_peyton-jones_eisenberg_injectivity_extended.pdf>`__.
+Haskell <https://richarde.dev/papers/2015/injective/injective-type-families.pdf>`__.
.. _injective-ty-fams-syntax:
=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -138,6 +138,7 @@ as ``-Wno-...`` for every individual warning in the group.
* :ghc-flag:`-Wunused-do-bind`
* :ghc-flag:`-Wunused-record-wildcards`
* :ghc-flag:`-Wincomplete-export-warnings`
+ * :ghc-flag:`-Wderiving-typeable`
.. ghc-flag:: -Weverything
:shortdesc: enable all warnings supported by GHC
=====================================
hadrian/src/Settings/Builders/SplitSections.hs
=====================================
@@ -29,6 +29,9 @@ splitSectionsArgs = do
) then
( mconcat
[ builder (Ghc CompileHs) ? arg "-fsplit-sections"
+ , builder (Ghc CompileCWithGhc) ? arg "-fsplit-sections"
+ , builder (Ghc CompileCppWithGhc) ? arg "-fsplit-sections"
+ , builder (Cc CompileC) ? arg "-ffunction-sections" <> arg "-fdata-sections"
, builder MergeObjects ? ifM (expr isWinTarget)
(pure ["-T", "driver/utils/merge_sections_pe.ld"])
(pure ["-T", "driver/utils/merge_sections.ld"])
=====================================
hadrian/src/Settings/Warnings.hs
=====================================
@@ -26,9 +26,17 @@ ghcWarningsArgs = do
mconcat
[ stage0 ? mconcat
[ libraryPackage ? pure [ "-fno-warn-deprecated-flags" ]
- , package terminfo ? pure [ "-fno-warn-unused-imports" ]
+ , package terminfo ? pure [ "-fno-warn-unused-imports", "-Wno-deriving-typeable"]
, package transformers ? pure [ "-fno-warn-unused-matches"
- , "-fno-warn-unused-imports" ] ]
+ , "-fno-warn-unused-imports" ]
+ , package stm ? pure [ "-Wno-deriving-typeable" ]
+ , package osString ? pure [ "-Wno-deriving-typeable" ]
+ , package parsec ? pure [ "-Wno-deriving-typeable" ]
+ , package cabal ? pure [ "-Wno-deriving-typeable" ]
+ , package cabalSyntax ? pure [ "-Wno-deriving-typeable" ]
+ , package time ? pure [ "-Wno-deriving-typeable" ]
+ , package unix ? pure [ "-Wno-deriving-typeable" ]
+ ]
, notStage0 ? mconcat
[ libraryPackage ? pure [ "-Wno-deprecated-flags" ]
, package ghcInternal ? pure [ "-Wno-trustworthy-safe" ]
@@ -51,19 +59,27 @@ ghcWarningsArgs = do
, "-Wno-x-partial"
, "-Wno-unused-imports"
, "-Wno-redundant-constraints"
- , "-Wno-simplifiable-class-constraints" ]
+ , "-Wno-simplifiable-class-constraints"
+ , "-Wno-deriving-typeable" ]
, package pretty ? pure [ "-Wno-unused-imports" ]
, package primitive ? pure [ "-Wno-unused-imports"
, "-Wno-deprecations" ]
, package rts ? pure [ "-Wcpp-undef" ]
- , package text ? pure [ "-Wno-deprecations" ]
- , package terminfo ? pure [ "-Wno-unused-imports" ]
+ , package text ? pure [ "-Wno-deprecations", "-Wno-deriving-typeable" ]
+ , package terminfo ? pure [ "-Wno-unused-imports", "-Wno-deriving-typeable" ]
+ , package stm ? pure [ "-Wno-deriving-typeable" ]
+ , package osString ? pure [ "-Wno-deriving-typeable" ]
+ , package parsec ? pure [ "-Wno-deriving-typeable" ]
+ , package cabal ? pure [ "-Wno-deriving-typeable" ]
+ , package cabalSyntax ? pure [ "-Wno-deriving-typeable" ]
+ , package time ? pure [ "-Wno-deriving-typeable" ]
, package transformers ? pure [ "-Wno-unused-matches"
, "-Wno-unused-imports"
, "-Wno-redundant-constraints"
, "-Wno-orphans" ]
- , package unix ? pure [ "-Wno-deprecations" ]
+ , package unix ? pure [ "-Wno-deprecations", "-Wno-deriving-typeable" ]
, package win32 ? pure [ "-Wno-trustworthy-safe"
, "-Wno-deprecations" -- https://gitlab.haskell.org/ghc/ghc/-/issues/24240
+ , "-Wno-deriving-typeable"
]
, package xhtml ? pure [ "-Wno-unused-imports" ] ] ]
=====================================
libraries/ghc-internal/ghc-internal.cabal
=====================================
@@ -1,19 +1,19 @@
cabal-version: 3.0
name: ghc-internal
version: 9.1001.0
--- NOTE: Don't forget to update ./changelog.md
-
license: BSD-3-Clause
license-file: LICENSE
-maintainer: Core Libraries Committee <core-libraries-committee at haskell.org>
-bug-reports: https://github.com/haskell/core-libraries-committee/issues
+maintainer: The GHC Developers <ghc-devs at haskell.org>
+bug-reports: https://gitlab.haskell.org/ghc/ghc/-/issues/new
synopsis: Basic libraries
category: Prelude
build-type: Configure
description:
- This package contains the Standard Haskell "Prelude" and its support libraries,
- and a large collection of useful libraries ranging from data
- structures to parsing combinators and debugging utilities.
+ This package contains the implementation of GHC's standard libraries and is
+ not intended for use by end-users.
+ .
+ Users should instead use either the @base@ or @ghc-experimental@ packages
+
extra-tmp-files:
autom4te.cache
=====================================
libraries/ghc-internal/src/GHC/Internal/JS/Foreign/Callback.hs
=====================================
@@ -23,14 +23,12 @@ import GHC.Internal.JS.Prim
import qualified GHC.Internal.Exts as Exts
-import GHC.Internal.Data.Typeable
-
import GHC.Internal.Unsafe.Coerce
import GHC.Internal.Base
data OnBlocked = ContinueAsync | ThrowWouldBlock deriving (Eq)
-newtype Callback a = Callback JSVal deriving Typeable
+newtype Callback a = Callback JSVal
{- |
When you create a callback, the Haskell runtime stores a reference to
=====================================
libraries/ghc-internal/src/GHC/Internal/JS/Prim.hs
=====================================
@@ -1,6 +1,5 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE JavaScriptFFI #-}
{-# LANGUAGE GHCForeignImportPrim #-}
@@ -40,7 +39,6 @@ module GHC.Internal.JS.Prim ( JSVal(..), JSVal#
#endif
) where
-import GHC.Internal.Data.Typeable (Typeable)
import GHC.Internal.Unsafe.Coerce (unsafeCoerce)
import GHC.Prim
@@ -71,7 +69,6 @@ type JSVal# = Addr#
to a JSException
-}
data JSException = JSException JSVal String
- deriving (Typeable)
instance Ex.Exception JSException
@@ -326,7 +323,6 @@ foreign import javascript unsafe "(($1, $2) => { return $1($2); })"
continue asynchronously, it receives this exception.
-}
data WouldBlockException = WouldBlockException
- deriving (Typeable)
instance Show WouldBlockException where
show _ = "thread would block"
=====================================
libraries/ghc-internal/src/GHC/Internal/TypeLits.hs
=====================================
@@ -16,6 +16,7 @@
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE QuantifiedConstraints #-}
{-|
GHC's @DataKinds@ language extension lifts data constructors, natural
@@ -49,11 +50,18 @@ module GHC.Internal.TypeLits
, OrderingI(..)
, N.cmpNat, cmpSymbol, cmpChar
-- ** Singleton values
- , N.SNat (..), SSymbol (..), SChar (..)
+ , N.SNat (..)
+ , SSymbol (UnsafeSSymbol)
+ -- We export a pattern synonym instead of the real constructor:
+ -- See Note [Preventing unsafe coercions for singleton types].
+ , SChar (UnsafeSChar)
+ -- We export a pattern synonym instead of the real constructor:
+ -- See Note [Preventing unsafe coercions for singleton types].
, pattern N.SNat, pattern SSymbol, pattern SChar
, fromSNat, fromSSymbol, fromSChar
, withSomeSNat, withSomeSSymbol, withSomeSChar
, N.withKnownNat, withKnownSymbol, withKnownChar
+ , N.unsafeWithSNatCo, unsafeWithSSymbolCo, unsafeWithSCharCo
-- * Functions on type literals
, type (N.<=), type (N.<=?), type (N.+), type (N.*), type (N.^), type (N.-)
@@ -72,7 +80,7 @@ module GHC.Internal.TypeLits
import GHC.Internal.Base ( Bool(..), Eq(..), Functor(..), Ord(..), Ordering(..), String
, (.), otherwise, withDict, Void, (++)
, errorWithoutStackTrace)
-import GHC.Types(Symbol, Char, TYPE)
+import GHC.Types(Symbol, Char, TYPE, Coercible)
import GHC.Internal.TypeError(ErrorMessage(..), TypeError)
import GHC.Internal.Num(Integer, fromInteger)
import GHC.Internal.Show(Show(..), appPrec, appPrec1, showParen, showString)
@@ -340,7 +348,9 @@ withSomeSNat n k
-- 'String'.
--
-- @since base-4.18.0.0
-newtype SSymbol (s :: Symbol) = UnsafeSSymbol String
+newtype SSymbol (s :: Symbol) = UnsafeSSymbol_ String
+-- nominal role: See Note [Preventing unsafe coercions for singleton types]
+-- in GHC.Internal.TypeNats
type role SSymbol nominal
-- | A explicitly bidirectional pattern synonym relating an 'SSymbol' to a
@@ -377,6 +387,26 @@ data KnownSymbolInstance (s :: Symbol) where
knownSymbolInstance :: SSymbol s -> KnownSymbolInstance s
knownSymbolInstance ss = withKnownSymbol ss KnownSymbolInstance
+-- | A pattern that can be used to manipulate the
+-- 'String' that an @SSymbol s@ contains under the hood.
+--
+-- When using this pattern to construct an @SSymbol s@, the actual
+-- @String@ being stored in the @SSymbol@ /must/ be equal to (the
+-- contents of) @s at . The compiler will not help you verify this,
+-- hence the \'unsafe\' name.
+pattern UnsafeSSymbol :: forall s. String -> SSymbol s
+pattern UnsafeSSymbol guts = UnsafeSSymbol_ guts
+{-# COMPLETE UnsafeSSymbol #-}
+
+-- | 'unsafeWithSSymbolCo' allows uses of @coerce@ in its argument to see the
+-- real representation of @SSymbol s@, without undermining the type-safety of
+-- @coerce@ elsewhere in the module.
+--
+-- See also the documentation for 'UnsafeSSymbol'.
+unsafeWithSSymbolCo
+ :: forall r. ((forall s. Coercible (SSymbol s) String) => r) -> r
+unsafeWithSSymbolCo v = v
+
-- | @since base-4.19.0.0
instance Eq (SSymbol s) where
_ == _ = True
@@ -443,7 +473,9 @@ withSomeSSymbol s k = k (UnsafeSSymbol s)
-- 3. The 'withSomeSChar' function, which creates an 'SChar' from a 'Char'.
--
-- @since base-4.18.0.0
-newtype SChar (s :: Char) = UnsafeSChar Char
+newtype SChar (s :: Char) = UnsafeSChar_ Char
+-- nominal role: See Note [Preventing unsafe coercions for singleton types]
+-- in GHC.Internal.TypeNats
type role SChar nominal
-- | A explicitly bidirectional pattern synonym relating an 'SChar' to a
@@ -480,6 +512,25 @@ data KnownCharInstance (n :: Char) where
knownCharInstance :: SChar c -> KnownCharInstance c
knownCharInstance sc = withKnownChar sc KnownCharInstance
+-- | A pattern that can be used to manipulate the
+-- 'Char' that an @SChar c@ contains under the hood.
+--
+-- When using this pattern to construct an @SChar c@, the actual
+-- @Char@ being stored in the @SChar c@ /must/ be equal to @c at .
+-- The compiler will not help you verify this, hence the \'unsafe\' name.
+pattern UnsafeSChar :: forall c. Char -> SChar c
+pattern UnsafeSChar guts = UnsafeSChar_ guts
+{-# COMPLETE UnsafeSChar #-}
+
+-- | 'unsafeWithSCharCo' allows uses of @coerce@ in its argument to see the
+-- real representation of @SChar c@, without undermining the type-safety of
+-- @coerce@ elsewhere in the module.
+--
+-- See also the documentation for 'UnsafeSChar'.
+unsafeWithSCharCo
+ :: forall r. ((forall c. Coercible (SChar c) Char) => r) -> r
+unsafeWithSCharCo v = v
+
-- | @since base-4.19.0.0
instance Eq (SChar c) where
_ == _ = True
=====================================
libraries/ghc-internal/src/GHC/Internal/TypeNats.hs
=====================================
@@ -17,6 +17,7 @@
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE QuantifiedConstraints #-}
{-| This module is an internal GHC module. It declares the constants used
in the implementation of type-level natural numbers. The programmer interface
@@ -36,11 +37,14 @@ module GHC.Internal.TypeNats
, sameNat
, decideNat
-- ** Singleton values
- , SNat (..)
+ , SNat (UnsafeSNat)
+ -- We export a pattern synonym instead of the real constructor:
+ -- See Note [Preventing unsafe coercions for singleton types].
, pattern SNat
, fromSNat
, withSomeSNat
, withKnownNat
+ , unsafeWithSNatCo
-- * Functions on type literals
, type (<=), type (<=?), type (+), type (*), type (^), type (-)
@@ -344,9 +348,60 @@ cmpNat x y = case compare (natVal x) (natVal y) of
-- number.
--
-- @since base-4.18.0.0
-newtype SNat (n :: Nat) = UnsafeSNat Natural
+newtype SNat (n :: Nat) = UnsafeSNat_ Natural
+-- nominal role: See Note [Preventing unsafe coercions for singleton types]
type role SNat nominal
+{-
+Note [Preventing unsafe coercions for singleton types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider a singleton type like this one:
+
+ newtype SNat (n :: Nat) = UnsafeSNat_ Natural
+
+We operate under the fiction that a (non-bottom) value
+``UnsafeSNat_ v :: SNat n`` also contains evidence that the value
+``v :: Natural`` is the same as the type ``n :: Natural``.
+Such evidence can only be safely ``coerce``d to evidence that the
+value ``v`` is the same as some other type ``n2`` if we know that
+``n ~ n2``, at nominal role. (This is #23454.)
+
+So, to preserve that fiction, we:
+
+ 1. Provide a role annotation indicating that ``SNat``'s type argument has
+ nominal role rather than the phantom role that would be inferred.
+ 2. Ensure that the real newtype constructor ``UnsafeSNat_`` is not
+ exported even from ghc-internal. Whenever that constructor is in
+ scope, typechecking of ``coerce`` will ignore the role annotation
+ and just unwrap the newtype.
+
+But users may wish to write functions like this one (#23478):
+
+ plusSNat :: SNat a -> SNat b -> SNat (a + b)
+
+We could ask them to use ``unsafeCoerce``, but it seems a bit more polite
+to provide a pattern synonym ``UnsafeSNat :: forall n. Natural -> SNat n``
+as an escape hatch (exported from ghc-internal only), so that such a function
+can be written as follows:
+
+ plusSNat (UnsafeSNat x) (UnsafeSNat y) = UnsafeSNat (x + y)
+
+Crucially, these pattern synonyms (unlike real newtype constructors) do not
+cause ``coerce`` to bypass our role annotation when they are in scope.
+
+To allow casting data structures containing SNats, we provide a
+further escape hatch in ``unsafeWithSNatCo``, which enables ``coerce`` to
+bypass our role annotation on ``SNat``, but /only within its argument/:
+
+ unsafeWithSNatCo
+ :: forall r. ((forall n. Coercible (SNat n) Natural) => r) -> r
+
+
+The above reasoning applies identically for the other singleton types
+'SChar' and 'SSymbol' as well.
+-}
+
+
-- | A explicitly bidirectional pattern synonym relating an 'SNat' to a
-- 'KnownNat' constraint.
--
@@ -381,6 +436,25 @@ data KnownNatInstance (n :: Nat) where
knownNatInstance :: SNat n -> KnownNatInstance n
knownNatInstance sn = withKnownNat sn KnownNatInstance
+-- | A pattern that can be used to manipulate the
+-- 'Natural' that an @SNat n@ contains under the hood.
+--
+-- When using this pattern to construct an @SNat n@, the actual
+-- @Natural@ being stored in the @SNat n@ /must/ be equal to @n at .
+-- The compiler will not help you verify this, hence the \'unsafe\' name.
+pattern UnsafeSNat :: forall n. Natural -> SNat n
+pattern UnsafeSNat guts = UnsafeSNat_ guts
+{-# COMPLETE UnsafeSNat #-}
+
+-- | 'unsafeWithSNatCo' allows uses of @coerce@ in its argument to see the
+-- real representation of @SNat n@, without undermining the type-safety of
+-- @coerce@ elsewhere in the module.
+--
+-- See also the documentation for 'UnsafeSNat'.
+unsafeWithSNatCo
+ :: forall r. ((forall n. Coercible (SNat n) Natural) => r) -> r
+unsafeWithSNatCo v = v
+
-- | @since base-4.19.0.0
instance Eq (SNat n) where
_ == _ = True
=====================================
testsuite/tests/ghci/scripts/T9181.stdout
=====================================
@@ -99,7 +99,7 @@ pattern GHC.Internal.TypeLits.SChar
type role GHC.Internal.TypeLits.SChar nominal
type GHC.Internal.TypeLits.SChar :: Char -> *
newtype GHC.Internal.TypeLits.SChar s
- = GHC.Internal.TypeLits.UnsafeSChar Char
+ = GHC.Internal.TypeLits.UnsafeSChar_ Char
pattern GHC.Internal.TypeNats.SNat
:: () =>
GHC.Internal.TypeNats.KnownNat n =>
@@ -107,7 +107,7 @@ pattern GHC.Internal.TypeNats.SNat
type role GHC.Internal.TypeNats.SNat nominal
type GHC.Internal.TypeNats.SNat :: GHC.Internal.TypeNats.Nat -> *
newtype GHC.Internal.TypeNats.SNat n
- = GHC.Internal.TypeNats.UnsafeSNat GHC.Num.Natural.Natural
+ = GHC.Internal.TypeNats.UnsafeSNat_ GHC.Num.Natural.Natural
pattern GHC.Internal.TypeLits.SSymbol
:: () =>
GHC.Internal.TypeLits.KnownSymbol s =>
@@ -115,7 +115,7 @@ pattern GHC.Internal.TypeLits.SSymbol
type role GHC.Internal.TypeLits.SSymbol nominal
type GHC.Internal.TypeLits.SSymbol :: GHC.Types.Symbol -> *
newtype GHC.Internal.TypeLits.SSymbol s
- = GHC.Internal.TypeLits.UnsafeSSymbol String
+ = GHC.Internal.TypeLits.UnsafeSSymbol_ String
type GHC.Internal.TypeLits.SomeChar :: *
data GHC.Internal.TypeLits.SomeChar
= forall (n :: Char).
=====================================
testsuite/tests/process/all.T
=====================================
@@ -7,7 +7,7 @@ test('process002', [fragile_for(16547, concurrent_ways), req_process], compile_a
test('process003', [fragile_for(17245, concurrent_ways), req_process], compile_and_run, [''])
test('process004', [normalise_exec, normalise_exe, req_process], compile_and_run, [''])
test('T1780', [req_process], compile_and_run, [''])
-test('process005', [omit_ghci, req_process], compile_and_run, [''])
+test('process005', [omit_ghci, req_process, when(js_arch(), fragile(24373))], compile_and_run, [''])
test('process006', [req_process], compile_and_run, [''])
test('process007',
=====================================
testsuite/tests/warnings/should_compile/DerivingTypeable.stderr
=====================================
@@ -1,4 +1,4 @@
-
-DerivingTypeable.hs:8:12: warning: [GHC-90584] [-Wderiving-typeable]
+DerivingTypeable.hs:8:12: warning: [GHC-90584] [-Wderiving-typeable (in -Wall)]
• Deriving ‘Typeable’ has no effect: all types now auto-derive Typeable
• In the data declaration for ‘Foo’
+
=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -50,7 +50,6 @@ import Control.Monad.State.Strict
import Data.Data (Data)
import Data.Map (Map)
import qualified Data.Set as Set
-import Data.Typeable (Typeable)
import Documentation.Haddock.Types
import qualified GHC.Data.Strict as Strict
import GHC.Types.Fixity (Fixity (..))
@@ -764,7 +763,6 @@ type Renamer = String -> (NameSpace -> Bool) -> [Name]
data HaddockException
= HaddockException String
| WithContext [String] SomeException
- deriving (Typeable)
instance Show HaddockException where
show (HaddockException str) = str
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/579b8cdfc35894f337a1f8fe16b7d0867897507d...8f3697ea2acc7f68795088b5374c21cf7e5b8fb5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/579b8cdfc35894f337a1f8fe16b7d0867897507d...8f3697ea2acc7f68795088b5374c21cf7e5b8fb5
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/20240531/d6e3134f/attachment-0001.html>
More information about the ghc-commits
mailing list