ghc-internal 9.1204.0 → 9.1401.0

raw patch · 172 files changed

+19905/−1410 lines, 172 filesdep −ghc-bignumdep −ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies removed: ghc-bignum, ghc-prim

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• aclocal.m4 +45/−0
• cbits/HeapPrim.cmm +13/−0
• cbits/RtsIface.c +0/−14
• cbits/Stack.cmm +182/−0
• cbits/StackCloningDecoding.cmm +0/−7
• cbits/Stack_c.c +151/−0
• cbits/debug.c +10/−0
• cbits/gmp_wrappers.c +896/−0
• configure +507/−1
• configure.ac +104/−1
• ghc-internal.buildinfo.in +5/−4
• ghc-internal.cabal +128/−18
• include/HsIntegerGmp.h.in +14/−0
• include/RtsIfaceSymbols.h +12/−12
• include/WordSize.h +32/−0
• jsbits/base.js +70/−29
• jsbits/errno.js +2/−0
• src/GHC/Internal/AllocationLimitHandler.hs +117/−0
• src/GHC/Internal/ArrayArray.hs +3/−3
• src/GHC/Internal/Base.hs +45/−62
• src/GHC/Internal/Bignum/Backend.hs +15/−0
• src/GHC/Internal/Bignum/Backend/Check.hs +508/−0
• src/GHC/Internal/Bignum/Backend/FFI.hs +641/−0
• src/GHC/Internal/Bignum/Backend/GMP.hs +642/−0
• src/GHC/Internal/Bignum/Backend/Native.hs +786/−0
• src/GHC/Internal/Bignum/Backend/Selected.hs +24/−0
• src/GHC/Internal/Bignum/BigNat.hs +1647/−0
• src/GHC/Internal/Bignum/BigNat.hs-boot +23/−0
• src/GHC/Internal/Bignum/Integer.hs +1668/−0
• src/GHC/Internal/Bignum/Integer.hs-boot +37/−0
• src/GHC/Internal/Bignum/Natural.hs +722/−0
• src/GHC/Internal/Bignum/Natural.hs-boot +27/−0
• src/GHC/Internal/Bignum/Primitives.hs +633/−0
• src/GHC/Internal/Bignum/WordArray.hs +434/−0
• src/GHC/Internal/ByteOrder.hs-boot +1/−1
• src/GHC/Internal/CString.hs +344/−0
• src/GHC/Internal/Char.hs +1/−1
• src/GHC/Internal/Classes.hs +1608/−0
• src/GHC/Internal/ClosureTypes.hs +1/−0
• src/GHC/Internal/Conc/IO.hs +12/−4
• src/GHC/Internal/Conc/Signal.hs +5/−2
• src/GHC/Internal/Conc/Sync.hs +4/−4
• src/GHC/Internal/ConsoleHandler.hsc +1/−1
• src/GHC/Internal/Control/Arrow.hs +2/−2
• src/GHC/Internal/Control/Exception/Base.hs +1/−1
• src/GHC/Internal/Control/Monad/Fail.hs +10/−3
• src/GHC/Internal/Control/Monad/Fix.hs +2/−1
• src/GHC/Internal/Control/Monad/Zip.hs +1/−1
• src/GHC/Internal/Data/Coerce.hs +2/−2
• src/GHC/Internal/Data/Data.hs +3/−2
• src/GHC/Internal/Data/Foldable.hs +5/−6
• src/GHC/Internal/Data/Functor/Identity.hs +1/−1
• src/GHC/Internal/Data/List/NonEmpty.hs +4/−3
• src/GHC/Internal/Data/Maybe.hs +3/−3
• src/GHC/Internal/Data/NonEmpty.hs +48/−0
• src/GHC/Internal/Data/OldList.hs +1/−25
• src/GHC/Internal/Data/Traversable.hs +2/−3
• src/GHC/Internal/Data/Tuple.hs +1/−1
• src/GHC/Internal/Data/Type/Ord.hs +1/−1
• src/GHC/Internal/Data/Typeable/Internal.hs +11/−11
• src/GHC/Internal/Data/Version.hs-boot +1/−1
• src/GHC/Internal/Debug.hs +53/−0
• src/GHC/Internal/Encoding/UTF8.hs +3/−39
• src/GHC/Internal/Enum.hs +3/−3
• src/GHC/Internal/Enum.hs-boot +1/−1
• src/GHC/Internal/Err.hs +4/−12
• src/GHC/Internal/Event.hs +4/−1
• src/GHC/Internal/Event/Arr.hs +3/−3
• src/GHC/Internal/Event/IntTable.hs +3/−3
• src/GHC/Internal/Event/Internal.hs +16/−0
• src/GHC/Internal/Event/Internal/Types.hs +5/−0
• src/GHC/Internal/Event/Manager.hs +15/−2
• src/GHC/Internal/Event/Thread.hs +15/−0
• src/GHC/Internal/Event/TimerManager.hs +4/−1
• src/GHC/Internal/Event/Windows.hsc +9/−12
• src/GHC/Internal/Event/Windows/ConsoleEvent.hsc +4/−1
• src/GHC/Internal/Event/Windows/Thread.hs +4/−4
• src/GHC/Internal/Exception.hs +1/−1
• src/GHC/Internal/Exception.hs-boot +1/−1
• src/GHC/Internal/Exception/Backtrace.hs +4/−16
• src/GHC/Internal/Exception/Context.hs-boot +1/−1
• src/GHC/Internal/Exception/Type.hs +2/−2
• src/GHC/Internal/Exception/Type.hs-boot +5/−2
• src/GHC/Internal/Exts.hs +9/−10
• src/GHC/Internal/Float.hs +11/−9
• src/GHC/Internal/Float/ConversionUtils.hs +1/−1
• src/GHC/Internal/Float/RealFracMethods.hs +1/−1
• src/GHC/Internal/Foreign/C/String/Encoding.hs +1/−1
• src/GHC/Internal/Generics.hs +5/−6
• src/GHC/Internal/Heap/Closures.hs +658/−0
• src/GHC/Internal/Heap/Constants.hsc +18/−0
• src/GHC/Internal/Heap/InfoTable.hsc +82/−0
• src/GHC/Internal/Heap/InfoTable/Types.hsc +53/−0
• src/GHC/Internal/Heap/InfoTableProf.hsc +75/−0
• src/GHC/Internal/Heap/ProfInfo/Types.hs +57/−0
• src/GHC/Internal/IO.hs +1/−1
• src/GHC/Internal/IO.hs-boot +4/−2
• src/GHC/Internal/IO/Buffer.hs +2/−2
• src/GHC/Internal/IO/Encoding/CodePage.hs +1/−1
• src/GHC/Internal/IO/Encoding/CodePage/Table.hs +1/−1
• src/GHC/Internal/IO/Encoding/Iconv.hs +1/−1
• src/GHC/Internal/IO/Exception.hs +3/−1
• src/GHC/Internal/IO/Exception.hs-boot +1/−1
• src/GHC/Internal/IO/Handle/FD.hs +5/−5
• src/GHC/Internal/IO/Handle/Lock.hs +9/−3
• src/GHC/Internal/IO/Handle/Lock/Flock.hsc +1/−1
• src/GHC/Internal/IO/Handle/Lock/LinuxOFD.hsc +1/−1
• src/GHC/Internal/IO/Handle/Lock/Windows.hsc +1/−1
• src/GHC/Internal/IO/Handle/Types.hs-boot +1/−1
• src/GHC/Internal/IO/Windows/Handle.hsc +9/−9
• src/GHC/Internal/IOPort.hs +0/−128
• src/GHC/Internal/InfoProv/Types.hsc +1/−1
• src/GHC/Internal/Int.hs +6/−6
• src/GHC/Internal/Integer.hs +4/−4
• src/GHC/Internal/Integer/Logarithms.hs +4/−4
• src/GHC/Internal/IsList.hs +1/−1
• src/GHC/Internal/Ix.hs +1/−1
• src/GHC/Internal/JS/Prim.hs +2/−2
• src/GHC/Internal/JS/Prim/Internal/Build.hs +1/−1
• src/GHC/Internal/LanguageExtensions.hs +2/−0
• src/GHC/Internal/List.hs +6/−73
• src/GHC/Internal/Magic.hs +139/−0
• src/GHC/Internal/Magic/Dict.hs +72/−0
• src/GHC/Internal/Maybe.hs +1/−1
• src/GHC/Internal/Natural.hs +7/−7
• src/GHC/Internal/Num.hs +4/−4
• src/GHC/Internal/Num.hs-boot +1/−1
• src/GHC/Internal/Numeric.hs +6/−3
• src/GHC/Internal/Numeric/Natural.hs +1/−1
• src/GHC/Internal/Pack.hs +1/−76
• src/GHC/Internal/Prim/Exception.hs +43/−0
• src/GHC/Internal/Prim/Ext.hs +249/−0
• src/GHC/Internal/Prim/Panic.hs +124/−0
• src/GHC/Internal/Prim/PtrEq.hs +148/−0
• src/GHC/Internal/Profiling.hs +10/−0
• src/GHC/Internal/RTS/Flags.hsc +2/−0
• src/GHC/Internal/Read.hs +1/−1
• src/GHC/Internal/Real.hs +7/−9
• src/GHC/Internal/Real.hs-boot +2/−2
• src/GHC/Internal/Records.hs +1/−4
• src/GHC/Internal/Show.hs +1/−1
• src/GHC/Internal/Stack/Annotation.hs +31/−0
• src/GHC/Internal/Stack/CloneStack.hs +0/−75
• src/GHC/Internal/Stack/Constants.hsc +135/−0
• src/GHC/Internal/Stack/ConstantsProf.hsc +140/−0
• src/GHC/Internal/Stack/Decode.hs +589/−0
• src/GHC/Internal/Stack/Types.hs +7/−7
• src/GHC/Internal/System/Environment/ExecutablePath.hsc +0/−1
• src/GHC/Internal/System/Posix/Internals.hs +2/−0
• src/GHC/Internal/TH/Lib.hs +25/−50
• src/GHC/Internal/TH/Lift.hs +6/−176
• src/GHC/Internal/TH/Quote.hs +3/−0
• src/GHC/Internal/TH/Syntax.hs +18/−23
• src/GHC/Internal/Text/ParserCombinators/ReadP.hs +2/−1
• src/GHC/Internal/Tuple.hs +600/−0
• src/GHC/Internal/Type/Reflection.hs +3/−3
• src/GHC/Internal/TypeError.hs +2/−2
• src/GHC/Internal/TypeLits.hs +4/−4
• src/GHC/Internal/TypeLits/Internal.hs +1/−1
• src/GHC/Internal/TypeNats.hs +5/−5
• src/GHC/Internal/TypeNats/Internal.hs +1/−1
• src/GHC/Internal/Types.hs +3677/−0
• src/GHC/Internal/Unicode/Bits.hs +1/−1
• src/GHC/Internal/Unicode/Char/DerivedCoreProperties.hs +3/−3
• src/GHC/Internal/Unicode/Char/UnicodeData/GeneralCategory.hs +303/−313
• src/GHC/Internal/Unicode/Char/UnicodeData/SimpleLowerCaseMapping.hs +29/−1
• src/GHC/Internal/Unicode/Char/UnicodeData/SimpleTitleCaseMapping.hs +29/−1
• src/GHC/Internal/Unicode/Char/UnicodeData/SimpleUpperCaseMapping.hs +29/−1
• src/GHC/Internal/Unicode/Version.hs +2/−2
• src/GHC/Internal/Wasm/Prim/Types.hs +9/−7
• src/GHC/Internal/Word.hs +6/−6

@@ -1,5 +1,9 @@ # Revision history for `ghc-internal` +## 9.1401.0 -- yyyy-mm-dd++* Introduce `dataToCodeQ` and `liftDataTyped`, typed variants of `dataToExpQ` and `liftData` respectively.+ ## 9.1001.0 -- 2024-05-01  * Package created containing implementation moved from `base`.

@@ -293,3 +293,48 @@     #include <unistd.h>   ]) ])+++dnl--------------------------------------------------------------------+dnl * Check whether this machine has gmp/gmp3 installed+dnl--------------------------------------------------------------------++AC_DEFUN([LOOK_FOR_GMP_LIB],[+    if test "$HaveFrameworkGMP" = "NO"+    then+        AC_CHECK_LIB([gmp],  [__gmpz_powm],+                     [HaveLibGmp=YES; GMP_LIBS=gmp])+        if test "$HaveLibGmp" = "NO"+        then+            AC_CHECK_LIB([gmp3], [__gmpz_powm],+                         [HaveLibGmp=YES; GMP_LIBS=gmp3])+        fi+        if test "$HaveLibGmp" = "YES"+        then+            AC_CHECK_LIB([$GMP_LIBS], [__gmpz_powm_sec],+                         [HaveSecurePowm=1])+        fi+    fi+])++dnl--------------------------------------------------------------------+dnl * Mac OS X only: check for GMP.framework+dnl--------------------------------------------------------------------++AC_DEFUN([LOOK_FOR_GMP_FRAMEWORK],[+    if test "$HaveLibGmp" = "NO"+    then+        case $target_os in+        darwin*)+            AC_MSG_CHECKING([for GMP.framework])+            save_libs="$LIBS"+            LIBS="-framework GMP"+            AC_TRY_LINK_FUNC(__gmpz_powm_sec,+                             [HaveFrameworkGMP=YES; GMP_FRAMEWORK=GMP])+            LIBS="$save_libs"+            AC_MSG_RESULT([$HaveFrameworkGMP])+            ;;+        esac+    fi+])+

@@ -0,0 +1,13 @@+#include "Cmm.h"++aToWordzh (P_ clos)+{+    return (clos);+}++reallyUnsafePtrEqualityUpToTag (W_ clos1, W_  clos2)+{+    clos1 = UNTAG(clos1);+    clos2 = UNTAG(clos2);+    return (clos1 == clos2);+}

