[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: In TcSShortCut, typechecker plugins should get empty Givens

Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2860a9a5 by Simon Peyton Jones at 2025-08-07T20:29:18-04: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! - - - - - 2a5a3d24 by sterni at 2025-08-08T10:52:08-04:00 hadrian: enable terminfo if --with-curses-* flags are given The GHC make build system used to support WITH_TERMINFO in ghc.mk which allowed controlling whether to build GHC with terminfo or not. hadrian has replaced this with a system where this is effectively controlled by the cross-compiling setting (the default WITH_TERMINFO value was bassed on CrossCompiling, iirc). This behavior is undesireable in some cases and there is not really a good way to work around it. Especially for downstream packagers, modifying this via UserSettings is not really feasible since such a source file has to be kept in sync with Settings/Default.hs manually since it can't import Settings.Default or any predefined Flavour definitions. To avoid having to add a new setting to cfg/system.config and/or a new configure flag (though I'm happy to implement both if required), I've chosen to take --with-curses-* being set explicitly as an indication that the user wants to have terminfo enabled. This would work for Nixpkgs which sets these flags [1] as well as haskell.nix [2] (which goes to some extreme measures [3] [4] to force terminfo in all scenarios). In general, I'm an advocate for making the GHC build be the same for native and cross insofar it is possible since it makes packaging GHC and Haskell related things while still supporting cross much less compilicated. A more minimal GHC with reduced dependencies should probably be a specific flavor, not the default. Partially addresses #26288 by forcing terminfo to be built if the user explicitly passes configure flags related to it. However, it isn't built by default when cross-compiling yet nor is there an explicit way to control the package being built. [1]: https://github.com/NixOS/nixpkgs/blob/3a7266fcefcb9ce353df49ba3f292d06443760... [2]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa4... [3]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa4... [4]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa4... - - - - - 8a29fee7 by David Feuer at 2025-08-08T10:52:09-04:00 Add default QuasiQuoters Add `defaultQuasiQuoter` and `namedDefaultQuasiQuoter` to make it easier to write `QuasiQuoters` that give helpful error messages when they're used in inappropriate contexts. Closes #24434. - - - - - 9 changed files: - compiler/GHC/Tc/Solver/Dict.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Solver/Solve.hs - hadrian/src/Settings/Default.hs - hadrian/src/Settings/Packages.hs - libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs - libraries/template-haskell/Language/Haskell/TH/Quote.hs - libraries/template-haskell/changelog.md - testsuite/tests/interface-stability/template-haskell-exports.stdout 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,7 +897,9 @@ 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] +-- | The mode for the constraint solving monad. +-- +-- See Note [TcSMode], where each constructor is documented data TcSMode = TcSVanilla -- ^ Normal constraint solving | TcSPMCheck -- ^ Used when doing patterm match overlap checks @@ -905,6 +907,12 @@ data TcSMode | 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,19 +1671,28 @@ 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 - - do { given <- getInertGivens - ; wanted <- TcS.zonkSimples simples1 -- Plugin requires zonked inputs - - ; traceTcS "Running plugins (" (vcat [ text "Given:" <+> ppr given - , text "Wanted:" <+> ppr wanted ]) - ; p <- runTcPluginSolvers solvers (given, bagToList wanted) + ; if null solvers then return (False, wanted) else + + 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 + + -- Plugin requires zonked input wanteds + ; zonked_wanted <- TcS.zonkSimples wanted + + ; traceTcS "Running plugins {" (vcat [ text "Given:" <+> ppr given + , text "Wanted:" <+> ppr zonked_wanted ]) + ; p <- runTcPluginSolvers solvers (given, bagToList zonked_wanted) ; let (_, solved_wanted) = pluginSolvedCts p (_, unsolved_wanted) = pluginInputCts p new_wanted = pluginNewCts 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) ===================================== hadrian/src/Settings/Default.hs ===================================== @@ -80,6 +80,7 @@ stageBootPackages = return stage0Packages :: Action [Package] stage0Packages = do cross <- flag CrossCompiling + haveCurses <- any (/= "") <$> traverse setting [ CursesIncludeDir, CursesLibDir ] return $ [ cabalSyntax , cabal , compiler @@ -116,8 +117,8 @@ stage0Packages = do -- that confused Hadrian, so we must make those a stage0 package as well. -- Once we drop `Win32`/`unix` it should be possible to drop those too. ] - ++ [ terminfo | not windowsHost, not cross ] - ++ [ timeout | windowsHost ] + ++ [ terminfo | not windowsHost, (not cross || haveCurses) ] + ++ [ timeout | windowsHost ] -- | Packages built in 'Stage1' by default. You can change this in "UserSettings". stage1Packages :: Action [Package] ===================================== hadrian/src/Settings/Packages.hs ===================================== @@ -24,6 +24,7 @@ packageArgs = do -- immediately and may lead to cyclic dependencies. -- See: https://gitlab.haskell.org/ghc/ghc/issues/16809. cross = flag CrossCompiling + haveCurses = any (/= "") <$> traverse setting [ CursesIncludeDir, CursesLibDir ] -- Check if the bootstrap compiler has the same version as the one we -- are building. This is used to build cross-compilers @@ -85,7 +86,7 @@ packageArgs = do -- backends at the moment, so we might as well disable it -- for cross GHC. [ andM [expr (ghcWithInterpreter stage), notCross] `cabalFlag` "internal-interpreter" - , notM cross `cabalFlag` "terminfo" + , orM [ notM cross, haveCurses ] `cabalFlag` "terminfo" , arg "-build-tool-depends" , flag UseLibzstd `cabalFlag` "with-libzstd" -- ROMES: While the boot compiler is not updated wrt -this-unit-id @@ -120,7 +121,7 @@ packageArgs = do -------------------------------- ghcPkg -------------------------------- , package ghcPkg ? - builder (Cabal Flags) ? notM cross `cabalFlag` "terminfo" + builder (Cabal Flags) ? orM [ notM cross, haveCurses ] `cabalFlag` "terminfo" -------------------------------- ghcBoot ------------------------------ , package ghcBoot ? @@ -202,10 +203,10 @@ packageArgs = do , package haskeline ? builder (Cabal Flags) ? arg "-examples" -- Don't depend upon terminfo when cross-compiling to avoid unnecessary - -- dependencies. - -- TODO: Perhaps the user should rather be responsible for this? + -- dependencies unless the user provided ncurses explicitly. + -- TODO: Perhaps the user should be able to explicitly enable/disable this. , package haskeline ? - builder (Cabal Flags) ? notM cross `cabalFlag` "terminfo" + builder (Cabal Flags) ? orM [ notM cross, haveCurses ] `cabalFlag` "terminfo" -------------------------------- terminfo ------------------------------ , package terminfo ? ===================================== libraries/ghc-internal/src/GHC/Internal/TH/Quote.hs ===================================== @@ -26,10 +26,10 @@ import GHC.Internal.Base hiding (Type) -- | The 'QuasiQuoter' type, a value @q@ of this type can be used -- in the syntax @[q| ... string to parse ...|]@. In fact, for -- convenience, a 'QuasiQuoter' actually defines multiple quasiquoters --- to be used in different splice contexts; if you are only interested --- in defining a quasiquoter to be used for expressions, you would --- define a 'QuasiQuoter' with only 'quoteExp', and leave the other --- fields stubbed out with errors. +-- to be used in different splice contexts. In the usual case of a +-- @QuasiQuoter@ that is only intended to be used in certain splice +-- contexts, the unused fields should just 'fail'. This is most easily +-- accomplished using 'namedefaultQuasiQuoter' or 'defaultQuasiQuoter'. data QuasiQuoter = QuasiQuoter { -- | Quasi-quoter for expressions, invoked by quotes like @lhs = $[q|...]@ quoteExp :: String -> Q Exp, ===================================== libraries/template-haskell/Language/Haskell/TH/Quote.hs ===================================== @@ -16,6 +16,8 @@ that is up to you. module Language.Haskell.TH.Quote ( QuasiQuoter(..) , quoteFile + , namedDefaultQuasiQuoter + , defaultQuasiQuoter -- * For backwards compatibility ,dataToQa, dataToExpQ, dataToPatQ ) where @@ -39,3 +41,54 @@ quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp, quoteType = qt, quoteDec get old_quoter file_name = do { file_cts <- runIO (readFile file_name) ; addDependentFile file_name ; old_quoter file_cts } + +-- | A 'QuasiQuoter' that fails with a helpful error message in every +-- context. It is intended to be modified to create a 'QuasiQuoter' that +-- fails in all inappropriate contexts. +-- +-- For example, you could write +-- +-- @ +-- myPatQQ = (namedDefaultQuasiQuoter "myPatQQ") +-- { quotePat = ... } +-- @ +-- +-- If 'myPatQQ' is used in an expression context, the compiler will report +-- that, naming 'myPatQQ'. +-- +-- See also 'defaultQuasiQuoter', which does not name the 'QuasiQuoter' in +-- the error message, and might therefore be more appropriate when +-- the users of a particular 'QuasiQuoter' tend to define local \"synonyms\" +-- for it. +namedDefaultQuasiQuoter :: String -> QuasiQuoter +namedDefaultQuasiQuoter name = QuasiQuoter + { quoteExp = f "use in expression contexts." + , quotePat = f "use in pattern contexts." + , quoteType = f "use in types." + , quoteDec = f "creating declarations." + } + where + f m _ = fail $ "The " ++ name ++ " quasiquoter is not for " ++ m + +-- | A 'QuasiQuoter' that fails with a helpful error message in every +-- context. It is intended to be modified to create a 'QuasiQuoter' that +-- fails in all inappropriate contexts. +-- +-- For example, you could write +-- +-- @ +-- myExpressionQQ = defaultQuasiQuoter +-- { quoteExp = ... } +-- @ +-- +-- See also 'namedDefaultQuasiQuoter', which names the 'QuasiQuoter' in the +-- error messages. +defaultQuasiQuoter :: QuasiQuoter +defaultQuasiQuoter = QuasiQuoter + { quoteExp = f "use in expression contexts." + , quotePat = f "use in pattern contexts." + , quoteType = f "use in types." + , quoteDec = f "creating declarations." + } + where + f m _ = fail $ "This quasiquoter is not for " ++ m ===================================== libraries/template-haskell/changelog.md ===================================== @@ -1,5 +1,8 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.25.0.0 + * Introduce `namedDefaultQuasiQuoter` and `defaultQuasiQuoter`, which fail with a helpful error when used in an inappropriate context. + ## 2.24.0.0 * Introduce `dataToCodeQ` and `liftDataTyped`, typed variants of `dataToExpQ` and `liftData` respectively. ===================================== testsuite/tests/interface-stability/template-haskell-exports.stdout ===================================== @@ -1370,6 +1370,8 @@ module Language.Haskell.TH.Quote where dataToExpQ :: forall (m :: * -> *) a. (GHC.Internal.TH.Syntax.Quote m, GHC.Internal.Data.Data.Data a) => (forall b. GHC.Internal.Data.Data.Data b => b -> GHC.Internal.Maybe.Maybe (m GHC.Internal.TH.Syntax.Exp)) -> a -> m GHC.Internal.TH.Syntax.Exp dataToPatQ :: forall (m :: * -> *) a. (GHC.Internal.TH.Syntax.Quote m, GHC.Internal.Data.Data.Data a) => (forall b. GHC.Internal.Data.Data.Data b => b -> GHC.Internal.Maybe.Maybe (m GHC.Internal.TH.Syntax.Pat)) -> a -> m GHC.Internal.TH.Syntax.Pat dataToQa :: forall (m :: * -> *) a k q. (GHC.Internal.TH.Syntax.Quote m, GHC.Internal.Data.Data.Data a) => (GHC.Internal.TH.Syntax.Name -> k) -> (GHC.Internal.TH.Syntax.Lit -> m q) -> (k -> [m q] -> m q) -> (forall b. GHC.Internal.Data.Data.Data b => b -> GHC.Internal.Maybe.Maybe (m q)) -> a -> m q + defaultQuasiQuoter :: QuasiQuoter + namedDefaultQuasiQuoter :: GHC.Internal.Base.String -> QuasiQuoter quoteFile :: QuasiQuoter -> QuasiQuoter module Language.Haskell.TH.Syntax where @@ -1720,8 +1722,8 @@ module Language.Haskell.TH.Syntax where qAddForeignFilePath :: ForeignSrcLang -> GHC.Internal.Base.String -> m () qAddModFinalizer :: Q () -> m () qAddCorePlugin :: GHC.Internal.Base.String -> m () - qGetQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => m (GHC.Internal.Maybe.Maybe a) - qPutQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> m () + qGetQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => m (GHC.Internal.Maybe.Maybe a) + qPutQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> m () qIsExtEnabled :: Extension -> m GHC.Internal.Types.Bool qExtsEnabled :: m [Extension] qPutDoc :: DocLoc -> GHC.Internal.Base.String -> m () @@ -1802,7 +1804,7 @@ module Language.Haskell.TH.Syntax where falseName :: Name getDoc :: DocLoc -> Q (GHC.Internal.Maybe.Maybe GHC.Internal.Base.String) getPackageRoot :: Q GHC.Internal.IO.FilePath - getQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => Q (GHC.Internal.Maybe.Maybe a) + getQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => Q (GHC.Internal.Maybe.Maybe a) get_cons_names :: Con -> [Name] hoistCode :: forall (m :: * -> *) (n :: * -> *) (r :: GHC.Internal.Types.RuntimeRep) (a :: TYPE r). GHC.Internal.Base.Monad m => (forall x. m x -> n x) -> Code m a -> Code n a isExtEnabled :: Extension -> Q GHC.Internal.Types.Bool @@ -1849,7 +1851,7 @@ module Language.Haskell.TH.Syntax where oneName :: Name pkgString :: PkgName -> GHC.Internal.Base.String putDoc :: DocLoc -> GHC.Internal.Base.String -> Q () - putQ :: forall a. ghc-internal-9.1300.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> Q () + putQ :: forall a. ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable a => a -> Q () recover :: forall a. Q a -> Q a -> Q a reify :: Name -> Q Info reifyAnnotations :: forall a. GHC.Internal.Data.Data.Data a => AnnLookup -> Q [a] View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7cf0aa9857b27696367e0cc3cf1b40... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/c7cf0aa9857b27696367e0cc3cf1b40... You're receiving this email because of your account on gitlab.haskell.org.