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
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:
| ... | ... | @@ -1522,12 +1522,12 @@ expandRecordUpd record_expr possible_parents rbnds res_ty |
| 1522 | 1522 | generatedSrcSpan
|
| 1523 | 1523 | in (genVarPat fld_nm, genLHsVar fld_nm)
|
| 1524 | 1524 | |
| 1525 | - -- STEP 2 (b): expand to HsCase, as per note [Record Updates]
|
|
| 1525 | + -- STEP 2 (b): expand to HsCase, as per Note [Record Updates]
|
|
| 1526 | 1526 | ; let ds_expr :: HsExpr GhcRn
|
| 1527 | 1527 | ds_expr = HsLet noExtField let_binds (wrapGenSpan case_expr)
|
| 1528 | 1528 | |
| 1529 | 1529 | case_expr :: HsExpr GhcRn
|
| 1530 | - case_expr = HsCase RecUpd record_expr
|
|
| 1530 | + case_expr = HsCase RecUpd (wrapGenSpan (unLoc record_expr))
|
|
| 1531 | 1531 | $ mkMatchGroup (Generated OtherExpansion DoPmc) (wrapGenSpan matches)
|
| 1532 | 1532 | matches :: [LMatch GhcRn (LHsExpr GhcRn)]
|
| 1533 | 1533 | matches = map make_pat (NE.toList relevant_cons)
|
| ... | ... | @@ -212,8 +212,11 @@ setLclEnvSrcCodeOrigin ec = modifyLclCtxt (setLclCtxtSrcCodeOrigin ec) |
| 212 | 212 | -- See Note [ErrCtxtStack Manipulation]
|
| 213 | 213 | setLclCtxtSrcCodeOrigin :: ErrCtxt -> TcLclCtxt -> TcLclCtxt
|
| 214 | 214 | setLclCtxtSrcCodeOrigin ec lclCtxt
|
| 215 | - | MkErrCtxt (ExpansionCodeCtxt _) _ : ecs <- tcl_err_ctxt lclCtxt
|
|
| 216 | - , MkErrCtxt (ExpansionCodeCtxt _) _ <- ec
|
|
| 215 | + | MkErrCtxt (ExpansionCodeCtxt{}) _ : ecs <- tcl_err_ctxt lclCtxt
|
|
| 216 | + , MkErrCtxt (ExpansionCodeCtxt OrigExpr{}) _ <- ec
|
|
| 217 | + = lclCtxt { tcl_err_ctxt = ec : ecs }
|
|
| 218 | + | MkErrCtxt (ExpansionCodeCtxt{}) _ : ecs <- tcl_err_ctxt lclCtxt
|
|
| 219 | + , MkErrCtxt (ExpansionCodeCtxt{}) _ <- ec
|
|
| 217 | 220 | = lclCtxt { tcl_err_ctxt = ec : ecs }
|
| 218 | 221 | | otherwise
|
| 219 | 222 | = lclCtxt { tcl_err_ctxt = ec : tcl_err_ctxt lclCtxt }
|
| ... | ... | @@ -4,13 +4,9 @@ RecordDotSyntaxFail10.hs:40:11: error: [GHC-39999] |
| 4 | 4 | NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class.
|
| 5 | 5 | Insoluble functional dependencies wrt top-level instances
|
| 6 | 6 | • In the second argument of ‘($)’, namely ‘a {foo.bar.baz.quux}’
|
| 7 | + In a stmt of a 'do' block: print $ a {foo.bar.baz.quux}
|
|
| 7 | 8 | In the expression:
|
| 8 | 9 | do let a = Foo {foo = ...}
|
| 9 | 10 | let quux = "Expecto patronum!"
|
| 10 | 11 | print $ a {foo.bar.baz.quux}
|
| 11 | - In an equation for ‘main’:
|
|
| 12 | - main
|
|
| 13 | - = do let a = ...
|
|
| 14 | - let quux = "Expecto patronum!"
|
|
| 15 | - print $ a {foo.bar.baz.quux}
|
|
| 16 | 12 |
| ... | ... | @@ -4,11 +4,8 @@ RecordDotSyntaxFail13.hs:26:11: error: [GHC-39999] |
| 4 | 4 | NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class.
|
| 5 | 5 | Insoluble functional dependencies wrt top-level instances
|
| 6 | 6 | • In the second argument of ‘($)’, namely ‘a {foo}’
|
| 7 | + In a stmt of a 'do' block: print $ a {foo}
|
|
| 7 | 8 | In the expression:
|
| 8 | 9 | do let a = Foo {foo = 12}
|
| 9 | 10 | print $ a {foo}
|
| 10 | - In an equation for ‘main’:
|
|
| 11 | - main
|
|
| 12 | - = do let a = ...
|
|
| 13 | - print $ a {foo}
|
|
| 14 | 11 |
| ... | ... | @@ -3,6 +3,7 @@ RecordDotSyntaxFail8.hs:47:17: error: [GHC-39999] |
| 3 | 3 | arising from selecting the field ‘quux1’
|
| 4 | 4 | NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class.
|
| 5 | 5 | • In the second argument of ‘($)’, namely ‘....bar.baz.quux1’
|
| 6 | + In a stmt of a 'do' block: print @Quux $ ....baz.quux1
|
|
| 6 | 7 | In the expression:
|
| 7 | 8 | do let a = Foo {foo = ...}
|
| 8 | 9 | print @Quux $ ....quux1
|
| ... | ... | @@ -10,19 +11,13 @@ RecordDotSyntaxFail8.hs:47:17: error: [GHC-39999] |
| 10 | 11 | print @Quux $ b.quux2
|
| 11 | 12 | let c = Foo {foo = ...}
|
| 12 | 13 | ...
|
| 13 | - In an equation for ‘main’:
|
|
| 14 | - main
|
|
| 15 | - = do let a = ...
|
|
| 16 | - print @Quux $ ....quux1
|
|
| 17 | - let b = myQuux
|
|
| 18 | - print @Quux $ b.quux2
|
|
| 19 | - ...
|
|
| 20 | 14 | |
| 21 | 15 | RecordDotSyntaxFail8.hs:50:17: error: [GHC-39999]
|
| 22 | 16 | • No instance for ‘HasField "quux2" Quux Quux’
|
| 23 | 17 | arising from selecting the field ‘quux2’
|
| 24 | 18 | NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class.
|
| 25 | 19 | • In the second argument of ‘($)’, namely ‘b.quux2’
|
| 20 | + In a stmt of a 'do' block: print @Quux $ b.quux2
|
|
| 26 | 21 | In the expression:
|
| 27 | 22 | do let a = Foo {foo = ...}
|
| 28 | 23 | print @Quux $ ....quux1
|
| ... | ... | @@ -30,31 +25,12 @@ RecordDotSyntaxFail8.hs:50:17: error: [GHC-39999] |
| 30 | 25 | print @Quux $ b.quux2
|
| 31 | 26 | let c = Foo {foo = ...}
|
| 32 | 27 | ...
|
| 33 | - In an equation for ‘main’:
|
|
| 34 | - main
|
|
| 35 | - = do let a = ...
|
|
| 36 | - print @Quux $ ....quux1
|
|
| 37 | - let b = myQuux
|
|
| 38 | - print @Quux $ b.quux2
|
|
| 39 | - ...
|
|
| 40 | 28 | |
| 41 | 29 | RecordDotSyntaxFail8.hs:53:17: error: [GHC-39999]
|
| 42 | 30 | • No instance for ‘HasField "quux3" Quux a0’
|
| 43 | 31 | arising from selecting the field ‘quux3’
|
| 44 | 32 | NB: ‘HasField’ is not the built-in ‘GHC.Internal.Records.HasField’ class.
|
| 45 | 33 | • In the expression: ....bar.baz.quux3
|
| 46 | - In the expression:
|
|
| 47 | - do let a = Foo {foo = ...}
|
|
| 48 | - print @Quux $ ....quux1
|
|
| 49 | - let b = myQuux
|
|
| 50 | - print @Quux $ b.quux2
|
|
| 51 | - let c = Foo {foo = ...}
|
|
| 52 | - ...
|
|
| 53 | - In an equation for ‘main’:
|
|
| 54 | - main
|
|
| 55 | - = do let a = ...
|
|
| 56 | - print @Quux $ ....quux1
|
|
| 57 | - let b = myQuux
|
|
| 58 | - print @Quux $ b.quux2
|
|
| 59 | - ...
|
|
| 34 | + In the second argument of ‘($)’, namely ‘....baz.quux3.wob’
|
|
| 35 | + In a stmt of a 'do' block: print @Bool $ ....quux3.wob
|
|
| 60 | 36 |