GitLab

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/3a7266fcefcb9ce353df49ba3f292d06443760bb/pkgs/development/compilers/ghc/common-hadrian.nix#L513-L515
[2]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa4f74d2cc85700042b/compiler/ghc/default.nix#L185
[3]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa4f74d2cc85700042b/compiler/ghc/default.nix#L678-L682
[4]: https://github.com/input-output-hk/haskell.nix/blob/6eaafcdf04bab7be745d1aa4f74d2cc85700042b/compiler/ghc/default.nix#L772-L773

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

 +.. _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

  # 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

 +{-# 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'])