@@ -14,40 +14,26 @@ #define CLOSURE(module, symbol) \     extern StgClosure ghczminternal_##module##_##symbol; -#define PRIMCLOSURE(module, symbol) \-    extern StgClosure ghczmprim_##module##_##symbol;- #define UNDEF_CLOSURE(module, symbol)  #define INFO_TBL(module, symbol) \     extern const StgInfoTable ghczminternal_##module##_##symbol; -#define PRIM_INFO_TBL(module, symbol) \-    extern const StgInfoTable ghczmprim_##module##_##symbol;- #include "RtsIfaceSymbols.h"  #undef CLOSURE-#undef PRIMCLOSURE #undef UNDEF_CLOSURE #undef INFO_TBL-#undef PRIM_INFO_TBL  // HsIface definition #define CLOSURE(module, symbol) \     .symbol = &ghczminternal_##module##_##symbol, -#define PRIMCLOSURE(module, symbol) \-    .symbol = &ghczmprim_##module##_##symbol,- #define UNDEF_CLOSURE(module, symbol) \     .symbol = NULL,  #define INFO_TBL(module, symbol) \     .symbol = &ghczminternal_##module##_##symbol,--#define PRIM_INFO_TBL(module, symbol) \-    .symbol = &ghczmprim_##module##_##symbol,  static HsIface the_ghc_hs_iface = { #include "RtsIfaceSymbols.h"

@@ -0,0 +1,182 @@+// Uncomment to enable assertions during development+// #define DEBUG 1++#include "Cmm.h"++// StgStack_marking was not available in the Stage0 compiler at the time of+// writing. Because, it has been added to derivedConstants when Stack.cmm was+// developed.+#if defined(StgStack_marking)++// Returns the next stackframe's StgStack* and offset in it. And, an indicator+// if this frame is the last one (`hasNext` bit.)+// (StgStack*, StgWord, StgWord) advanceStackFrameLocationzh(StgStack* stack, StgWord offsetWords)+advanceStackFrameLocationzh (P_ stack, W_ offsetWords) {+  W_ frameSize;+  (frameSize) = ccall stackFrameSize(stack, offsetWords);++  P_ nextClosurePtr;+  nextClosurePtr = (StgStack_sp(stack) + WDS(offsetWords) + WDS(frameSize));++  P_ stackArrayPtr;+  stackArrayPtr = stack + SIZEOF_StgHeader + OFFSET_StgStack_stack;++  P_ stackBottom;+  W_ stackSize, stackSizeInBytes;+  stackSize = TO_W_(StgStack_stack_size(stack));+  stackSizeInBytes = WDS(stackSize);+  stackBottom = stackSizeInBytes + stackArrayPtr;++  P_ newStack;+  W_ newOffsetWords, hasNext;+  if(nextClosurePtr < stackBottom) (likely: True) {+    newStack = stack;+    newOffsetWords = offsetWords + frameSize;+    hasNext = 1;+  } else {+    P_ underflowFrameStack;+    (underflowFrameStack) = ccall getUnderflowFrameStack(stack, offsetWords);+    if (underflowFrameStack == NULL) (likely: True) {+      newStack = NULL;+      newOffsetWords = NULL;+      hasNext = NULL;+    } else {+      newStack = underflowFrameStack;+      newOffsetWords = NULL;+      hasNext = 1;+    }+  }++  return (newStack, newOffsetWords, hasNext);+}++// (StgWord, StgWord) getSmallBitmapzh(StgStack* stack, StgWord offsetWords)+getSmallBitmapzh(P_ stack, W_ offsetWords) {+  P_ c;+  c = StgStack_sp(stack) + WDS(offsetWords);+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));++  W_ bitmap, size;+  (bitmap) = ccall getBitmapWord(c);+  (size) = ccall getBitmapSize(c);++  return (bitmap, size);+}+++// (StgWord, StgWord) getRetFunSmallBitmapzh(StgStack* stack, StgWord offsetWords)+getRetFunSmallBitmapzh(P_ stack, W_ offsetWords) {+  P_ c;+  c = StgStack_sp(stack) + WDS(offsetWords);+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));++  W_ bitmap, size, specialType;+  (bitmap) = ccall getRetFunBitmapWord(c);+  (size) = ccall getRetFunBitmapSize(c);++  return (bitmap, size);+}++// (StgWord*, StgWord) getLargeBitmapzh(StgStack* stack, StgWord offsetWords)+getLargeBitmapzh(P_ stack, W_ offsetWords) {+  P_ c, words;+  W_ size;+  c = StgStack_sp(stack) + WDS(offsetWords);+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));++  (words) = ccall getLargeBitmap(MyCapability(), c);+  (size) = ccall getLargeBitmapSize(c);++  return (words, size);+}++// (StgWord*, StgWord) getBCOLargeBitmapzh(StgStack* stack, StgWord offsetWords)+getBCOLargeBitmapzh(P_ stack, W_ offsetWords) {+  P_ c, words;+  W_ size;+  c = StgStack_sp(stack) + WDS(offsetWords);+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));++  (words) = ccall getBCOLargeBitmap(MyCapability(), c);+  (size) = ccall getBCOLargeBitmapSize(c);++  return (words, size);+}++// (StgWord*, StgWord) getRetFunLargeBitmapzh(StgStack* stack, StgWord offsetWords)+getRetFunLargeBitmapzh(P_ stack, W_ offsetWords) {+  P_ c, words;+  W_ size;+  c = StgStack_sp(stack) + WDS(offsetWords);+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));++  (words) = ccall getRetFunLargeBitmap(MyCapability(), c);+  (size) = ccall getRetFunSize(c);++  return (words, size);+}++// (StgWord) getWordzh(StgStack* stack, StgWord offsetWords)+getWordzh(P_ stack, W_ offsetWords) {+  P_ wordAddr;+  wordAddr = (StgStack_sp(stack) + WDS(offsetWords));+  return (W_[wordAddr]);+}++// (StgStack*) getUnderflowFrameNextChunkzh(StgStack* stack, StgWord offsetWords)+getUnderflowFrameNextChunkzh(P_ stack, W_ offsetWords) {+  P_ closurePtr;+  closurePtr = (StgStack_sp(stack) + WDS(offsetWords));+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtr));++  P_ next_chunk;+  (next_chunk) = ccall getUnderflowFrameNextChunk(closurePtr);+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(next_chunk));+  return (next_chunk);+}++// (StgWord) getRetFunTypezh(StgStack* stack, StgWord offsetWords)+isArgGenBigRetFunTypezh(P_ stack, W_ offsetWords) {+  P_ c;+  c = StgStack_sp(stack) + WDS(offsetWords);+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));++  W_ type;+  (type) = ccall isArgGenBigRetFunType(c);+  return (type);+}++// (StgInfoTable*, StgInfoTable*) getInfoTableAddrszh(StgStack* stack, StgWord offsetWords)+getInfoTableAddrszh(P_ stack, W_ offsetWords) {+  P_ p, info_struct, info_ptr_ipe_key;+  p = StgStack_sp(stack) + WDS(offsetWords);+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));+  info_struct = %GET_STD_INFO(UNTAG(p));+  info_ptr_ipe_key = %INFO_PTR(UNTAG(p));+  return (info_struct, info_ptr_ipe_key);+}++// (StgInfoTable*) getStackInfoTableAddrzh(StgStack* stack)+getStackInfoTableAddrzh(P_ stack) {+  P_ info;+  info = %GET_STD_INFO(UNTAG(stack));+  return (info);+}++// (StgClosure*) getStackClosurezh(StgStack* stack, StgWord offsetWords)+getStackClosurezh(P_ stack, W_ offsetWords) {+  P_ ptr;+  ptr = StgStack_sp(stack) + WDS(offsetWords);++  P_ closure;+  (closure) = ccall getStackClosure(ptr);+  return (closure);+}++// (bits32) getStackFieldszh(StgStack* stack)+getStackFieldszh(P_ stack){+  bits32 size;+  size = StgStack_stack_size(stack);+  return (size);+}+#endif

@@ -17,10 +17,3 @@      return (); }--stg_decodeStackzh (gcptr stgStack) {-    gcptr stackEntries;-    ("ptr" stackEntries) = ccall decodeClonedStack(MyCapability() "ptr", stgStack "ptr");--    return (stackEntries);-}

@@ -0,0 +1,151 @@+#include "MachDeps.h"+#include "Rts.h"+#include "RtsAPI.h"+#include "rts/Messages.h"+#include "rts/Types.h"+#include "rts/storage/ClosureTypes.h"+#include "rts/storage/Closures.h"+#include "rts/storage/FunTypes.h"+#include "rts/storage/InfoTables.h"++StgWord stackFrameSize(StgStack *stack, StgWord offset) {+  StgClosure *c = (StgClosure *)(stack->sp + offset);+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));+  return stack_frame_sizeW(c);+}++StgStack *getUnderflowFrameStack(StgStack *stack, StgWord offset) {+  StgClosure *frame = (StgClosure *)(stack->sp + offset);+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(frame));+  const StgRetInfoTable *info = get_ret_itbl((StgClosure *)frame);++  if (info->i.type == UNDERFLOW_FRAME) {+    return ((StgUnderflowFrame *)frame)->next_chunk;+  } else {+    return NULL;+  }+}++// Only exists to make the get_itbl macro available in Haskell code (via FFI).+const StgInfoTable *getItbl(StgClosure *closure) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure));+  return get_itbl(closure);+}++StgWord getBitmapSize(StgClosure *c) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));++  const StgInfoTable *info = get_itbl(c);+  StgWord bitmap = info->layout.bitmap;+  return BITMAP_SIZE(bitmap);+}++StgWord getRetFunBitmapSize(StgRetFun *ret_fun) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun));++  const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));+  switch (fun_info->f.fun_type) {+  case ARG_GEN:+    return BITMAP_SIZE(fun_info->f.b.bitmap);+  case ARG_GEN_BIG:+    return GET_FUN_LARGE_BITMAP(fun_info)->size;+  default:+    return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);+  }+}++StgWord getBitmapWord(StgClosure *c) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));++  const StgInfoTable *info = get_itbl(c);+  StgWord bitmap = info->layout.bitmap;+  StgWord bitmapWord = BITMAP_BITS(bitmap);+  return bitmapWord;+}++StgWord getRetFunBitmapWord(StgRetFun *ret_fun) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun));++  const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));+  fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));+  switch (fun_info->f.fun_type) {+  case ARG_GEN:+    return BITMAP_BITS(fun_info->f.b.bitmap);+  case ARG_GEN_BIG:+    // Cannot do more than warn and exit.+    errorBelch("Unexpected ARG_GEN_BIG StgRetFun closure %p", ret_fun);+    stg_exit(EXIT_INTERNAL_ERROR);+  default:+    return BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);+  }+}++StgWord getLargeBitmapSize(StgClosure *c) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));++  const StgInfoTable *info = get_itbl(c);+  StgLargeBitmap *bitmap = GET_LARGE_BITMAP(info);+  return bitmap->size;+}++StgWord getRetFunSize(StgRetFun *ret_fun) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun));++  const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));+  fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));+  switch (fun_info->f.fun_type) {+  case ARG_GEN:+    return BITMAP_SIZE(fun_info->f.b.bitmap);+  case ARG_GEN_BIG:+    return GET_FUN_LARGE_BITMAP(fun_info)->size;+  default:+    return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);+  }+}++StgWord getBCOLargeBitmapSize(StgClosure *c) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));++  StgBCO *bco = (StgBCO *)*c->payload;++  return BCO_BITMAP_SIZE(bco);+}++StgWord *getLargeBitmap(Capability *cap, StgClosure *c) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));+  const StgInfoTable *info = get_itbl(c);+  StgLargeBitmap *bitmap = GET_LARGE_BITMAP(info);++  return bitmap->bitmap;+}++StgWord *getRetFunLargeBitmap(Capability *cap, StgRetFun *ret_fun) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun));++  const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));+  StgLargeBitmap *bitmap = GET_FUN_LARGE_BITMAP(fun_info);++  return bitmap->bitmap;+}++StgWord *getBCOLargeBitmap(Capability *cap, StgClosure *c) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));++  StgBCO *bco = (StgBCO *)*c->payload;+  StgLargeBitmap *bitmap = BCO_BITMAP(bco);++  return bitmap->bitmap;+}++StgStack *getUnderflowFrameNextChunk(StgUnderflowFrame *frame) {+  return frame->next_chunk;+}++StgWord isArgGenBigRetFunType(StgRetFun *ret_fun) {+  ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun));++  const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));+  return fun_info->f.fun_type == ARG_GEN_BIG;+}++StgClosure *getStackClosure(StgClosure **c) { return *c; }

@@ -0,0 +1,10 @@++#include <stdio.h>++void debugLn(char *s) {+    printf("%s\n", s);+}++void debugErrLn(char *s) {+    fprintf(stderr, "%s\n", s);+}

