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@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@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@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/d603477f4cd5dff83d81d8ecef52e21... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d603477f4cd5dff83d81d8ecef52e21... You're receiving this email because of your account on gitlab.haskell.org.