[Git][ghc/ghc][wip/amg/T22156] 2 commits: Representation-polymorphic HasField (fixes #22156)
Adam Gundry (@adamgundry)
gitlab at gitlab.haskell.org
Sat Dec 30 14:26:52 UTC 2023
Adam Gundry pushed to branch wip/amg/T22156 at Glasgow Haskell Compiler / GHC
Commits:
0ad47fd7 by Adam Gundry at 2023-12-30T14:26:02+00:00
Representation-polymorphic HasField (fixes #22156)
This generalises the HasField class to support representation polymorphism,
so that instead of
type HasField :: forall {k} . k -> Type -> Type -> Constraint
we have
type HasField :: forall {k} {r_rep} {a_rep} . k -> TYPE r_rep -> TYPE a_rep -> Constraint
- - - - -
05c2e01b by Adam Gundry at 2023-12-30T14:26:02+00:00
Mark GHC.Records as Trustworthy
The previous patch added an import of GHC.Exts, which means GHC.Records
ceases to be Safe-Inferred. Rather than breaking any user code which
relied on GHC.Records being considered Safe, we declare it Trustworthy.
- - - - -
12 changed files:
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Validity.hs
- docs/users_guide/9.10.1-notes.rst
- libraries/base/changelog.md
- libraries/base/src/GHC/Records.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
- testsuite/tests/overloadedrecflds/should_run/all.T
- + testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.hs
- + testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.stdout
Changes:
=====================================
compiler/GHC/Tc/Instance/Class.hs
=====================================
@@ -1192,7 +1192,8 @@ appropriately cast.
The HasField class is defined (in GHC.Records) thus:
- class HasField (x :: k) r a | x r -> a where
+ type HasField :: forall {k} {r_rep} {a_rep} . k -> TYPE r_rep -> TYPE a_rep -> Constraint
+ class HasField x r a | x r -> a where
getField :: r -> a
Since this is a one-method class, it is represented as a newtype.
@@ -1248,8 +1249,8 @@ matchHasField dflags short_cut clas tys
= do { fam_inst_envs <- tcGetFamInstEnvs
; rdr_env <- getGlobalRdrEnv
; case tys of
- -- We are matching HasField {k} x r a...
- [_k_ty, x_ty, r_ty, a_ty]
+ -- We are matching HasField {k} {r_rep} {a_rep} x r a...
+ [_k_ty, _r_rep, _a_rep, x_ty, r_ty, a_ty]
-- x should be a literal string
| Just x <- isStrLitTy x_ty
-- r should be an applied type constructor
=====================================
compiler/GHC/Tc/Validity.hs
=====================================
@@ -1755,7 +1755,7 @@ dropCastsB b = b -- Don't bother in the kind of a forall
-- | See Note [Validity checking of HasField instances]
checkHasFieldInst :: Class -> [Type] -> TcM ()
-checkHasFieldInst cls tys@[_k_ty, lbl_ty, r_ty, _a_ty] =
+checkHasFieldInst cls tys@[_k_ty, _r_rep, _a_rep, lbl_ty, r_ty, _a_ty] =
case splitTyConApp_maybe r_ty of
Nothing -> add_err IllegalHasFieldInstanceNotATyCon
Just (tc, _)
=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -45,6 +45,12 @@ Language
where
y = f x
+- The built-in ``HasField`` class, used by :extension:`OverloadedRecordDot`, now
+ supports representation polymorphism (implementing part of `GHC Proposal #583
+ <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0583-hasfield-redesign.rst>`_).
+ This means that code using :extension:`UnliftedDatatypes` or
+ :extension:`UnliftedNewtypes` can now use :extension:`OverloadedRecordDot`.
+
- Due to an oversight, previous GHC releases (starting from 9.4) allowed the use
of promoted data types in kinds, even when :extension:`DataKinds` was not
enabled. That is, GHC would erroneously accept the following code: ::
=====================================
libraries/base/changelog.md
=====================================
@@ -7,6 +7,7 @@
* Implement `stimes` for `instance Semigroup (Endo a)` explicitly ([CLC proposal #4](https://github.com/haskell/core-libraries-committee/issues/4))
* Add laws relating between `Foldable` / `Traversable` with `Bifoldable` / `Bitraversable` ([CLC proposal #205](https://github.com/haskell/core-libraries-committee/issues/205))
* The `Enum Int64` and `Enum Word64` instances now use native operations on 32-bit platforms, increasing performance by up to 1.5x on i386 and up to 5.6x with the JavaScript backend. ([CLC proposal #187](https://github.com/haskell/core-libraries-committee/issues/187))
+ * The `HasField` class now supports representation polymorphism ([CLC proposal #194](https://github.com/haskell/core-libraries-committee/issues/194))
* Update to [Unicode 15.1.0](https://www.unicode.org/versions/Unicode15.1.0/).
* Fix `fdIsNonBlocking` to always be `0` for regular files and block devices on unix, regardless of `O_NONBLOCK`
* Always use `safe` call to `read` for regular files and block devices on unix if the RTS is multi-threaded, regardless of `O_NONBLOCK`.
=====================================
libraries/base/src/GHC/Records.hs
=====================================
@@ -1,11 +1,14 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
+{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Records
--- Copyright : (c) Adam Gundry 2015-2016
+-- Copyright : (c) Adam Gundry 2015-2023
-- License : see libraries/base/LICENSE
--
-- Maintainer : cvs-ghc at haskell.org
@@ -13,9 +16,9 @@
-- Portability : non-portable (GHC extensions)
--
-- This module defines the 'HasField' class used by the
--- @OverloadedRecordFields@ extension. See the
--- <https://gitlab.haskell.org/ghc/ghc/wikis/records/overloaded-record-fields
--- wiki page> for more details.
+-- @OverloadedRecordDot@ extension. See the
+-- <https://downloads.haskell.org/ghc/latest/docs/users_guide/exts/hasfield.html
+-- user's guide> for more details.
--
-----------------------------------------------------------------------------
@@ -23,16 +26,20 @@ module GHC.Records
( HasField(..)
) where
+import Data.Kind (Constraint)
+import GHC.Exts (TYPE)
+
-- | Constraint representing the fact that the field @x@ belongs to
-- the record type @r@ and has field type @a at . This will be solved
-- automatically, but manual instances may be provided as well.
--- HasField :: forall {k}. k -> * -> * -> Constraint
--- getField :: forall {k} (x::k) r a. HasField x r a => r -> a
+-- HasField :: forall {k} {r_rep} {a_rep} . k -> TYPE r_rep -> TYPE a_rep -> Constraint
+-- getField :: forall {k} {r_rep} {a_rep} (x::k) (r :: TYPE r_rep) (a :: TYPE a_rep) . HasField x r a => r -> a
-- NB: The {k} means that k is an 'inferred' type variable, and
-- hence not provided in visible type applications. Thus you
-- say getField @"foo"
-- not getField @Symbol @"foo"
+type HasField :: forall {k} {r_rep} {a_rep} . k -> TYPE r_rep -> TYPE a_rep -> Constraint
class HasField x r a | x r -> a where
-- | Selector function to extract the field from the record.
getField :: r -> a
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -9101,8 +9101,8 @@ module GHC.Real where
underflowError :: forall a. a
module GHC.Records where
- -- Safety: Safe-Inferred
- type HasField :: forall {k}. k -> * -> * -> Constraint
+ -- Safety: Trustworthy
+ type HasField :: forall {k} {r_rep :: GHC.Types.RuntimeRep} {a_rep :: GHC.Types.RuntimeRep}. k -> TYPE r_rep -> TYPE a_rep -> Constraint
class HasField x r a | x r -> a where
getField :: r -> a
{-# MINIMAL getField #-}
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -11879,8 +11879,8 @@ module GHC.Real where
underflowError :: forall a. a
module GHC.Records where
- -- Safety: Safe-Inferred
- type HasField :: forall {k}. k -> * -> * -> Constraint
+ -- Safety: Trustworthy
+ type HasField :: forall {k} {r_rep :: GHC.Types.RuntimeRep} {a_rep :: GHC.Types.RuntimeRep}. k -> TYPE r_rep -> TYPE a_rep -> Constraint
class HasField x r a | x r -> a where
getField :: r -> a
{-# MINIMAL getField #-}
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -9325,8 +9325,8 @@ module GHC.Real where
underflowError :: forall a. a
module GHC.Records where
- -- Safety: Safe-Inferred
- type HasField :: forall {k}. k -> * -> * -> Constraint
+ -- Safety: Trustworthy
+ type HasField :: forall {k} {r_rep :: GHC.Types.RuntimeRep} {a_rep :: GHC.Types.RuntimeRep}. k -> TYPE r_rep -> TYPE a_rep -> Constraint
class HasField x r a | x r -> a where
getField :: r -> a
{-# MINIMAL getField #-}
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -9105,8 +9105,8 @@ module GHC.Real where
underflowError :: forall a. a
module GHC.Records where
- -- Safety: Safe-Inferred
- type HasField :: forall {k}. k -> * -> * -> Constraint
+ -- Safety: Trustworthy
+ type HasField :: forall {k} {r_rep :: GHC.Types.RuntimeRep} {a_rep :: GHC.Types.RuntimeRep}. k -> TYPE r_rep -> TYPE a_rep -> Constraint
class HasField x r a | x r -> a where
getField :: r -> a
{-# MINIMAL getField #-}
=====================================
testsuite/tests/overloadedrecflds/should_run/all.T
=====================================
@@ -15,6 +15,7 @@ test('overloadedlabelsrun04', [req_th, extra_files(['OverloadedLabelsRun04_A.hs'
['overloadedlabelsrun04', config.ghc_th_way_flags])
test('hasfieldrun01', normal, compile_and_run, [''])
test('hasfieldrun02', normal, compile_and_run, [''])
+test('hasfieldrun03', normal, compile_and_run, [''])
test('T12243', normal, compile_and_run, [''])
test('T11228', normal, compile_and_run, [''])
test('T11671_run', normal, compile_and_run, [''])
=====================================
testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.hs
=====================================
@@ -0,0 +1,25 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UnliftedNewtypes #-}
+{-# LANGUAGE UnliftedDatatypes #-}
+
+import GHC.Exts (Int#, Int(I#), RuntimeRep(..), UnliftedType, TYPE)
+import GHC.Records (HasField(..))
+
+data U = MkU { f1 :: Int# }
+
+instance a ~ Int# => HasField "f2" U a where
+ getField = f1
+
+type V :: TYPE IntRep -> UnliftedType
+data V x = MkV { g1 :: x }
+
+instance a ~ x => HasField "g2" (V x) a where
+ getField = g1
+
+main = do print (I# (getField @"f1" (MkU 42#)))
+ print (I# (getField @"f2" (MkU 42#)))
+ print (I# (getField @"g1" (MkV 100#)))
+ print (I# (getField @"g2" (MkV 100#)))
=====================================
testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.stdout
=====================================
@@ -0,0 +1,4 @@
+42
+42
+100
+100
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13c4df6943745cf8e7fcb0162c165bb85e3069f6...05c2e01bc0882ab8ffc66750452336bbfa0f126e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13c4df6943745cf8e7fcb0162c165bb85e3069f6...05c2e01bc0882ab8ffc66750452336bbfa0f126e
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/20231230/83c6c5c0/attachment-0001.html>
More information about the ghc-commits
mailing list