Simon Peyton Jones pushed to branch wip/T26258 at Glasgow Haskell Compiler / GHC

Commits:

11 changed files:

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
    496 496 
     instance `Eq a => Eq [a]`.   But if we did the latter we'd be stuck with an
    497 497 
     insoluble constraint (Eq a).
    498 498
    499 
    -So the ShortCutSolving rule is this:
    499 
    +-----------------------------------
    500 
    +So the ShortCutSolving plan is this:
    500 501 
        If we could solve a constraint from a local Given,
    501 
    -   try first to /completely/ solve the constraint using only top-level instances.
    502 
    +       try first to /completely/ solve the constraint
    503 
    +       using only top-level instances,
    504 
    +       /without/ using any local Givens.
    502 505 
        - If that succeeds, use it
    503 506 
        - If not, use the local Given
    507 
    +-----------------------------------
    504 508
    505 509 
     An example that succeeds:
    506 510
    ... ... @@ -555,7 +559,7 @@ The moving parts are relatively simple:
    555 559 
       - `matchLocalInst`, which would otherwise consult Given quantified constraints
    556 560 
       - `GHC.Tc.Solver.Instance.Class.matchInstEnv`: when short-cut solving, don't
    557 561 
         pick overlappable top-level instances
    558 
    -
    562 
    +  - `GHC.Tc.Solver.Solve.runTcPluginsWanted`: don't pass any Givens to the plugin
    559 563
    560 564 
     Some wrinkles:
    561 565

  • compiler/GHC/Tc/Solver/Monad.hs
    ... ... @@ -897,14 +897,19 @@ for it, so TcS carries a mutable location where the binding can be
    897 897 
     added.  This is initialised from the innermost implication constraint.
    898 898 
     -}
    899 899
    900 
    --- | See Note [TcSMode]
    901 
    -data TcSMode
    900 
    +data TcSMode -- | See Note [TcSMode], where each constructor is documented
    902 901 
       = TcSVanilla    -- ^ Normal constraint solving
    903 902 
       | TcSPMCheck    -- ^ Used when doing patterm match overlap checks
    904 903 
       | TcSEarlyAbort -- ^ Abort early on insoluble constraints
    905 904 
       | TcSShortCut   -- ^ Fully solve all constraints, without using local Givens
    906 905 
       deriving (Eq)
    907 906
    907 
    +instance Outputable TcSMode where
    908 
    +  ppr TcSVanilla    = text "TcSVanilla"
    909 
    +  ppr TcSPMCheck    = text "TcSPMCheck"
    910 
    +  ppr TcSEarlyAbort = text "TcSEarlyAbort"
    911 
    +  ppr TcSShortCut   = text "TcSShortcut"
    912 
    +
    908 913 
     {- Note [TcSMode]
    909 914 
     ~~~~~~~~~~~~~~~~~
    910 915 
     The constraint solver can operate in different modes:

  • compiler/GHC/Tc/Solver/Solve.hs
    ... ... @@ -1011,9 +1011,17 @@ solveSimpleGivens givens
    1011 1011 
     solveSimpleWanteds :: Cts -> TcS Cts
    1012 1012 
     -- The result is not necessarily zonked
    1013 1013 
     solveSimpleWanteds simples
    1014 
    -  = do { traceTcS "solveSimpleWanteds {" (ppr simples)
    1014 
    +  = do { mode   <- getTcSMode
    1015 1015 
            ; dflags <- getDynFlags
    1016 
    +       ; inerts <- getInertSet
    1017 
    +
    1018 
    +       ; traceTcS "solveSimpleWanteds {" $
    1019 
    +         vcat [ text "Mode:" <+> ppr mode
    1020 
    +              , text "Inerts:" <+> ppr inerts
    1021 
    +              , text "Wanteds to solve:" <+> ppr simples ]
    1022 
    +
    1016 1023 
            ; (n,wc) <- go 1 (solverIterations dflags) simples
    1024 
    +
    1017 1025 
            ; traceTcS "solveSimpleWanteds end }" $
    1018 1026 
                  vcat [ text "iterations =" <+> ppr n
    1019 1027 
                       , text "residual =" <+> ppr wc ]
    ... ... @@ -1663,17 +1671,26 @@ runTcPluginsGiven
    1663 1671 
     -- 'solveSimpleWanteds' should feed the updated wanteds back into the
    1664 1672 
     -- main solver.
    1665 1673 
     runTcPluginsWanted :: Cts -> TcS (Bool, Cts)
    1666 
    -runTcPluginsWanted simples1
    1667 
    -  | isEmptyBag simples1
    1668 
    -  = return (False, simples1)
    1674 
    +runTcPluginsWanted wanted
    1675 
    +  | isEmptyBag wanted
    1676 
    +  = return (False, wanted)
    1669 1677 
       | otherwise
    1670 1678 
       = do { solvers <- getTcPluginSolvers
    1671 
    -       ; if null solvers then return (False, simples1) else
    1679 
    +       ; if null solvers then return (False, wanted) else
    1672 1680
    1673 
    -    do { given <- getInertGivens
    1674 
    -       ; wanted <- TcS.zonkSimples simples1    -- Plugin requires zonked inputs
    1681 
    +    do { -- Find the set of Givens to give to the plugin.
    1682 
    +         -- If TcSMode = TcSShortCut, we are solving with
    1683 
    +         -- no Givens so don't return any (#26258)!
    1684 
    +         -- See Note [Shortcut solving] in GHC.Tc.Solver.Dict
    1685 
    +         mode <- getTcSMode
    1686 
    +       ; given <- case mode of
    1687 
    +                     TcSShortCut -> return []
    1688 
    +                     _           -> getInertGivens
    1675 1689
    1676 
    -       ; traceTcS "Running plugins (" (vcat [ text "Given:" <+> ppr given
    1690 
    +         -- Plugin requires zonked input wanteds
    1691 
    +       ; zonked_wanted <- TcS.zonkSimples wanted
    1692 
    +
    1693 
    +       ; traceTcS "Running plugins {" (vcat [ text "Given:" <+> ppr given
    1677 1694 
                                                 , text "Wanted:" <+> ppr wanted ])
    1678 1695 
            ; p <- runTcPluginSolvers solvers (given, bagToList wanted)
    1679 1696 
            ; let (_, solved_wanted)   = pluginSolvedCts p
    ... ... @@ -1684,9 +1701,6 @@ runTcPluginsWanted simples1
    1684 1701 
                                   listToBag unsolved_wanted  `andCts`
    1685 1702 
                                   listToBag insols
    1686 1703
    1687 
    --- SLPJ: I'm deeply suspicious of this
    1688 
    ---       ; updInertCans (removeInertCts $ solved_givens)
    1689 
    -
    1690 1704 
            ; mapM_ setEv solved_wanted
    1691 1705
    1692 1706 
            ; traceTcS "Finished plugins }" (ppr new_wanted)

  • libraries/base/changelog.md
    ... ... @@ -3,6 +3,7 @@
    3 3 
     ## 4.23.0.0 *TBA*
    4 4 
       * Add `Data.List.NonEmpty.mapMaybe`. ([CLC proposal #337](https://github.com/haskell/core-libraries-committee/issues/337))
    5 5 
       * 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))
    6 
    +  * Modify the implementation of `Data.List.sortOn` to use `(>)` instead of `compare`. ([CLC proposal #332](https://github.com/haskell/core-libraries-committee/issues/332))
    6 7
    7 8 
     ## 4.22.0.0 *TBA*
    8 9 
       * Shipped with GHC 9.14.1
    ... ... @@ -29,7 +30,6 @@
    29 30 
           * `GHC.TypeNats.Internal`
    30 31 
           * `GHC.ExecutionStack.Internal`.
    31 32 
       * Deprecate `GHC.JS.Prim.Internal.Build`, as per [CLC #329](https://github.com/haskell/core-libraries-committee/issues/329)
    32 
    -  * Expose constructor and field of `Backtraces` from `Control.Exception.Backtrace`, as per [CLC #199](https://github.com/haskell/core-libraries-committee/issues/199#issuecomment-1954662391)
    33 33
    34 34 
       * 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)).
    35 35 
       * 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
    51 51 
         , getBacktraceMechanismState
    52 52 
         , setBacktraceMechanismState
    53 53 
           -- * Collecting backtraces
    54 
    -    , Backtraces(..)
    54 
    +    , Backtraces
    55 55 
         , displayBacktraces
    56 56 
         , collectBacktraces
    57 57 
         ) where

  • libraries/base/src/Data/List/NonEmpty.hs
    ... ... @@ -268,6 +268,9 @@ sort = lift List.sort
    268 268 
     -- >>> (sortBy . comparing) fst $ (3, 1) :| [(2, 2), (1, 3)]
    269 269 
     -- (1,3) :| [(2,2),(3,1)]
    270 270 
     --
    271 
    +-- However, 'sortOn' may still be faster for instances with a more efficient
    272 
    +-- implementation of '(>)' than 'compare'.
    273 
    +--
    271 274 
     -- 'sortWith' is an alias for `sortBy . comparing`.
    272 275 
     --
    273 276 
     -- @since 4.20.0.0

  • libraries/ghc-internal/src/GHC/Internal/Data/OldList.hs
    ... ... @@ -216,7 +216,6 @@ module GHC.Internal.Data.OldList
    216 216 
     import GHC.Internal.Data.Maybe
    217 217 
     import GHC.Internal.Data.Bits        ( (.&.) )
    218 218 
     import GHC.Internal.Unicode      ( isSpace )
    219 
    -import GHC.Internal.Data.Ord         ( comparing )
    220 219 
     import GHC.Internal.Data.Tuple       ( fst, snd )
    221 220
    222 221 
     import GHC.Internal.Num
    ... ... @@ -1862,10 +1861,13 @@ rqpart cmp x (y:ys) rle rgt r =
    1862 1861 
     -- >>> (sortBy . comparing) fst [(3, 1), (2, 2), (1, 3)]
    1863 1862 
     -- [(1,3),(2,2),(3,1)]
    1864 1863 
     --
    1864 
    +-- However, 'sortOn' may still be faster for instances with a more efficient
    1865 
    +-- implementation of '(>)' than 'compare'.
    1866 
    +--
    1865 1867 
     -- @since base-4.8.0.0
    1866 1868 
     sortOn :: Ord b => (a -> b) -> [a] -> [a]
    1867 1869 
     sortOn f =
    1868 
    -  map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))
    1870 
    +  map snd . actualSort (\x y -> fst x > fst y) . map (\x -> let y = f x in y `seq` (y, x))
    1869 1871
    1870 1872 
     -- | Construct a list from a single element.
    1871 1873 
     --

  • testsuite/tests/interface-stability/base-exports.stdout
    ... ... @@ -323,7 +323,7 @@ module Control.Exception.Backtrace where
    323 323 
       type BacktraceMechanism :: *
    324 324 
       data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
    325 325 
       type Backtraces :: *
    326 
    -  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]}
    326 
    +  data Backtraces = ...
    327 327 
       collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
    328 328 
       displayBacktraces :: Backtraces -> GHC.Internal.Base.String
    329 329 
       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
    323 323 
       type BacktraceMechanism :: *
    324 324 
       data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
    325 325 
       type Backtraces :: *
    326 
    -  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]}
    326 
    +  data Backtraces = ...
    327 327 
       collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
    328 328 
       displayBacktraces :: Backtraces -> GHC.Internal.Base.String
    329 329 
       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
    323 323 
       type BacktraceMechanism :: *
    324 324 
       data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
    325 325 
       type Backtraces :: *
    326 
    -  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]}
    326 
    +  data Backtraces = ...
    327 327 
       collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
    328 328 
       displayBacktraces :: Backtraces -> GHC.Internal.Base.String
    329 329 
       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
    323 323 
       type BacktraceMechanism :: *
    324 324 
       data BacktraceMechanism = CostCentreBacktrace | HasCallStackBacktrace | ExecutionBacktrace | IPEBacktrace
    325 325 
       type Backtraces :: *
    326 
    -  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]}
    326 
    +  data Backtraces = ...
    327 327 
       collectBacktraces :: (?callStack::GHC.Internal.Stack.Types.CallStack) => GHC.Internal.Types.IO Backtraces
    328 328 
       displayBacktraces :: Backtraces -> GHC.Internal.Base.String
    329 329 
       getBacktraceMechanismState :: BacktraceMechanism -> GHC.Internal.Types.IO GHC.Internal.Types.Bool

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help