Simon Peyton Jones pushed to branch wip/T26258 at Glasgow Haskell Compiler / GHC
Commits:
1f9e4f54 by Stephen Morgan at 2025-08-03T15:14:08+10:00
refactor: Modify Data.List.sortOn to use (>) instead of compare. (#26184)
This lets a more efficient (>) operation be used if one exists.
This is technically a breaking change for malformed Ord instances, where
x > y is not equivalent to compare x y == GT.
Discussed by the CLC in issue #332: https://github.com/haskell/core-libraries-committee/issues/332
- - - - -
4f6bc9cf by fendor at 2025-08-04T17:50:06-04:00
Revert "base: Expose Backtraces constructor and fields"
This reverts commit 17db44c5b32fff82ea988fa4f1a233d1a27bdf57.
- - - - -
00ce1eb9 by Simon Peyton Jones at 2025-08-05T10:32:34+01:00
In TcSShortCut, typechecker plugins should get empty Givens
Solving in TcShortCut mode means /ignoring the Givens/. So we
should not pass them to typechecker plugins!
Fixes #26258.
This is a fixup to the earlier MR:
commit 1bd12371feacc52394a0e660ef9349f9e8ee1c06
Author: Simon Peyton Jones
Date: Mon Jul 21 10:04:49 2025 +0100
Improve treatment of SPECIALISE pragmas -- again!
- - - - -
11 changed files:
- compiler/GHC/Tc/Solver/Dict.hs
- compiler/GHC/Tc/Solver/Monad.hs
- compiler/GHC/Tc/Solver/Solve.hs
- libraries/base/changelog.md
- libraries/base/src/Control/Exception/Backtrace.hs
- libraries/base/src/Data/List/NonEmpty.hs
- libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
- testsuite/tests/interface-stability/base-exports.stdout
- testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
- testsuite/tests/interface-stability/base-exports.stdout-mingw32
- testsuite/tests/interface-stability/base-exports.stdout-ws-32
Changes:
=====================================
compiler/GHC/Tc/Solver/Dict.hs
=====================================
@@ -496,11 +496,15 @@ We could use the Eq [a] superclass of the Ord [a], or we could use the top-level
instance `Eq a => Eq [a]`. But if we did the latter we'd be stuck with an
insoluble constraint (Eq a).
-So the ShortCutSolving rule is this:
+-----------------------------------
+So the ShortCutSolving plan is this:
If we could solve a constraint from a local Given,
- try first to /completely/ solve the constraint using only top-level instances.
+ try first to /completely/ solve the constraint
+ using only top-level instances,
+ /without/ using any local Givens.
- If that succeeds, use it
- If not, use the local Given
+-----------------------------------
An example that succeeds:
@@ -555,7 +559,7 @@ The moving parts are relatively simple:
- `matchLocalInst`, which would otherwise consult Given quantified constraints
- `GHC.Tc.Solver.Instance.Class.matchInstEnv`: when short-cut solving, don't
pick overlappable top-level instances
-
+ - `GHC.Tc.Solver.Solve.runTcPluginsWanted`: don't pass any Givens to the plugin
Some wrinkles:
=====================================
compiler/GHC/Tc/Solver/Monad.hs
=====================================
@@ -897,14 +897,19 @@ for it, so TcS carries a mutable location where the binding can be
added. This is initialised from the innermost implication constraint.
-}
--- | See Note [TcSMode]
-data TcSMode
+data TcSMode -- | See Note [TcSMode], where each constructor is documented
= TcSVanilla -- ^ Normal constraint solving
| TcSPMCheck -- ^ Used when doing patterm match overlap checks
| TcSEarlyAbort -- ^ Abort early on insoluble constraints
| TcSShortCut -- ^ Fully solve all constraints, without using local Givens
deriving (Eq)
+instance Outputable TcSMode where
+ ppr TcSVanilla = text "TcSVanilla"
+ ppr TcSPMCheck = text "TcSPMCheck"
+ ppr TcSEarlyAbort = text "TcSEarlyAbort"
+ ppr TcSShortCut = text "TcSShortcut"
+
{- Note [TcSMode]
~~~~~~~~~~~~~~~~~
The constraint solver can operate in different modes:
=====================================
compiler/GHC/Tc/Solver/Solve.hs
=====================================
@@ -1011,9 +1011,17 @@ solveSimpleGivens givens
solveSimpleWanteds :: Cts -> TcS Cts
-- The result is not necessarily zonked
solveSimpleWanteds simples
- = do { traceTcS "solveSimpleWanteds {" (ppr simples)
+ = do { mode <- getTcSMode
; dflags <- getDynFlags
+ ; inerts <- getInertSet
+
+ ; traceTcS "solveSimpleWanteds {" $
+ vcat [ text "Mode:" <+> ppr mode
+ , text "Inerts:" <+> ppr inerts
+ , text "Wanteds to solve:" <+> ppr simples ]
+
; (n,wc) <- go 1 (solverIterations dflags) simples
+
; traceTcS "solveSimpleWanteds end }" $
vcat [ text "iterations =" <+> ppr n
, text "residual =" <+> ppr wc ]
@@ -1663,17 +1671,26 @@ runTcPluginsGiven
-- 'solveSimpleWanteds' should feed the updated wanteds back into the
-- main solver.
runTcPluginsWanted :: Cts -> TcS (Bool, Cts)
-runTcPluginsWanted simples1
- | isEmptyBag simples1
- = return (False, simples1)
+runTcPluginsWanted wanted
+ | isEmptyBag wanted
+ = return (False, wanted)
| otherwise
= do { solvers <- getTcPluginSolvers
- ; if null solvers then return (False, simples1) else
+ ; if null solvers then return (False, wanted) else
- do { given <- getInertGivens
- ; wanted <- TcS.zonkSimples simples1 -- Plugin requires zonked inputs
+ do { -- Find the set of Givens to give to the plugin.
+ -- If TcSMode = TcSShortCut, we are solving with
+ -- no Givens so don't return any (#26258)!
+ -- See Note [Shortcut solving] in GHC.Tc.Solver.Dict
+ mode <- getTcSMode
+ ; given <- case mode of
+ TcSShortCut -> return []
+ _ -> getInertGivens
- ; traceTcS "Running plugins (" (vcat [ text "Given:" <+> ppr given
+ -- Plugin requires zonked input wanteds
+ ; zonked_wanted <- TcS.zonkSimples wanted
+
+ ; traceTcS "Running plugins {" (vcat [ text "Given:" <+> ppr given
, text "Wanted:" <+> ppr wanted ])
; p <- runTcPluginSolvers solvers (given, bagToList wanted)
; let (_, solved_wanted) = pluginSolvedCts p
@@ -1684,9 +1701,6 @@ runTcPluginsWanted simples1
listToBag unsolved_wanted `andCts`
listToBag insols
--- SLPJ: I'm deeply suspicious of this
--- ; updInertCans (removeInertCts $ solved_givens)
-
; mapM_ setEv solved_wanted
; traceTcS "Finished plugins }" (ppr new_wanted)
=====================================
libraries/base/changelog.md
=====================================
@@ -3,6 +3,7 @@
## 4.23.0.0 *TBA*
* Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337))
* Fix issues with toRational for types capable to represent infinite and not-a-number values ([CLC proposal #338](https://github.com/haskell/core-libraries-committee/issues/338))
+ * Modify the implementation of `Data.List.sortOn` to use `(>)` instead of `compare`. ([CLC proposal #332](https://github.com/haskell/core-libraries-committee/issues/332))
## 4.22.0.0 *TBA*
* Shipped with GHC 9.14.1
@@ -29,7 +30,6 @@
* `GHC.TypeNats.Internal`
* `GHC.ExecutionStack.Internal`.
* Deprecate `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329)
- * Expose constructor and field of `Backtraces` from `Control.Exception.Backtrace`, as per [CLC #199](https://github.com/haskell/core-libraries-committee/issues/199#issuecomment-...)
* Fix incorrect results of `integerPowMod` when the base is 0 and the exponent is negative, and `integerRecipMod` when the modulus is zero ([#26017](https://gitlab.haskell.org/ghc/ghc/-/issues/26017)).
* Fix the rewrite rule for `scanl'` not being strict in the first element of the output list ([#26143](https://gitlab.haskell.org/ghc/ghc/-/issues/26143)).
=====================================
libraries/base/src/Control/Exception/Backtrace.hs
=====================================
@@ -51,7 +51,7 @@ module Control.Exception.Backtrace
, getBacktraceMechanismState
, setBacktraceMechanismState
-- * Collecting backtraces
- , Backtraces(..)
+ , Backtraces
, displayBacktraces
, collectBacktraces
) where
=====================================
libraries/base/src/Data/List/NonEmpty.hs
=====================================
@@ -268,6 +268,9 @@ sort = lift List.sort
-- >>> (sortBy . comparing) fst $ (3, 1) :| [(2, 2), (1, 3)]
-- (1,3) :| [(2,2),(3,1)]
--
+-- However, 'sortOn' may still be faster for instances with a more efficient
+-- implementation of '(>)' than 'compare'.
+--
-- 'sortWith' is an alias for `sortBy . comparing`.
--
-- @since 4.20.0.0
=====================================
libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
=====================================
@@ -216,7 +216,6 @@ module GHC.Internal.Data.OldList
import GHC.Internal.Data.Maybe
import GHC.Internal.Data.Bits ( (.&.) )
import GHC.Internal.Unicode ( isSpace )
-import GHC.Internal.Data.Ord ( comparing )
import GHC.Internal.Data.Tuple ( fst, snd )
import GHC.Internal.Num
@@ -1862,10 +1861,13 @@ rqpart cmp x (y:ys) rle rgt r =
-- >>> (sortBy . comparing) fst [(3, 1), (2, 2), (1, 3)]
-- [(1,3),(2,2),(3,1)]
--
+-- However, 'sortOn' may still be faster for instances with a more efficient
+-- implementation of '(>)' than 'compare'.
+--
-- @since base-4.8.0.0
sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn f =
- map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))
+ map snd . actualSort (\x y -> fst x > fst y) . map (\x -> let y = f x in y `seq` (y, x))
-- | Construct a list from a single element.
--
=====================================
testsuite/tests/interface-stability/base-exports.stdout
=====================================
@@ -323,7 +323,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
+ data Backtraces = ...
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-javascript-unknown-ghcjs
=====================================
@@ -323,7 +323,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
+ data Backtraces = ...
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-mingw32
=====================================
@@ -323,7 +323,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
+ data Backtraces = ...
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
=====================================
testsuite/tests/interface-stability/base-exports.stdout-ws-32
=====================================
@@ -323,7 +323,7 @@ module Control.Exception.Backtrace where
type BacktraceMechanism :: *
data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
type Backtraces :: *
- data Backtraces = Backtraces {btrCostCentre :: GHC.Internal.Maybe.Maybe (GHC.Internal.Ptr.Ptr GHC.Internal.Stack.CCS.CostCentreStack), btrHasCallStack :: GHC.Internal.Maybe.Maybe GHC.Internal.Stack.Types.CallStack, btrExecutionStack :: GHC.Internal.Maybe.Maybe [GHC.Internal.ExecutionStack.Internal.Location], btrIpe :: GHC.Internal.Maybe.Maybe [GHC.Internal.Stack.CloneStack.StackEntry]}
+ data Backtraces = ...
collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
displayBacktraces :: Backtraces -> GHC.Internal.Base.String
getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e087f4adcb22a3b83cd64276c74f252...
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e087f4adcb22a3b83cd64276c74f252...
You're receiving this email because of your account on gitlab.haskell.org.