Simon Peyton Jones pushed to branch wip/T27731 at Glasgow Haskell Compiler / GHC
Commits:
-
d2286d58
by Simon Peyton Jones at 2026-09-27T23:43:04+01:00
2 changed files:
Changes:
| ... | ... | @@ -69,7 +69,7 @@ module GHC.Tc.Utils.Monad( |
| 69 | 69 | wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,
|
| 70 | 70 | wrapLocMA_,wrapLocMA,
|
| 71 | 71 | getErrsVar, setErrsVar,
|
| 72 | - addErr,
|
|
| 72 | + addErr, captureMessagesTcM,
|
|
| 73 | 73 | failWith, failAt,
|
| 74 | 74 | addErrAt, addErrs,
|
| 75 | 75 | checkErr, checkErrAt,
|
| ... | ... | @@ -1604,26 +1604,26 @@ tcTryM thing_inside |
| 1604 | 1604 | -- built-in in exception; see IOEnv.failM
|
| 1605 | 1605 | |
| 1606 | 1606 | -----------------------
|
| 1607 | -capture_constraints :: TcM r -> TcM (r, WantedConstraints)
|
|
| 1608 | --- capture_constraints simply captures and returns the
|
|
| 1607 | +captureConstraintsTcM :: TcM r -> TcM (r, WantedConstraints)
|
|
| 1608 | +-- captureConstraintsTcM simply captures and returns the
|
|
| 1609 | 1609 | -- constraints generated by thing_inside
|
| 1610 | 1610 | -- Precondition: thing_inside must not throw an exception!
|
| 1611 | 1611 | -- Reason for precondition: an exception would blow past the place
|
| 1612 | 1612 | -- where we read the lie_var, and we'd lose the constraints altogether
|
| 1613 | -capture_constraints thing_inside
|
|
| 1613 | +captureConstraintsTcM thing_inside
|
|
| 1614 | 1614 | = do { lie_var <- newTcRef emptyWC
|
| 1615 | 1615 | ; res <- updLclEnv (\ env -> env { tcl_lie = lie_var }) $
|
| 1616 | 1616 | thing_inside
|
| 1617 | 1617 | ; lie <- readTcRef lie_var
|
| 1618 | 1618 | ; return (res, lie) }
|
| 1619 | 1619 | |
| 1620 | -capture_messages :: TcM r -> TcM (r, Messages TcRnMessage)
|
|
| 1621 | --- capture_messages simply captures and returns the
|
|
| 1620 | +captureMessagesTcM :: TcM r -> TcM (r, Messages TcRnMessage)
|
|
| 1621 | +-- captureMessagesTcM simply captures and returns the
|
|
| 1622 | 1622 | -- errors and warnings generated by thing_inside
|
| 1623 | 1623 | -- Precondition: thing_inside must not throw an exception!
|
| 1624 | 1624 | -- Reason for precondition: an exception would blow past the place
|
| 1625 | 1625 | -- where we read the msg_var, and we'd lose the constraints altogether
|
| 1626 | -capture_messages thing_inside
|
|
| 1626 | +captureMessagesTcM thing_inside
|
|
| 1627 | 1627 | = do { msg_var <- newTcRef emptyMessages
|
| 1628 | 1628 | ; res <- setErrsVar msg_var thing_inside
|
| 1629 | 1629 | ; msgs <- readTcRef msg_var
|
| ... | ... | @@ -1643,8 +1643,8 @@ capture_messages thing_inside |
| 1643 | 1643 | -- propagate any errors/warnings generated by m
|
| 1644 | 1644 | askErrsFound :: TcRn a -> TcRn (a, Bool)
|
| 1645 | 1645 | askErrsFound thing_inside
|
| 1646 | - = do { ((mb_res, lie), msgs) <- capture_messages $
|
|
| 1647 | - capture_constraints $
|
|
| 1646 | + = do { ((mb_res, lie), msgs) <- captureMessagesTcM $
|
|
| 1647 | + captureConstraintsTcM $
|
|
| 1648 | 1648 | tcTryM thing_inside
|
| 1649 | 1649 | ; addMessages msgs
|
| 1650 | 1650 | |
| ... | ... | @@ -1665,7 +1665,7 @@ tryCaptureConstraints :: TcM a -> TcM (Maybe a, WantedConstraints) |
| 1665 | 1665 | -- it returns Nothing and the /insoluble/ constraints
|
| 1666 | 1666 | -- Error messages are propagated
|
| 1667 | 1667 | tryCaptureConstraints thing_inside
|
| 1668 | - = do { (mb_res, lie) <- capture_constraints $
|
|
| 1668 | + = do { (mb_res, lie) <- captureConstraintsTcM $
|
|
| 1669 | 1669 | tcTryM thing_inside
|
| 1670 | 1670 | |
| 1671 | 1671 | -- See Note [Constraints and errors]
|
| ... | ... | @@ -1794,7 +1794,7 @@ tryTc :: TcRn a -> TcRn (Maybe a, Messages TcRnMessage) |
| 1794 | 1794 | -- It also returns all the errors and warnings accumulated by m
|
| 1795 | 1795 | -- It always succeeds (never raises an exception)
|
| 1796 | 1796 | tryTc thing_inside
|
| 1797 | - = capture_messages (attemptM thing_inside)
|
|
| 1797 | + = captureMessagesTcM (attemptM thing_inside)
|
|
| 1798 | 1798 | |
| 1799 | 1799 | -----------------------
|
| 1800 | 1800 | discardErrs :: TcRn a -> TcRn a
|
| ... | ... | @@ -1827,8 +1827,8 @@ tryTcDiscardingErrs' :: (WantedConstraints -> Messages TcRnMessage -> r -> Bool) |
| 1827 | 1827 | -- otherwise discard everything from 'thing_inside', including errors,
|
| 1828 | 1828 | -- and try 'recover' instead.
|
| 1829 | 1829 | tryTcDiscardingErrs' validate recover_invalid recover_error thing_inside
|
| 1830 | - = do { ((mb_res, lie), msgs) <- capture_messages $
|
|
| 1831 | - capture_constraints $
|
|
| 1830 | + = do { ((mb_res, lie), msgs) <- captureMessagesTcM $
|
|
| 1831 | + captureConstraintsTcM $
|
|
| 1832 | 1832 | tcTryM thing_inside
|
| 1833 | 1833 | ; case mb_res of
|
| 1834 | 1834 | Just res | not (errorsFound msgs)
|
| 1 | - |
|
| 2 | 1 | ClassOperator.hs:14:3: error: [GHC-39999]
|
| 3 | 2 | • Could not deduce ‘a ><> b0’
|
| 4 | 3 | from the context: a ><> b
|
| 5 | 4 | bound by the type signature for:
|
| 6 | - (**>) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 5 | + (<**) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 7 | 6 | at ClassOperator.hs:14:3-44
|
| 8 | 7 | The type variable ‘b0’ is ambiguous
|
| 9 | - • In the ambiguity check for ‘**>’
|
|
| 8 | + • In the ambiguity check for ‘<**’
|
|
| 10 | 9 | To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
|
| 11 | 10 | When checking the class method:
|
| 12 | - (**>) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 11 | + (<**) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 13 | 12 | In the class declaration for ‘><>’
|
| 14 | 13 | |
| 15 | 14 | ClassOperator.hs:14:3: error: [GHC-39999]
|
| 16 | 15 | • Could not deduce ‘a ><> b0’
|
| 17 | 16 | from the context: a ><> b
|
| 18 | 17 | bound by the type signature for:
|
| 19 | - (**<) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 18 | + (>**) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 20 | 19 | at ClassOperator.hs:14:3-44
|
| 21 | 20 | The type variable ‘b0’ is ambiguous
|
| 22 | - • In the ambiguity check for ‘**<’
|
|
| 21 | + • In the ambiguity check for ‘>**’
|
|
| 23 | 22 | To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
|
| 24 | 23 | When checking the class method:
|
| 25 | - (**<) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 24 | + (>**) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 26 | 25 | In the class declaration for ‘><>’
|
| 27 | 26 | |
| 28 | 27 | ClassOperator.hs:14:3: error: [GHC-39999]
|
| 29 | 28 | • Could not deduce ‘a ><> b0’
|
| 30 | 29 | from the context: a ><> b
|
| 31 | 30 | bound by the type signature for:
|
| 32 | - (>**) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 31 | + (**<) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 33 | 32 | at ClassOperator.hs:14:3-44
|
| 34 | 33 | The type variable ‘b0’ is ambiguous
|
| 35 | - • In the ambiguity check for ‘>**’
|
|
| 34 | + • In the ambiguity check for ‘**<’
|
|
| 36 | 35 | To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
|
| 37 | 36 | When checking the class method:
|
| 38 | - (>**) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 37 | + (**<) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 39 | 38 | In the class declaration for ‘><>’
|
| 40 | 39 | |
| 41 | 40 | ClassOperator.hs:14:3: error: [GHC-39999]
|
| 42 | 41 | • Could not deduce ‘a ><> b0’
|
| 43 | 42 | from the context: a ><> b
|
| 44 | 43 | bound by the type signature for:
|
| 45 | - (<**) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 44 | + (**>) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 46 | 45 | at ClassOperator.hs:14:3-44
|
| 47 | 46 | The type variable ‘b0’ is ambiguous
|
| 48 | - • In the ambiguity check for ‘<**’
|
|
| 47 | + • In the ambiguity check for ‘**>’
|
|
| 49 | 48 | To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
|
| 50 | 49 | When checking the class method:
|
| 51 | - (<**) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 50 | + (**>) :: forall a b. (a ><> b) => a -> a -> ()
|
|
| 52 | 51 | In the class declaration for ‘><>’
|
| 52 | + |