@@ -0,0 +1,896 @@+/*+ * `ghc-bignum` GMP FFI wrappers+ *+ * Copyright (c) 2014, Herbert Valerio Riedel <hvr@gnu.org>+ *+ * BSD3 licensed, see ../LICENSE file for details+ *+ */++#define _ISOC99_SOURCE++#include "HsFFI.h"+#include "MachDeps.h"+#include "HsIntegerGmp.h"+#include "ghc-gmp.h"++#include <assert.h>+#include <stdbool.h>+#include <stdlib.h>+#include <stdint.h>+#include <string.h>+#include <math.h>+#include <float.h>+#include <stdio.h>++++// GMP 4.x compatibility+#if !defined(__GNU_MP_VERSION)+# error __GNU_MP_VERSION not defined+#elif __GNU_MP_VERSION < 4+# error need GMP 4.0 or later+#elif __GNU_MP_VERSION < 5+typedef unsigned long int mp_bitcnt_t;+#endif++#if (GMP_NUMB_BITS) != (GMP_LIMB_BITS)+# error GMP_NUMB_BITS != GMP_LIMB_BITS not supported+#endif++#if (WORD_SIZE_IN_BITS) != (GMP_LIMB_BITS)+# error WORD_SIZE_IN_BITS != GMP_LIMB_BITS not supported+#endif++// sanity check+#if (SIZEOF_HSWORD*8) != WORD_SIZE_IN_BITS+# error (SIZEOF_HSWORD*8) != WORD_SIZE_IN_BITS+#endif++// Turn a (const) {xp,xn} pair into static initializer+#define CONST_MPZ_INIT(xp,xn) \+  {{ ._mp_alloc = 0, ._mp_size  = (xn), ._mp_d = (mp_limb_t*)(xp) }}++// Test if {sp,sn} represents a zero value+static inline int+mp_limb_zero_p(const mp_limb_t sp[], mp_size_t sn)+{+  return !sn || ((sn == 1 || sn == -1) && !sp[0]);+}++static inline mp_size_t+mp_size_abs(const mp_size_t x)+{+  return x>=0 ? x : -x;+}++static inline mp_size_t+mp_size_min(const mp_size_t x, const mp_size_t y)+{+  return x<y ? x : y;+}++static inline mp_size_t+mp_size_minabs(const mp_size_t x, const mp_size_t y)+{+  return mp_size_min(mp_size_abs(x), mp_size_abs(y));+}++/* Perform arithmetic right shift on MPNs (multi-precision naturals)+ *+ * pre-conditions:+ *  - 0 < count < sn*GMP_NUMB_BITS+ *  - rn = sn - floor(count / GMP_NUMB_BITS)+ *  - sn > 0+ *+ * write {sp,sn} right-shifted by count bits into {rp,rn}+ *+ * return value: most-significant limb stored in {rp,rn} result+ */+mp_limb_t+integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[], mp_size_t sn,+                        mp_bitcnt_t count)+{+  const mp_size_t    limb_shift = count / GMP_NUMB_BITS;+  const unsigned int bit_shift  = count % GMP_NUMB_BITS;+  const mp_size_t    rn         = sn - limb_shift;++  if (bit_shift)+    mpn_rshift(rp, &sp[limb_shift], rn, bit_shift);+  else+    memcpy(rp, &sp[limb_shift], rn*sizeof(mp_limb_t));++  return rp[rn-1];+}++/* Twos-complement version of 'integer_gmp_mpn_rshift' for performing+ * arithmetic right shifts on "negative" MPNs.+ *+ * pre-conditions:+ *  - 0 < count < sn*GMP_NUMB_BITS+ *  - rn = sn - floor((count - 1) / GMP_NUMB_BITS)+ *  - sn > 0+ *+ * This variant is needed to operate on MPNs interpreted as negative+ * numbers, which require "rounding" towards minus infinity iff a+ * non-zero bit is shifted out.+ */+mp_limb_t+integer_gmp_mpn_rshift_2c (mp_limb_t rp[], const mp_limb_t sp[],+                           const mp_size_t sn, const mp_bitcnt_t count)+{+  const mp_size_t    limb_shift = count / GMP_NUMB_BITS;+  const unsigned int bit_shift  = count % GMP_NUMB_BITS;+  mp_size_t    rn         = sn - limb_shift;++  // whether non-zero bits were shifted out+  bool nz_shift_out = false;++  if (bit_shift) {+    if (mpn_rshift(rp, &sp[limb_shift], rn, bit_shift))+      nz_shift_out = true;+  } else {+    // rp was allocated (rn + 1) limbs, to prevent carry+    // on mpn_add_1 when all the bits of {rp, rn} are 1.+    memset(&rp[rn], 0, sizeof(mp_limb_t));+    memcpy(rp, &sp[limb_shift], rn*sizeof(mp_limb_t));+    rn++;+  }++  if (!nz_shift_out)+    for (unsigned i = 0; i < limb_shift; i++)+      if (sp[i]) {+        nz_shift_out = true;+        break;+      }++  // round if non-zero bits were shifted out+  if (nz_shift_out)+    if (mpn_add_1(rp, rp, rn, 1))+      abort(); /* should never happen */++  return rp[rn-1];+}++/* Perform left-shift operation on MPN+ *+ * pre-conditions:+ *  - 0 < count+ *  - rn = sn + ceil(count / GMP_NUMB_BITS)+ *  - sn > 0+ *+ * return value: most-significant limb stored in {rp,rn} result+ */+mp_limb_t+integer_gmp_mpn_lshift (mp_limb_t rp[], const mp_limb_t sp[],+                        const mp_size_t sn, const mp_bitcnt_t count)+{+  const mp_size_t    limb_shift = count / GMP_NUMB_BITS;+  const unsigned int bit_shift  = count % GMP_NUMB_BITS;+  const mp_size_t    rn0        = sn + limb_shift;++  memset(rp, 0, limb_shift*sizeof(mp_limb_t));+  if (bit_shift) {+    const mp_limb_t msl = mpn_lshift(&rp[limb_shift], sp, sn, bit_shift);+    rp[rn0] = msl;+    return msl;+  } else {+    memcpy(&rp[limb_shift], sp, sn*sizeof(mp_limb_t));+    return rp[rn0-1];+  }+}++/* Convert bignum to a `double`, truncating if necessary+ * (i.e. rounding towards zero).+ *+ * sign of mp_size_t argument controls sign of converted double+ */+HsDouble+integer_gmp_mpn_get_d (const mp_limb_t sp[], const mp_size_t sn,+                       const HsInt exponent)+{+  if (mp_limb_zero_p(sp, sn))+    return 0.0;++  const mpz_t mpz = CONST_MPZ_INIT(sp, sn);++  if (!exponent)+    return mpz_get_d(mpz);++  long e = 0;+  double d = mpz_get_d_2exp (&e, mpz);++  // TODO: over/underflow handling?+  return ldexp(d, e+exponent);+}++mp_limb_t+integer_gmp_gcd_word(const mp_limb_t x, const mp_limb_t y)+{+  if (!x) return y;+  if (!y) return x;++  return mpn_gcd_1(&x, 1, y);+}++mp_limb_t+integer_gmp_mpn_gcd_1(const mp_limb_t x[], const mp_size_t xn,+                      const mp_limb_t y)+{+  assert (xn > 0);+  assert (xn == 1 || y != 0);++  if (xn == 1)+    return integer_gmp_gcd_word(x[0], y);++  return mpn_gcd_1(x, xn, y);+}+++mp_size_t+integer_gmp_mpn_gcd(mp_limb_t r[],+                    const mp_limb_t x0[], const mp_size_t xn,+                    const mp_limb_t y0[], const mp_size_t yn)+{+  assert (xn >= yn);+  assert (yn > 0);+  assert (xn == yn || yn > 1 || y0[0] != 0);+  /* post-condition: rn <= xn */++  if (yn == 1) {+    if (y0[0]) {+      r[0] = integer_gmp_mpn_gcd_1(x0, xn, y0[0]);+      return 1;+    } else { /* {y0,yn} == 0 */+      assert (xn==yn); /* NB: redundant assertion */+      memcpy(r, x0, xn*sizeof(mp_limb_t));+      return xn;+    }+  } else {+    // mpn_gcd() seems to require non-trivial normalization of its+    // input arguments (which does not seem to be documented anywhere,+    // see source of mpz_gcd() for more details), so we resort to just+    // use mpz_gcd() which does the tiresome normalization for us at+    // the cost of a few additional temporary buffer allocations in+    // C-land.++    const mpz_t op1 = CONST_MPZ_INIT(x0, xn);+    const mpz_t op2 = CONST_MPZ_INIT(y0, yn);++    mpz_t rop;+    mpz_init (rop);++    mpz_gcd(rop, op1, op2);++    const mp_size_t rn = rop[0]._mp_size;+    assert(rn > 0);+    assert(rn <= xn);++    /* the allocation/memcpy of the result can be neglectable since+       mpz_gcd() already has to allocate other temporary buffers+       anyway */+    memcpy(r, rop[0]._mp_d, rn*sizeof(mp_limb_t));++    mpz_clear(rop);++    return rn;+  }+}++/* wraps mpz_gcdext()+ *+ * Set g={g0,gn} to the greatest common divisor of x={x0,xn} and+ * y={y0,yn}, and in addition set s={s0,sn} and t={t0,tn} to+ * coefficients satisfying x*s + y*t = g.+ *+ * g0 must have space for exactly gn=min(xn,yn) limbs.+ * s0 must have space for at least yn limbs.+ * t0 must have space for at least xn limbs.+ *+ * Actual sizes are returned by pointers.+ *+ */+void+integer_gmp_gcdext(mp_limb_t s0[], int32_t * ssn,+                   mp_limb_t t0[], int32_t * stn,+                   mp_limb_t g0[], int32_t * gn,+                   const mp_limb_t x0[], const mp_size_t xn,+                   const mp_limb_t y0[], const mp_size_t yn)+{+  const mpz_t x = CONST_MPZ_INIT(x0, mp_limb_zero_p(x0,xn) ? 0 : xn);+  const mpz_t y = CONST_MPZ_INIT(y0, mp_limb_zero_p(y0,yn) ? 0 : yn);++  mpz_t g, s, t;+  mpz_init (g);+  mpz_init (s);+  mpz_init (t);++  mpz_gcdext (g, s, t, x, y);++  // g must be positive (0 <= gn).+  // According to the docs for mpz_gcdext(), we have:+  //       g < min(|y|/2|s|, |x|/2|t|)+  // -->   g < min(|y|, |x|)+  // -->   gn <= min(yn, xn)+  // <->   gn <= gn0+  const mp_size_t gn0 = mp_size_minabs(xn, yn);+  *gn = g[0]._mp_size;+  assert(0 <= *gn && *gn <= gn0);+  memcpy(g0, g[0]._mp_d, *gn * sizeof(mp_limb_t));+  mpz_clear (g);++  // According to the docs for mpz_gcdext(), we have:+  //       |s| < |y| / 2g+  // -->   |s| < |y|         (note g > 0)+  // -->   sn <= yn+  *ssn = s[0]._mp_size;+  const mp_size_t sn  = mp_size_abs(*ssn);+  assert(sn <= mp_size_abs(yn));+  memcpy(s0, s[0]._mp_d, sn*sizeof(mp_limb_t));+  mpz_clear (s);++  // According to the docs for mpz_gcdext(), we have:+  //       |t| < |x| / 2g+  // -->   |t| < |x|         (note g > 0)+  // -->   st <= xn+  *stn = t[0]._mp_size;+  const mp_size_t tn  = mp_size_abs(*stn);+  assert(tn <= mp_size_abs(xn));+  memcpy(t0, t[0]._mp_d, tn*sizeof(mp_limb_t));+  mpz_clear (t);+}++/* Truncating (i.e. rounded towards zero) integer division-quotient of MPN */+void+integer_gmp_mpn_tdiv_q (mp_limb_t q[],+                        const mp_limb_t n[], const mp_size_t nn,+                        const mp_limb_t d[], const mp_size_t dn)+{+  /* qn = 1+nn-dn; rn = dn */+  assert(nn>=dn);++  if (dn > 128) {+    // Use temporary heap allocated throw-away buffer for MPNs larger+    // than 1KiB for 64bit-sized limbs (larger than 512bytes for+    // 32bit-sized limbs)+    mp_limb_t *const r = malloc(dn*sizeof(mp_limb_t));+    mpn_tdiv_qr(q, r, 0, n, nn, d, dn);+    free (r);+  } else { // allocate smaller arrays on the stack+    mp_limb_t r[dn];+    mpn_tdiv_qr(q, r, 0, n, nn, d, dn);+  }+}++/* Truncating (i.e. rounded towards zero) integer division-remainder of MPNs */+void+integer_gmp_mpn_tdiv_r (mp_limb_t r[],+                        const mp_limb_t n[], const mp_size_t nn,+                        const mp_limb_t d[], const mp_size_t dn)+{+  /* qn = 1+nn-dn; rn = dn */+  assert(nn>=dn);+  const mp_size_t qn = 1+nn-dn;++  if (qn > 128) {+    // Use temporary heap allocated throw-away buffer for MPNs larger+    // than 1KiB for 64bit-sized limbs (larger than 512bytes for+    // 32bit-sized limbs)+    mp_limb_t *const q = malloc(qn*sizeof(mp_limb_t));+    mpn_tdiv_qr(q, r, 0, n, nn, d, dn);+    free (q);+  } else { // allocate smaller arrays on the stack+    mp_limb_t q[qn];+    mpn_tdiv_qr(q, r, 0, n, nn, d, dn);+  }+}+++/* Wraps GMP's 'mpz_sizeinbase()' function */+HsWord+integer_gmp_mpn_sizeinbase(const mp_limb_t s[], const mp_size_t sn,+                           const HsInt base)+{+  assert (2 <= base && base <= 256);++  if (mp_limb_zero_p(s,sn)) return 1;++  const mpz_t zs = CONST_MPZ_INIT(s, sn);++  return mpz_sizeinbase(zs, base);+}++/* Single-limb version of 'integer_gmp_mpn_sizeinbase()' */+HsWord+integer_gmp_mpn_sizeinbase1(const mp_limb_t s, const HsInt base)+{+  return s ? integer_gmp_mpn_sizeinbase(&s, 1, base) : 1;+}++/* Wrapper around GMP's 'mpz_export()' function */+HsWord+integer_gmp_mpn_export(const mp_limb_t s[], const mp_size_t sn,+                       void *destptr, HsInt destofs, HsInt msbf)+{+  /* TODO: implement w/o GMP, c.f. 'integer_gmp_mpn_import()' */+  assert (msbf == 0 || msbf == 1);++  if (mp_limb_zero_p(s,sn)) return 0;++  const mpz_t zs = CONST_MPZ_INIT(s, sn);++  size_t written = 0;++  // mpz_export (void *rop, size_t *countp, int order, size_t size, int endian,+  //             size_t nails, const mpz_t op)+  (void) mpz_export(((char *)destptr)+destofs, &written, !msbf ? -1 : 1,+                    /* size */ 1, /* endian */ 0, /* nails */ 0, zs);++  return written;+}++/* Single-limb version of 'integer_gmp_mpn_export()' */+HsWord+integer_gmp_mpn_export1(const mp_limb_t s,+                        void *destptr, const HsInt destofs, const HsInt msbf)+{+  /* TODO: implement w/o GMP */+  return integer_gmp_mpn_export(&s, 1, destptr, destofs, msbf);+}++/* Import single limb from memory location+ *+ * We can't use GMP's 'mpz_import()'+ */+HsWord+integer_gmp_mpn_import1(const uint8_t *srcptr, const HsWord srcofs,+                        const HsWord srclen, const HsInt msbf)+{+  assert (msbf == 0 || msbf == 1);+  assert (srclen <= SIZEOF_HSWORD);++  srcptr += srcofs;++  HsWord result = 0;++  if (msbf)+    for (unsigned i = 0; i < srclen; ++i)+      result |= (HsWord)srcptr[i] << ((srclen-i-1)*8);+  else // lsbf+    for (unsigned i = 0; i < srclen; ++i)+      result |= (HsWord)srcptr[i] << (i*8);++  return result;+}++/* import into mp_limb_t[] from memory location */+void+integer_gmp_mpn_import(mp_limb_t * restrict r, const uint8_t * restrict srcptr,+                       const HsWord srcofs, const HsWord srclen,+                       const HsInt msbf)+{+  assert (msbf == 0 || msbf == 1);++  srcptr += srcofs;++  const unsigned  limb_cnt_rem = srclen % SIZEOF_HSWORD;+  const mp_size_t limb_cnt     = srclen / SIZEOF_HSWORD;++  if (msbf) {+    if (limb_cnt_rem) { // partial limb+      r[limb_cnt] = integer_gmp_mpn_import1(srcptr, 0, limb_cnt_rem, 1);+      srcptr += limb_cnt_rem;+    }++    for (unsigned ri = 0; ri < limb_cnt; ++ri) {+      r[limb_cnt-ri-1] = integer_gmp_mpn_import1(srcptr, 0, SIZEOF_HSWORD, 1);+      srcptr += SIZEOF_HSWORD;+    }+  } else { // lsbf+    for (unsigned ri = 0; ri < limb_cnt; ++ri) {+      r[ri] = integer_gmp_mpn_import1(srcptr, 0, SIZEOF_HSWORD, 0);+      srcptr += SIZEOF_HSWORD;+    }++    if (limb_cnt_rem) // partial limb+      r[limb_cnt] = integer_gmp_mpn_import1(srcptr, 0, limb_cnt_rem, 0);+  }+}++/* Scan for first non-zero byte starting at srcptr[srcofs], ending at+ * srcptr[srcofs+srclen-1];+ *+ * If no non-zero byte found, returns srcofs+srclen; otherwise returns+ * index of srcptr where first non-zero byte was found.+ */+HsWord+integer_gmp_scan_nzbyte(const uint8_t *srcptr,+                        const HsWord srcofs, const HsWord srclen)+{+  // TODO: consider implementing this function in Haskell-land+  srcptr += srcofs;++  for (unsigned i = 0; i < srclen; ++i)+    if (srcptr[i])+      return srcofs+i;++  return srcofs+srclen;+}++/* Reverse scan for non-zero byte+ * starting at srcptr[srcofs+srclen-1], ending at srcptr[srcofs].+ *+ * Returns new length srclen1 such that srcptr[srcofs+i] == 0 for+ * srclen1 <= i < srclen.+ */+HsWord+integer_gmp_rscan_nzbyte(const uint8_t *srcptr,+                         const HsWord srcofs, const HsWord srclen)+{+  // TODO: consider implementing this function in Haskell-land+  srcptr += srcofs;++  for (unsigned i = srclen; i > 0; --i)+    if (srcptr[i-1])+      return i;++  return 0;+}++/* wrapper around mpz_probab_prime_p */+HsInt+integer_gmp_test_prime(const mp_limb_t s[], const mp_size_t sn, const HsInt rep)+{+  if (mp_limb_zero_p(s,sn)) return 0;++  const mpz_t sz = CONST_MPZ_INIT(s, sn);++  // int mpz_probab_prime_p (const mpz_t n, int reps)+  return mpz_probab_prime_p(sz, rep);+}++/* wrapper around mpz_probab_prime_p */+HsInt+integer_gmp_test_prime1(const mp_limb_t limb, const HsInt rep)+{+  if (!limb) return 0;++  return integer_gmp_test_prime(&limb, 1, rep);+}++/* wrapper around mpz_nextprime()+ *+ * Stores next prime (relative to {sp,sn}) in {rp,sn}.+ * Return value is most significant limb of {rp,sn+1}.+ */+mp_limb_t+integer_gmp_next_prime(mp_limb_t rp[], const mp_limb_t sp[],+                       const mp_size_t sn)+{+  assert (sn>=0);++  if (!sn) return 2;+  if (sn == 1 && sp[0] < 2) {+    rp[0] = 2;+    return 0;+  }++  const mpz_t op = CONST_MPZ_INIT(sp, sn);++  mpz_t rop;+  mpz_init (rop);+  mpz_nextprime (rop, op);++  const mp_size_t rn = rop[0]._mp_size;++  // copy result into {rp,sn} buffer+  assert (rn == sn || rn == sn+1);+  memcpy(rp, rop[0]._mp_d, sn*sizeof(mp_limb_t));+  const mp_limb_t result = rn>sn ? rop[0]._mp_d[sn] : 0;++  mpz_clear (rop);++  return result;+}++/* wrapper around mpz_nextprime()+ *+ * returns next prime modulo 2^GMP_LIMB_BITS+ */+mp_limb_t+integer_gmp_next_prime1(const mp_limb_t limb)+{+  if (limb < 2) return 2;++  const mpz_t op = CONST_MPZ_INIT(&limb, 1);++  mpz_t rop;+  mpz_init (rop);+  mpz_nextprime (rop, op);+  assert (rop[0]._mp_size > 0);+  const mp_limb_t result = rop[0]._mp_d[0];+  mpz_clear (rop);++  return result;+}++/* wrapper around mpz_powm()+ *+ * Store '(B^E) mod M' in {rp,rn}+ *+ * rp must have allocated mn limbs; This function's return value is+ * the actual number rn (0 < rn <= mn) of limbs written to the rp limb-array.+ *+ * bn and en are allowed to be negative to denote negative numbers+ */+mp_size_t+integer_gmp_powm(mp_limb_t rp[], // result+                 const mp_limb_t bp[], const mp_size_t bn, // base+                 const mp_limb_t ep[], const mp_size_t en, // exponent+                 const mp_limb_t mp[], const mp_size_t mn) // mod+{+  assert(!mp_limb_zero_p(mp,mn));++  if ((mn == 1 || mn == -1) && mp[0] == 1) {+    return 0;+  }++  if (mp_limb_zero_p(ep,en)) {+    rp[0] = 1;+    return 1;+  }++  const mpz_t b = CONST_MPZ_INIT(bp, mp_limb_zero_p(bp,bn) ? 0 : bn);+  const mpz_t e = CONST_MPZ_INIT(ep, en);+  const mpz_t m = CONST_MPZ_INIT(mp, mn);++  mpz_t r;+  mpz_init (r);++  mpz_powm(r, b, e, m);++  const mp_size_t rn = r[0]._mp_size;++  if (rn) {+    assert(0 < rn && rn <= mn);+    memcpy(rp, r[0]._mp_d, rn*sizeof(mp_limb_t));+  }++  mpz_clear (r);++  return rn;+}++/* version of integer_gmp_powm() for single-limb moduli */+mp_limb_t+integer_gmp_powm1(const mp_limb_t bp[], const mp_size_t bn, // base+                  const mp_limb_t ep[], const mp_size_t en, // exponent+                  const mp_limb_t m0) // mod+{+  assert(m0);++  if (m0==1) return 0;+  if (mp_limb_zero_p(ep,en)) return 1;++  const mpz_t b = CONST_MPZ_INIT(bp, mp_limb_zero_p(bp,bn) ? 0 : bn);+  const mpz_t e = CONST_MPZ_INIT(ep, en);+  const mpz_t m = CONST_MPZ_INIT(&m0, !!m0);++  mpz_t r;+  mpz_init (r);+  mpz_powm(r, b, e, m);++  assert(r[0]._mp_size == 0 || r[0]._mp_size == 1);+  const mp_limb_t result = r[0]._mp_size ? r[0]._mp_d[0] : 0;++  mpz_clear (r);++  return result;+}++/* version of integer_gmp_powm() for single-limb arguments */+mp_limb_t+integer_gmp_powm_word(const mp_limb_t b0, // base+                      const mp_limb_t e0, // exponent+                      const mp_limb_t m0) // mod+{+  return integer_gmp_powm1(&b0, !!b0, &e0, !!e0, m0);+}++/* version of integer_gmp_powm() based on mpz_powm_sec+ *+ * With GMP 5.0 or later execution time depends on size of arguments+ * and size of result.+ *+ * 'M' must be odd and 'E' non-negative.+ */+mp_size_t+integer_gmp_powm_sec(mp_limb_t rp[], // result+                     const mp_limb_t bp[], const mp_size_t bn, // base+                     const mp_limb_t ep[], const mp_size_t en, // exponent+                     const mp_limb_t mp[], const mp_size_t mn) // mod+{+  assert(!mp_limb_zero_p(mp,mn));+  assert(mp[0] & 1);++  if ((mn == 1 || mn == -1) && mp[0] == 1) {+    return 0;+  }++  if (mp_limb_zero_p(ep,en)) {+    rp[0] = 1;+    return 1;+  }++  assert(en > 0);++  const mpz_t b = CONST_MPZ_INIT(bp, mp_limb_zero_p(bp,bn) ? 0 : bn);+  const mpz_t e = CONST_MPZ_INIT(ep, en);+  const mpz_t m = CONST_MPZ_INIT(mp, mn);++  mpz_t r;+  mpz_init (r);++#if HAVE_SECURE_POWM == 0+  mpz_powm(r, b, e, m);+#else+  mpz_powm_sec(r, b, e, m);+#endif++  const mp_size_t rn = r[0]._mp_size;++  if (rn) {+    assert(0 < rn && rn <= mn);+    memcpy(rp, r[0]._mp_d, rn*sizeof(mp_limb_t));+  }++  mpz_clear (r);++  return rn;+}+++/* wrapper around mpz_invert()+ *+ * Store '(1/X) mod abs(M)' in {rp,rn}+ *+ * rp must have allocated mn limbs; This function's return value is+ * the actual number rn (0 < rn <= mn) of limbs written to the rp limb-array.+ *+ * Returns 0 if inverse does not exist.+ */+mp_size_t+integer_gmp_invert(mp_limb_t rp[], // result+                   const mp_limb_t xp[], const mp_size_t xn, // base+                   const mp_limb_t mp[], const mp_size_t mn) // mod+{+  if (mp_limb_zero_p(xp,xn)+      || mp_limb_zero_p(mp,mn)+      || ((mn == 1 || mn == -1) && mp[0] == 1)) {+    return 0;+  }++  const mpz_t x = CONST_MPZ_INIT(xp, xn);+  const mpz_t m = CONST_MPZ_INIT(mp, mn);++  mpz_t r;+  mpz_init (r);++  const int inv_exists = mpz_invert(r, x, m);++  const mp_size_t rn = inv_exists ? r[0]._mp_size : 0;++  if (rn) {+    assert(0 < rn && rn <= mn);+    memcpy(rp, r[0]._mp_d, rn*sizeof(mp_limb_t));+  }++  mpz_clear (r);++  return rn;+}+++/* Version of integer_gmp_invert() operating on single limbs */+mp_limb_t+integer_gmp_invert_word(const mp_limb_t x0, const mp_limb_t m0)+{+  if (!x0 || m0<=1) return 0;+  if (x0 == 1) return 1;++  const mpz_t x = CONST_MPZ_INIT(&x0, 1);+  const mpz_t m = CONST_MPZ_INIT(&m0, 1);++  mpz_t r;+  mpz_init (r);++  const int inv_exists = mpz_invert(r, x, m);+  const mp_size_t rn = inv_exists ? r[0]._mp_size : 0;++  assert (rn == 0 || rn == 1);+  const mp_limb_t r0 = rn ? r[0]._mp_d[0] : 0;++  mpz_clear (r);++  return r0;+}+++/* Wrappers for GMP 4.x compat+ *+ * In GMP 5.0 the following operations were added:+ *+ *  mpn_sqr, mpn_and_n, mpn_ior_n, mpn_xor_n, mpn_nand_n, mpn_nior_n,+ *  mpn_xnor_n, mpn_andn_n, mpn_iorn_n, mpn_com, mpn_neg, mpn_copyi,+ *  mpn_copyd, mpn_zero+ *+ * We use some of those, but for GMP 4.x compatibility we need to+ * emulate those (while incurring some overhead).+ */+#if __GNU_MP_VERSION < 5++#define MPN_LOGIC_OP_WRAPPER(MPN_WRAPPER, MPZ_OP) \+void                                                               \+MPN_WRAPPER(mp_limb_t *rp, const mp_limb_t *s1p,                   \+            const mp_limb_t *s2p, mp_size_t n)                     \+{                                                                  \+  assert(n > 0);                                                   \+                                                                   \+  const mpz_t s1 = CONST_MPZ_INIT(s1p, n);                         \+  const mpz_t s2 = CONST_MPZ_INIT(s2p, n);                         \+                                                                   \+  mpz_t r;                                                         \+  mpz_init (r);                                                    \+  MPZ_OP (r, s1, s2);                                              \+                                                                   \+  const mp_size_t rn = r[0]._mp_size;                              \+  memset (rp, 0, n*sizeof(mp_limb_t));                             \+  memcpy (rp, r[0]._mp_d, mp_size_minabs(rn,n)*sizeof(mp_limb_t)); \+                                                                   \+  mpz_clear (r);                                                   \+}++static void+__mpz_andn(mpz_t r, const mpz_t s1, const mpz_t s2)+{+  mpz_t s2c;+  mpz_init (s2c);+  mpz_com (s2c, s2);+  mpz_and (r, s1, s2c);+  mpz_clear (s2c);+}++MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_and_n,  mpz_and)+MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_andn_n, __mpz_andn)+MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_ior_n,  mpz_ior)+MPN_LOGIC_OP_WRAPPER(integer_gmp_mpn_xor_n,  mpz_xor)++#else /* __GNU_MP_VERSION >= 5 */+void+integer_gmp_mpn_and_n(mp_limb_t *rp, const mp_limb_t *s1p,+                      const mp_limb_t *s2p, mp_size_t n)+{+  mpn_and_n(rp, s1p, s2p, n);+}++void+integer_gmp_mpn_andn_n(mp_limb_t *rp, const mp_limb_t *s1p,+                      const mp_limb_t *s2p, mp_size_t n)+{+  mpn_andn_n(rp, s1p, s2p, n);+}++void+integer_gmp_mpn_ior_n(mp_limb_t *rp, const mp_limb_t *s1p,+                      const mp_limb_t *s2p, mp_size_t n)+{+  mpn_ior_n(rp, s1p, s2p, n);+}++void+integer_gmp_mpn_xor_n(mp_limb_t *rp, const mp_limb_t *s1p,+                      const mp_limb_t *s2p, mp_size_t n)+{+  mpn_xor_n(rp, s1p, s2p, n);+}+#endif

