[Git][ghc/ghc][wip/amg/T22156] Representation-polymorphic HasField (fixes #22156)
Adam Gundry (@adamgundry)
gitlab at gitlab.haskell.org
Thu May 16 06:51:54 UTC 2024
Adam Gundry pushed to branch wip/amg/T22156 at Glasgow Haskell Compiler / GHC
Commits:
8554fb65 by Adam Gundry at 2024-05-16T07:51:33+01: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
- - - - -
12 changed files:
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/Validity.hs
- docs/users_guide/9.12.1-notes.rst
- libraries/base/changelog.md
- libraries/ghc-internal/src/GHC/Internal/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
=====================================
@@ -1749,7 +1749,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.12.1-notes.rst
=====================================
@@ -23,6 +23,13 @@ Language
This change is backwards-incompatible, although in practice we don't expect it
to cause significant disruption.
+- 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`.
+
+
Compiler
~~~~~~~~
=====================================
libraries/base/changelog.md
=====================================
@@ -3,6 +3,7 @@
## 4.21.0.0 *TBA*
* Add the `MonadFix` instance for `(,) a`, similar to the one for `Writer a` ([CLC proposal #238](https://github.com/haskell/core-libraries-committee/issues/238))
* Improve `toInteger :: Word32 -> Integer` on 64-bit platforms ([CLC proposal #259](https://github.com/haskell/core-libraries-committee/issues/259))
+ * The `HasField` class now supports representation polymorphism ([CLC proposal #194](https://github.com/haskell/core-libraries-committee/issues/194))
* Make `read` accept binary integer notation ([CLC proposal #177](https://github.com/haskell/core-libraries-committee/issues/177))
* Improve the performance of `Data.List.sort` using an improved merging strategy. Instead of `compare`, `sort` now uses `(>)` which may break *malformed* `Ord` instances ([CLC proposal #236](https://github.com/haskell/core-libraries-committee/issues/236))
=====================================
libraries/ghc-internal/src/GHC/Internal/Records.hs
=====================================
@@ -1,13 +1,15 @@
{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE Trustworthy #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.Internal.Records
--- Copyright : (c) Adam Gundry 2015-2016
+-- Copyright : (c) Adam Gundry 2015-2024
-- License : see libraries/base/LICENSE
--
-- Maintainer : ghc-devs at haskell.org
@@ -15,9 +17,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.
--
-----------------------------------------------------------------------------
@@ -28,16 +30,19 @@ module GHC.Internal.Records
-- See W1 of Note [Tracking dependencies on primitives] in GHC.Internal.Base
import GHC.Types ()
+import GHC.Types (TYPE, Constraint)
+
-- | 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
=====================================
@@ -9255,7 +9255,7 @@ module GHC.Real where
module GHC.Records where
-- Safety: Safe
- type HasField :: forall {k}. k -> * -> * -> Constraint
+ 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
=====================================
@@ -12297,7 +12297,7 @@ module GHC.Real where
module GHC.Records where
-- Safety: Safe
- type HasField :: forall {k}. k -> * -> * -> Constraint
+ 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
=====================================
@@ -9479,7 +9479,7 @@ module GHC.Real where
module GHC.Records where
-- Safety: Safe
- type HasField :: forall {k}. k -> * -> * -> Constraint
+ 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
=====================================
@@ -9255,7 +9255,7 @@ module GHC.Real where
module GHC.Records where
-- Safety: Safe
- type HasField :: forall {k}. k -> * -> * -> Constraint
+ 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,32 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# 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 u = f1 u +# 1#
+
+type V :: TYPE IntRep -> UnliftedType
+data V x = MkV { g1 :: x }
+
+instance (a ~ Int#, x ~ Int#) => HasField "g2" (V x) a where
+ getField u = g1 u +# 3#
+
+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#)))
+ let u = MkU 1#
+ let v = MkV 0#
+ print (I# (u.f1))
+ print (I# (u.f2))
+ print (I# (v.g1))
+ print (I# (v.g2))
=====================================
testsuite/tests/overloadedrecflds/should_run/hasfieldrun03.stdout
=====================================
@@ -0,0 +1,8 @@
+42
+43
+100
+103
+1
+2
+0
+3
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8554fb654da80874f87c25ef908320e45f679310
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8554fb654da80874f87c25ef908320e45f679310
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/20240516/ae5eac11/attachment-0001.html>
More information about the ghc-commits
mailing list