[Git][ghc/ghc][master] Representation-polymorphic HasField (fixes #22156)

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Thu May 16 19:32:43 UTC 2024



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
b84b91f5 by Adam Gundry at 2024-05-16T15:32:06-04: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/b84b91f548ef2b357db4246631b7c285e276098b

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/b84b91f548ef2b357db4246631b7c285e276098b
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/5b104d6d/attachment-0001.html>


More information about the ghc-commits mailing list