@@ -652,6 +652,18 @@ ac_subst_vars='LTLIBOBJS LIBOBJS EXTRA_LIBS+GhcGmpVerPl+GhcGmpVerMi+GhcGmpVerMj+UseIntreeGmp+HaveSecurePowm+HaveFrameworkGMP+HaveLibGmp+GMP_INSTALL_INCLUDES+GMP_FRAMEWORK+GMP_LIB_DIRS+GMP_LIBS+GMP_INCLUDE_DIRS ICONV_LIB_DIRS ICONV_INCLUDE_DIRS EGREP@@ -709,6 +721,11 @@ enable_largefile with_iconv_includes with_iconv_libraries+with_gmp+with_gmp_includes+with_gmp_libraries+with_gmp_framework_preferred+with_intree_gmp with_libcharset '       ac_precious_vars='build_alias@@ -1345,6 +1362,12 @@   --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)   --with-iconv-includes   directory containing iconv.h   --with-iconv-libraries  directory containing iconv library+  --with-gmp              Enable GMP backend+  --with-gmp-includes     directory containing gmp.h+  --with-gmp-libraries    directory containing gmp library+  --with-gmp-framework-preferred+                          on OSX, prefer the GMP framework to the gmp lib+  --with-intree-gmp       force using the in-tree GMP   --with-libcharset       Use libcharset [default=only if available]  Some influential environment variables:@@ -5046,6 +5069,488 @@   ++# Check whether --with-gmp was given.+if test ${with_gmp+y}+then :+  withval=$with_gmp; GMP_ENABLED=YES+else $as_nop+  GMP_ENABLED=NO+fi++++# Check whether --with-gmp-includes was given.+if test ${with_gmp_includes+y}+then :+  withval=$with_gmp_includes; GMP_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval"+else $as_nop+  GMP_INCLUDE_DIRS=+fi++++# Check whether --with-gmp-libraries was given.+if test ${with_gmp_libraries+y}+then :+  withval=$with_gmp_libraries; GMP_LIB_DIRS=$withval; LDFLAGS="-L$withval"+else $as_nop+  GMP_LIB_DIRS=+fi++++# Check whether --with-gmp-framework-preferred was given.+if test ${with_gmp_framework_preferred+y}+then :+  withval=$with_gmp_framework_preferred; GMP_PREFER_FRAMEWORK=YES+else $as_nop+  GMP_PREFER_FRAMEWORK=NO+fi++++# Check whether --with-intree-gmp was given.+if test ${with_intree_gmp+y}+then :+  withval=$with_intree_gmp; GMP_FORCE_INTREE=YES+else $as_nop+  GMP_FORCE_INTREE=NO+fi+++if test "$GMP_ENABLED" = "YES"+then+++   HaveLibGmp=NO+   GMP_LIBS=+   HaveFrameworkGMP=NO+   GMP_FRAMEWORK=+   HaveSecurePowm=0++   if test "$GMP_FORCE_INTREE" != "YES"+   then+       if test "$GMP_PREFER_FRAMEWORK" = "YES"+       then++    if test "$HaveLibGmp" = "NO"+    then+        case $target_os in+        darwin*)+            { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for GMP.framework" >&5+printf %s "checking for GMP.framework... " >&6; }+            save_libs="$LIBS"+            LIBS="-framework GMP"+            cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+char __gmpz_powm_sec ();+int+main (void)+{+return __gmpz_powm_sec ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"+then :+  HaveFrameworkGMP=YES; GMP_FRAMEWORK=GMP+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam \+    conftest$ac_exeext conftest.$ac_ext+            LIBS="$save_libs"+            { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $HaveFrameworkGMP" >&5+printf "%s\n" "$HaveFrameworkGMP" >&6; }+            ;;+        esac+    fi+++    if test "$HaveFrameworkGMP" = "NO"+    then+        { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm in -lgmp" >&5+printf %s "checking for __gmpz_powm in -lgmp... " >&6; }+if test ${ac_cv_lib_gmp___gmpz_powm+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lgmp  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+char __gmpz_powm ();+int+main (void)+{+return __gmpz_powm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"+then :+  ac_cv_lib_gmp___gmpz_powm=yes+else $as_nop+  ac_cv_lib_gmp___gmpz_powm=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmpz_powm" >&5+printf "%s\n" "$ac_cv_lib_gmp___gmpz_powm" >&6; }+if test "x$ac_cv_lib_gmp___gmpz_powm" = xyes+then :+  HaveLibGmp=YES; GMP_LIBS=gmp+fi++        if test "$HaveLibGmp" = "NO"+        then+            { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm in -lgmp3" >&5+printf %s "checking for __gmpz_powm in -lgmp3... " >&6; }+if test ${ac_cv_lib_gmp3___gmpz_powm+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lgmp3  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+char __gmpz_powm ();+int+main (void)+{+return __gmpz_powm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"+then :+  ac_cv_lib_gmp3___gmpz_powm=yes+else $as_nop+  ac_cv_lib_gmp3___gmpz_powm=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp3___gmpz_powm" >&5+printf "%s\n" "$ac_cv_lib_gmp3___gmpz_powm" >&6; }+if test "x$ac_cv_lib_gmp3___gmpz_powm" = xyes+then :+  HaveLibGmp=YES; GMP_LIBS=gmp3+fi++        fi+        if test "$HaveLibGmp" = "YES"+        then+            as_ac_Lib=`printf "%s\n" "ac_cv_lib_$GMP_LIBS""___gmpz_powm_sec" | $as_tr_sh`+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm_sec in -l$GMP_LIBS" >&5+printf %s "checking for __gmpz_powm_sec in -l$GMP_LIBS... " >&6; }+if eval test \${$as_ac_Lib+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  ac_check_lib_save_LIBS=$LIBS+LIBS="-l$GMP_LIBS  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+char __gmpz_powm_sec ();+int+main (void)+{+return __gmpz_powm_sec ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"+then :+  eval "$as_ac_Lib=yes"+else $as_nop+  eval "$as_ac_Lib=no"+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+eval ac_res=\$$as_ac_Lib+	       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+printf "%s\n" "$ac_res" >&6; }+if eval test \"x\$"$as_ac_Lib"\" = x"yes"+then :+  HaveSecurePowm=1+fi++        fi+    fi++       else++    if test "$HaveFrameworkGMP" = "NO"+    then+        { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm in -lgmp" >&5+printf %s "checking for __gmpz_powm in -lgmp... " >&6; }+if test ${ac_cv_lib_gmp___gmpz_powm+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lgmp  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+char __gmpz_powm ();+int+main (void)+{+return __gmpz_powm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"+then :+  ac_cv_lib_gmp___gmpz_powm=yes+else $as_nop+  ac_cv_lib_gmp___gmpz_powm=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmpz_powm" >&5+printf "%s\n" "$ac_cv_lib_gmp___gmpz_powm" >&6; }+if test "x$ac_cv_lib_gmp___gmpz_powm" = xyes+then :+  HaveLibGmp=YES; GMP_LIBS=gmp+fi++        if test "$HaveLibGmp" = "NO"+        then+            { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm in -lgmp3" >&5+printf %s "checking for __gmpz_powm in -lgmp3... " >&6; }+if test ${ac_cv_lib_gmp3___gmpz_powm+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  ac_check_lib_save_LIBS=$LIBS+LIBS="-lgmp3  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+char __gmpz_powm ();+int+main (void)+{+return __gmpz_powm ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"+then :+  ac_cv_lib_gmp3___gmpz_powm=yes+else $as_nop+  ac_cv_lib_gmp3___gmpz_powm=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp3___gmpz_powm" >&5+printf "%s\n" "$ac_cv_lib_gmp3___gmpz_powm" >&6; }+if test "x$ac_cv_lib_gmp3___gmpz_powm" = xyes+then :+  HaveLibGmp=YES; GMP_LIBS=gmp3+fi++        fi+        if test "$HaveLibGmp" = "YES"+        then+            as_ac_Lib=`printf "%s\n" "ac_cv_lib_$GMP_LIBS""___gmpz_powm_sec" | $as_tr_sh`+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm_sec in -l$GMP_LIBS" >&5+printf %s "checking for __gmpz_powm_sec in -l$GMP_LIBS... " >&6; }+if eval test \${$as_ac_Lib+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  ac_check_lib_save_LIBS=$LIBS+LIBS="-l$GMP_LIBS  $LIBS"+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+char __gmpz_powm_sec ();+int+main (void)+{+return __gmpz_powm_sec ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"+then :+  eval "$as_ac_Lib=yes"+else $as_nop+  eval "$as_ac_Lib=no"+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam \+    conftest$ac_exeext conftest.$ac_ext+LIBS=$ac_check_lib_save_LIBS+fi+eval ac_res=\$$as_ac_Lib+	       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+printf "%s\n" "$ac_res" >&6; }+if eval test \"x\$"$as_ac_Lib"\" = x"yes"+then :+  HaveSecurePowm=1+fi++        fi+    fi+++    if test "$HaveLibGmp" = "NO"+    then+        case $target_os in+        darwin*)+            { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for GMP.framework" >&5+printf %s "checking for GMP.framework... " >&6; }+            save_libs="$LIBS"+            LIBS="-framework GMP"+            cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+char __gmpz_powm_sec ();+int+main (void)+{+return __gmpz_powm_sec ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"+then :+  HaveFrameworkGMP=YES; GMP_FRAMEWORK=GMP+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam \+    conftest$ac_exeext conftest.$ac_ext+            LIBS="$save_libs"+            { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $HaveFrameworkGMP" >&5+printf "%s\n" "$HaveFrameworkGMP" >&6; }+            ;;+        esac+    fi++       fi+   fi++   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether to use in-tree GMP" >&5+printf %s "checking whether to use in-tree GMP... " >&6; }+   if test "$HaveFrameworkGMP" = "YES" || test "$HaveLibGmp" = "YES"+   then+       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+       UseIntreeGmp=0+       ac_fn_c_check_header_compile "$LINENO" "gmp.h" "ac_cv_header_gmp_h" "$ac_includes_default"+if test "x$ac_cv_header_gmp_h" = xyes+then :++else $as_nop+  as_fn_error $? "Cannot find gmp.h" "$LINENO" 5+fi+++       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GMP version" >&5+printf %s "checking GMP version... " >&6; }+       if ac_fn_c_compute_int "$LINENO" "__GNU_MP_VERSION" "GhcGmpVerMj"        "#include <gmp.h>"+then :++else $as_nop+  as_fn_error $? "Unable to get value of __GNU_MP_VERSION" "$LINENO" 5+fi++       if ac_fn_c_compute_int "$LINENO" "__GNU_MP_VERSION_MINOR" "GhcGmpVerMi"        "#include <gmp.h>"+then :++else $as_nop+  as_fn_error $? "Unable to get value of __GNU_MP_VERSION_MINOR" "$LINENO" 5+fi++       if ac_fn_c_compute_int "$LINENO" "__GNU_MP_VERSION_PATCHLEVEL" "GhcGmpVerPl"        "#include <gmp.h>"+then :++else $as_nop+  as_fn_error $? "Unable to get value of __GNU_MP_VERSION_PATCHLEVEL" "$LINENO" 5+fi++       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl" >&5+printf "%s\n" "$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl" >&6; }++   else+       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5+printf "%s\n" "yes" >&6; }+       UseIntreeGmp=1+       HaveSecurePowm=1++       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking GMP version" >&5+printf %s "checking GMP version... " >&6; }+       GhcGmpVerMj=6+       GhcGmpVerMi=1+       GhcGmpVerPl=2+       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl" >&5+printf "%s\n" "$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl" >&6; }+   fi++   GMP_INSTALL_INCLUDES="HsIntegerGmp.h ghc-gmp.h"+fi+++++++++++++++ # Compute offsets/sizes used by jsbits/base.js if test "$host" = "javascript-ghcjs" then@@ -32800,7 +33305,7 @@   -ac_config_files="$ac_config_files ghc-internal.buildinfo"+ac_config_files="$ac_config_files ghc-internal.buildinfo include/HsIntegerGmp.h"   cat >confcache <<\_ACEOF@@ -33490,6 +33995,7 @@     "include/HsBaseConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/HsBaseConfig.h" ;;     "include/EventConfig.h") CONFIG_HEADERS="$CONFIG_HEADERS include/EventConfig.h" ;;     "ghc-internal.buildinfo") CONFIG_FILES="$CONFIG_FILES ghc-internal.buildinfo" ;;+    "include/HsIntegerGmp.h") CONFIG_FILES="$CONFIG_FILES include/HsIntegerGmp.h" ;;    *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;   esac

