Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC Commits: 2157db2d by sterni at 2025-08-08T15:32:39-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... - - - - - b3c31488 by David Feuer at 2025-08-08T15:33:21-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. - - - - - 129c9fa1 by Sylvain Henry at 2025-08-10T16:40:21-04:00 Handle non-fractional CmmFloats in Cmm's CBE (#26229) Since f8d9d016305be355f518c141f6c6d4826f2de9a2, toRational for Float and Double converts float's infinity and NaN into Rational's infinity and NaN (respectively 1%0 and 0%0). Cmm CommonBlockEliminator hashing function needs to take these values into account as they can appear as literals now. See added testcase. - - - - - 593cb612 by J. Ryan Stinnett at 2025-08-10T16:40:24-04:00 Fix extensions list in `DoAndIfThenElse` docs - - - - - 464c54b8 by J. Ryan Stinnett at 2025-08-10T16:40:24-04:00 Document status of `RelaxedPolyRec` extension This adds a brief extension page explaining the status of the `RelaxedPolyRec` extension. The behaviour of this mode is already explained elsewhere, so this page is mainly for completeness so that various lists of extensions have somewhere to point to for this flag. Fixes #18630 - - - - - 14 changed files: - compiler/GHC/Cmm/CommonBlockElim.hs - docs/users_guide/conf.py - docs/users_guide/expected-undocumented-flags.txt - docs/users_guide/exts/doandifthenelse.rst - + docs/users_guide/exts/relaxed_poly_rec.rst - docs/users_guide/exts/types.rst - 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 - + testsuite/tests/numeric/should_compile/T26229.hs - testsuite/tests/numeric/should_compile/all.T Changes: ===================================== compiler/GHC/Cmm/CommonBlockElim.hs ===================================== @@ -29,6 +29,7 @@ import GHC.Utils.Word64 (truncateWord64ToWord32) import Control.Arrow (first, second) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE +import GHC.Real (infinity,notANumber) -- ----------------------------------------------------------------------------- -- Eliminate common blocks @@ -167,7 +168,12 @@ hash_block block = hash_lit :: CmmLit -> Word32 hash_lit (CmmInt i _) = fromInteger i - hash_lit (CmmFloat r _) = truncate r + hash_lit (CmmFloat r _) + -- handle these special cases as `truncate` fails on non-fractional numbers (#26229) + | r == infinity = 9999999 + | r == -infinity = 9999998 + | r == notANumber = 6666666 + | otherwise = truncate r hash_lit (CmmVec ls) = hash_list hash_lit ls hash_lit (CmmLabel _) = 119 -- ugh hash_lit (CmmLabelOff _ i) = cvt $ 199 + i ===================================== docs/users_guide/conf.py ===================================== @@ -35,8 +35,6 @@ nitpick_ignore = [ ("envvar", "TMPDIR"), ("c:type", "bool"), - - ("extension", "RelaxedPolyRec"), ] rst_prolog = """ ===================================== docs/users_guide/expected-undocumented-flags.txt ===================================== @@ -14,7 +14,6 @@ -XPolymorphicComponents -XRecordPuns -XRelaxedLayout --XRelaxedPolyRec -copy-libs-when-linking -dannot-lint -dppr-ticks ===================================== docs/users_guide/exts/doandifthenelse.rst ===================================== @@ -8,7 +8,7 @@ Do And If Then Else :since: 7.0.1 - :status: Included in :extension:`Haskell2010` + :status: Included in :extension:`GHC2024`, :extension:`GHC2021`, :extension:`Haskell2010` Allow semicolons in ``if`` expressions. ===================================== docs/users_guide/exts/relaxed_poly_rec.rst ===================================== @@ -0,0 +1,17 @@ +.. _relaxed-poly-rec: + +Generalised typing of mutually recursive bindings +------------------------------------------------- + +.. extension:: RelaxedPolyRec + :shortdesc: Generalised typing of mutually recursive bindings. + + :since: 6.8.1 + + :status: Included in :extension:`GHC2024`, :extension:`GHC2021`, :extension:`Haskell2010` + +See :ref:`infelicities-recursive-groups` for a description of this extension. +This is a long-standing GHC extension. Around the time of GHC 7.6.3, this +extension became required as part of a typechecker refactoring. +The ``-XRelaxedPolyRec`` flag is now deprecated (since the feature is always +enabled) and may be removed at some future time. ===================================== docs/users_guide/exts/types.rst ===================================== @@ -30,3 +30,4 @@ Types type_errors defer_type_errors roles + relaxed_poly_rec ===================================== 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] ===================================== testsuite/tests/numeric/should_compile/T26229.hs ===================================== @@ -0,0 +1,12 @@ +{-# LANGUAGE NegativeLiterals #-} + +module T26229 where + +sqrte2pqiq :: (Floating a, Ord a) => a -> a -> a +sqrte2pqiq e qiq -- = sqrt (e*e + qiq) + | e < - 1.5097698010472593e153 = -(qiq/e) - e + | e < 5.582399551122541e57 = sqrt (e*e + qiq) -- test Infinity# + | e < -5.582399551122541e57 = -sqrt (e*e + qiq) -- test -Infinity# + | otherwise = (qiq/e) + e +{-# SPECIALIZE sqrte2pqiq :: Double -> Double -> Double #-} +{-# SPECIALIZE sqrte2pqiq :: Float -> Float -> Float #-} ===================================== testsuite/tests/numeric/should_compile/all.T ===================================== @@ -22,3 +22,4 @@ test('T15547', normal, compile, ['-ddump-simpl -O -dsuppress-all -dno-typeable-b test('T23019', normal, compile, ['-O']) test('T23907', [ when(wordsize(32), expect_broken(23908))], compile, ['-ddump-simpl -O2 -dsuppress-all -dno-typeable-binds -dsuppress-uniques']) test('T24331', normal, compile, ['-O -ddump-simpl -dsuppress-all -dsuppress-uniques -dno-typeable-binds']) +test('T26229', normal, compile, ['-O2']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a29fee78a3a81fe7b447ac12f8e660... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8a29fee78a3a81fe7b447ac12f8e660... You're receiving this email because of your account on gitlab.haskell.org.