[Git][ghc/ghc][master] 3 commits: ghc-bignum: copy backend interface haddocks to Native backend (#27305)
by Marge Bot (@marge-bot) 29 May '26
by Marge Bot (@marge-bot) 29 May '26
29 May '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
1fc21753 by Sylvain Henry at 2026-05-29T13:18:14-04:00
ghc-bignum: copy backend interface haddocks to Native backend (#27305)
The haddock comments documenting the BigNat backend interface (function
contracts, expected MutableWordArray# sizes, return-value semantics, etc.)
were attached to the FFI backend module. Copy them to the Native backend
so they remain in tree once the FFI backend is removed.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com>
- - - - -
717059df by Sylvain Henry at 2026-05-29T13:18:14-04:00
ghc-bignum: remove FFI backend (#27305)
The FFI backend of ghc-bignum (now part of ghc-internal) had no known
users and is easy to recreate by relinking ghc-internal with a custom
backend. Remove the backend module, the bignum-ffi cabal flag, and the
ffi option from Hadrian's --bignum selector. The backend interface
documentation now lives in the Native backend module.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com>
- - - - -
4bb3b1d8 by Sylvain Henry at 2026-05-29T13:18:14-04:00
ghc-bignum: remove Check backend (#27305)
The Check backend of ghc-bignum (now part of ghc-internal) compared the
selected backend's output against the Native backend for validation.
It had no known users. Remove the backend module, the bignum-check
cabal flag, the bignumCheck Hadrian flavour field, and the check-
prefix in Hadrian's --bignum selector.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com>
- - - - -
18 changed files:
- + changelog.d/remove-bignum-check-backend
- + changelog.d/remove-bignum-ffi-backend
- hadrian/README.md
- hadrian/doc/user-settings.md
- hadrian/src/CommandLine.hs
- hadrian/src/Flavour/Type.hs
- hadrian/src/Settings.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Packages.hs
- libraries/ghc-bignum/ghc-bignum.cabal
- libraries/ghc-internal/bignum-backend.rst
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Bignum/Backend.hs
- − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Check.hs
- − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/FFI.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs
- − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Selected.hs
Changes:
=====================================
changelog.d/remove-bignum-check-backend
=====================================
@@ -0,0 +1,11 @@
+section: packaging
+synopsis: Remove the Check backend of ghc-bignum
+issues: #27305
+mrs: !16106
+
+description: {
+ The Check backend of ghc-bignum (now part of ghc-internal), which compared
+ the results of the selected backend against the Native backend, has been
+ removed along with the ``bignum-check`` cabal flag and the ``check-``
+ prefix in Hadrian's ``--bignum`` option.
+}
=====================================
changelog.d/remove-bignum-ffi-backend
=====================================
@@ -0,0 +1,12 @@
+section: packaging
+synopsis: Remove the FFI backend of ghc-bignum
+issues: #27305
+mrs: !16106
+
+description: {
+ The FFI backend of ghc-bignum (now part of ghc-internal) has been removed.
+ It had no known users and was easy to recreate by relinking ghc-internal
+ with a custom backend implementation. As a result, the ``bignum-ffi``
+ cabal flag has been dropped, and selecting the ``ffi`` backend via
+ Hadrian's ``--bignum`` option is no longer supported.
+}
=====================================
hadrian/README.md
=====================================
@@ -101,7 +101,7 @@ Stage2 GHC.
* `--skip-depends`: skips rebuilding Haskell module dependency files.
-* `--bignum={native,gmp,check-gmp,ffi}`: **Deprecated.** Use the `+native_bignum` flavour
+* `--bignum={native,gmp}`: **Deprecated.** Use the `+native_bignum` flavour
transformer instead (e.g. `--flavour=default+native_bignum`). When building for the
JavaScript target, the native bignum backend is enabled automatically.
=====================================
hadrian/doc/user-settings.md
=====================================
@@ -24,10 +24,8 @@ data Flavour = Flavour {
extraArgs :: Args,
-- | Build these packages.
packages :: Stage -> Action [Package],
- -- | Bignum backend: 'native', 'gmp', 'ffi', etc.
+ -- | Bignum backend: 'native', 'gmp', etc.
bignumBackend :: String,
- -- | Check selected bignum backend against native backend
- bignumCheck :: Bool,
-- | Build the @text@ package with @simdutf@ support. Disabled by
-- default due to packaging difficulties described in #20724.
textWithSIMDUTF :: Bool,
=====================================
hadrian/src/CommandLine.hs
=====================================
@@ -1,7 +1,7 @@
module CommandLine (
optDescrs, cmdLineArgsMap, cmdFlavour, lookupFreeze1, lookupFreeze2, lookupSkipDepends,
lookupBignum,
- cmdBignum, cmdBignumCheck, cmdProgressInfo, cmdCompleteSetting,
+ cmdBignum, cmdProgressInfo, cmdCompleteSetting,
cmdDocsArgs, cmdUnitIdHash, lookupBuildRoot, TestArgs(..), TestSpeed(..), defaultTestArgs,
cmdPrefix, cmdChangelogVersion, DocArgs(..), defaultDocArgs,
cmdKeepResponseFiles
@@ -32,7 +32,6 @@ data CommandLineArgs = CommandLineArgs
, skipDepends :: Bool
, unitIdHash :: Bool
, bignum :: Maybe String
- , bignumCheck :: Bool
, progressInfo :: ProgressInfo
, buildRoot :: BuildRoot
, testArgs :: TestArgs
@@ -54,7 +53,6 @@ defaultCommandLineArgs = CommandLineArgs
, skipDepends = False
, unitIdHash = False
, bignum = Nothing
- , bignumCheck = False
, progressInfo = Brief
, buildRoot = BuildRoot "_build"
, testArgs = defaultTestArgs
@@ -132,10 +130,7 @@ readFlavour ms = Right $ \flags -> flags { flavour = lower <$> ms }
readBignum :: Maybe String -> Either String (CommandLineArgs -> CommandLineArgs)
readBignum Nothing = Right id
-readBignum (Just ms) = Right $ \flags -> case break (== '-') (lower ms) of
- (backend,"") -> flags { bignum = Just backend }
- ("check",'-':backend) -> flags { bignum = Just backend, bignumCheck = True }
- _ -> flags { bignum = Just (lower ms) }
+readBignum (Just ms) = Right $ \flags -> flags { bignum = Just (lower ms) }
readBuildRoot :: FilePath -> Either String (CommandLineArgs -> CommandLineArgs)
readBuildRoot ms =
@@ -302,7 +297,7 @@ optDescrs =
, Option [] ["skip-depends"] (NoArg readSkipDepends)
"Skip rebuilding dependency information."
, Option [] ["bignum"] (OptArg readBignum "BACKEND")
- "Select bignum backend: native, gmp (default), check-gmp (gmp compared to native), ffi."
+ "Select bignum backend: native, gmp (default)."
, Option [] ["progress-info"] (ReqArg readProgressInfo "STYLE")
"Progress info style (None, Brief, Normal or Unicorn)."
, Option [] ["docs"] (ReqArg readDocsArg "TARGET")
@@ -429,9 +424,6 @@ cmdUnitIdHash = unitIdHash <$> cmdLineArgs
cmdBignum :: Action (Maybe String)
cmdBignum = bignum <$> cmdLineArgs
-cmdBignumCheck :: Action Bool
-cmdBignumCheck = bignumCheck <$> cmdLineArgs
-
cmdKeepResponseFiles :: Action Bool
cmdKeepResponseFiles = keepResponseFiles <$> cmdLineArgs
=====================================
hadrian/src/Flavour/Type.hs
=====================================
@@ -19,10 +19,8 @@ data Flavour = Flavour {
extraArgs :: Args,
-- | Build these packages.
packages :: Stage -> Action [Package],
- -- | Bignum backend: 'native', 'gmp', 'ffi', etc.
+ -- | Bignum backend: 'native', 'gmp', etc.
bignumBackend :: String,
- -- | Check selected bignum backend against native backend
- bignumCheck :: Bool,
-- | Build the @text@ package with @simdutf@ support. Disabled by
-- default due to packaging difficulties described in #20724.
textWithSIMDUTF :: Bool,
=====================================
hadrian/src/Settings.hs
=====================================
@@ -3,7 +3,7 @@
module Settings (
getExtraArgs, getArgs, getLibraryWays, getRtsWays, flavour, knownPackages,
findPackageByName, unsafeFindPackageByName, unsafeFindPackageByPath,
- isLibrary, stagePackages, getBignumBackend, getBignumCheck, completeSetting,
+ isLibrary, stagePackages, getBignumBackend, completeSetting,
queryBuildTarget, queryHostTarget, queryTargetTarget,
queryBuild, queryHost, queryTarget,
queryArch, queryOS, queryVendor
@@ -46,11 +46,6 @@ getRtsWays = expr flavour >>= rtsWays
getBignumBackend :: Expr String
getBignumBackend = bignumBackend <$> expr flavour
-getBignumCheck :: Expr Bool
-getBignumCheck = expr $ cmdBignum >>= \case
- Nothing -> bignumCheck <$> flavour
- Just _ -> cmdBignumCheck
-
stagePackages :: Stage -> Action [Package]
stagePackages stage = do
f <- flavour
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -241,7 +241,6 @@ runTestBuilderArgs = builder Testsuite ? do
-- MP: TODO, these should be queried from the test compiler?
bignumBackend <- getBignumBackend
- bignumCheck <- getBignumCheck
keepFiles <- expr (testKeepFiles <$> userSetting defaultTestArgs)
@@ -307,7 +306,7 @@ runTestBuilderArgs = builder Testsuite ? do
, arg "-e", arg $ "ghc_compiler_always_flags=" ++ quote ghcFlags
, arg "-e", arg $ asBool "ghc_with_dynamic_rts=" (hasDynamicRts)
, arg "-e", arg $ asBool "config.ghc_with_threaded_rts=" (hasThreadedRts)
- , arg "-e", arg $ asBool "config.have_fast_bignum=" (bignumBackend /= "native" && not bignumCheck)
+ , arg "-e", arg $ asBool "config.have_fast_bignum=" (bignumBackend /= "native")
, arg "-e", arg $ asBool "config.target_has_smp=" targetWithSMP
, arg "-e", arg $ "config.ghc_dynamic=" ++ show hasDynamic
, arg "-e", arg $ "config.leading_underscore=" ++ show leadingUnderscore
=====================================
hadrian/src/Settings/Default.hs
=====================================
@@ -293,7 +293,6 @@ defaultFlavour = Flavour
, extraArgs = defaultExtraArgs
, packages = defaultPackages
, bignumBackend = defaultBignumBackend
- , bignumCheck = False
, textWithSIMDUTF = False
, libraryWays = defaultLibraryWays
, rtsWays = defaultRtsWays
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -240,15 +240,11 @@ ghcInternalArgs = package ghcInternal ? do
includesGmp <- getSetting GmpIncludeDir
backend <- getBignumBackend
- check <- getBignumCheck
mconcat
[ -- select bignum backend
builder (Cabal Flags) ? arg ("bignum-" <> backend)
- , -- check the selected backend against native backend
- builder (Cabal Flags) ? check `cabalFlag` "bignum-check"
-
-- backend specific
, case backend of
"gmp" -> mconcat
=====================================
libraries/ghc-bignum/ghc-bignum.cabal
=====================================
@@ -36,7 +36,7 @@ library
GHC.Internal.Bignum.Primitives as GHC.Num.Primitives
, GHC.Internal.Bignum.WordArray as GHC.Num.WordArray
, GHC.Internal.Bignum.Backend as GHC.Num.Backend
- , GHC.Internal.Bignum.Backend.Selected as GHC.Num.Backend.Selected
+ , GHC.Internal.Bignum.Backend as GHC.Num.Backend.Selected
, GHC.Internal.Bignum.Backend.Native as GHC.Num.Backend.Native
, GHC.Internal.Bignum.BigNat as GHC.Num.BigNat
, GHC.Internal.Bignum.Natural as GHC.Num.Natural
=====================================
libraries/ghc-internal/bignum-backend.rst
=====================================
@@ -33,20 +33,9 @@ supported:
integer-simple package. The major difference is that it uses a much more
efficient memory representation (integer-simple was based on Haskell lists)
and that it allows a lot more code sharing between the different backends than
- was previously possible between integer-gmp and integer-simple.
-
-* FFI: an implementation that relies on external FFI calls. This backend can be
- useful:
-
- * for alternative GHC backends that target non native platforms (JavaScript,
- JVM, etc.): the backend can dynamically match and rewrite the FFI calls in
- order to call the appropriate platform specific BigNum API.
-
- * to test new native backends: just tweak the ghc-bignum build to link with
- the native library providing the implementation of the FFI calls
-
- Note that the FFI backend module contains the description of the interface
- that needs to be implemented by every backend.
+ was previously possible between integer-gmp and integer-simple. The Native
+ backend module contains the description of the interface that needs to be
+ implemented by every backend.
This package has been designed to make the implementation of new backends
relatively easy. Previously you had to implement the whole Integer/Natural
=====================================
libraries/ghc-internal/ghc-internal.cabal.in
=====================================
@@ -56,21 +56,11 @@ Flag bignum-native
Manual: True
Default: False
-Flag bignum-ffi
- Description: Enable FFI bignum backend
- Manual: True
- Default: False
-
Flag bignum-gmp
Description: Enable GMP bignum backend
Manual: True
Default: False
-Flag bignum-check
- Description: Validate results of the enabled backend against native backend.
- Manual: True
- Default: False
-
Flag need-atomic
Description: Enable linking with "atomic" library (for 64-bit atomic ops on armel, #20549)
Manual: True
@@ -382,13 +372,11 @@ Library
-- Bignum configuration
----------------------------------------
-- check that at least one backend is enabled
- if !flag(bignum-native) && !flag(bignum-gmp) && !flag(bignum-ffi)
+ if !flag(bignum-native) && !flag(bignum-gmp)
buildable: False
-- check that at most one flag is set
- if flag(bignum-native) && (flag(bignum-gmp) || flag(bignum-ffi))
- buildable: False
- if flag(bignum-gmp) && flag(bignum-ffi)
+ if flag(bignum-native) && flag(bignum-gmp)
buildable: False
if flag(bignum-gmp)
@@ -398,25 +386,14 @@ Library
c-sources:
cbits/gmp_wrappers.c
- if flag(bignum-ffi)
- cpp-options: -DBIGNUM_FFI
- other-modules:
- GHC.Internal.Bignum.Backend.FFI
-
if flag(bignum-native)
cpp-options: -DBIGNUM_NATIVE
- if flag(bignum-check)
- cpp-options: -DBIGNUM_CHECK
- other-modules:
- GHC.Internal.Bignum.Backend.Check
-
exposed-modules:
GHC.Internal.Bignum.Primitives
GHC.Internal.Bignum.WordArray
GHC.Internal.Bignum.BigNat
GHC.Internal.Bignum.Backend
- GHC.Internal.Bignum.Backend.Selected
GHC.Internal.Bignum.Backend.Native
GHC.Internal.Bignum.Natural
GHC.Internal.Bignum.Integer
=====================================
libraries/ghc-internal/src/GHC/Internal/Bignum/Backend.hs
=====================================
@@ -7,9 +7,12 @@ module GHC.Internal.Bignum.Backend
)
where
-#if defined(BIGNUM_CHECK)
-import GHC.Internal.Bignum.Backend.Check as Backend
+#if defined(BIGNUM_NATIVE)
+import GHC.Internal.Bignum.Backend.Native as Backend
+
+#elif defined(BIGNUM_GMP)
+import GHC.Internal.Bignum.Backend.GMP as Backend
+
#else
-import GHC.Internal.Bignum.Backend.Selected as Backend
+#error Undefined BigNum backend. Use a flag to select it (e.g. gmp, native)`
#endif
-
=====================================
libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Check.hs deleted
=====================================
@@ -1,508 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE GHCForeignImportPrim #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-{-# LANGUAGE NegativeLiterals #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
-{-# OPTIONS_GHC -Wno-name-shadowing #-}
-
--- | Check Native implementation against another backend
-module GHC.Internal.Bignum.Backend.Check where
-
-import GHC.Internal.CString
-import GHC.Internal.Prim
-import GHC.Internal.Types
-import GHC.Internal.Bignum.WordArray
-import GHC.Internal.Bignum.Primitives
-import {-# SOURCE #-} GHC.Internal.Bignum.Integer
-import {-# SOURCE #-} GHC.Internal.Bignum.Natural
-import qualified GHC.Internal.Bignum.Backend.Native as Native
-import qualified GHC.Internal.Bignum.Backend.Selected as Other
-
-#if defined(BIGNUM_NATIVE)
-#error You can't validate Native backend against itself. Choose another backend (e.g. gmp, ffi)
-#endif
-
-default ()
-
--- | ghc-bignum backend name
-backendName :: [Char]
-backendName = unpackAppendCString# "check-"# Other.backendName
- -- we don't have (++) at our disposal, so we directly use
- -- `unpackAppendCString#`
-
-bignat_compare
- :: WordArray#
- -> WordArray#
- -> Int#
-bignat_compare a b =
- let
- gr = Other.bignat_compare a b
- nr = Native.bignat_compare a b
- in case gr ==# nr of
- 0# -> unexpectedValue_Int# (# #)
- _ -> gr
-
-mwaCompare
- :: MutableWordArray# s
- -> MutableWordArray# s
- -> State# s
- -> (# State# s, Bool# #)
-mwaCompare mwa mwb s =
- case mwaSize# mwa s of
- (# s, szA #) -> case mwaSize# mwb s of
- (# s, szB #) -> case szA ==# szB of
- 0# -> (# s, 0# #)
- _ -> let
- go i s
- | isTrue# (i <# 0#) = (# s, 1# #)
- | True =
- case readWordArray# mwa i s of
- (# s, a #) -> case readWordArray# mwb i s of
- (# s, b #) -> case a `eqWord#` b of
- 0# -> (# s, 0# #)
- _ -> go (i -# 1#) s
- in go (szA -# 1#) s
-
-mwaCompareOp
- :: MutableWordArray# s
- -> (MutableWordArray# s -> State# s -> State# s)
- -> (MutableWordArray# s -> State# s -> State# s)
- -> State# s
- -> State# s
-mwaCompareOp mwa f g s =
- case mwaSize# mwa s of { (# s, sz #) ->
- case newWordArray# sz s of { (# s, mwb #) ->
- case f mwa s of { s ->
- case g mwb s of { s ->
- case mwaTrimZeroes# mwa s of { s ->
- case mwaTrimZeroes# mwb s of { s ->
- case mwaCompare mwa mwb s of
- (# s, 0# #) -> case unexpectedValue of
- !_ -> s
- -- see Note [ghc-bignum exceptions] in
- -- GHC.Num.Primitives
- (# s, _ #) -> s
- }}}}}}
-
-mwaCompareOp2
- :: MutableWordArray# s
- -> MutableWordArray# s
- -> (MutableWordArray# s -> MutableWordArray# s -> State# s -> State# s)
- -> (MutableWordArray# s -> MutableWordArray# s -> State# s -> State# s)
- -> State# s
- -> State# s
-mwaCompareOp2 mwa mwb f g s =
- case mwaSize# mwa s of { (# s, szA #) ->
- case mwaSize# mwb s of { (# s, szB #) ->
- case newWordArray# szA s of { (# s, mwa' #) ->
- case newWordArray# szB s of { (# s, mwb' #) ->
- case f mwa mwb s of { s ->
- case g mwa' mwb' s of { s ->
- case mwaTrimZeroes# mwa s of { s ->
- case mwaTrimZeroes# mwb s of { s ->
- case mwaTrimZeroes# mwa' s of { s ->
- case mwaTrimZeroes# mwb' s of { s ->
- case mwaCompare mwa mwa' s of { (# s, ba #) ->
- case mwaCompare mwb mwb' s of { (# s, bb #) ->
- case ba &&# bb of
- 0# -> case unexpectedValue of
- !_ -> s
- -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives
- _ -> s
- }}}}}}}}}}}}
-
-mwaCompareOpBool
- :: MutableWordArray# s
- -> (MutableWordArray# s -> State# s -> (#State# s, Bool# #))
- -> (MutableWordArray# s -> State# s -> (#State# s, Bool# #))
- -> State# s
- -> (# State# s, Bool# #)
-mwaCompareOpBool mwa f g s =
- case mwaSize# mwa s of { (# s, sz #) ->
- case newWordArray# sz s of { (# s, mwb #) ->
- case f mwa s of { (# s, ra #) ->
- case g mwb s of { (# s, rb #) ->
- case ra ==# rb of
- 0# -> case unexpectedValue of
- !_ -> (# s, ra #)
- -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives
- _ -> case ra of -- don't compare MWAs if underflow signaled!
- 0# -> (# s, ra #) -- underflow
- _ -> case mwaTrimZeroes# mwa s of { s ->
- case mwaTrimZeroes# mwb s of { s ->
- case mwaCompare mwa mwb s of
- (# s, 0# #) -> case unexpectedValue of
- !_ -> (# s, ra #)
- -- see Note [ghc-bignum exceptions] in
- -- GHC.Num.Primitives
- _ -> (# s, ra #)
- }}}}}}
-
-mwaCompareOpWord
- :: MutableWordArray# s
- -> (MutableWordArray# s -> State# s -> (#State# s, Word# #))
- -> (MutableWordArray# s -> State# s -> (#State# s, Word# #))
- -> State# s
- -> (# State# s, Word# #)
-mwaCompareOpWord mwa f g s =
- case mwaSize# mwa s of { (# s, sz #) ->
- case newWordArray# sz s of { (# s, mwb #) ->
- case f mwa s of { (# s, ra #) ->
- case g mwb s of { (# s, rb #) ->
- case mwaTrimZeroes# mwa s of { s ->
- case mwaTrimZeroes# mwb s of { s ->
- case mwaCompare mwa mwb s of
- (# s, b #) -> case b &&# (ra `eqWord#` rb) of
- 0# -> case unexpectedValue of
- !_ -> (# s, ra #)
- -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives
- _ -> (# s, ra #)
- }}}}}}
-
-bignat_add
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_add mwa wa wb
- = mwaCompareOp mwa
- (\m -> Other.bignat_add m wa wb)
- (\m -> Native.bignat_add m wa wb)
-
-bignat_add_word
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_add_word mwa wa b
- = mwaCompareOp mwa
- (\m -> Other.bignat_add_word m wa b)
- (\m -> Native.bignat_add_word m wa b)
-
-bignat_mul_word
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_mul_word mwa wa b
- = mwaCompareOp mwa
- (\m -> Other.bignat_mul_word m wa b)
- (\m -> Native.bignat_mul_word m wa b)
-
-bignat_sub
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> (# State# RealWorld, Bool# #)
-bignat_sub mwa wa wb
- = mwaCompareOpBool mwa
- (\m -> Other.bignat_sub m wa wb)
- (\m -> Native.bignat_sub m wa wb)
-
-bignat_sub_word
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> (# State# RealWorld, Bool# #)
-bignat_sub_word mwa wa b
- = mwaCompareOpBool mwa
- (\m -> Other.bignat_sub_word m wa b)
- (\m -> Native.bignat_sub_word m wa b)
-
-bignat_mul
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_mul mwa wa wb
- = mwaCompareOp mwa
- (\m -> Other.bignat_mul m wa wb)
- (\m -> Native.bignat_mul m wa wb)
-
-bignat_popcount :: WordArray# -> Word#
-bignat_popcount wa =
- let
- gr = Other.bignat_popcount wa
- nr = Native.bignat_popcount wa
- in case gr `eqWord#` nr of
- 0# -> 1## `quotWord#` 0##
- _ -> gr
-
-bignat_shiftl
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_shiftl mwa wa n
- = mwaCompareOp mwa
- (\m -> Other.bignat_shiftl m wa n)
- (\m -> Native.bignat_shiftl m wa n)
-
-bignat_shiftr
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_shiftr mwa wa n
- = mwaCompareOp mwa
- (\m -> Other.bignat_shiftr m wa n)
- (\m -> Native.bignat_shiftr m wa n)
-
-bignat_shiftr_neg
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_shiftr_neg mwa wa n
- = mwaCompareOp mwa
- (\m -> Other.bignat_shiftr_neg m wa n)
- (\m -> Native.bignat_shiftr_neg m wa n)
-
-bignat_or
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_or mwa wa wb
- = mwaCompareOp mwa
- (\m -> Other.bignat_or m wa wb)
- (\m -> Native.bignat_or m wa wb)
-
-bignat_xor
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_xor mwa wa wb
- = mwaCompareOp mwa
- (\m -> Other.bignat_xor m wa wb)
- (\m -> Native.bignat_xor m wa wb)
-
-bignat_and
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_and mwa wa wb
- = mwaCompareOp mwa
- (\m -> Other.bignat_and m wa wb)
- (\m -> Native.bignat_and m wa wb)
-
-bignat_and_not
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_and_not mwa wa wb
- = mwaCompareOp mwa
- (\m -> Other.bignat_and_not m wa wb)
- (\m -> Native.bignat_and_not m wa wb)
-
-bignat_quotrem
- :: MutableWordArray# RealWorld
- -> MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_quotrem mwq mwr wa wb
- = mwaCompareOp2 mwq mwr
- (\m1 m2 -> Other.bignat_quotrem m1 m2 wa wb)
- (\m1 m2 -> Native.bignat_quotrem m1 m2 wa wb)
-
-bignat_quot
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_quot mwq wa wb
- = mwaCompareOp mwq
- (\m -> Other.bignat_quot m wa wb)
- (\m -> Native.bignat_quot m wa wb)
-
-bignat_rem
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_rem mwr wa wb
- = mwaCompareOp mwr
- (\m -> Other.bignat_rem m wa wb)
- (\m -> Native.bignat_rem m wa wb)
-
-bignat_quotrem_word
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> (# State# RealWorld, Word# #)
-bignat_quotrem_word mwq wa b
- = mwaCompareOpWord mwq
- (\m -> Other.bignat_quotrem_word m wa b)
- (\m -> Native.bignat_quotrem_word m wa b)
-
-bignat_quot_word
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_quot_word mwq wa b
- = mwaCompareOp mwq
- (\m -> Other.bignat_quot_word m wa b)
- (\m -> Native.bignat_quot_word m wa b)
-
-bignat_rem_word
- :: WordArray#
- -> Word#
- -> Word#
-bignat_rem_word wa b =
- let
- gr = Other.bignat_rem_word wa b
- nr = Native.bignat_rem_word wa b
- in case gr `eqWord#` nr of
- 1# -> gr
- _ -> unexpectedValue_Word# (# #)
-
-bignat_gcd
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_gcd mwr wa wb
- = mwaCompareOp mwr
- (\m -> Other.bignat_gcd m wa wb)
- (\m -> Native.bignat_gcd m wa wb)
-
-bignat_gcd_word
- :: WordArray#
- -> Word#
- -> Word#
-bignat_gcd_word wa b =
- let
- gr = Other.bignat_gcd_word wa b
- nr = Native.bignat_gcd_word wa b
- in case gr `eqWord#` nr of
- 1# -> gr
- _ -> unexpectedValue_Word# (# #)
-
-bignat_gcd_word_word
- :: Word#
- -> Word#
- -> Word#
-bignat_gcd_word_word a b =
- let
- gr = Other.bignat_gcd_word_word a b
- nr = Native.bignat_gcd_word_word a b
- in case gr `eqWord#` nr of
- 1# -> gr
- _ -> unexpectedValue_Word# (# #)
-
-bignat_encode_double :: WordArray# -> Int# -> Double#
-bignat_encode_double a e =
- let
- gr = Other.bignat_encode_double a e
- nr = Native.bignat_encode_double a e
- in case gr ==## nr of
- 1# -> gr
- _ -> case unexpectedValue of
- !_ -> 0.0##
- -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives
-
-bignat_powmod_word :: WordArray# -> WordArray# -> Word# -> Word#
-bignat_powmod_word b e m =
- let
- gr = Other.bignat_powmod_word b e m
- nr = Native.bignat_powmod_word b e m
- in case gr `eqWord#` nr of
- 1# -> gr
- _ -> unexpectedValue_Word# (# #)
-
-bignat_powmod
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_powmod r b e m
- = mwaCompareOp r
- (\r' -> Other.bignat_powmod r' b e m)
- (\r' -> Native.bignat_powmod r' b e m)
-
-bignat_powmod_words
- :: Word#
- -> Word#
- -> Word#
- -> Word#
-bignat_powmod_words b e m =
- let
- gr = Other.bignat_powmod_words b e m
- nr = Native.bignat_powmod_words b e m
- in case gr `eqWord#` nr of
- 1# -> gr
- _ -> unexpectedValue_Word# (# #)
-
-integer_gcde
- :: Integer
- -> Integer
- -> (# Integer, Integer, Integer #)
-integer_gcde a b =
- let
- !(# g0,x0,y0 #) = Other.integer_gcde a b
- !(# g1,x1,y1 #) = Native.integer_gcde a b
- in if isTrue# (integerEq# x0 x1
- &&# integerEq# y0 y1
- &&# integerEq# g0 g1)
- then (# g0, x0, y0 #)
- else case unexpectedValue of
- !_ -> (# integerZero, integerZero, integerZero #)
-
-integer_recip_mod
- :: Integer
- -> Natural
- -> (# Natural | () #)
-integer_recip_mod x m =
- let
- !r0 = Other.integer_recip_mod x m
- !r1 = Native.integer_recip_mod x m
- in case (# r0, r1 #) of
- (# (# | () #), (# | () #) #) -> r0
- (# (# y0 | #), (# y1 | #) #)
- | isTrue# (naturalEq# y0 y1) -> r0
- _ -> case unexpectedValue of
- !_ -> (# | () #)
-
-integer_powmod
- :: Integer
- -> Natural
- -> Natural
- -> Natural
-integer_powmod b e m =
- let
- !r0 = Other.integer_powmod b e m
- !r1 = Native.integer_powmod b e m
- in if isTrue# (naturalEq# r0 r1)
- then r0
- else case unexpectedValue of
- !_ -> naturalZero
=====================================
libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/FFI.hs deleted
=====================================
@@ -1,641 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE GHCForeignImportPrim #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-{-# LANGUAGE NegativeLiterals #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
-
--- | External BigNat backend that directly call FFI operations.
---
--- This backend can be useful for specific compilers such as GHCJS or Asterius
--- that replace bignat foreign calls with calls to the native platform bignat
--- library (e.g. JavaScript's BigInt). You can also link an extra object
--- providing the implementation.
-module GHC.Internal.Bignum.Backend.FFI where
-
-import GHC.Internal.Prim
-import GHC.Internal.Types
-import GHC.Internal.Bignum.WordArray
-import GHC.Internal.Bignum.Primitives
-import qualified GHC.Internal.Bignum.Backend.Native as Native
-import {-# SOURCE #-} GHC.Internal.Bignum.Natural
-import {-# SOURCE #-} GHC.Internal.Bignum.Integer
-
--- See W1 of Note [Tracking dependencies on primitives] in GHC.Internal.Base
--- (This module uses the empty tuple () and string literals.)
-import GHC.Internal.Tuple ()
-import GHC.Internal.CString ()
-
-default ()
-
--- | ghc-bignum backend name
-backendName :: [Char]
-backendName = "ffi"
-
--- | Compare two non-zero BigNat of the same length
---
--- Return:
--- < 0 ==> LT
--- == 0 ==> EQ
--- > 0 ==> GT
-bignat_compare
- :: WordArray#
- -> WordArray#
- -> Int#
-bignat_compare = ghc_bignat_compare
-
-foreign import ccall unsafe ghc_bignat_compare
- :: WordArray#
- -> WordArray#
- -> Int#
-
--- | Add two non-zero BigNat
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: max (size a, size b) + 1
---
--- The potential 0 most-significant Word (i.e. the potential carry) will be
--- removed by the caller if it is not already done by the backend.
-bignat_add
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_add mwa wa wb s
- = ioVoid (ghc_bignat_add mwa wa wb) s
-
-foreign import ccall unsafe ghc_bignat_add
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> WordArray#
- -> IO ()
-
--- | Add a non-zero BigNat and a non-zero Word#
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: size a + 1
---
--- The potential 0 most-significant Word (i.e. the potential carry) will be
--- removed by the caller if it is not already done by the backend.
-bignat_add_word
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_add_word mwa wa b s =
- ioVoid (ghc_bignat_add_word mwa wa b) s
-
-foreign import ccall unsafe ghc_bignat_add_word
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> Word#
- -> IO ()
-
--- | Multiply a non-zero BigNat and a non-zero Word#
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: size a + 1
---
--- The potential 0 most-significant Word (i.e. the potential carry) will be
--- removed by the caller if it is not already done by the backend.
-bignat_mul_word
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_mul_word mwa wa b s =
- ioVoid (ghc_bignat_mul_word mwa wa b) s
-
-foreign import ccall unsafe ghc_bignat_mul_word
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> Word#
- -> IO ()
-
--- | Sub two non-zero BigNat
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: size a
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
---
--- Return False# to indicate underflow.
-bignat_sub
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> (# State# RealWorld, Bool# #)
-bignat_sub mwa wa wb s = ioBool (ghc_bignat_sub mwa wa wb) s
-
-foreign import ccall unsafe ghc_bignat_sub
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> WordArray#
- -> IO Bool
-
--- | Sub a non-zero word from a non-zero BigNat
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: size a
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
---
--- Return False# to indicate underflow.
-bignat_sub_word
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> (# State# RealWorld, Bool# #)
-bignat_sub_word mwa wa b s = ioBool (ghc_bignat_sub_word mwa wa b) s
-
-foreign import ccall unsafe ghc_bignat_sub_word
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> Word#
- -> IO Bool
-
--- | Multiply two non-zero BigNat
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: size a+size b
---
--- The potential 0 most-significant Word (i.e. the potential carry) will be
--- removed by the caller if it is not already done by the backend.
-bignat_mul
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_mul mwa wa wb s = ioVoid (ghc_bignat_mul mwa wa wb) s
-
-foreign import ccall unsafe ghc_bignat_mul
- :: MutableWordArray# RealWorld -- ^ Result
- -> WordArray#
- -> WordArray#
- -> IO ()
-
--- | PopCount of a non-zero BigNat
-bignat_popcount :: WordArray# -> Word#
-bignat_popcount = ghc_bignat_popcount
-
-foreign import ccall unsafe ghc_bignat_popcount
- :: WordArray#
- -> Word#
-
--- | Left-shift a non-zero BigNat by a non-zero amount of bits
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: size a + required new limbs
---
--- The potential 0 most-significant Word (i.e. the potential carry) will be
--- removed by the caller if it is not already done by the backend.
-bignat_shiftl
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_shiftl mwa wa n s = ioVoid (ghc_bignat_shiftl mwa wa n) s
-
-foreign import ccall unsafe ghc_bignat_shiftl
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> IO ()
-
--- | Right-shift a non-zero BigNat by a non-zero amount of bits
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: required limbs
---
--- The potential 0 most-significant Word (i.e. the potential carry) will be
--- removed by the caller if it is not already done by the backend.
-bignat_shiftr
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_shiftr mwa wa n s = ioVoid (ghc_bignat_shiftr mwa wa n) s
-
-foreign import ccall unsafe ghc_bignat_shiftr
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> IO ()
-
--- | Right-shift a non-zero BigNat by a non-zero amount of bits by first
--- converting it into its two's complement representation and then again after
--- the arithmetic shift.
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: required limbs
---
--- The potential 0 most-significant Words (i.e. the potential carry) will be
--- removed by the caller if it is not already done by the backend.
-bignat_shiftr_neg
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_shiftr_neg mwa wa n s = ioVoid (ghc_bignat_shiftr_neg mwa wa n) s
-
-foreign import ccall unsafe ghc_bignat_shiftr_neg
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> IO ()
-
-
--- | OR two non-zero BigNat
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: max (size a, size b)
-bignat_or
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-{-# INLINE bignat_or #-}
-bignat_or mwa wa wb s = ioVoid (ghc_bignat_or mwa wa wb) s
-
-foreign import ccall unsafe ghc_bignat_or
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> IO ()
-
--- | XOR two non-zero BigNat
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: max (size a, size b)
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
-bignat_xor
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-{-# INLINE bignat_xor #-}
-bignat_xor mwa wa wb s = ioVoid (ghc_bignat_xor mwa wa wb) s
-
-foreign import ccall unsafe ghc_bignat_xor
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> IO ()
-
--- | AND two non-zero BigNat
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: min (size a, size b)
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
-bignat_and
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-{-# INLINE bignat_and #-}
-bignat_and mwa wa wb s = ioVoid (ghc_bignat_and mwa wa wb) s
-
-foreign import ccall unsafe ghc_bignat_and
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> IO ()
-
--- | ANDNOT two non-zero BigNat
---
--- Result is to be stored in the MutableWordArray#.
--- The latter has size: size a
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
-bignat_and_not
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-{-# INLINE bignat_and_not #-}
-bignat_and_not mwa wa wb s = ioVoid (ghc_bignat_and_not mwa wa wb) s
-
-foreign import ccall unsafe ghc_bignat_and_not
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> IO ()
-
--- | QuotRem of two non-zero BigNat
---
--- Result quotient and remainder are to be stored in the MutableWordArray#.
--- The first one (quotient) has size: size(A)-size(B)+1
--- The second one (remainder) has size: size(b)
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
-bignat_quotrem
- :: MutableWordArray# RealWorld -- ^ Quotient
- -> MutableWordArray# RealWorld -- ^ Remainder
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_quotrem mwq mwr wa wb s =
- ioVoid (ghc_bignat_quotrem mwq mwr wa wb) s
-
-foreign import ccall unsafe ghc_bignat_quotrem
- :: MutableWordArray# RealWorld
- -> MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> IO ()
-
--- | Quotient of two non-zero BigNat
---
--- Result quotient is to be stored in the MutableWordArray#.
--- The latter has size: size(A)-size(B)+1
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
-bignat_quot
- :: MutableWordArray# RealWorld -- ^ Quotient
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_quot mwq wa wb s =
- ioVoid (ghc_bignat_quot mwq wa wb) s
-
-foreign import ccall unsafe ghc_bignat_quot
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> IO ()
-
--- | Remainder of two non-zero BigNat
---
--- Result remainder is to be stored in the MutableWordArray#.
--- The latter has size: size(B)
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
-bignat_rem
- :: MutableWordArray# RealWorld -- ^ Quotient
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_rem mwr wa wb s =
- ioVoid (ghc_bignat_rem mwr wa wb) s
-
-foreign import ccall unsafe ghc_bignat_rem
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> IO ()
-
--- | QuotRem of a non-zero BigNat and a non-zero Word
---
--- Result quotient is to be stored in the MutableWordArray#.
--- The latter has size: size(A)
---
--- The remainder is returned.
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
-bignat_quotrem_word
- :: MutableWordArray# RealWorld -- ^ Quotient
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> (# State# RealWorld, Word# #)
-bignat_quotrem_word mwq wa b s =
- ioWord# (ghc_bignat_quotrem_word mwq wa b) s
-
-foreign import ccall unsafe ghc_bignat_quotrem_word
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> IO Word
-
--- | Quot of a non-zero BigNat and a non-zero Word
---
--- Result quotient is to be stored in the MutableWordArray#.
--- The latter has size: size(A)
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
-bignat_quot_word
- :: MutableWordArray# RealWorld -- ^ Quotient
- -> WordArray#
- -> Word#
- -> State# RealWorld
- -> State# RealWorld
-bignat_quot_word mwq wa b s =
- ioVoid (ghc_bignat_quot_word mwq wa b) s
-
-foreign import ccall unsafe ghc_bignat_quot_word
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> Word#
- -> IO ()
-
--- | Remainder of a non-zero BigNat and a non-zero Word
---
--- The remainder is returned.
-bignat_rem_word
- :: WordArray#
- -> Word#
- -> Word#
-bignat_rem_word = ghc_bignat_rem_word
-
-foreign import ccall unsafe ghc_bignat_rem_word
- :: WordArray#
- -> Word#
- -> Word#
-
-
--- | Greatest common divisor (GCD) of two non-zero and non-one BigNat
---
--- Result GCD is to be stored in the MutableWordArray#.
--- The latter has size: size(B)
--- The first WordArray# is greater than the second WordArray#.
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
-bignat_gcd
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_gcd mwr wa wb s =
- ioVoid (ghc_bignat_gcd mwr wa wb) s
-
-foreign import ccall unsafe ghc_bignat_gcd
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> IO ()
-
--- | Greatest common divisor (GCD) of a non-zero/non-one BigNat and a
--- non-zero/non-one Word#
---
--- Result GCD is returned
-bignat_gcd_word
- :: WordArray#
- -> Word#
- -> Word#
-bignat_gcd_word = ghc_bignat_gcd_word
-
-foreign import ccall unsafe ghc_bignat_gcd_word
- :: WordArray#
- -> Word#
- -> Word#
-
--- | Greatest common divisor (GCD) of two Word#
---
--- Result GCD is returned
-bignat_gcd_word_word
- :: Word#
- -> Word#
- -> Word#
-bignat_gcd_word_word = ghc_bignat_gcd_word_word
-
-foreign import ccall unsafe ghc_bignat_gcd_word_word
- :: Word#
- -> Word#
- -> Word#
-
--- | Encode (# BigNat mantissa, Int# exponent #) into a Double#
-bignat_encode_double :: WordArray# -> Int# -> Double#
-bignat_encode_double = ghc_bignat_encode_double
-
-foreign import ccall unsafe ghc_bignat_encode_double
- :: WordArray#
- -> Int#
- -> Double#
-
--- | \"@'bignat_powmod_word' /b/ /e/ /m/@\" computes base @/b/@ raised to
--- exponent @/e/@ modulo @/m/@.
---
--- b > 1
--- e > 0
--- m > 1
-bignat_powmod_word :: WordArray# -> WordArray# -> Word# -> Word#
-bignat_powmod_word = ghc_bignat_powmod_word
-
-foreign import ccall unsafe ghc_bignat_powmod_word
- :: WordArray# -> WordArray# -> Word# -> Word#
-
--- | \"@'bignat_powmod' r /b/ /e/ /m/@\" computes base @/b/@ raised to
--- exponent @/e/@ modulo @/m/@.
---
--- b > 1
--- e > 0
--- m > 1
---
--- Result is to be stored in the MutableWordArray# (which size is equal to the
--- one of m).
---
--- The potential 0 most-significant Words will be removed by the caller if it is
--- not already done by the backend.
-bignat_powmod
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> WordArray#
- -> State# RealWorld
- -> State# RealWorld
-bignat_powmod r b e m s =
- ioVoid (ghc_bignat_powmod r b e m) s
-
-foreign import ccall unsafe ghc_bignat_powmod
- :: MutableWordArray# RealWorld
- -> WordArray#
- -> WordArray#
- -> WordArray#
- -> IO ()
-
--- | \"@'bignat_powmod' /b/ /e/ /m/@\" computes base @/b/@ raised to
--- exponent @/e/@ modulo @/m/@.
---
--- b > 1
--- e > 0
--- m > 1
-bignat_powmod_words
- :: Word#
- -> Word#
- -> Word#
- -> Word#
-bignat_powmod_words = ghc_bignat_powmod_words
-
-foreign import ccall unsafe ghc_bignat_powmod_words
- :: Word# -> Word# -> Word# -> Word#
-
-
--- | Return extended GCD of two non-zero integers.
---
--- I.e. integer_gcde a b returns (g,x,y) so that ax + by = g
---
--- Input: a and b are non zero.
--- Output: g must be > 0
---
-integer_gcde
- :: Integer
- -> Integer
- -> (# Integer, Integer, Integer #)
-integer_gcde = Native.integer_gcde
- -- for now we use Native's implementation. If some FFI backend user needs a
- -- specific implementation, we'll need to determine a prototype to pass and
- -- return BigNat signs and sizes via FFI.
-
-
--- | Computes the modular inverse of two non-zero integers.
---
--- I.e. y = integer_recip_mod x m
--- = x^(-1) `mod` m
---
--- with 0 < y < abs m
-integer_recip_mod
- :: Integer
- -> Natural
- -> (# Natural | () #)
-integer_recip_mod = Native.integer_recip_mod
- -- for now we use Native's implementation. If some FFI backend user needs a
- -- specific implementation, we'll need to determine a prototype to pass and
- -- return BigNat signs and sizes via FFI.
-
--- | Computes the modular exponentiation.
---
--- I.e. y = integer_powmod b e m
--- = b^e `mod` m
---
--- with 0 <= y < abs m
-integer_powmod
- :: Integer
- -> Natural
- -> Natural
- -> Natural
-integer_powmod = Native.integer_powmod
- -- for now we use Native's implementation. If some FFI backend user needs a
- -- specific implementation, we'll need to determine a prototype to pass and
- -- return BigNat signs and sizes via FFI.
=====================================
libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs
=====================================
@@ -14,7 +14,7 @@ module GHC.Internal.Bignum.Backend.Native where
#include "MachDeps.h"
#include "WordSize.h"
-#if defined(BIGNUM_NATIVE) || defined(BIGNUM_CHECK) || defined(BIGNUM_FFI)
+#if defined(BIGNUM_NATIVE)
import {-# SOURCE #-} GHC.Internal.Bignum.BigNat
import {-# SOURCE #-} GHC.Internal.Bignum.Natural
import {-# SOURCE #-} GHC.Internal.Bignum.Integer
@@ -50,6 +50,12 @@ count_words_bits_int :: Word# -> (# Int#, Int# #)
count_words_bits_int n = case count_words_bits n of
(# nw, nb #) -> (# word2Int# nw, word2Int# nb #)
+-- | Compare two non-zero BigNat of the same length
+--
+-- Return:
+-- < 0 ==> LT
+-- == 0 ==> EQ
+-- > 0 ==> GT
bignat_compare :: WordArray# -> WordArray# -> Int#
bignat_compare wa wb = go (sz -# 1#)
where
@@ -62,6 +68,13 @@ bignat_compare wa wb = go (sz -# 1#)
| isTrue# (a `gtWord#` b) -> 1#
| True -> -1#
+-- | Add two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: max (size a, size b) + 1
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
bignat_add
:: MutableWordArray# s -- ^ Result
-> WordArray#
@@ -120,6 +133,13 @@ bignat_add mwa wa wb = addABc 0# 0##
in case mwaWrite# mwa i r s of
s' -> addAoBc wab (i +# 1#) carry' s'
+-- | Add a non-zero BigNat and a non-zero Word#
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a + 1
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
bignat_add_word
:: MutableWordArray# RealWorld -- ^ Result
-> WordArray#
@@ -128,6 +148,15 @@ bignat_add_word
-> State# RealWorld
bignat_add_word mwa wa b s = mwaInitArrayPlusWord mwa wa b s
+-- | Sub a non-zero word from a non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+--
+-- Return False# to indicate underflow.
bignat_sub_word
:: MutableWordArray# RealWorld
-> WordArray#
@@ -154,6 +183,13 @@ bignat_sub_word mwa wa b = go b 0#
(# l , c #) -> case mwaWrite# mwa i l s of
s1 -> go (int2Word# c) (i +# 1#) s1
+-- | Multiply a non-zero BigNat and a non-zero Word#
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a + 1
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
bignat_mul_word
:: MutableWordArray# RealWorld -- ^ Result
-> WordArray#
@@ -173,6 +209,13 @@ bignat_mul_word mwa wa b = go 0# 0##
s' -> go (i +# 1#) carry' s'
+-- | Multiply two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a+size b
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
bignat_mul
:: MutableWordArray# RealWorld -- ^ Result
-> WordArray#
@@ -214,6 +257,15 @@ bignat_mul mwa wa wb s1 =
bi -> case mul mwa wa bi i ctzA 0## s of
s' -> mulEachB (i +# 1#) s'
+-- | Sub two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
+--
+-- Return False# to indicate underflow.
bignat_sub
:: MutableWordArray# RealWorld
-> WordArray#
@@ -227,6 +279,7 @@ bignat_sub mwa wa wb s =
case mwaArrayCopy# mwa 0# wa 0# (wordArraySize# wa) s of
s' -> mwaSubInplaceArray mwa 0# wb s'
+-- | PopCount of a non-zero BigNat
bignat_popcount :: WordArray# -> Word#
bignat_popcount wa = go 0# 0##
where
@@ -235,6 +288,13 @@ bignat_popcount wa = go 0# 0##
| isTrue# (i ==# sz) = c
| True = go (i +# 1#) (c `plusWord#` popCnt# (indexWordArray# wa i))
+-- | Left-shift a non-zero BigNat by a non-zero amount of bits
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a + required new limbs
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
bignat_shiftl
:: MutableWordArray# s
-> WordArray#
@@ -267,6 +327,13 @@ bignat_shiftl mwa wa n s1 =
s' -> mwaBitShift (i +# 1#) c' s'
+-- | Right-shift a non-zero BigNat by a non-zero amount of bits
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: required limbs
+--
+-- The potential 0 most-significant Word (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
bignat_shiftr
:: MutableWordArray# s
-> WordArray#
@@ -293,6 +360,15 @@ bignat_shiftr mwa wa n s1
in case mwaWrite# mwa i v s of
s' -> mwaBitShift (i -# 1#) c' s'
+-- | Right-shift a non-zero BigNat by a non-zero amount of bits by first
+-- converting it into its two's complement representation and then again after
+-- the arithmetic shift.
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: required limbs
+--
+-- The potential 0 most-significant Words (i.e. the potential carry) will be
+-- removed by the caller if it is not already done by the backend.
bignat_shiftr_neg
:: MutableWordArray# s
-> WordArray#
@@ -329,6 +405,10 @@ bignat_shiftr_neg mwa wa n s1
in go 0#
+-- | OR two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: max (size a, size b)
bignat_or
:: MutableWordArray# RealWorld -- ^ Result
-> WordArray#
@@ -346,6 +426,13 @@ bignat_or mwa wa wb s1
case mwaInitArrayBinOp mwa wx wy or# s of
s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s'
+-- | XOR two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: max (size a, size b)
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
bignat_xor
:: MutableWordArray# RealWorld -- ^ Result
-> WordArray#
@@ -363,6 +450,13 @@ bignat_xor mwa wa wb s1
case mwaInitArrayBinOp mwa wx wy xor# s of
s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s'
+-- | AND two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: min (size a, size b)
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
bignat_and
:: MutableWordArray# RealWorld -- ^ Result
-> WordArray#
@@ -371,6 +465,13 @@ bignat_and
-> State# RealWorld
bignat_and mwa wa wb s = mwaInitArrayBinOp mwa wa wb and# s
+-- | ANDNOT two non-zero BigNat
+--
+-- Result is to be stored in the MutableWordArray#.
+-- The latter has size: size a
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
bignat_and_not
:: MutableWordArray# RealWorld -- ^ Result
-> WordArray#
@@ -384,9 +485,17 @@ bignat_and_not mwa wa wb s =
!szA = wordArraySize# wa
!szB = wordArraySize# wb
+-- | QuotRem of two non-zero BigNat
+--
+-- Result quotient and remainder are to be stored in the MutableWordArray#.
+-- The first one (quotient) has size: size(A)-size(B)+1
+-- The second one (remainder) has size: size(b)
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
bignat_quotrem
- :: MutableWordArray# s
- -> MutableWordArray# s
+ :: MutableWordArray# s -- ^ Quotient
+ -> MutableWordArray# s -- ^ Remainder
-> WordArray#
-> WordArray#
-> State# s
@@ -434,8 +543,15 @@ bignat_quotrem mwq mwr uwa uwb s0 =
+-- | Quotient of two non-zero BigNat
+--
+-- Result quotient is to be stored in the MutableWordArray#.
+-- The latter has size: size(A)-size(B)+1
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
bignat_quot
- :: MutableWordArray# RealWorld
+ :: MutableWordArray# RealWorld -- ^ Quotient
-> WordArray#
-> WordArray#
-> State# RealWorld
@@ -445,8 +561,15 @@ bignat_quot mwq wa wb s =
case newWordArray# (wordArraySize# wb) s of
(# s, mwr #) -> bignat_quotrem mwq mwr wa wb s
+-- | Remainder of two non-zero BigNat
+--
+-- Result remainder is to be stored in the MutableWordArray#.
+-- The latter has size: size(B)
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
bignat_rem
- :: MutableWordArray# RealWorld
+ :: MutableWordArray# RealWorld -- ^ Remainder
-> WordArray#
-> WordArray#
-> State# RealWorld
@@ -577,6 +700,15 @@ bignat_quotrem_normalized mwq mwa b s0 =
| True -> loop (m -# 1#) s2
}}
+-- | QuotRem of a non-zero BigNat and a non-zero Word
+--
+-- Result quotient is to be stored in the MutableWordArray#.
+-- The latter has size: size(A)
+--
+-- The remainder is returned.
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
bignat_quotrem_word
:: MutableWordArray# s -- ^ Quotient
-> WordArray#
@@ -595,6 +727,13 @@ bignat_quotrem_word mwq wa b s = go (sz -# 1#) 0## s
in case mwaWrite# mwq i q s of
s' -> go (i -# 1#) r' s'
+-- | Quot of a non-zero BigNat and a non-zero Word
+--
+-- Result quotient is to be stored in the MutableWordArray#.
+-- The latter has size: size(A)
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
bignat_quot_word
:: MutableWordArray# s -- ^ Quotient
-> WordArray#
@@ -613,6 +752,9 @@ bignat_quot_word mwq wa b s = go (sz -# 1#) 0## s
in case mwaWrite# mwq i q s of
s' -> go (i -# 1#) r' s'
+-- | Remainder of a non-zero BigNat and a non-zero Word
+--
+-- The remainder is returned.
bignat_rem_word
:: WordArray#
-> Word#
@@ -629,6 +771,14 @@ bignat_rem_word wa b = go (sz -# 1#) 0##
in go (i -# 1#) r'
+-- | Greatest common divisor (GCD) of two non-zero and non-one BigNat
+--
+-- Result GCD is to be stored in the MutableWordArray#.
+-- The latter has size: size(B)
+-- The first WordArray# is greater than the second WordArray#.
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
bignat_gcd
:: MutableWordArray# s
-> WordArray#
@@ -647,13 +797,21 @@ bignat_gcd mwr = go
!wmin' = bigNatRem wmax wmin
in go wmax' wmin' s
+-- | Greatest common divisor (GCD) of a non-zero/non-one BigNat and a
+-- non-zero/non-one Word#
+--
+-- Result GCD is returned
bignat_gcd_word
:: WordArray#
-> Word#
-> Word#
bignat_gcd_word a b = bignat_gcd_word_word b (bigNatRemWord# a b)
--- | This operation doesn't really belongs here, but GMP's one is much faster
+-- | Greatest common divisor (GCD) of two Word#
+--
+-- Result GCD is returned.
+--
+-- This operation doesn't really belongs here, but GMP's one is much faster
-- than this simple implementation (basic Euclid algorithm).
--
-- Ideally we should make an implementation as fast as GMP's one and put it into
@@ -665,6 +823,7 @@ bignat_gcd_word_word
bignat_gcd_word_word a 0## = a
bignat_gcd_word_word a b = bignat_gcd_word_word b (a `remWord#` b)
+-- | Encode (# BigNat mantissa, Int# exponent #) into a Double#
bignat_encode_double :: WordArray# -> Int# -> Double#
bignat_encode_double wa e0 = go 0.0## e0 0#
where
@@ -676,6 +835,12 @@ bignat_encode_double wa e0 = go 0.0## e0 0#
(e +# WORD_SIZE_IN_BITS#) -- FIXME: we assume that e doesn't overflow...
(i +# 1#)
+-- | \"@'bignat_powmod_word' /b/ /e/ /m/@\" computes base @/b/@ raised to
+-- exponent @/e/@ modulo @/m/@.
+--
+-- b > 1
+-- e > 0
+-- m > 1
bignat_powmod_word :: WordArray# -> WordArray# -> Word# -> Word#
bignat_powmod_word b0 e0 m = go (naturalFromBigNat# b0) (naturalFromBigNat# e0) (naturalFromWord# 1##)
where
@@ -693,6 +858,18 @@ bignat_powmod_word b0 e0 m = go (naturalFromBigNat# b0) (naturalFromBigNat# e0)
m' = naturalFromWord# m
e' = e `naturalShiftR#` 1## -- slightly faster than "e `div` 2"
+-- | \"@'bignat_powmod' r /b/ /e/ /m/@\" computes base @/b/@ raised to
+-- exponent @/e/@ modulo @/m/@.
+--
+-- b > 1
+-- e > 0
+-- m > 1
+--
+-- Result is to be stored in the MutableWordArray# (which size is equal to the
+-- one of m).
+--
+-- The potential 0 most-significant Words will be removed by the caller if it is
+-- not already done by the backend.
bignat_powmod
:: MutableWordArray# RealWorld
-> WordArray#
@@ -720,6 +897,12 @@ bignat_powmod r b0 e0 m s = mwaInitCopyShrink# r r' s
m' = naturalFromBigNat# m
e' = e `naturalShiftR#` 1## -- slightly faster than "e `div` 2"
+-- | \"@'bignat_powmod' /b/ /e/ /m/@\" computes base @/b/@ raised to
+-- exponent @/e/@ modulo @/m/@.
+--
+-- b > 1
+-- e > 0
+-- m > 1
bignat_powmod_words
:: Word#
-> Word#
@@ -731,6 +914,13 @@ bignat_powmod_words b e m =
m
+-- | Return extended GCD of two non-zero integers.
+--
+-- I.e. integer_gcde a b returns (g,x,y) so that ax + by = g
+--
+-- Input: a and b are non zero.
+-- Output: g must be > 0
+--
integer_gcde
:: Integer
-> Integer
@@ -748,6 +938,12 @@ integer_gcde a b = f (# a,integerOne,integerZero #) (# b,integerZero,integerOne
!(# q, r #) -> f new (# r , old_s `integerSub` (q `integerMul` s)
, old_t `integerSub` (q `integerMul` t) #)
+-- | Computes the modular inverse of two non-zero integers.
+--
+-- I.e. y = integer_recip_mod x m
+-- = x^(-1) `mod` m
+--
+-- with 0 < y < abs m
integer_recip_mod
:: Integer
-> Natural
@@ -763,6 +959,12 @@ integer_recip_mod x m =
-- a `mod` m > 0 because m > 0
| True -> (# | () #)
+-- | Computes the modular exponentiation.
+--
+-- I.e. y = integer_powmod b e m
+-- = b^e `mod` m
+--
+-- with 0 <= y < abs m
integer_powmod
:: Integer
-> Natural
=====================================
libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Selected.hs deleted
=====================================
@@ -1,24 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
--- | Selected backend
---
--- We need this module in addition to GHC.Internal.Bignum.Backend to avoid module loops with
--- Check backend.
-module GHC.Internal.Bignum.Backend.Selected
- ( module Backend
- )
-where
-
-#if defined(BIGNUM_NATIVE)
-import GHC.Internal.Bignum.Backend.Native as Backend
-
-#elif defined(BIGNUM_FFI)
-import GHC.Internal.Bignum.Backend.FFI as Backend
-
-#elif defined(BIGNUM_GMP)
-import GHC.Internal.Bignum.Backend.GMP as Backend
-
-#else
-#error Undefined BigNum backend. Use a flag to select it (e.g. gmp, native, ffi)`
-#endif
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d603477f4cd5dff83d81d8ecef52e2…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d603477f4cd5dff83d81d8ecef52e2…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][master] Hadrian: create a ghc-internal .def file per ghc-internal dll
by Marge Bot (@marge-bot) 29 May '26
by Marge Bot (@marge-bot) 29 May '26
29 May '26
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
d603477f by David Eichmann at 2026-05-29T13:17:12-04:00
Hadrian: create a ghc-internal .def file per ghc-internal dll
The .def file generated from rts/win32/libHSghc-internal.def.in contains
the name of the ghc-internal dll. The correct dll name differs based
on if the dll is inplace/final and if using the Dynamic way. Previously,
this was not accounted for and inconsistent dlls names where used. That
led to failure when loading dlls at runtime in experiments with windows
dynamic linking.
- - - - -
4 changed files:
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Rts.hs
- rts/win32/libHSghc-internal.def.in
Changes:
=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -390,7 +390,6 @@ templateRules = do
, interpolateSetting "ProjectPatchLevel1" ProjectPatchLevel1
, interpolateSetting "ProjectPatchLevel2" ProjectPatchLevel2
]
- templateRule "rts/win32/libHSghc-internal.def" projectVersion
templateRule "docs/index.html" $ packageUnitIds Stage1
templateRule "docs/users_guide/ghc_config.py" $ mconcat
[ projectVersion
=====================================
hadrian/src/Rules/Library.hs
=====================================
@@ -9,6 +9,7 @@ import GHC.Toolchain.Target (Target(tgtArchOs))
import Base
import Context
+import qualified Data.List as List
import Expression hiding (way, package, stage)
import Oracles.ModuleFiles
import Packages
@@ -20,6 +21,7 @@ import Utilities
import Data.Time.Clock
import Rules.Generate (generatedDependencies)
import Oracles.Flag
+import Way.Type (wayToUnits)
-- * Library 'Rules'
@@ -203,13 +205,32 @@ extraObjects context
| package context == rts = do
target <- interpretInContext context getStagedTarget
- builddir <- buildPath context
- return [ builddir -/- "libHSghc-internal.dll.a"
- | archOS_OS (tgtArchOs target) == OSMinGW32
- , Dynamic `wayUnit` way context ]
+ if not (archOS_OS (tgtArchOs target) == OSMinGW32
+ && Dynamic `wayUnit` way context)
+ then return []
+ else do
+ -- Find the ghc-internal library file name. Note that the
+ -- ghc-internal's .dll.a file is placed in the RTS build dir and not
+ -- the ghc-internal build dir as we only use it when building the
+ -- RTS and not other libraries.
+ ghcInternalDllName <- takeFileName <$> pkgLibraryFile Context {
+ stage = stage context,
+ way = rtsWayToLibraryWay (way context),
+ iplace = iplace context,
+ package = ghcInternal
+ }
+
+ builddir <- buildPath context
+ return [ builddir -/- ghcInternalDllName <> ".a"]
| otherwise = return []
+-- | The rts is compiled in many different ways, but libraries are only built in
+-- (non)Dynamic and (non)Profiled ways. This function converts the rts way into
+-- compatible library way.
+rtsWayToLibraryWay :: Way -> Way
+rtsWayToLibraryWay = wayFromUnits . List.intersect [Dynamic, Profiling] . wayToUnits
+
-- | Return all the object files to be put into the library we're building for
-- the given 'Context'.
libraryObjects :: Context -> Action [FilePath]
=====================================
hadrian/src/Rules/Rts.hs
=====================================
@@ -13,11 +13,19 @@ rtsRules = priority 3 $ do
-- to be linked into the rts dll.
forM_ [Stage1, Stage2, Stage3 ] $ \ stage -> do
let buildPath = root -/- buildDir (rtsContext stage)
- buildPath -/- "libHSghc-internal.dll.a" %> buildGhcInternalImportLib
+ buildPath -/- "libHSghc-internal-*.def" %> buildGhcInternalImportDef
+ buildPath -/- "libHSghc-internal-*.dll.a" %> buildGhcInternalImportLib
+
+buildGhcInternalImportDef :: FilePath -> Action ()
+buildGhcInternalImportDef target = do
+ templateIn <- readFile' "rts/win32/libHSghc-internal.def.in"
+ let dllName = takeFileName target -<.> "dll"
+ templateOut = replace "@GhcInternalDll@" dllName templateIn
+ writeFile' target templateOut
buildGhcInternalImportLib :: FilePath -> Action ()
buildGhcInternalImportLib target = do
- let input = "rts/win32/libHSghc-internal.def"
+ let input = dropExtensions target <.> "def" -- the .def file
output = target -- the .dll.a import lib
need [input]
runBuilder Dlltool ["-d", input, "-l", output] [input] [output]
=====================================
rts/win32/libHSghc-internal.def.in
=====================================
@@ -1,4 +1,4 @@
-LIBRARY libHSghc-internal-@ProjectVersionForLib@.0-ghc@ProjectVersion@.dll
+LIBRARY @GhcInternalDll@
EXPORTS
init_ghc_hs_iface
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d603477f4cd5dff83d81d8ecef52e21…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d603477f4cd5dff83d81d8ecef52e21…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/mangoiv/ghc-9.12-bp] Trim the continuation in mkDupableContWithDmds
by Magnus (@MangoIV) 29 May '26
by Magnus (@MangoIV) 29 May '26
29 May '26
Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC
Commits:
ede8d11e by mangoiv at 2026-05-29T18:46:15+02:00
Trim the continuation in mkDupableContWithDmds
When there are no remaining argument demands, it means the application
is bottoming. In this case, we can trim the continuation to avoid the
panic that was observed in #27261.
See Note [Trimming the continuation for bottoming functions] in
GHC.Core.Opt.Simplify.Iteration.
This patch was rewritten to avoid pulling in a refactor.
The original patch is included in master as 4a645683
- - - - -
5 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- + testsuite/tests/simplCore/should_compile/T27261.hs
- + testsuite/tests/simplCore/should_compile/T27261_aux.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -24,7 +24,7 @@ import GHC.Core.Opt.Simplify.Env
import GHC.Core.Opt.Simplify.Inline
import GHC.Core.Opt.Simplify.Utils
import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutOkForBinderSwap, BinderSwapDecision (..) )
-import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr )
+import GHC.Core.Make ( FloatBind, mkImpossibleExpr )
import qualified GHC.Core.Make
import GHC.Core.Coercion hiding ( substCo, substCoVar )
import GHC.Core.Reduction
@@ -2293,24 +2293,14 @@ rebuildCall :: SimplEnv -> ArgInfo -> SimplCont
---------- Bottoming applications --------------
rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_dmds = [] }) cont
- -- When we run out of strictness args, it means
- -- that the call is definitely bottom; see GHC.Core.Opt.Simplify.Utils.mkArgInfo
- -- Then we want to discard the entire strict continuation. E.g.
- -- * case (error "hello") of { ... }
- -- * (error "Hello") arg
- -- * f (error "Hello") where f is strict
- -- etc
- -- Then, especially in the first of these cases, we'd like to discard
- -- the continuation, leaving just the bottoming expression. But the
- -- type might not be right, so we may have to add a coerce.
- | not (contIsTrivial cont) -- Only do this if there is a non-trivial
- -- continuation to discard, else we do it
- -- again and again!
- = seqType cont_ty `seq` -- See Note [Avoiding space leaks in OutType]
- return (emptyFloats env, castBottomExpr res cont_ty)
- where
- res = argInfoExpr fun rev_args
- cont_ty = contResultType cont
+ -- When we run out of demands, it means that the call is definitely bottom.
+ -- See (TC2) in Note [Trimming the continuation for bottoming functions]
+ = rebuild env (argInfoExpr fun rev_args) (mkBottomCont env cont)
+ -- NOTE(mangoiv): the env passed to mkBottomCont is only relevant for its static part
+ -- and should not be looked at whatsoever, which is why it should be fine to pass it
+ -- this way. The reason why we deviate from the original patch is that it was done
+ -- after a significant refactor we cannot backport.
+ -- The original patch should be included in `master` as 4a645683ee0bd4421a88cd6ec49b40c6046b041d
---------- Try inlining, if ai_rewrite = TryInlining --------
-- In the TryInlining case we try inlining immediately, before simplifying
@@ -3813,6 +3803,41 @@ When we have
then we can just duplicate those alts because the A and C cases
will disappear immediately. This is more direct than creating
join points and inlining them away. See #4930.
+
+Note [Trimming the continuation for bottoming functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose
+ f :: Int -> Int -> Int
+ f x = error "urk"
+
+ foo = f 3 4
+
+f's demand signature say "after one arg I return bottom". We can drop
+the remaining arguments, thus
+
+ foo = case f 3 of {}
+
+This trimming can also be done with other continuations:
+ * case (error "hello") of { ... }
+ * f (error "Hello") where f is strict
+ etc
+
+We implement the trimming in three parts:
+
+(TC1) In `mkArgInfo`, for a bottoming function, we make a list of `RemainingArgDmds`
+ with a finite list of elements (in the example above, just one).
+
+ For comparison, note that, for non-bottoming functions, the `RemainingArgDmds`
+ always finishes with an infinite list of `topDmd`.
+
+(TC2) In `rebuildCall`, when we run out of `RemainingArgDmds` we discard the
+ remaining continuation.
+
+ After discarding the continuation, the types might not match, in which case
+ we leave behind a (case <hole> of {}) wrapper. See the call to `mkBottomCont`.
+
+(TC3) In `mkDupableContWithDmds`, we similarly discard the continuation when
+ we run out of `RemainingArgDmds`.
-}
--------------------
@@ -3856,6 +3881,13 @@ mkDupableContWithDmds env _ cont
mkDupableContWithDmds _ _ (Stop {}) = panic "mkDupableCont" -- Handled by previous eqn
+mkDupableContWithDmds env dmds cont
+ -- No more demands => function is definitely bottom
+ -- => simply trim the continuation
+ -- c.f. the null-demands case in `rebuildCall`
+ -- See (TC3) in Note [Trimming the continuation for bottoming functions]
+ | [] <- dmds = return (emptyFloats env, mkBottomCont env cont)
+
mkDupableContWithDmds env dmds (CastIt { sc_co = co, sc_opt = opt, sc_cont = cont })
= do { (floats, cont') <- mkDupableContWithDmds env dmds cont
; return (floats, CastIt { sc_co = optOutCoercion env co opt
@@ -3931,7 +3963,7 @@ mkDupableContWithDmds env dmds
; return (floats, ApplyToTy { sc_cont = cont'
, sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) }
-mkDupableContWithDmds env dmds
+mkDupableContWithDmds env (dmd : cont_dmds)
(ApplyToVal { sc_arg = arg, sc_dup = dup, sc_env = se
, sc_cont = cont, sc_hole_ty = hole_ty })
= -- e.g. [...hole...] (...arg...)
@@ -3939,8 +3971,7 @@ mkDupableContWithDmds env dmds
-- let a = ...arg...
-- in [...hole...] a
-- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable
- do { let (dmd:cont_dmds) = dmds -- Never fails
- ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont
+ do { (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont
; let env' = env `setInScopeFromF` floats1
; (_, se', arg') <- simplLazyArg env' dup hole_ty Nothing se arg
; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg'
@@ -3954,7 +3985,6 @@ mkDupableContWithDmds env dmds
-- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils
, sc_dup = OkToDup, sc_cont = cont'
, sc_hole_ty = hole_ty }) }
-
mkDupableContWithDmds env _
(Select { sc_bndr = case_bndr, sc_alts = alts, sc_env = se, sc_cont = cont })
= -- e.g. (case [...hole...] of { pi -> ei })
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -24,7 +24,7 @@ module GHC.Core.Opt.Simplify.Utils (
SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv,
isSimplified, contIsStop,
contIsDupable, contResultType, contHoleType, contHoleScaling,
- contIsTrivial, contArgs, contIsRhs,
+ contIsTrivial, contArgs, contIsRhs, mkBottomCont,
countArgs,
mkBoringStop, mkRhsStop, mkLazyArgStop,
interestingCallContext,
@@ -87,6 +87,8 @@ import Control.Monad ( guard, when )
import Data.List ( sortBy )
import Data.Maybe
import Data.Graph
+import GHC.Core.TyCo.Compare (eqTypeIgnoringMultiplicity)
+import GHC.Core.Make (mkWildValBinder)
{- *********************************************************************
* *
@@ -505,6 +507,20 @@ contIsTrivial (ApplyToTy { sc_cont = k }) = contIsTrivial
contIsTrivial (CastIt { sc_cont = k }) = contIsTrivial k
contIsTrivial _ = False
+-------------------
+contStop :: SimplCont -> SimplCont
+-- ^ Get the 'Stop' at the tail of the continuation
+--
+-- Always returns a continuation of form @(Stop ...)@.
+contStop stop@(Stop {}) = stop
+contStop (CastIt { sc_cont = k }) = contStop k
+contStop (StrictBind { sc_cont = k }) = contStop k
+contStop (StrictArg { sc_cont = k }) = contStop k
+contStop (Select { sc_cont = k }) = contStop k
+contStop (ApplyToTy { sc_cont = k }) = contStop k
+contStop (ApplyToVal { sc_cont = k }) = contStop k
+contStop (TickIt _ k) = contStop k
+
-------------------
contResultType :: SimplCont -> OutType
contResultType (Stop ty _ _) = ty
@@ -623,6 +639,40 @@ contEvalContext k = case k of
-- Perhaps reconstruct the demand on the scrutinee by looking at field
-- and case binder dmds, see addCaseBndrDmd. No priority right now.
+-------------------
+mkBottomCont ::StaticEnv -> SimplCont -> SimplCont
+-- ^ Given a continuation `cont`, return a `cont` /of the same type/,
+-- looking like @(case \<hole\> of {})@.
+--
+-- This is used when we are going to fill in the @<hole>@ with bottom.
+-- See (TC2,3) in Note [Trimming the continuation for bottoming functions]
+--
+-- Don't bother to trim, making a @case <hole> of {}@, if we have only
+-- an essentially-trivial continuation; e.g. @(<hole> \@ty |> co)@.
+mkBottomCont se cont = go cont
+ where
+ go k@(Stop {}) = k
+ go (TickIt t k') = TickIt t (go k')
+ go k@(CastIt { sc_cont = k' }) = k { sc_cont = go k' }
+ go k@(ApplyToTy { sc_cont = k' }) = k { sc_cont = go k' }
+ go k@(Select { sc_alts = [], sc_cont = Stop {} }) = k -- Optimisation only
+ go k | Stop res_ty _ _ <- stop_cont
+ = if hole_ty `eqTypeIgnoringMultiplicity` res_ty
+ then stop_cont
+ else Select { sc_alts = []
+ , sc_bndr = mkWildValBinder OneTy hole_ty
+ , sc_dup = OkToDup
+ , sc_env = zapSubstEnv se
+ -- NOTE(mangoiv): we zap the env here because there were
+ -- some subtle changes in invariants on substitutions.
+ -- that would require backports of major refactorings.
+ , sc_cont = stop_cont }
+ | otherwise = panic "stop_cont is not Stop {}"
+ where
+ hole_ty = contHoleType k
+ stop_cont = contStop k
+
+
-------------------
mkArgInfo :: SimplEnv -> RuleEnv -> Id -> SimplCont -> ArgInfo
=====================================
testsuite/tests/simplCore/should_compile/T27261.hs
=====================================
@@ -0,0 +1,17 @@
+{-# OPTIONS_GHC -fno-full-laziness -dppr-debug #-}
+
+module T27261 (foo) where
+
+import T27261_aux (myError)
+
+foo :: [String] -> (() -> Int) -> Int
+foo cs =
+ \ k -> ( case bar of
+ Just str -> let cs2 = case cs of { [] -> cs; _ -> "stack entry" : cs }
+ in myError cs2 str
+ Nothing -> \ c -> c () )
+ ( \ _ -> k () )
+
+bar :: Maybe String
+bar = Nothing
+{-# NOINLINE bar #-}
=====================================
testsuite/tests/simplCore/should_compile/T27261_aux.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE BangPatterns #-}
+
+module T27261_aux (myError) where
+
+myError :: [String] -> String -> a
+myError !_ _ = undefined
+{-# NOINLINE myError #-}
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -541,3 +541,4 @@ test('T25883d', [extra_files(['T25883d_import.hs'])], multimod_compile_filter, [
test('T26681', normal, compile, ['-O'])
test('T26903', [grep_errmsg(r'reverse')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques -dsuppress-all'])
test('T26682', normal, multimod_compile, ['T26682', '-O -v0'])
+test('T27261', [extra_files(['T27261_aux.hs'])], multimod_compile, ['T27261', '-v0 -O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ede8d11e16d63622e68977dfe325b70…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ede8d11e16d63622e68977dfe325b70…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/davide/hadrian_avoid_response_files] Hadrian: disable response files for GHC/Haddock builders on non-Windows
by David Eichmann (@DavidEichmann) 29 May '26
by David Eichmann (@DavidEichmann) 29 May '26
29 May '26
David Eichmann pushed to branch wip/davide/hadrian_avoid_response_files at Glasgow Haskell Compiler / GHC
Commits:
52935fea by David Eichmann at 2026-05-29T17:19:55+01:00
Hadrian: disable response files for GHC/Haddock builders on non-Windows
This makes debugging build errors easier on non-windows hosts.
See issue #27230
- - - - -
2 changed files:
- hadrian/src/Builder.hs
- hadrian/src/Hadrian/Utilities.hs
Changes:
=====================================
hadrian/src/Builder.hs
=====================================
@@ -346,7 +346,16 @@ instance H.Builder Builder where
Haddock BuildPackage -> runHaddock path buildArgs buildInputs
- Ghc _ _ -> runGhcWithResponse path buildArgs buildInputs buildOptions
+ Ghc _ _ ->
+ -- Use a response file for ghc invocations to avoid issues with command line
+ -- size limit on Windows (#26637).
+ -- Note we can't put the buildArgs in a response file, because some flags require
+ -- empty arguments (such as the -dep-suffix flag), but that isn't supported
+ -- yet due to #26560.
+ withResponseFileOnWindows
+ buildInputs
+ (escapeArgs buildInputs)
+ (\buildInputs' -> cmd [path] buildArgs buildInputs' buildOptions)
HsCpp -> captureStdout
@@ -386,23 +395,10 @@ runHaddock :: FilePath -- ^ path to @haddock@
-> [String]
-> [FilePath] -- ^ input file paths
-> Action ()
-runHaddock haddockPath flagArgs fileInputs = withResponseFile $ \tmp -> do
- writeFile' tmp $ escapeArgs fileInputs
- cmd [haddockPath] flagArgs ('@' : tmp)
-
--- | Use a response file for ghc invocations to avoid issues with command line
--- size limit on Windows (#26637).
-runGhcWithResponse :: FilePath -- ^ Path to ghc
- -> [String] -- ^ Arguments passed on the command line
- -> [FilePath] -- ^ Input file paths (passed via response file)
- -> [CmdOption]
- -> Action ()
-runGhcWithResponse ghcPath buildArgs buildInputs buildOptions = withResponseFile $ \tmp -> do
- -- We can't put the buildArgs in a response file, because some flags require
- -- empty arguments (such as the -dep-suffix flag), but that isn't supported
- -- yet due to #26560.
- writeFile' tmp (escapeArgs buildInputs)
- cmd [ghcPath] buildArgs ('@' : tmp) buildOptions
+runHaddock haddockPath flagArgs fileInputs = withResponseFileOnWindows
+ fileInputs
+ (escapeArgs fileInputs)
+ (\fileInputs' -> cmd [haddockPath] flagArgs fileInputs')
-- TODO: Some builders are required only on certain platforms. For example,
-- 'Objdump' is only required on OpenBSD and AIX. Add support for platform
=====================================
hadrian/src/Hadrian/Utilities.hs
=====================================
@@ -14,7 +14,7 @@ module Hadrian.Utilities (
-- * Paths
BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource,
- KeepResponseFiles (..), keepResponseFiles, withResponseFile,
+ KeepResponseFiles (..), keepResponseFiles, withResponseFile, withResponseFileOnWindows,
-- * File system operations
copyFile, copyFileUntracked, createFileLink, fixFile,
@@ -49,7 +49,9 @@ import Development.Shake hiding (Normal)
import Development.Shake.Classes
import Development.Shake.FilePath
import System.Environment (lookupEnv)
+import System.Info.Extra (isWindows)
import System.IO (hClose, openTempFile)
+import System.IO.Error (isPermissionError)
import qualified Data.ByteString as BS
import qualified Control.Exception.Base as IO
@@ -57,8 +59,7 @@ import qualified Data.HashMap.Strict as Map
import qualified System.Directory.Extra as IO
import qualified System.Info.Extra as IO
import qualified System.IO as IO
-import System.IO.Error (isPermissionError)
-import qualified System.FilePath.Posix as Posix
+import qualified System.FilePath.Posix as Posix
-- | Extract a value from a singleton list, or terminate with an error message
-- if the list does not contain exactly one value.
@@ -328,6 +329,23 @@ keepResponseFiles = do
KeepResponseFiles keep <- userSetting (KeepResponseFiles False)
return keep
+-- | Run an action either with command arguments direcly or by, on windows,
+-- placing those arguments into a response file (initialized to some string).
+--
+-- With @--keep-response-files@, the file is left on disk (if used)
+withResponseFileOnWindows ::
+ [String] -- ^ Command arguments
+ -> String -- ^ Response file content (the command arguments converted to the response file format).
+ -> ([String] -> Action a) -- ^ Perform an action with the given command arguments or, on windows, the with the
+ -- response file initialized and the passed argument is in the form ["@reponseFilePath"]
+ -> Action a
+withResponseFileOnWindows commandArgs responseFileContent action = do
+ if isWindows
+ then withResponseFile $ \tmp -> do
+ writeFile' tmp responseFileContent
+ action ['@' : tmp]
+ else action commandArgs
+
-- | Run an action with a response file path.
--
-- With @--keep-response-files@, the file is left on disk.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52935feab3cdf20cc7c98f6214c38b4…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52935feab3cdf20cc7c98f6214c38b4…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/davide/hadrian_avoid_response_files] Hadrian: disable response files on windows for GHC/Haddock builders
by David Eichmann (@DavidEichmann) 29 May '26
by David Eichmann (@DavidEichmann) 29 May '26
29 May '26
David Eichmann pushed to branch wip/davide/hadrian_avoid_response_files at Glasgow Haskell Compiler / GHC
Commits:
9b9e0d5e by David Eichmann at 2026-05-29T17:14:31+01:00
Hadrian: disable response files on windows for GHC/Haddock builders
This makes debugging build errors easier on non-windows hosts.
See issue #27230
- - - - -
2 changed files:
- hadrian/src/Builder.hs
- hadrian/src/Hadrian/Utilities.hs
Changes:
=====================================
hadrian/src/Builder.hs
=====================================
@@ -346,7 +346,16 @@ instance H.Builder Builder where
Haddock BuildPackage -> runHaddock path buildArgs buildInputs
- Ghc _ _ -> runGhcWithResponse path buildArgs buildInputs buildOptions
+ Ghc _ _ ->
+ -- Use a response file for ghc invocations to avoid issues with command line
+ -- size limit on Windows (#26637).
+ -- Note we can't put the buildArgs in a response file, because some flags require
+ -- empty arguments (such as the -dep-suffix flag), but that isn't supported
+ -- yet due to #26560.
+ withResponseFileOnWindows
+ buildInputs
+ (escapeArgs buildInputs)
+ (\buildInputs' -> cmd [path] buildArgs buildInputs' buildOptions)
HsCpp -> captureStdout
@@ -386,23 +395,10 @@ runHaddock :: FilePath -- ^ path to @haddock@
-> [String]
-> [FilePath] -- ^ input file paths
-> Action ()
-runHaddock haddockPath flagArgs fileInputs = withResponseFile $ \tmp -> do
- writeFile' tmp $ escapeArgs fileInputs
- cmd [haddockPath] flagArgs ('@' : tmp)
-
--- | Use a response file for ghc invocations to avoid issues with command line
--- size limit on Windows (#26637).
-runGhcWithResponse :: FilePath -- ^ Path to ghc
- -> [String] -- ^ Arguments passed on the command line
- -> [FilePath] -- ^ Input file paths (passed via response file)
- -> [CmdOption]
- -> Action ()
-runGhcWithResponse ghcPath buildArgs buildInputs buildOptions = withResponseFile $ \tmp -> do
- -- We can't put the buildArgs in a response file, because some flags require
- -- empty arguments (such as the -dep-suffix flag), but that isn't supported
- -- yet due to #26560.
- writeFile' tmp (escapeArgs buildInputs)
- cmd [ghcPath] buildArgs ('@' : tmp) buildOptions
+runHaddock haddockPath flagArgs fileInputs = withResponseFileOnWindows
+ fileInputs
+ (escapeArgs fileInputs)
+ (\fileInputs' -> cmd [haddockPath] flagArgs fileInputs')
-- TODO: Some builders are required only on certain platforms. For example,
-- 'Objdump' is only required on OpenBSD and AIX. Add support for platform
=====================================
hadrian/src/Hadrian/Utilities.hs
=====================================
@@ -14,7 +14,7 @@ module Hadrian.Utilities (
-- * Paths
BuildRoot (..), buildRoot, buildRootRules, isGeneratedSource,
- KeepResponseFiles (..), keepResponseFiles, withResponseFile,
+ KeepResponseFiles (..), keepResponseFiles, withResponseFile, withResponseFileOnWindows,
-- * File system operations
copyFile, copyFileUntracked, createFileLink, fixFile,
@@ -49,7 +49,9 @@ import Development.Shake hiding (Normal)
import Development.Shake.Classes
import Development.Shake.FilePath
import System.Environment (lookupEnv)
+import System.Info.Extra (isWindows)
import System.IO (hClose, openTempFile)
+import System.IO.Error (isPermissionError)
import qualified Data.ByteString as BS
import qualified Control.Exception.Base as IO
@@ -57,8 +59,7 @@ import qualified Data.HashMap.Strict as Map
import qualified System.Directory.Extra as IO
import qualified System.Info.Extra as IO
import qualified System.IO as IO
-import System.IO.Error (isPermissionError)
-import qualified System.FilePath.Posix as Posix
+import qualified System.FilePath.Posix as Posix
-- | Extract a value from a singleton list, or terminate with an error message
-- if the list does not contain exactly one value.
@@ -328,6 +329,23 @@ keepResponseFiles = do
KeepResponseFiles keep <- userSetting (KeepResponseFiles False)
return keep
+-- | Run an action either with command arguments direcly or by, on windows,
+-- placing those arguments into a response file (initialized to some string).
+--
+-- With @--keep-response-files@, the file is left on disk (if used)
+withResponseFileOnWindows ::
+ [String] -- ^ Command arguments
+ -> String -- ^ Response file content (the command arguments converted to the response file format).
+ -> ([String] -> Action a) -- ^ Perform an action with the given command arguments or, on windows, the with the
+ -- response file initialized and the passed argument is in the form ["@reponseFilePath"]
+ -> Action a
+withResponseFileOnWindows commandArgs responseFileContent action = do
+ if isWindows
+ then withResponseFile $ \tmp -> do
+ writeFile' tmp responseFileContent
+ action ['@' : tmp]
+ else action commandArgs
+
-- | Run an action with a response file path.
--
-- With @--keep-response-files@, the file is left on disk.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b9e0d5e7baffd2e40e2189336ee8cd…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9b9e0d5e7baffd2e40e2189336ee8cd…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/davide/hadrian_avoid_response_files
by David Eichmann (@DavidEichmann) 29 May '26
by David Eichmann (@DavidEichmann) 29 May '26
29 May '26
David Eichmann pushed new branch wip/davide/hadrian_avoid_response_files at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/davide/hadrian_avoid_response…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc] Pushed new branch wip/davide/windows-dlls-and-ghc-internal-def
by David Eichmann (@DavidEichmann) 29 May '26
by David Eichmann (@DavidEichmann) 29 May '26
29 May '26
David Eichmann pushed new branch wip/davide/windows-dlls-and-ghc-internal-def at Glasgow Haskell Compiler / GHC
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/davide/windows-dlls-and-ghc-i…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 8 commits: Add optional config setting for LibDir (#19174)
by Marge Bot (@marge-bot) 29 May '26
by Marge Bot (@marge-bot) 29 May '26
29 May '26
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
ed29a5e6 by Sven Tennie at 2026-05-28T17:30:36-04:00
Add optional config setting for LibDir (#19174)
Previously, the `libDir` was derived from `topDir`. This won't work for
inplace stage2 cross-compilers where binaries and libraries are in
different stage dirs (`_build/stage1/` for executables and
`_build/stage2` for libraries).
`LibDir` is set in the inplace `settings` files. For bindists, we
generate a new `settings` file with no `LibDir` entry. GHC then defaults
to use `topDir` as `libDir` again. This keeps the bindist relocatable.
If `LibDir` is a relative path, it is interpreted relatively to
`topDir`.
The global package db is part of the `lib/` folder. If we want to point
for inplace cross-compilers to the succeeding stage's folder, this is
done by setting `LibDir`. Thus, the global package db must be found
relative to `libDir`` (which may default to `topDir` or be set by
`LibDir`).
The complexity of settings becomes scary. So, add a test to ensure
`LibDir` works as expected.
- - - - -
8339cf8f by Sven Tennie at 2026-05-28T17:30:36-04:00
Add Haddock to FileSettings
Helping to understand the fields' meanings without deeper analyses.
- - - - -
4ce251e4 by Sylvain Henry at 2026-05-28T17:31:39-04:00
foundation test: skip signed minBound `quot` (-1) (#27222)
`minBound `quot` (-1)` for fixed-width signed integers is platform
dependent: the mathematical result -minBound is not representable in
the type. On x86, IDIV traps; LLVM's sdiv is undefined behaviour in
this case; on AArch64/RISC-V, SDIV wraps to minBound.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com>
- - - - -
b8ba7e61 by Simon Jakobi at 2026-05-28T17:32:23-04:00
Prevent dictionary-passing in checkTyEqRhs
...by pre-specializing it to TcM.
Previously, wherever checkTyEqRhs was used in other modules, the
Core showed dictionary passing ($fMonadIOEnv). The added SPECIALIZE
pragma prevents this.
- - - - -
2528c662 by David Eichmann at 2026-05-29T09:36:40-04:00
Hadrian: create a ghc-internal .def file per ghc-internal dll
The .def file generated from rts/win32/libHSghc-internal.def.in contains
the name of the ghc-internal dll. The correct dll name differs based
on if the dll is inplace/final and if using the Dynamic way. Previously,
this was not accounted for and inconsistent dlls names where used. That
led to failure when loading dlls at runtime in experiments with windows
dynamic linking.
- - - - -
6d27ac8b by Sylvain Henry at 2026-05-29T09:36:48-04:00
ghc-bignum: copy backend interface haddocks to Native backend (#27305)
The haddock comments documenting the BigNat backend interface (function
contracts, expected MutableWordArray# sizes, return-value semantics, etc.)
were attached to the FFI backend module. Copy them to the Native backend
so they remain in tree once the FFI backend is removed.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com>
- - - - -
4ce5f90c by Sylvain Henry at 2026-05-29T09:36:48-04:00
ghc-bignum: remove FFI backend (#27305)
The FFI backend of ghc-bignum (now part of ghc-internal) had no known
users and is easy to recreate by relinking ghc-internal with a custom
backend. Remove the backend module, the bignum-ffi cabal flag, and the
ffi option from Hadrian's --bignum selector. The backend interface
documentation now lives in the Native backend module.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com>
- - - - -
da02b9b4 by Sylvain Henry at 2026-05-29T09:36:48-04:00
ghc-bignum: remove Check backend (#27305)
The Check backend of ghc-bignum (now part of ghc-internal) compared the
selected backend's output against the Native backend for validation.
It had no known users. Remove the backend module, the bignum-check
cabal flag, the bignumCheck Hadrian flavour field, and the check-
prefix in Hadrian's --bignum selector.
Co-Authored-By: Claude Opus 4.7 (1M context) <noreply(a)anthropic.com>
- - - - -
36 changed files:
- + changelog.d/libdir-setting
- + changelog.d/remove-bignum-check-backend
- + changelog.d/remove-bignum-ffi-backend
- compiler/GHC/Driver/Config/Interpreter.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Settings.hs
- compiler/GHC/Settings/IO.hs
- compiler/GHC/Tc/Utils/Unify.hs
- hadrian/README.md
- hadrian/doc/user-settings.md
- hadrian/src/CommandLine.hs
- hadrian/src/Flavour/Type.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Settings.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Packages.hs
- libraries/ghc-bignum/ghc-bignum.cabal
- libraries/ghc-boot/GHC/Settings/Utils.hs
- libraries/ghc-internal/bignum-backend.rst
- libraries/ghc-internal/ghc-internal.cabal.in
- libraries/ghc-internal/src/GHC/Internal/Bignum/Backend.hs
- − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Check.hs
- − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/FFI.hs
- libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Native.hs
- − libraries/ghc-internal/src/GHC/Internal/Bignum/Backend/Selected.hs
- rts/win32/libHSghc-internal.def.in
- testsuite/tests/MiniQuickCheck.hs
- + testsuite/tests/ghc-api/settings/LibDir.hs
- + testsuite/tests/ghc-api/settings/LibDir.stdout
- + testsuite/tests/ghc-api/settings/all.T
- testsuite/tests/numeric/should_run/foundation.hs
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f6730aa32dcb9cf81a8512f247e6ec…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f6730aa32dcb9cf81a8512f247e6ec…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/mangoiv/ghc-9.12-bp] Trim the continuation in mkDupableContWithDmds
by Magnus (@MangoIV) 29 May '26
by Magnus (@MangoIV) 29 May '26
29 May '26
Magnus pushed to branch wip/mangoiv/ghc-9.12-bp at Glasgow Haskell Compiler / GHC
Commits:
8725aa42 by mangoiv at 2026-05-29T13:33:44+02:00
Trim the continuation in mkDupableContWithDmds
When there are no remaining argument demands, it means the application
is bottoming. In this case, we can trim the continuation to avoid the
panic that was observed in #27261.
See Note [Trimming the continuation for bottoming functions] in
GHC.Core.Opt.Simplify.Iteration.
This patch was rewritten to avoid pulling in a refactor.
The original patch is included in master as 4a645683ee0bd4421a88cd6ec49b40c6046b041d
- - - - -
5 changed files:
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- + testsuite/tests/simplCore/should_compile/T27261.hs
- + testsuite/tests/simplCore/should_compile/T27261_aux.hs
- testsuite/tests/simplCore/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -24,7 +24,7 @@ import GHC.Core.Opt.Simplify.Env
import GHC.Core.Opt.Simplify.Inline
import GHC.Core.Opt.Simplify.Utils
import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutOkForBinderSwap, BinderSwapDecision (..) )
-import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr )
+import GHC.Core.Make ( FloatBind, mkImpossibleExpr )
import qualified GHC.Core.Make
import GHC.Core.Coercion hiding ( substCo, substCoVar )
import GHC.Core.Reduction
@@ -2293,24 +2293,14 @@ rebuildCall :: SimplEnv -> ArgInfo -> SimplCont
---------- Bottoming applications --------------
rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_dmds = [] }) cont
- -- When we run out of strictness args, it means
- -- that the call is definitely bottom; see GHC.Core.Opt.Simplify.Utils.mkArgInfo
- -- Then we want to discard the entire strict continuation. E.g.
- -- * case (error "hello") of { ... }
- -- * (error "Hello") arg
- -- * f (error "Hello") where f is strict
- -- etc
- -- Then, especially in the first of these cases, we'd like to discard
- -- the continuation, leaving just the bottoming expression. But the
- -- type might not be right, so we may have to add a coerce.
- | not (contIsTrivial cont) -- Only do this if there is a non-trivial
- -- continuation to discard, else we do it
- -- again and again!
- = seqType cont_ty `seq` -- See Note [Avoiding space leaks in OutType]
- return (emptyFloats env, castBottomExpr res cont_ty)
- where
- res = argInfoExpr fun rev_args
- cont_ty = contResultType cont
+ -- When we run out of demands, it means that the call is definitely bottom.
+ -- See (TC2) in Note [Trimming the continuation for bottoming functions]
+ = rebuild env (argInfoExpr fun rev_args) (mkBottomCont env cont)
+ -- NOTE(mangoiv): the env passed to mkBottomCont is only relevant for its static part
+ -- and should not be looked at whatsoever, which is why it should be fine to pass it
+ -- this way. The reason why we deviate from the original patch is that it was done
+ -- after a significant refactor we cannot backport.
+ -- The original patch should be included in `master` as 4a645683ee0bd4421a88cd6ec49b40c6046b041d
---------- Try inlining, if ai_rewrite = TryInlining --------
-- In the TryInlining case we try inlining immediately, before simplifying
@@ -3813,6 +3803,41 @@ When we have
then we can just duplicate those alts because the A and C cases
will disappear immediately. This is more direct than creating
join points and inlining them away. See #4930.
+
+Note [Trimming the continuation for bottoming functions]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose
+ f :: Int -> Int -> Int
+ f x = error "urk"
+
+ foo = f 3 4
+
+f's demand signature say "after one arg I return bottom". We can drop
+the remaining arguments, thus
+
+ foo = case f 3 of {}
+
+This trimming can also be done with other continuations:
+ * case (error "hello") of { ... }
+ * f (error "Hello") where f is strict
+ etc
+
+We implement the trimming in three parts:
+
+(TC1) In `mkArgInfo`, for a bottoming function, we make a list of `RemainingArgDmds`
+ with a finite list of elements (in the example above, just one).
+
+ For comparison, note that, for non-bottoming functions, the `RemainingArgDmds`
+ always finishes with an infinite list of `topDmd`.
+
+(TC2) In `rebuildCall`, when we run out of `RemainingArgDmds` we discard the
+ remaining continuation.
+
+ After discarding the continuation, the types might not match, in which case
+ we leave behind a (case <hole> of {}) wrapper. See the call to `mkBottomCont`.
+
+(TC3) In `mkDupableContWithDmds`, we similarly discard the continuation when
+ we run out of `RemainingArgDmds`.
-}
--------------------
@@ -3931,7 +3956,7 @@ mkDupableContWithDmds env dmds
; return (floats, ApplyToTy { sc_cont = cont'
, sc_arg_ty = arg_ty, sc_hole_ty = hole_ty }) }
-mkDupableContWithDmds env dmds
+mkDupableContWithDmds env (dmd : cont_dmds)
(ApplyToVal { sc_arg = arg, sc_dup = dup, sc_env = se
, sc_cont = cont, sc_hole_ty = hole_ty })
= -- e.g. [...hole...] (...arg...)
@@ -3939,8 +3964,7 @@ mkDupableContWithDmds env dmds
-- let a = ...arg...
-- in [...hole...] a
-- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable
- do { let (dmd:cont_dmds) = dmds -- Never fails
- ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont
+ do { (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont
; let env' = env `setInScopeFromF` floats1
; (_, se', arg') <- simplLazyArg env' dup hole_ty Nothing se arg
; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg'
@@ -3954,6 +3978,12 @@ mkDupableContWithDmds env dmds
-- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils
, sc_dup = OkToDup, sc_cont = cont'
, sc_hole_ty = hole_ty }) }
+mkDupableContWithDmds env dmds cont
+ -- No more demands => function is definitely bottom
+ -- => simply trim the continuation
+ -- c.f. the null-demands case in `rebuildCall`
+ -- See (TC3) in Note [Trimming the continuation for bottoming functions]
+ | [] <- dmds = return (emptyFloats env, mkBottomCont env cont)
mkDupableContWithDmds env _
(Select { sc_bndr = case_bndr, sc_alts = alts, sc_env = se, sc_cont = cont })
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -24,7 +24,7 @@ module GHC.Core.Opt.Simplify.Utils (
SimplCont(..), DupFlag(..), FromWhat(..), StaticEnv,
isSimplified, contIsStop,
contIsDupable, contResultType, contHoleType, contHoleScaling,
- contIsTrivial, contArgs, contIsRhs,
+ contIsTrivial, contArgs, contIsRhs, mkBottomCont,
countArgs,
mkBoringStop, mkRhsStop, mkLazyArgStop,
interestingCallContext,
@@ -87,6 +87,8 @@ import Control.Monad ( guard, when )
import Data.List ( sortBy )
import Data.Maybe
import Data.Graph
+import GHC.Core.TyCo.Compare (eqTypeIgnoringMultiplicity)
+import GHC.Core.Make (mkWildValBinder)
{- *********************************************************************
* *
@@ -505,6 +507,20 @@ contIsTrivial (ApplyToTy { sc_cont = k }) = contIsTrivial
contIsTrivial (CastIt { sc_cont = k }) = contIsTrivial k
contIsTrivial _ = False
+-------------------
+contStop :: SimplCont -> SimplCont
+-- ^ Get the 'Stop' at the tail of the continuation
+--
+-- Always returns a continuation of form @(Stop ...)@.
+contStop stop@(Stop {}) = stop
+contStop (CastIt { sc_cont = k }) = contStop k
+contStop (StrictBind { sc_cont = k }) = contStop k
+contStop (StrictArg { sc_cont = k }) = contStop k
+contStop (Select { sc_cont = k }) = contStop k
+contStop (ApplyToTy { sc_cont = k }) = contStop k
+contStop (ApplyToVal { sc_cont = k }) = contStop k
+contStop (TickIt _ k) = contStop k
+
-------------------
contResultType :: SimplCont -> OutType
contResultType (Stop ty _ _) = ty
@@ -623,6 +639,37 @@ contEvalContext k = case k of
-- Perhaps reconstruct the demand on the scrutinee by looking at field
-- and case binder dmds, see addCaseBndrDmd. No priority right now.
+-------------------
+mkBottomCont ::StaticEnv -> SimplCont -> SimplCont
+-- ^ Given a continuation `cont`, return a `cont` /of the same type/,
+-- looking like @(case \<hole\> of {})@.
+--
+-- This is used when we are going to fill in the @<hole>@ with bottom.
+-- See (TC2,3) in Note [Trimming the continuation for bottoming functions]
+--
+-- Don't bother to trim, making a @case <hole> of {}@, if we have only
+-- an essentially-trivial continuation; e.g. @(<hole> \@ty |> co)@.
+mkBottomCont se cont = go cont
+ where
+ go k@(Stop {}) = k
+ go (TickIt t k') = TickIt t (go k')
+ go k@(CastIt { sc_cont = k' }) = k { sc_cont = go k' }
+ go k@(ApplyToTy { sc_cont = k' }) = k { sc_cont = go k' }
+ go k@(Select { sc_alts = [], sc_cont = Stop {} }) = k -- Optimisation only
+ go k | Stop res_ty _ _ <- stop_cont
+ , hole_ty `eqTypeIgnoringMultiplicity` res_ty
+ = stop_cont
+ | otherwise
+ = Select { sc_alts = []
+ , sc_bndr = mkWildValBinder OneTy hole_ty
+ , sc_dup = OkToDup
+ , sc_env = se
+ , sc_cont = stop_cont }
+ where
+ hole_ty = contHoleType k
+ stop_cont = contStop k
+
+
-------------------
mkArgInfo :: SimplEnv -> RuleEnv -> Id -> SimplCont -> ArgInfo
=====================================
testsuite/tests/simplCore/should_compile/T27261.hs
=====================================
@@ -0,0 +1,17 @@
+{-# OPTIONS_GHC -fno-full-laziness #-}
+
+module T27261 (foo) where
+
+import T27261_aux (myError)
+
+foo :: [String] -> (() -> Int) -> Int
+foo cs =
+ \ k -> ( case bar of
+ Just str -> let cs2 = case cs of { [] -> cs; _ -> "stack entry" : cs }
+ in myError cs2 str
+ Nothing -> \ c -> c () )
+ ( \ _ -> k () )
+
+bar :: Maybe String
+bar = Nothing
+{-# NOINLINE bar #-}
=====================================
testsuite/tests/simplCore/should_compile/T27261_aux.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE BangPatterns #-}
+
+module T27261_aux (myError) where
+
+myError :: [String] -> String -> a
+myError !_ _ = undefined
+{-# NOINLINE myError #-}
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -541,3 +541,4 @@ test('T25883d', [extra_files(['T25883d_import.hs'])], multimod_compile_filter, [
test('T26681', normal, compile, ['-O'])
test('T26903', [grep_errmsg(r'reverse')], compile, ['-O -dno-typeable-binds -ddump-simpl -dsuppress-uniques -dsuppress-all'])
test('T26682', normal, multimod_compile, ['T26682', '-O -v0'])
+test('T27261', [extra_files(['T27261_aux.hs'])], multimod_compile, ['T27261', '-v0 -O'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8725aa42c3349c2c1bd51e7419454a9…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/8725aa42c3349c2c1bd51e7419454a9…
You're receiving this email because of your account on gitlab.haskell.org.
1
0
[Git][ghc/ghc][wip/romes/hadrian-cross-stage2-rebase_SVEN_FINAL] 22 commits: hadrian: Build stage 2 cross compilers
by Sven Tennie (@supersven) 29 May '26
by Sven Tennie (@supersven) 29 May '26
29 May '26
Sven Tennie pushed to branch wip/romes/hadrian-cross-stage2-rebase_SVEN_FINAL at Glasgow Haskell Compiler / GHC
Commits:
a539e303 by Matthew Pickering at 2026-05-29T13:21:40+02:00
hadrian: Build stage 2 cross compilers
* Most of hadrian is abstracted over the stage in order to remove the
assumption that the target of all stages is the same platform. This
allows the RTS to be built for two different targets for example.
* Abstracts the bindist creation logic to allow building either normal
or cross bindists. Normal bindists use stage 1 libraries and a stage 2
compiler. Cross bindists use stage 2 libararies and a stage 2
compiler.
* hadrian: Make binary-dist-dir the default build target. This allows us
to have the logic in one place about which libraries/stages to build
with cross compilers. Fixes #24192
New hadrian target:
* `binary-dist-dir-cross`: Build a cross compiler bindist (compiler =
stage 1, libraries = stage 2)
This commit also contains various changes to make stage2 compilers
feasible.
-------------------------
Metric Decrease:
ManyAlternatives
MultiComponentModulesRecomp
MultiLayerModulesRecomp
T10421
T12425
T12707
T13035
T13379
T15703
T16577
T18698a
T18698b
T18923
T1969
T21839c
T3294
T4801
T5030
T5321Fun
T5642
T783
T9198
T9872d
T9961
parsing001
T5321FD
T6048
T12227
T18140
T18282
T9233
T5631
T9630
-------------------------
Co-authored-by: Sven Tennie <sven.tennie(a)gmail.com>
Fix rebase: settings-use-distro-mingw is now staged
- - - - -
db70f834 by Matthew Pickering at 2026-05-29T13:21:40+02:00
ci: Test cross bindists
We remove the special logic for testing in-tree cross
compilers and instead test cross compiler bindists, like we do for all
other platforms.
- - - - -
9799f794 by Matthew Pickering at 2026-05-29T13:21:40+02:00
ci: Introduce CROSS_STAGE variable
In preparation for building and testing stage3 bindists we introduce the
CROSS_STAGE variable which is used by a CI job to determine what kind of
bindist the CI job should produce.
At the moment we are only using CROSS_STAGE=2 but in the future we will
have some jobs which set CROSS_STAGE=3 to produce native bindists for a
target, but produced by a cross compiler, which can be tested on by
another CI job on the native platform.
CROSS_STAGE=2: Build a normal cross compiler bindist
CROSS_STAGE=3: Build a stage 3 bindist, one which is a native compiler and library for the target
- - - - -
21b8c07a by Sven Tennie at 2026-05-29T13:21:40+02:00
ghc: Distinguish between having an interpreter and having an internal one
Otherwise, we fail with warnings when compiling tools. Actually, these
are related but different things:
- ghc can run an interpreter (either internal or external)
- ghc is compiled with an internal interpreter
- - - - -
3f57e535 by Matthew Pickering at 2026-05-29T13:21:40+02:00
hadrian: Refactor system-cxx-std-lib rules0
I noticed a few things wrong with the hadrian rules for `system-cxx-std-lib` rules.
* For `text` there is an ad-hoc check to depend on `system-cxx-std-lib` outside of `configurePackage`.
* The `system-cxx-std-lib` dependency is not read from cabal files.
* Recache is not called on the packge database after the `.conf` file is generated, a more natural place for this rule is `registerRules`.
Treating this uniformly like other packages is complicated by it not having any source code or a cabal file. However we can do a bit better by reporting the dependency firstly in `PackageData` and then needing the `.conf` file in the same place as every other package in `configurePackage`.
Fixes #25303
- - - - -
a3f4d490 by Sven Tennie at 2026-05-29T13:21:40+02:00
ci: Increase timeout for emulators
Test runs with emulators naturally take longer than on native machines.
Generate jobs.yml
- - - - -
51fb5b44 by Matthew Pickering at 2026-05-29T13:21:40+02:00
ci: Javascript don't set CROSS_EMULATOR
There is no CROSS_EMULATOR needed to run javascript binaries, so we
don't set the CROSS_EMULATOR to some dummy value.
- - - - -
abf225a1 by Sven Tennie at 2026-05-29T13:21:40+02:00
Javascript skip T23697
See #22355 about how HSC2HS and the Javascript target don't play well
together.
- - - - -
f50903fe by Sven Tennie at 2026-05-29T13:21:40+02:00
Mark T24602 as fragile
It was skipped before (due to CROSS_EMULATOR being set, which changed
for JS), so we don't make things worse by marking it as fragile.
- - - - -
f7ad5b50 by Sven Tennie at 2026-05-29T13:21:40+02:00
Windows needs NM_STAGE0 as well
The stage0 always needs nm.
- - - - -
78a2b35c by Sven Tennie at 2026-05-29T13:21:40+02:00
Add haddock to `NoEmulatorNeeded TimeoutIncrease`
- - - - -
d032d81d by Sven Tennie at 2026-05-29T13:21:40+02:00
Delete done TODO
- - - - -
b743be44 by Sven Tennie at 2026-05-29T13:24:34+02:00
Delete done TODO
- - - - -
ee341ea8 by Sven Tennie at 2026-05-29T13:24:34+02:00
Remove cross special case of performance flavour
- - - - -
3cc2bb69 by Sven Tennie at 2026-05-29T13:24:34+02:00
Delete obsolete iserv comment
- - - - -
5e0e25f8 by Sven Tennie at 2026-05-29T13:24:34+02:00
No more cross stage special cases
- - - - -
276d1ff6 by Sven Tennie at 2026-05-29T13:24:35+02:00
Fix commented out code
- - - - -
8e2ea904 by Sven Tennie at 2026-05-29T13:24:35+02:00
Remove trace log
- - - - -
86a51edf by Sven Tennie at 2026-05-29T13:24:35+02:00
configure.ac: Remove unnecessay blank
- - - - -
545763df by Sven Tennie at 2026-05-29T13:24:35+02:00
Drop Rules.Libffi
- - - - -
40637b2e by Sven Tennie at 2026-05-29T13:24:35+02:00
Delete targetSupportsGhciObjects
- - - - -
850bece6 by Sven Tennie at 2026-05-29T13:24:35+02:00
Fixup
- - - - -
62 changed files:
- .gitlab/ci.sh
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- configure.ac
- distrib/configure.ac.in
- hadrian/README.md
- hadrian/bindist/config.mk.in
- + hadrian/cfg/system.config.host.in
- hadrian/cfg/system.config.in
- + hadrian/cfg/system.config.target.in
- hadrian/hadrian.cabal
- hadrian/src/Base.hs
- + hadrian/src/BindistConfig.hs
- hadrian/src/Builder.hs
- hadrian/src/Context.hs
- hadrian/src/Expression.hs
- hadrian/src/Flavour.hs
- hadrian/src/Flavour/Type.hs
- hadrian/src/Hadrian/Builder.hs
- hadrian/src/Hadrian/Haskell/Cabal/Parse.hs
- hadrian/src/Hadrian/Haskell/Cabal/Type.hs
- hadrian/src/Hadrian/Haskell/Hash.hs
- hadrian/src/Hadrian/Oracles/TextFile.hs
- hadrian/src/Oracles/Flag.hs
- hadrian/src/Oracles/Flavour.hs
- hadrian/src/Oracles/Setting.hs
- hadrian/src/Oracles/TestSettings.hs
- hadrian/src/Packages.hs
- hadrian/src/Rules.hs
- hadrian/src/Rules/BinaryDist.hs
- hadrian/src/Rules/CabalReinstall.hs
- hadrian/src/Rules/Changelog.hs
- hadrian/src/Rules/Compile.hs
- hadrian/src/Rules/Documentation.hs
- hadrian/src/Rules/Generate.hs
- hadrian/src/Rules/Gmp.hs
- hadrian/src/Rules/Library.hs
- hadrian/src/Rules/Program.hs
- hadrian/src/Rules/Register.hs
- hadrian/src/Rules/Rts.hs
- hadrian/src/Rules/Test.hs
- hadrian/src/Settings.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Builders/Common.hs
- hadrian/src/Settings/Builders/Configure.hs
- hadrian/src/Settings/Builders/DeriveConstants.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Builders/Hsc2Hs.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Builders/SplitSections.hs
- hadrian/src/Settings/Default.hs
- hadrian/src/Settings/Flavours/GhcInGhci.hs
- hadrian/src/Settings/Flavours/Performance.hs
- hadrian/src/Settings/Flavours/QuickCross.hs
- hadrian/src/Settings/Flavours/Validate.hs
- hadrian/src/Settings/Packages.hs
- hadrian/src/Settings/Program.hs
- hadrian/src/Settings/Warnings.hs
- libraries/base/tests/all.T
- m4/fp_find_nm.m4
- testsuite/ghc-config/ghc-config.hs
- testsuite/tests/javascript/closure/all.T
The diff was not included because it is too large.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee753b795f301de084ff2a7fac6a8a…
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ee753b795f301de084ff2a7fac6a8a…
You're receiving this email because of your account on gitlab.haskell.org.
1
0