@@ -132,7 +132,110 @@ AC_SUBST(ICONV_INCLUDE_DIRS) AC_SUBST(ICONV_LIB_DIRS) +dnl--------------------------------------------------------------------+dnl * Deal with arguments telling us gmp is somewhere odd+dnl-------------------------------------------------------------------- +AC_ARG_WITH([gmp],+  [AS_HELP_STRING([--with-gmp],+    [Enable GMP backend])],+    [GMP_ENABLED=YES],+    [GMP_ENABLED=NO])++AC_ARG_WITH([gmp-includes],+  [AS_HELP_STRING([--with-gmp-includes],+    [directory containing gmp.h])],+    [GMP_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval"],+    [GMP_INCLUDE_DIRS=])++AC_ARG_WITH([gmp-libraries],+  [AS_HELP_STRING([--with-gmp-libraries],+    [directory containing gmp library])],+    [GMP_LIB_DIRS=$withval; LDFLAGS="-L$withval"],+    [GMP_LIB_DIRS=])++AC_ARG_WITH([gmp-framework-preferred],+  [AS_HELP_STRING([--with-gmp-framework-preferred],+    [on OSX, prefer the GMP framework to the gmp lib])],+    [GMP_PREFER_FRAMEWORK=YES],+    [GMP_PREFER_FRAMEWORK=NO])++AC_ARG_WITH([intree-gmp],+  [AS_HELP_STRING([--with-intree-gmp],+    [force using the in-tree GMP])],+    [GMP_FORCE_INTREE=YES],+    [GMP_FORCE_INTREE=NO])++if test "$GMP_ENABLED" = "YES"+then++dnl--------------------------------------------------------------------+dnl * Detect gmp+dnl--------------------------------------------------------------------++   HaveLibGmp=NO+   GMP_LIBS=+   HaveFrameworkGMP=NO+   GMP_FRAMEWORK=+   HaveSecurePowm=0++   if test "$GMP_FORCE_INTREE" != "YES"+   then+       if test "$GMP_PREFER_FRAMEWORK" = "YES"+       then+           LOOK_FOR_GMP_FRAMEWORK+           LOOK_FOR_GMP_LIB+       else+           LOOK_FOR_GMP_LIB+           LOOK_FOR_GMP_FRAMEWORK+       fi+   fi++   AC_MSG_CHECKING([whether to use in-tree GMP])+   if test "$HaveFrameworkGMP" = "YES" || test "$HaveLibGmp" = "YES"+   then+       AC_MSG_RESULT([no])+       UseIntreeGmp=0+       AC_CHECK_HEADER([gmp.h], , [AC_MSG_ERROR([Cannot find gmp.h])])++       AC_MSG_CHECKING([GMP version])+       AC_COMPUTE_INT(GhcGmpVerMj, __GNU_MP_VERSION, [#include <gmp.h>],+           AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION]))+       AC_COMPUTE_INT(GhcGmpVerMi, __GNU_MP_VERSION_MINOR, [#include <gmp.h>],+           AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_MINOR]))+       AC_COMPUTE_INT(GhcGmpVerPl, __GNU_MP_VERSION_PATCHLEVEL, [#include <gmp.h>],+           AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_PATCHLEVEL]))+       AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl])++   else+       AC_MSG_RESULT([yes])+       UseIntreeGmp=1+       HaveSecurePowm=1++       AC_MSG_CHECKING([GMP version])+       GhcGmpVerMj=6+       GhcGmpVerMi=1+       GhcGmpVerPl=2+       AC_MSG_RESULT([$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl])+   fi++   GMP_INSTALL_INCLUDES="HsIntegerGmp.h ghc-gmp.h"+fi+++AC_SUBST(GMP_INCLUDE_DIRS)+AC_SUBST(GMP_LIBS)+AC_SUBST(GMP_LIB_DIRS)+AC_SUBST(GMP_FRAMEWORK)+AC_SUBST(GMP_INSTALL_INCLUDES)+AC_SUBST(HaveLibGmp)+AC_SUBST(HaveFrameworkGMP)+AC_SUBST(HaveSecurePowm)+AC_SUBST(UseIntreeGmp)+AC_SUBST(GhcGmpVerMj)+AC_SUBST(GhcGmpVerMi)+AC_SUBST(GhcGmpVerPl)+ # Compute offsets/sizes used by jsbits/base.js if test "$host" = "javascript-ghcjs" then@@ -305,6 +408,6 @@ AC_CHECK_SIZEOF([struct MD5Context], [], [#include "include/md5.h"])  AC_SUBST(EXTRA_LIBS)-AC_CONFIG_FILES([ghc-internal.buildinfo])+AC_CONFIG_FILES([ghc-internal.buildinfo include/HsIntegerGmp.h])  AC_OUTPUT

@@ -1,4 +1,5 @@-extra-lib-dirs: @ICONV_LIB_DIRS@-extra-libraries: @EXTRA_LIBS@-include-dirs: @ICONV_INCLUDE_DIRS@-install-includes: HsBaseConfig.h EventConfig.h+extra-lib-dirs: @ICONV_LIB_DIRS@ @GMP_LIB_DIRS@+extra-libraries: @EXTRA_LIBS@ @GMP_LIBS@+include-dirs: @ICONV_INCLUDE_DIRS@ @GMP_INCLUDE_DIRS@+frameworks: @GMP_FRAMEWORK@+install-includes: HsBaseConfig.h EventConfig.h @GMP_INSTALL_INCLUDES@

@@ -4,7 +4,7 @@ name:           ghc-internal -- The project is ghc's version plus ghc-internal's version suffix. -- For example, for ghc=9.10.1, ghc-internal's version will be 9.1001.0.-version:        9.1204.0+version:        9.1401.0 license:        BSD-3-Clause license-file:   LICENSE maintainer:     The GHC Developers <ghc-devs@haskell.org>@@ -31,6 +31,7 @@     aclocal.m4     ghc-internal.buildinfo.in     CHANGELOG.md+    cbits/gmp_wrappers.c     configure     configure.ac     include/CTypes.h@@ -40,6 +41,8 @@     include/md5.h     include/fs.h     include/winio_structs.h+    include/WordSize.h+    include/HsIntegerGmp.h.in     include/RtsIfaceSymbols.h     install-sh @@ -48,6 +51,32 @@     location: https://gitlab.haskell.org/ghc/ghc.git     subdir:   libraries/base +Flag bignum-native+    Description: Enable native Haskell bignum backend+    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+    Default: False++ Library     default-language: Haskell2010     default-extensions:@@ -91,11 +120,10 @@         Unsafe      build-depends:-        rts == 1.0.*,-        ghc-prim >= 0.11 && < 0.14,-        ghc-bignum >= 1.0 && < 2.0+        rts == 1.0.*      exposed-modules:+        GHC.Internal.AllocationLimitHandler         GHC.Internal.ClosureTypes         GHC.Internal.Control.Arrow         GHC.Internal.Control.Category@@ -130,6 +158,7 @@         GHC.Internal.Data.List.NonEmpty         GHC.Internal.Data.Maybe         GHC.Internal.Data.Monoid+        GHC.Internal.Data.NonEmpty         GHC.Internal.Data.OldList         GHC.Internal.Data.Ord         GHC.Internal.Data.Proxy@@ -203,6 +232,12 @@         GHC.Internal.GHCi         GHC.Internal.GHCi.Helpers         GHC.Internal.Generics+        GHC.Internal.Heap.Closures+        GHC.Internal.Heap.Constants+        GHC.Internal.Heap.InfoTable+        GHC.Internal.Heap.InfoTable.Types+        GHC.Internal.Heap.InfoTableProf+        GHC.Internal.Heap.ProfInfo.Types         GHC.Internal.InfoProv         GHC.Internal.InfoProv.Types         GHC.Internal.IO@@ -255,14 +290,18 @@         GHC.Internal.RTS.Flags         GHC.Internal.RTS.Flags.Test         GHC.Internal.ST-        GHC.Internal.Stack.CloneStack         GHC.Internal.StaticPtr         GHC.Internal.STRef         GHC.Internal.Show         GHC.Internal.Stable         GHC.Internal.StableName         GHC.Internal.Stack+        GHC.Internal.Stack.Annotation         GHC.Internal.Stack.CCS+        GHC.Internal.Stack.CloneStack+        GHC.Internal.Stack.Constants+        GHC.Internal.Stack.ConstantsProf+        GHC.Internal.Stack.Decode         GHC.Internal.Stack.Types         GHC.Internal.Stats         GHC.Internal.Storable@@ -299,15 +338,25 @@         GHC.Internal.Type.Reflection         GHC.Internal.Type.Reflection.Unsafe         GHC.Internal.Unsafe.Coerce-        -- TODO: remove-        GHC.Internal.IOPort -    reexported-modules:-          GHC.Num.Integer-        , GHC.Num.Natural-        , GHC.Num.BigNat-        , GHC.Tuple+        GHC.Internal.CString+        GHC.Internal.Classes+        GHC.Internal.Debug+        GHC.Internal.Magic+        GHC.Internal.Magic.Dict+        GHC.Internal.Prim+        GHC.Internal.Prim.Ext+        GHC.Internal.Prim.Panic+        GHC.Internal.Prim.Exception+        GHC.Internal.Prim.PtrEq+        GHC.Internal.PrimopWrappers+        GHC.Internal.Tuple+        GHC.Internal.Types +    autogen-modules:+        GHC.Internal.Prim+        GHC.Internal.PrimopWrappers+     other-modules:         GHC.Internal.Data.Typeable.Internal         GHC.Internal.IO.Handle.Lock.Common@@ -324,7 +373,6 @@         GHC.Internal.Event.IntVar         GHC.Internal.Event.PSQ         GHC.Internal.Event.Unique-        -- GHC.Internal.IOPort -- TODO: hide again after debug         GHC.Internal.Unicode.Bits         GHC.Internal.Unicode.Char.DerivedCoreProperties         GHC.Internal.Unicode.Char.UnicodeData.GeneralCategory@@ -334,6 +382,55 @@         GHC.Internal.Unicode.Version         GHC.Internal.System.Environment.ExecutablePath ++    ----------------------------------------+    -- Bignum configuration+    ----------------------------------------+    -- check that at least one backend is enabled+    if !flag(bignum-native) && !flag(bignum-gmp) && !flag(bignum-ffi)+      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)+      buildable: False++    if flag(bignum-gmp)+        cpp-options: -DBIGNUM_GMP+        other-modules:+           GHC.Internal.Bignum.Backend.GMP+        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++    -- some other properties related to bignum are set via the+    -- ghc-internal.buildinfo file generated by this package's configure script+    ----------------------------------------++     if !arch(javascript)       c-sources:           cbits/DarwinUtils.c@@ -346,10 +443,14 @@           cbits/sysconf.c           cbits/fs.c           cbits/strerror.c+          cbits/debug.c+          cbits/Stack_c.c           cbits/RtsIface.c        cmm-sources:           cbits/StackCloningDecoding.cmm+          cbits/Stack.cmm+          cbits/HeapPrim.cmm      if arch(javascript)       js-sources:@@ -367,10 +468,16 @@         HsBase.h         consUtils.h +    if flag(need-atomic)+        -- for 64-bit atomic ops on armel (#20549)+        extra-libraries: atomic+     -- OS Specific     if os(windows)         -- Windows requires some extra libraries for linking because the RTS-        -- is no longer re-exporting them.+        -- is no longer re-exporting them (see #11223)+        -- ucrt: standard C library. The RTS will automatically include this,+        --       but is added for completeness.         -- mingwex: provides GNU POSIX extensions that aren't provided by ucrt.         -- mingw32: Unfortunately required because of a resource leak between         --          mingwex and mingw32. the __math_err symbol is defined in@@ -382,9 +489,11 @@         -- ntdll: provides access to functions to inspect window handles         -- kernel32: provides GetConsoleCP         -- advapi32: provides advanced kernel functions+        -- user32: provides access to apis to modify user components (UI etc)+        --         on Windows. Required because of mingw32.         extra-libraries:             wsock32, user32, shell32, mingw32, kernel32, advapi32,-            mingwex, ws2_32, shlwapi, ole32, rpcrt4, ntdll+            mingwex, ws2_32, shlwapi, ole32, rpcrt4, ntdll, ucrt         -- Minimum supported Windows version.         -- These numbers can be found at:         --  https://msdn.microsoft.com/en-us/library/windows/desktop/aa383745(v=vs.85).aspx@@ -427,9 +536,10 @@             GHC.Internal.Event.Thread             GHC.Internal.Event.TimerManager --        if arch(javascript)-          other-modules:+    if os(linux)+        -- we need libm, but for musl and other's we might need libc, as libm+        -- is just an empty shell.+        extra-libraries: c, m      -- The Ports framework always passes this flag when building software that     -- uses iconv to make iconv from Ports compatible with iconv from the base system

@@ -0,0 +1,14 @@+#pragma once++/* Whether GMP is embedded into ghc-internal */+#define GHC_GMP_INTREE     @UseIntreeGmp@++/* The following values denote the GMP version used during GHC build-time */+#define GHC_GMP_VERSION_MJ @GhcGmpVerMj@+#define GHC_GMP_VERSION_MI @GhcGmpVerMi@+#define GHC_GMP_VERSION_PL @GhcGmpVerPl@+#define GHC_GMP_VERSION \+    (@GhcGmpVerMj@ * 10000 + @GhcGmpVerMi@ * 100 + @GhcGmpVerPl@)++/* Whether GMP supports mpz_powm_sec */+#define HAVE_SECURE_POWM @HaveSecurePowm@

@@ -7,14 +7,13 @@ #endif CLOSURE(GHCziInternalziTopHandler, runIO_closure) CLOSURE(GHCziInternalziTopHandler, runNonIO_closure)-PRIMCLOSURE(GHCziTuple, Z0T_closure)-PRIMCLOSURE(GHCziTypes, True_closure)-PRIMCLOSURE(GHCziTypes, False_closure)+CLOSURE(GHCziInternalziTuple, Z0T_closure)+CLOSURE(GHCziInternalziTypes, True_closure)+CLOSURE(GHCziInternalziTypes, False_closure) CLOSURE(GHCziInternalziPack, unpackCString_closure) CLOSURE(GHCziInternalziWeakziFinalizze, runFinalizzerBatch_closure) CLOSURE(GHCziInternalziIOziException, stackOverflow_closure) CLOSURE(GHCziInternalziIOziException, heapOverflow_closure)-CLOSURE(GHCziInternalziIOPort, doubleReadException_closure) CLOSURE(GHCziInternalziIOziException, allocationLimitExceeded_closure) CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnMVar_closure) CLOSURE(GHCziInternalziIOziException, blockedIndefinitelyOnSTM_closure)@@ -36,12 +35,13 @@ CLOSURE(GHCziInternalziConcziSignal, runHandlersPtr_closure) CLOSURE(GHCziInternalziTopHandler, flushStdHandles_closure) CLOSURE(GHCziInternalziTopHandler, runMainIO_closure)-PRIM_INFO_TBL(GHCziTypes, Czh_con_info)-PRIM_INFO_TBL(GHCziTypes, Izh_con_info)-PRIM_INFO_TBL(GHCziTypes, Fzh_con_info)-PRIM_INFO_TBL(GHCziTypes, Dzh_con_info)-PRIM_INFO_TBL(GHCziTypes, Wzh_con_info)-PRIMCLOSURE(GHCziPrimziPanic, absentSumFieldError_closure)+INFO_TBL(GHCziInternalziTypes, Czh_con_info)+INFO_TBL(GHCziInternalziTypes, Izh_con_info)+INFO_TBL(GHCziInternalziTypes, Fzh_con_info)+INFO_TBL(GHCziInternalziTypes, Dzh_con_info)+INFO_TBL(GHCziInternalziTypes, Wzh_con_info)+CLOSURE(GHCziInternalziPrimziPanic, absentSumFieldError_closure)+CLOSURE(GHCziInternalziAllocationLimitHandler, runAllocationLimitHandler_closure) INFO_TBL(GHCziInternalziPtr, Ptr_con_info) INFO_TBL(GHCziInternalziPtr, FunPtr_con_info) INFO_TBL(GHCziInternalziInt, I8zh_con_info)@@ -57,8 +57,8 @@ CLOSURE(GHCziInternalziExceptionziType, divZZeroException_closure) CLOSURE(GHCziInternalziExceptionziType, underflowException_closure) CLOSURE(GHCziInternalziExceptionziType, overflowException_closure)-PRIM_INFO_TBL(GHCziCString, unpackCStringzh_info)-PRIM_INFO_TBL(GHCziCString, unpackCStringUtf8zh_info)+INFO_TBL(GHCziInternalziCString, unpackCStringzh_info)+INFO_TBL(GHCziInternalziCString, unpackCStringUtf8zh_info) #if defined(wasm32_HOST_ARCH) && defined(__PIC__) CLOSURE(GHCziInternalziWasmziPrimziImports, raiseJSException_closure) INFO_TBL(GHCziInternalziWasmziPrimziTypes, JSVal_con_info)

@@ -0,0 +1,32 @@+#include "MachDeps.h"++#if WORD_SIZE_IN_BITS == 64++# define WORD_SIZE_IN_BYTES    8+# define WORD_SIZE_BYTES_SHIFT 3+# define WORD_SIZE_BYTES_MASK  0b111+# define WORD_SIZE_BITS_SHIFT  6+# define WORD_SIZE_BITS_MASK   0b111111+# define WORD_MAXBOUND         0xffffffffffffffff+# define INT_MINBOUND         -0x8000000000000000+# define INT_MAXBOUND          0x7fffffffffffffff+# define ABS_INT_MINBOUND      0x8000000000000000+# define SQRT_INT_MAXBOUND     0xb504f333++#elif WORD_SIZE_IN_BITS == 32++# define WORD_SIZE_IN_BYTES    4+# define WORD_SIZE_BYTES_SHIFT 2+# define WORD_SIZE_BYTES_MASK  0b11+# define WORD_SIZE_BITS_SHIFT  5+# define WORD_SIZE_BITS_MASK   0b11111+# define WORD_MAXBOUND         0xffffffff+# define INT_MINBOUND         -0x80000000+# define INT_MAXBOUND          0x7fffffff+# define ABS_INT_MINBOUND      0x80000000+# define SQRT_INT_MAXBOUND     0xb504++#else+# error unsupported WORD_SIZE_IN_BITS config+#endif+

@@ -44,30 +44,45 @@ }  function h$close(fd,c) {-  if (c) {-    //asynchronous-    var fdo = h$base_fds[fd];-    if(fdo) {+  var fdo = h$base_fds[fd];++  // File descriptor was closed already?+  // It may happen only if its reference count reached <1 and actual closing is processed at underlying fd+  if (!fdo) {+    h$setErrno('EINVAL');++    if (c) {+      TRACE_IO("base_close: file descriptor not found, already closed?")+      c(-1);+      return;+    }++    TRACE_IO("base_close sync: file descriptor not found, already closed?")+    return (-1);+  }++  fdo.refs--;++  if (fdo.refs < 1) {+    // Process closing at underlying fd++    if (c) {+      TRACE_IO("base_close: closing underlying fd")+      if (fdo.close) {+        fdo.close(fd, fdo, c);+      } else {+        TRACE_IO("base_close: no actual underlying fd close, dummy implementation")         delete h$base_fds[fd];-        if(--fdo.refs < 1) {-          TRACE_IO("base_close: closing underlying fd")-          if(fdo.close) {-            fdo.close(fd, fdo, c);-          } else {-            c(0);-          }-        } else {-          TRACE_IO("base_close: remaining references, not closing underlying fd")-          c(0);-        }-    } else {-        TRACE_IO("base_close: file descriptor not found, already closed?")-        h$errno = CONST_EINVAL;-        c(-1);+        c(0);+      }+      return;     }-  } else {-    //synchronous++    TRACE_IO("base_close sync: closing underlying fd")     try {+      // See: https://nodejs.org/api/fs.html#fsclosesyncfd+      // Calling fs.closeSync() on any file descriptor (fd) that is currently in use through any other fs operation may lead to undefined behavior.+      delete h$base_fds[fd];       h$fs.closeSync(fd);       return 0;     } catch(err) {@@ -75,6 +90,16 @@       return (-1);     }   }++  // Dummy process closing due of remaining references+  if (c) {+    TRACE_IO("base_close: remaining references, not closing underlying fd")+    c(0);+    return;+  }++  TRACE_IO("base_close sync: remaining references, not closing underlying fd")+  return 0; }  function h$base_dup(fd, c) {@@ -122,7 +147,7 @@ }  function h$base_fstat(fd, stat, stat_off, c) {-    TRACE_IO("base_stat")+    TRACE_IO("base_fstat") #ifndef GHCJS_BROWSER     if(h$isNode()) {         h$fs.fstat(fd, function(err, fs) {@@ -384,11 +409,13 @@ }  function h$rename(old_path, old_path_off, new_path, new_path_off) {-  TRACE_IO("rename")+  var old_path_str = h$decodeUtf8z(old_path, old_path_off);+  var new_path_str = h$decodeUtf8z(new_path, new_path_off);+  TRACE_IO("rename sync: " + old_path_str + " -> " + new_path_str) #ifndef GHCJS_BROWSER   if (h$isNode()) {     try {-      h$fs.renameSync(h$decodeUtf8z(old_path, old_path_off), h$decodeUtf8z(new_path, new_path_off));+      h$fs.renameSync(old_path_str, new_path_str);       return 0;     } catch(e) {       h$setErrno(e);@@ -473,11 +500,13 @@  function h$openat(dirfd, file, file_off, how, mode, c) {   var path = h$calculate_at(dirfd, file, file_off);+  TRACE_IO("openat" + (!!c ? ": " : " sync: ") + path)   return h$base_open(path, how, mode, c); }  function h$open(file, file_off, how, mode, c) {   var path = h$decodeUtf8z(file, file_off);+  TRACE_IO("open" + (!!c ? ": " : " sync: ") + path)   return h$base_open(path, how, mode, c); } @@ -485,7 +514,7 @@ #ifndef GHCJS_BROWSER     if(h$isNode()) {         var flags, off;-        TRACE_IO("open: " + fp)+        TRACE_IO("base_open" + (!!c ? ": " : " sync: ") + fp)         var acc  = how & h$base_o_accmode;         // passing a number lets node.js use it directly as the flags (undocumented)         if(acc === h$base_o_rdonly) {@@ -539,7 +568,7 @@                                        , pos:   p                                        , refs:  1                                        };-                      TRACE_IO("open: " + fp + " -> " + fd)+                      TRACE_IO("base_open sync: " + fp + " -> " + fd)                   }             if(off === -1) {               var fs = h$fs.statSync(fp);@@ -944,8 +973,8 @@     h$base_closeFile = function(fd, fdo, c) {         TRACE_IO("base_closeFile: " + fd + " (" + fdo.fd + ")")         var real_fd = typeof fdo.fd === 'number' ? fdo.fd : fd;+        delete h$base_fds[fd];         h$fs.close(real_fd, function(err) {-            delete h$base_fds[fd];             h$handleErrnoC(err, -1, 0, c);         });     }@@ -1216,9 +1245,21 @@  // It is required by Google Closure Compiler to be at least defined if // somewhere it is used-var h$stg_cloneMyStackzh, h$stg_decodeStackzh+var h$stg_cloneMyStackzh,+    h$advanceStackFrameLocationzh, h$getStackFieldszh, h$getStackClosurezh,+    h$getWordzh, h$getStackInfoTableAddrzh, h$getRetFunSmallBitmapzh, h$getRetFunLargeBitmapzh,+    h$isArgGenBigRetFunTypezh,+    h$getUnderflowFrameNextChunkzh,+    h$getInfoTableAddrszh,+    h$getLargeBitmapzh, h$getSmallBitmapzh, h$getBCOLargeBitmapzh h$stg_cloneMyStackzh-  = h$stg_decodeStackzh+  = h$advanceStackFrameLocationzh+  = h$getStackFieldszh = h$getStackClosurezh+  = h$getWordzh, h$getStackInfoTableAddrzh = h$getRetFunSmallBitmapzh = h$getRetFunLargeBitmapzh+  = h$isArgGenBigRetFunTypezh+  = h$getUnderflowFrameNextChunkzh+  = h$getInfoTableAddrszh+  = h$getLargeBitmapzh = h$getSmallBitmapzh = h$getBCOLargeBitmapzh   = function () {     throw new Error('Stack Cloning Decoding: Not Implemented Yet')   }

@@ -52,6 +52,7 @@       if(es.indexOf('EBADF') !== -1)        return CONST_EBADF;       if(es.indexOf('ENOSPC') !== -1)       return CONST_ENOSPC;       if(es.indexOf('EACCES') !== -1)       return CONST_EACCES;+      if(es.indexOf('EXDEV') !== -1)        return CONST_EXDEV;       if(es.indexOf('Bad argument') !== -1) return CONST_ENOENT; // fixme?       throw ("setErrno not yet implemented for: " + e); @@ -72,6 +73,7 @@                    , CONST_EPIPE:   "Broken pipe"                    , CONST_EAGAIN:  "Resource temporarily unavailable"                    , CONST_ESPIPE:  "Illegal seek"+                   , CONST_EXDEV:   "Cross-device link" // See https://en.cppreference.com/w/cpp/error/errno_macros                    }  function h$handleErrno(r_err, f) {

@@ -0,0 +1,117 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UnliftedFFITypes #-}+{-# LANGUAGE GHCForeignImportPrim #-}+{-# OPTIONS_HADDOCK not-home #-}+module GHC.Internal.AllocationLimitHandler+  ( runAllocationLimitHandler+  , setGlobalAllocationLimitHandler+  , AllocationLimitKillBehaviour(..)+  , getAllocationCounterFor+  , setAllocationCounterFor+  , enableAllocationLimitFor+  , disableAllocationLimitFor+  )+  where+import GHC.Internal.Base+import GHC.Internal.Conc.Sync (ThreadId(..))+import GHC.Internal.Data.IORef (IORef, readIORef, writeIORef, newIORef)+import GHC.Internal.Foreign.C.Types+import GHC.Internal.IO (unsafePerformIO)+import GHC.Internal.Int (Int64(..))+++{-# NOINLINE allocationLimitHandler #-}+allocationLimitHandler :: IORef (ThreadId -> IO ())+allocationLimitHandler = unsafePerformIO (newIORef defaultHandler)++defaultHandler :: ThreadId -> IO ()+defaultHandler _ = pure ()++foreign import ccall "setAllocLimitKill" setAllocLimitKill :: CBool -> CBool -> IO ()++runAllocationLimitHandler :: ThreadId# -> IO ()+runAllocationLimitHandler tid = do+  hook <- getAllocationLimitHandler+  hook $ ThreadId tid++getAllocationLimitHandler :: IO (ThreadId -> IO ())+getAllocationLimitHandler = readIORef allocationLimitHandler++data AllocationLimitKillBehaviour =+  KillOnAllocationLimit+  -- ^ Throw a @AllocationLimitExceeded@ async exception to the thread when the+  -- allocation limit is exceeded.+  | DontKillOnAllocationLimit+  -- ^ Do not throw an exception when the allocation limit is exceeded.++-- | Define the behaviour for handling allocation limits.+-- The default behaviour is to throw an @AllocationLimitExceeded@ async exception to the thread.+-- This can be overriden using @AllocationLimitKillBehaviour@.+--+-- We can set a user-specified handler, which can be run in addition to+-- or in place of the exception.+-- This allows for instance logging on the allocation limit being exceeded,+-- or dynamically determining whether to terminate the thread.+-- The handler is not guaranteed to run before the thread is terminated or restarted.+--+-- Note: that if you don't terminate the thread, then the allocation limit gets+-- removed.+-- If you wish to keep the allocation limit you will have to reset it using+-- @setAllocationCounter@ and @enableAllocationLimit@.+setGlobalAllocationLimitHandler :: AllocationLimitKillBehaviour -> Maybe (ThreadId -> IO ()) -> IO ()+setGlobalAllocationLimitHandler killBehaviour mHandler = do+  shouldRunHandler <- case mHandler of+    Just hook -> do+      writeIORef allocationLimitHandler hook+      pure 1+    Nothing -> do+      writeIORef allocationLimitHandler defaultHandler+      pure 0+  let shouldKill =+        case killBehaviour of+          KillOnAllocationLimit -> 1+          DontKillOnAllocationLimit -> 0+  setAllocLimitKill shouldKill shouldRunHandler++-- | Retrieves the allocation counter for the another thread.+foreign import prim "stg_getOtherThreadAllocationCounterzh" getOtherThreadAllocationCounter#+  :: ThreadId#+  -> State# RealWorld+  -> (# State# RealWorld, Int64# #)++-- | Get the allocation counter for a different thread.+--+-- Note: this doesn't take the current nursery chunk into account.+-- If the thread is running then it may underestimate allocations by the size of a nursery thread.+getAllocationCounterFor :: ThreadId -> IO Int64+getAllocationCounterFor (ThreadId t#) = IO $ \s ->+  case getOtherThreadAllocationCounter# t# s of (# s', i# #)  -> (# s', I64# i# #)++-- | Set the allocation counter for a different thread.+-- This can be combined with 'enableAllocationLimitFor' to enable allocation limits for another thread.+-- You may wish to do this during a user-specified allocation limit handler.+--+-- Note: this doesn't take the current nursery chunk into account.+-- If the thread is running then it may overestimate allocations by the size of a nursery thread,+-- and trigger the limit sooner than expected.+setAllocationCounterFor :: Int64 -> ThreadId -> IO ()+setAllocationCounterFor (I64# i#) (ThreadId t#) = IO $ \s ->+  case setOtherThreadAllocationCounter# i# t# s of s' -> (# s', () #)+++-- | Enable allocation limit processing the thread @t@.+enableAllocationLimitFor :: ThreadId -> IO ()+enableAllocationLimitFor (ThreadId t) = do+  rts_enableThreadAllocationLimit t++-- | Disable allocation limit processing the thread @t@.+disableAllocationLimitFor :: ThreadId -> IO ()+disableAllocationLimitFor (ThreadId t) = do+  rts_disableThreadAllocationLimit t++foreign import ccall unsafe "rts_enableThreadAllocationLimit"+  rts_enableThreadAllocationLimit :: ThreadId# -> IO ()++foreign import ccall unsafe "rts_disableThreadAllocationLimit"+  rts_disableThreadAllocationLimit :: ThreadId# -> IO ()

@@ -48,9 +48,9 @@   )   where -import GHC.Prim-import GHC.Prim.PtrEq ( unsafePtrEquality# )-import GHC.Types ( Type, UnliftedType, isTrue# )+import GHC.Internal.Prim+import GHC.Internal.Prim.PtrEq ( unsafePtrEquality# )+import GHC.Internal.Types ( Type, UnliftedType, isTrue# ) import GHC.Internal.Unsafe.Coerce ( unsafeCoerce, unsafeCoerceUnlifted ) default () 

@@ -11,13 +11,13 @@ So the rough structure is as follows, in (linearised) dependency order  -GHC.Prim        Has no implementation.  It defines built-in things, and-                by importing it you bring them into scope.-                The source file is GHC.Prim.hi-boot, which is just-                copied to make GHC.Prim.hi+GHC.Internal.Prim        Has no implementation.  It defines built-in things, and+                         by importing it you bring them into scope.+                         The source file is GHC.Internal.Prim.hi-boot, which is just+                         copied to make GHC.Internal.Prim.hi  GHC.Internal.Base        Classes: Eq, Ord, Functor, Monad-                Types:   List, (), Int, Bool, Ordering, Char, String+                Types:   List, (), Int, Bool, Ordering, Char, String, NonEmpty  GHC.Internal.Data.Tuple      Types: tuples, plus instances for GHC.Internal.Base classes @@ -29,6 +29,13 @@  GHC.Internal.List        List functions +GHC.Internal.Data.NonEmpty   Orphan instances for GHC.Internal.Base.NonEmpty of+                             GHC.Internal.Base classes (other than Eq and Ord)+                             plus function map++GHC.Internal.Data.List.NonEmpty   Re-export GHC.Internal.Data.NonEmpty plus+                                  functions zip and zipWith+ GHC.Internal.Num         Class: Num, plus instances for Int                 Type:  Integer, plus instances for all classes so far (Eq, Ord, Num, Show) @@ -99,20 +106,20 @@ module GHC.Internal.Base         (         module GHC.Internal.Base,-        module GHC.Classes,-        module GHC.CString,-        module GHC.Magic,-        module GHC.Magic.Dict,-        module GHC.Types,-        module GHC.Prim,         -- Re-export GHC.Prim, GHC.Prim.Ext,-        module GHC.Prim.Ext,     -- GHC.Prim.PtrEq and [boot] GHC.Internal.Err-        module GHC.Prim.PtrEq,   -- to avoid lots of people having to-        module GHC.Internal.Err, -- import these modules explicitly+        module GHC.Internal.Classes,+        module GHC.Internal.CString,+        module GHC.Internal.Magic,+        module GHC.Internal.Magic.Dict,+        module GHC.Internal.Types,+        module GHC.Internal.Prim,         -- Re-export GHC.Internal.Prim, GHC.Internal.Prim.Ext,+        module GHC.Internal.Prim.Ext,     -- GHC.Internal.Prim.PtrEq and [boot] GHC.Internal.Err+        module GHC.Internal.Prim.PtrEq,   -- to avoid lots of people having to+        module GHC.Internal.Err,          -- import these modules explicitly         module GHC.Internal.Maybe   )         where -import GHC.Types hiding (+import GHC.Internal.Types hiding (   Unit#,   Solo#,   Tuple0#,@@ -243,7 +250,7 @@   Sum62#,   Sum63#,   )-import GHC.Classes hiding (+import GHC.Internal.Classes hiding (   CUnit,   CSolo,   CTuple0,@@ -312,21 +319,21 @@   CTuple63,   CTuple64,   )-import GHC.CString-import GHC.Magic-import GHC.Magic.Dict-import GHC.Prim hiding (dataToTagSmall#, dataToTagLarge#, whereFrom#)+import GHC.Internal.CString+import GHC.Internal.Magic+import GHC.Internal.Magic.Dict+import GHC.Internal.Prim hiding (dataToTagSmall#, dataToTagLarge#, whereFrom#)   -- Hide dataToTag# ops because they are expected to break for   -- GHC-internal reasons in the near future, and shouldn't   -- be exposed from base (not even GHC.Exts) -import GHC.Prim.Ext-import GHC.Prim.PtrEq+import GHC.Internal.Prim.Ext+import GHC.Internal.Prim.PtrEq import GHC.Internal.Err import GHC.Internal.Maybe import {-# SOURCE #-} GHC.Internal.IO (mkUserError, mplusIO) -import GHC.Tuple (Solo (MkSolo))+import GHC.Internal.Tuple (Solo (MkSolo))  -- See Note [Semigroup stimes cycle] import {-# SOURCE #-} GHC.Internal.Num (Num (..))@@ -371,11 +378,11 @@  W1:   Common awkward dependencies:-   * TypeRep metadata introduces references to GHC.Types in EVERY module.-   * A String literal introduces a reference to GHC.CString, for either+   * TypeRep metadata introduces references to GHC.Internal.Types in EVERY module.+   * A String literal introduces a reference to GHC.Internal.CString, for either      unpackCString# or unpackCStringUtf8# depending on its contents.-   * Tuple-notation introduces references to GHC.Tuple.-   * Constraint tuples introduce references to GHC.Classes.+   * Tuple-notation introduces references to GHC.Internal.Tuple.+   * Constraint tuples introduce references to GHC.Internal.Classes.    * Short lists like [3,8,2] produce references to GHC.Internal.Base.build    A module can transitively depend on all of these by importing any of@@ -387,7 +394,7 @@    * Most modules in ghc-internal import GHC.Internal.Base.    * Most modules in compiler/ import GHC.Prelude, which imports Prelude.    * Most hs-boot files that would otherwise have no imports can get-     away with just importing GHC.Types.+     away with just importing GHC.Internal.Types.    Unfortunately, the requirement to transitively import these modules   when they are implicitly used is obscure and causes only /intermittent/@@ -401,7 +408,8 @@   missing record fields, and missing class instance methods all   introduce references to GHC.Internal.Control.Exception.Base. -  These constructs are therefore not allowed in ghc-prim or ghc-bignum.+  These constructs are therefore not allowed in packages below ghc-internal.+  This was the case when ghc-prim and ghc-bignum were separate of ghc-internal.   But since they generally have bad code smell and are avoided by   developers anyway, this restriction has not been very burdensome. @@ -442,7 +450,7 @@  W5:   If no explicit "default" declaration is present, the assumed-  "default (Integer, Double)" creates a dependency on GHC.Num.Integer+  "default (Integer, Double)" creates a dependency on GHC.Internal.Bignum.Integer   for the Integer type if defaulting is ever attempted during   type-checking.  (This doesn't apply to hs-boot files, which can't   be given "default" declarations anyway.)@@ -754,10 +762,6 @@ -}  -- | @since base-4.9.0.0-instance Semigroup (NonEmpty a) where-        (a :| as) <> ~(b :| bs) = a :| (as ++ b : bs)---- | @since base-4.9.0.0 instance Semigroup b => Semigroup (a -> b) where         f <> g = \x -> f x <> g x         stimes n f e = stimes n (f e)@@ -972,7 +976,7 @@     -- | 'fmap' is used to apply a function of type @(a -> b)@ to a value of type @f a@,     -- where f is a functor, to produce a value of type @f b@.     -- Note that for any type constructor with more than one parameter (e.g., 'Either'),-    -- only the last type parameter can be modified with `fmap` (e.g., `b` in `Either a b`).+    -- only the last type parameter can be modified with `fmap` (e.g., `b` in @Either a b@).     --     -- Some type constructors with two parameters or more have a @'Data.Bifunctor'@ instance that allows     -- both the last and the penultimate parameters to be mapped over.@@ -1707,25 +1711,6 @@            , Ord -- ^ @since base-4.9.0.0            ) --- | @since base-4.9.0.0-instance Functor NonEmpty where-  fmap f ~(a :| as) = f a :| fmap f as-  b <$ ~(_ :| as)   = b   :| (b <$ as)---- | @since base-4.9.0.0-instance Applicative NonEmpty where-  pure a = a :| []-  (<*>) = ap-  liftA2 = liftM2---- | @since base-4.9.0.0-instance Monad NonEmpty where-  ~(a :| as) >>= f = b :| (bs ++ bs')-    where b :| bs = f a-          bs' = as >>= toList . f-          toList ~(c :| cs) = c : cs-- ---------------------------------------------- -- The list type @@ -2107,6 +2092,9 @@  -- Assertion function.  This simply ignores its boolean argument. -- The compiler may rewrite it to @('assertError' line)@.+-- The Haddock below is attached to `assert`, since that is+-- what occurs in source programs.+-- See Note [Overview of assertions] in GHC.Tc.Gen.Head  -- | If the first argument evaluates to 'True', then the result is the -- second argument.  Otherwise an 'Control.Exception.AssertionFailed' exception@@ -2115,14 +2103,9 @@ -- -- Assertions can normally be turned on or off with a compiler flag -- (for GHC, assertions are normally on unless optimisation is turned on--- with @-O@ or the @-fignore-asserts@--- option is given).  When assertions are turned off, the first--- argument to 'assert' is ignored, and the second argument is--- returned as the result.----      SLPJ: in 5.04 etc 'assert' is in GHC.Prim,---      but from Template Haskell onwards it's simply---      defined here in Base.hs+-- with @-O@ or the @-fignore-asserts@ option is given). When assertions+-- are turned off, the first argument to 'assert' is ignored, and the second+-- argument is returned as the result. assert :: Bool -> a -> a assert _pred r = r 

@@ -0,0 +1,15 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- | Selected backend+module GHC.Internal.Bignum.Backend+   ( module Backend+   )+where++#if defined(BIGNUM_CHECK)+import GHC.Internal.Bignum.Backend.Check    as Backend+#else+import GHC.Internal.Bignum.Backend.Selected as Backend+#endif+

@@ -0,0 +1,508 @@+{-# 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

@@ -0,0 +1,641 @@+{-# 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.