Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: 1107af89 by Oleg Grenrus at 2025-08-13T21:08:06-04:00 Allow defining HasField instances for naughty fields Resolves #26295 ... as HasField solver doesn't solve for fields with "naughty" selectors, we could as well allow defining HasField instances for these fields. - - - - - 4 changed files: - compiler/GHC/Tc/Validity.hs - + testsuite/tests/overloadedrecflds/should_run/T26295.hs - + testsuite/tests/overloadedrecflds/should_run/T26295.stdout - testsuite/tests/overloadedrecflds/should_run/all.T Changes: ===================================== compiler/GHC/Tc/Validity.hs ===================================== @@ -31,6 +31,7 @@ import GHC.Tc.Instance.Family import GHC.Tc.Types.Origin import GHC.Tc.Types.Rank import GHC.Tc.Errors.Types +import GHC.Tc.Utils.Env (tcLookupId) import GHC.Tc.Utils.TcType import GHC.Tc.Utils.Monad import GHC.Tc.Zonk.TcType @@ -60,6 +61,8 @@ import qualified GHC.LanguageExtensions as LangExt import GHC.Types.Error import GHC.Types.Basic ( TypeOrKind(..), UnboxedTupleOrSum(..) , unboxedTupleOrSumExtension ) +import GHC.Types.Id (isNaughtyRecordSelector) +import GHC.Types.FieldLabel (flSelector) import GHC.Types.Name import GHC.Types.Var.Env import GHC.Types.Var.Set @@ -1718,8 +1721,17 @@ checkHasFieldInst cls tys@[_k_ty, _r_rep, _a_rep, lbl_ty, r_ty, _a_ty] = | otherwise -> case isStrLitTy lbl_ty of Just lbl | let lbl_str = FieldLabelString lbl - , isJust (lookupTyConFieldLabel lbl_str tc) - -> add_err $ IllegalHasFieldInstanceTyConHasField tc lbl_str + , Just fl <- lookupTyConFieldLabel lbl_str tc + -> do + -- GHC does not provide HasField instances for naughty record selectors + -- (see Note [Naughty record selectors] in GHC.Tc.TyCl.Utils), + -- so don't prevent the user from writing such instances. + -- See GHC.Tc.Instance.Class.matchHasField. + -- Test case: T26295. + sel_id <- tcLookupId $ flSelector fl + if isNaughtyRecordSelector sel_id + then return () + else add_err $ IllegalHasFieldInstanceTyConHasField tc lbl_str | otherwise -> return () Nothing ===================================== testsuite/tests/overloadedrecflds/should_run/T26295.hs ===================================== @@ -0,0 +1,26 @@ +{-# LANGUAGE GHC2021 #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedRecordDot #-} +{-# LANGUAGE UndecidableInstances #-} +import GHC.Records + +-- large-records mangles record definitions to look like below to +-- prevent selector function generation (even implicit ones) +data R = forall a b. (a ~ Int, b ~ Char) => MkR + { field_a :: a + , field_b :: b + } + +-- fields in R are naughty, so we can define custom HasField instancs for them +instance a ~ Int => HasField "field_a" R a where + getField (MkR a _) = a + +ex :: Int +ex = r.field_a + where + r :: R + r = MkR 42 'x' + +main :: IO () +main = print ex ===================================== testsuite/tests/overloadedrecflds/should_run/T26295.stdout ===================================== @@ -0,0 +1 @@ +42 ===================================== testsuite/tests/overloadedrecflds/should_run/all.T ===================================== @@ -20,3 +20,4 @@ test('T12243', normal, compile_and_run, ['']) test('T11228', normal, compile_and_run, ['']) test('T11671_run', normal, compile_and_run, ['']) test('T17551b', [req_th], compile_and_run, ['']) +test('T26295', [], compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1107af899a1222f0d6101dacddca7e6b... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1107af899a1222f0d6101dacddca7e6b... You're receiving this email because of your account on gitlab.haskell.org.