Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 744f5ea2 by Apoorv Ingle at 2025-12-22T11:40:39-06:00 some minor things - - - - - 9e0ddc42 by Apoorv Ingle at 2026-01-09T12:09:25+01:00 enable NB for custom, user written HasField constraint errors - - - - - 7 changed files: - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Utils/Monad.hs - testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr - testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr Changes: ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -81,6 +81,8 @@ import qualified GHC.Data.Strict as Strict import Language.Haskell.Syntax.Basic (FieldLabelString(..)) +import Language.Haskell.Syntax (HsExpr (RecordUpd, HsGetField, HsProjection)) +import GHC.Hs.Expr (SrcCodeOrigin(..)) import Control.Monad ( unless, when, foldM, forM_ ) import Data.Bifunctor ( bimap ) @@ -2685,6 +2687,10 @@ isHasFieldOrigin = \case RecordUpdOrigin {} -> True RecordFieldProjectionOrigin {} -> True GetFieldOrigin {} -> True + ExpansionOrigin (OrigExpr e) + | HsGetField{} <- e -> True + | RecordUpd{} <- e -> True + | HsProjection{} <- e -> True _ -> False ----------------------- ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -958,7 +958,7 @@ addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside , ppr arg , ppr arg_no]) ; setSrcSpanA arg_loc $ - mkNthFunArgErrCtxt app_head arg arg_no $ + addNthFunArgErrCtxt app_head arg arg_no $ thing_inside } | otherwise @@ -971,8 +971,8 @@ addArgCtxt arg_no (app_head, app_head_lspan) (L arg_loc arg) thing_inside thing_inside } where - mkNthFunArgErrCtxt :: HsExpr GhcRn -> HsExpr GhcRn -> Int -> TcM a -> TcM a - mkNthFunArgErrCtxt app_head arg arg_no thing_inside + addNthFunArgErrCtxt :: HsExpr GhcRn -> HsExpr GhcRn -> Int -> TcM a -> TcM a + addNthFunArgErrCtxt app_head arg arg_no thing_inside | XExpr (ExpandedThingRn o _) <- arg = addExpansionErrCtxt o (FunAppCtxt (FunAppCtxtExpr app_head arg) arg_no) $ thing_inside ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -765,7 +765,7 @@ tcXExpr :: XXExprGhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) tcXExpr (ExpandedThingRn o e) res_ty = mkExpandedTc o <$> -- necessary for hpc ticks -- Need to call tcExpr and not tcApp - -- as e can be let statements which tcApp cannot gracefully handle + -- as e can be let statement which tcApp cannot gracefully handle tcExpr e res_ty -- For record selection, same as HsVar case ===================================== compiler/GHC/Tc/Utils/Monad.hs ===================================== @@ -1079,7 +1079,7 @@ setSrcSpan :: SrcSpan -> TcRn a -> TcRn a setSrcSpan (RealSrcSpan loc _) thing_inside = updLclCtxt (\env -> env { tcl_loc = loc }) thing_inside -setSrcSpan (UnhelpfulSpan _) thing_inside +setSrcSpan loc thing_inside = thing_inside getSrcCodeOrigin :: TcRn (Maybe SrcCodeOrigin) ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr ===================================== @@ -1,9 +1,15 @@ RecordDotSyntaxFail10.hs:40:11: error: [GHC-39999] • No instance for ‘HasField "quux" Quux String’ + arising from a record update NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class. • In the second argument of ‘($)’, namely ‘a {foo.bar.baz.quux}’ - In a stmt of a 'do' block: print $ a {foo.bar.baz.quux} In the expression: - do let a = Foo {foo = ...} - let quux = "Expecto patronum!" - print $ a {foo.bar.baz.quux} + do let a = Foo {foo = ...} + let quux = "Expecto patronum!" + print $ a {foo.bar.baz.quux} + In an equation for ‘main’: + main + = do let a = ... + let quux = "Expecto patronum!" + print $ a {foo.bar.baz.quux} + ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail13.stderr ===================================== @@ -3,8 +3,11 @@ RecordDotSyntaxFail13.hs:26:11: error: [GHC-39999] arising from a record update NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class. • In the second argument of ‘($)’, namely ‘a {foo}’ - In a stmt of a 'do' block: print $ a {foo} In the expression: do let a = Foo {foo = 12} print $ a {foo} + In an equation for ‘main’: + main + = do let a = ... + print $ a {foo} ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail8.stderr ===================================== @@ -3,7 +3,6 @@ RecordDotSyntaxFail8.hs:47:17: error: [GHC-39999] arising from selecting the field ‘quux1’ NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class. • In the second argument of ‘($)’, namely ‘....bar.baz.quux1’ - In a stmt of a 'do' block: print @Quux $ ....baz.quux1 In the expression: do let a = Foo {foo = ...} print @Quux $ ....quux1 @@ -11,13 +10,19 @@ RecordDotSyntaxFail8.hs:47:17: error: [GHC-39999] print @Quux $ b.quux2 let c = Foo {foo = ...} ... + In an equation for ‘main’: + main + = do let a = ... + print @Quux $ ....quux1 + let b = myQuux + print @Quux $ b.quux2 + ... RecordDotSyntaxFail8.hs:50:17: error: [GHC-39999] • No instance for ‘HasField "quux2" Quux Quux’ arising from selecting the field ‘quux2’ NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class. • In the second argument of ‘($)’, namely ‘b.quux2’ - In a stmt of a 'do' block: print @Quux $ b.quux2 In the expression: do let a = Foo {foo = ...} print @Quux $ ....quux1 @@ -25,12 +30,31 @@ RecordDotSyntaxFail8.hs:50:17: error: [GHC-39999] print @Quux $ b.quux2 let c = Foo {foo = ...} ... + In an equation for ‘main’: + main + = do let a = ... + print @Quux $ ....quux1 + let b = myQuux + print @Quux $ b.quux2 + ... RecordDotSyntaxFail8.hs:53:17: error: [GHC-39999] - • No instance for ‘HasField "quux3" Quux r0’ + • No instance for ‘HasField "quux3" Quux a0’ arising from selecting the field ‘quux3’ NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class. • In the expression: ....bar.baz.quux3 - In the second argument of ‘($)’, namely ‘....baz.quux3.wob’ - In a stmt of a 'do' block: print @Bool $ ....quux3.wob + In the expression: + do let a = Foo {foo = ...} + print @Quux $ ....quux1 + let b = myQuux + print @Quux $ b.quux2 + let c = Foo {foo = ...} + ... + In an equation for ‘main’: + main + = do let a = ... + print @Quux $ ....quux1 + let b = myQuux + print @Quux $ b.quux2 + ... View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40a3603f392fb50b057dc07ba56a4e1... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/40a3603f392fb50b057dc07ba56a4e1... You're receiving this email because of your account on gitlab.haskell.org.