Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: 05158af4 by Apoorv Ingle at 2026-01-19T11:08:34-06:00 do not overwrite err ctxt head when we add err ctxt due to expanded exprs `(XExpr (OrigStmt{})` fixes RecordDotSyntaxFail test cases where a record is updated within a do statement - - - - - 5 changed files: - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Types/LclEnv.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/Gen/Expr.hs ===================================== @@ -1522,12 +1522,12 @@ expandRecordUpd record_expr possible_parents rbnds res_ty generatedSrcSpan in (genVarPat fld_nm, genLHsVar fld_nm) - -- STEP 2 (b): expand to HsCase, as per note [Record Updates] + -- STEP 2 (b): expand to HsCase, as per Note [Record Updates] ; let ds_expr :: HsExpr GhcRn ds_expr = HsLet noExtField let_binds (wrapGenSpan case_expr) case_expr :: HsExpr GhcRn - case_expr = HsCase RecUpd record_expr + case_expr = HsCase RecUpd (wrapGenSpan (unLoc record_expr)) $ mkMatchGroup (Generated OtherExpansion DoPmc) (wrapGenSpan matches) matches :: [LMatch GhcRn (LHsExpr GhcRn)] matches = map make_pat (NE.toList relevant_cons) ===================================== compiler/GHC/Tc/Types/LclEnv.hs ===================================== @@ -212,8 +212,11 @@ setLclEnvSrcCodeOrigin ec = modifyLclCtxt (setLclCtxtSrcCodeOrigin ec) -- See Note [ErrCtxtStack Manipulation] setLclCtxtSrcCodeOrigin :: ErrCtxt -> TcLclCtxt -> TcLclCtxt setLclCtxtSrcCodeOrigin ec lclCtxt - | MkErrCtxt (ExpansionCodeCtxt _) _ : ecs <- tcl_err_ctxt lclCtxt - , MkErrCtxt (ExpansionCodeCtxt _) _ <- ec + | MkErrCtxt (ExpansionCodeCtxt{}) _ : ecs <- tcl_err_ctxt lclCtxt + , MkErrCtxt (ExpansionCodeCtxt OrigExpr{}) _ <- ec + = lclCtxt { tcl_err_ctxt = ec : ecs } + | MkErrCtxt (ExpansionCodeCtxt{}) _ : ecs <- tcl_err_ctxt lclCtxt + , MkErrCtxt (ExpansionCodeCtxt{}) _ <- ec = lclCtxt { tcl_err_ctxt = ec : ecs } | otherwise = lclCtxt { tcl_err_ctxt = ec : tcl_err_ctxt lclCtxt } ===================================== testsuite/tests/parser/should_fail/RecordDotSyntaxFail10.stderr ===================================== @@ -4,13 +4,9 @@ RecordDotSyntaxFail10.hs:40:11: error: [GHC-39999] NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class. Insoluble functional dependencies wrt top-level instances • 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} - 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 ===================================== @@ -4,11 +4,8 @@ RecordDotSyntaxFail13.hs:26:11: error: [GHC-39999] NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class. Insoluble functional dependencies wrt top-level instances • 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,6 +3,7 @@ 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 @@ -10,19 +11,13 @@ 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 @@ -30,31 +25,12 @@ 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 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 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 - ... + In the second argument of ‘($)’, namely ‘....baz.quux3.wob’ + In a stmt of a 'do' block: print @Bool $ ....quux3.wob View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/05158af44f23fcc04b43a607533b299a... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/05158af44f23fcc04b43a607533b299a... You're receiving this email because of your account on gitlab.haskell.org.