diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +The Glasgow Haskell Compiler License + +Copyright 2020, The University Court of the University of Glasgow. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +- Redistributions of source code must retain the above copyright notice, +this list of conditions and the following disclaimer. + +- Redistributions in binary form must reproduce the above copyright notice, +this list of conditions and the following disclaimer in the documentation +and/or other materials provided with the distribution. + +- Neither name of the University nor the names of its contributors may be +used to endorse or promote products derived from this software without +specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF +GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, +INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND +FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE +UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH +DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMainWithHooks autoconfUserHooks diff --git a/aclocal.m4 b/aclocal.m4 new file mode 100644 --- /dev/null +++ b/aclocal.m4 @@ -0,0 +1,44 @@ + +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 +]) + diff --git a/cbits/gmp_wrappers.c b/cbits/gmp_wrappers.c new file mode 100644 --- /dev/null +++ b/cbits/gmp_wrappers.c @@ -0,0 +1,896 @@ +/* + * `ghc-bignum` GMP FFI wrappers + * + * Copyright (c) 2014, Herbert Valerio Riedel + * + * BSD3 licensed, see ../LICENSE file for details + * + */ + +#define _ISOC99_SOURCE + +#include "HsFFI.h" +#include "MachDeps.h" +#include "HsIntegerGmp.h" +#include "ghc-gmp.h" + +#include +#include +#include +#include +#include +#include +#include +#include + + + +// 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 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 diff --git a/changelog.md b/changelog.md new file mode 100644 --- /dev/null +++ b/changelog.md @@ -0,0 +1,1 @@ +# Changelog for `ghc-bignum` package diff --git a/config.guess b/config.guess new file mode 100644 --- /dev/null +++ b/config.guess @@ -0,0 +1,1700 @@ +#! /bin/sh +# Attempt to guess a canonical system name. +# Copyright 1992-2021 Free Software Foundation, Inc. + +timestamp='2021-01-25' + +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, see . +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. +# +# You can get the latest version of this script from: +# https://git.savannah.gnu.org/cgit/config.git/plain/config.guess +# +# Please send patches to . + + +me=$(echo "$0" | sed -e 's,.*/,,') + +usage="\ +Usage: $0 [OPTION] + +Output the configuration name of the system \`$me' is run on. + +Options: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.guess ($timestamp) + +Originally written by Per Bothner. +Copyright 1992-2021 Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + * ) + break ;; + esac +done + +if test $# != 0; then + echo "$me: too many arguments$help" >&2 + exit 1 +fi + +# CC_FOR_BUILD -- compiler used by this script. Note that the use of a +# compiler to aid in system detection is discouraged as it requires +# temporary files to be created and, as you can see below, it is a +# headache to deal with in a portable fashion. + +# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still +# use `HOST_CC' if defined, but it is deprecated. + +# Portable tmp directory creation inspired by the Autoconf team. + +tmp= +# shellcheck disable=SC2172 +trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15 + +set_cc_for_build() { + # prevent multiple calls if $tmp is already set + test "$tmp" && return 0 + : "${TMPDIR=/tmp}" + # shellcheck disable=SC2039 + { tmp=$( (umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null) && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } + dummy=$tmp/dummy + case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in + ,,) echo "int x;" > "$dummy.c" + for driver in cc gcc c89 c99 ; do + if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then + CC_FOR_BUILD="$driver" + break + fi + done + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; + esac +} + +# This is needed to find uname on a Pyramid OSx when run in the BSD universe. +# (ghazi@noc.rutgers.edu 1994-08-24) +if test -f /.attbin/uname ; then + PATH=$PATH:/.attbin ; export PATH +fi + +UNAME_MACHINE=$( (uname -m) 2>/dev/null) || UNAME_MACHINE=unknown +UNAME_RELEASE=$( (uname -r) 2>/dev/null) || UNAME_RELEASE=unknown +UNAME_SYSTEM=$( (uname -s) 2>/dev/null) || UNAME_SYSTEM=unknown +UNAME_VERSION=$( (uname -v) 2>/dev/null) || UNAME_VERSION=unknown + +case "$UNAME_SYSTEM" in +Linux|GNU|GNU/*) + LIBC=unknown + + set_cc_for_build + cat <<-EOF > "$dummy.c" + #include + #if defined(__UCLIBC__) + LIBC=uclibc + #elif defined(__dietlibc__) + LIBC=dietlibc + #elif defined(__GLIBC__) + LIBC=gnu + #else + #include + /* First heuristic to detect musl libc. */ + #ifdef __DEFINED_va_list + LIBC=musl + #endif + #endif + EOF + eval "$($CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g')" + + # Second heuristic to detect musl libc. + if [ "$LIBC" = unknown ] && + command -v ldd >/dev/null && + ldd --version 2>&1 | grep -q ^musl; then + LIBC=musl + fi + + # If the system lacks a compiler, then just pick glibc. + # We could probably try harder. + if [ "$LIBC" = unknown ]; then + LIBC=gnu + fi + ;; +esac + +# Note: order is significant - the case branches are not exclusive. + +case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in + *:NetBSD:*:*) + # NetBSD (nbsd) targets should (where applicable) match one or + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, + # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently + # switched to ELF, *-*-netbsd* would select the old + # object file format. This provides both forward + # compatibility and a consistent mechanism for selecting the + # object file format. + # + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + UNAME_MACHINE_ARCH=$( (uname -p 2>/dev/null || \ + /sbin/sysctl -n hw.machine_arch 2>/dev/null || \ + /usr/sbin/sysctl -n hw.machine_arch 2>/dev/null || \ + echo unknown)) + case "$UNAME_MACHINE_ARCH" in + aarch64eb) machine=aarch64_be-unknown ;; + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; + earmv*) + arch=$(echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,') + endian=$(echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p') + machine="${arch}${endian}"-unknown + ;; + *) machine="$UNAME_MACHINE_ARCH"-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently (or will in the future) and ABI. + case "$UNAME_MACHINE_ARCH" in + earm*) + os=netbsdelf + ;; + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ELF__ + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? + os=netbsd + else + os=netbsdelf + fi + ;; + *) + os=netbsd + ;; + esac + # Determine ABI tags. + case "$UNAME_MACHINE_ARCH" in + earm*) + expr='s/^earmv[0-9]/-eabi/;s/eb$//' + abi=$(echo "$UNAME_MACHINE_ARCH" | sed -e "$expr") + ;; + esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need + # kernel version information, so it can be replaced with a + # suitable tag, in the style of linux-gnu. + case "$UNAME_VERSION" in + Debian*) + release='-gnu' + ;; + *) + release=$(echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2) + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "$machine-${os}${release}${abi-}" + exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=$(arch | sed 's/Bitrig.//') + echo "$UNAME_MACHINE_ARCH"-unknown-bitrig"$UNAME_RELEASE" + exit ;; + *:OpenBSD:*:*) + UNAME_MACHINE_ARCH=$(arch | sed 's/OpenBSD.//') + echo "$UNAME_MACHINE_ARCH"-unknown-openbsd"$UNAME_RELEASE" + exit ;; + *:LibertyBSD:*:*) + UNAME_MACHINE_ARCH=$(arch | sed 's/^.*BSD\.//') + echo "$UNAME_MACHINE_ARCH"-unknown-libertybsd"$UNAME_RELEASE" + exit ;; + *:MidnightBSD:*:*) + echo "$UNAME_MACHINE"-unknown-midnightbsd"$UNAME_RELEASE" + exit ;; + *:ekkoBSD:*:*) + echo "$UNAME_MACHINE"-unknown-ekkobsd"$UNAME_RELEASE" + exit ;; + *:SolidBSD:*:*) + echo "$UNAME_MACHINE"-unknown-solidbsd"$UNAME_RELEASE" + exit ;; + *:OS108:*:*) + echo "$UNAME_MACHINE"-unknown-os108_"$UNAME_RELEASE" + exit ;; + macppc:MirBSD:*:*) + echo powerpc-unknown-mirbsd"$UNAME_RELEASE" + exit ;; + *:MirBSD:*:*) + echo "$UNAME_MACHINE"-unknown-mirbsd"$UNAME_RELEASE" + exit ;; + *:Sortix:*:*) + echo "$UNAME_MACHINE"-unknown-sortix + exit ;; + *:Twizzler:*:*) + echo "$UNAME_MACHINE"-unknown-twizzler + exit ;; + *:Redox:*:*) + echo "$UNAME_MACHINE"-unknown-redox + exit ;; + mips:OSF1:*.*) + echo mips-dec-osf1 + exit ;; + alpha:OSF1:*:*) + case $UNAME_RELEASE in + *4.0) + UNAME_RELEASE=$(/usr/sbin/sizer -v | awk '{print $3}') + ;; + *5.*) + UNAME_RELEASE=$(/usr/sbin/sizer -v | awk '{print $4}') + ;; + esac + # According to Compaq, /usr/sbin/psrinfo has been available on + # OSF/1 and Tru64 systems produced since 1995. I hope that + # covers most systems running today. This code pipes the CPU + # types through head -n 1, so we only detect the type of CPU 0. + ALPHA_CPU_TYPE=$(/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1) + case "$ALPHA_CPU_TYPE" in + "EV4 (21064)") + UNAME_MACHINE=alpha ;; + "EV4.5 (21064)") + UNAME_MACHINE=alpha ;; + "LCA4 (21066/21068)") + UNAME_MACHINE=alpha ;; + "EV5 (21164)") + UNAME_MACHINE=alphaev5 ;; + "EV5.6 (21164A)") + UNAME_MACHINE=alphaev56 ;; + "EV5.6 (21164PC)") + UNAME_MACHINE=alphapca56 ;; + "EV5.7 (21164PC)") + UNAME_MACHINE=alphapca57 ;; + "EV6 (21264)") + UNAME_MACHINE=alphaev6 ;; + "EV6.7 (21264A)") + UNAME_MACHINE=alphaev67 ;; + "EV6.8CB (21264C)") + UNAME_MACHINE=alphaev68 ;; + "EV6.8AL (21264B)") + UNAME_MACHINE=alphaev68 ;; + "EV6.8CX (21264D)") + UNAME_MACHINE=alphaev68 ;; + "EV6.9A (21264/EV69A)") + UNAME_MACHINE=alphaev69 ;; + "EV7 (21364)") + UNAME_MACHINE=alphaev7 ;; + "EV7.9 (21364A)") + UNAME_MACHINE=alphaev79 ;; + esac + # A Pn.n version is a patched version. + # A Vn.n version is a released version. + # A Tn.n version is a released field test version. + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + echo "$UNAME_MACHINE"-dec-osf"$(echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz)" + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; + Amiga*:UNIX_System_V:4.0:*) + echo m68k-unknown-sysv4 + exit ;; + *:[Aa]miga[Oo][Ss]:*:*) + echo "$UNAME_MACHINE"-unknown-amigaos + exit ;; + *:[Mm]orph[Oo][Ss]:*:*) + echo "$UNAME_MACHINE"-unknown-morphos + exit ;; + *:OS/390:*:*) + echo i370-ibm-openedition + exit ;; + *:z/VM:*:*) + echo s390-ibm-zvmoe + exit ;; + *:OS400:*:*) + echo powerpc-ibm-os400 + exit ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix"$UNAME_RELEASE" + exit ;; + arm*:riscos:*:*|arm*:RISCOS:*:*) + echo arm-unknown-riscos + exit ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + echo hppa1.1-hitachi-hiuxmpp + exit ;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + if test "$( (/bin/universe) 2>/dev/null)" = att ; then + echo pyramid-pyramid-sysv3 + else + echo pyramid-pyramid-bsd + fi + exit ;; + NILE*:*:*:dcosx) + echo pyramid-pyramid-svr4 + exit ;; + DRS?6000:unix:4.0:6*) + echo sparc-icl-nx6 + exit ;; + DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) + case $(/usr/bin/uname -p) in + sparc) echo sparc-icl-nx7; exit ;; + esac ;; + s390x:SunOS:*:*) + echo "$UNAME_MACHINE"-ibm-solaris2"$(echo "$UNAME_RELEASE" | sed -e 's/[^.]*//')" + exit ;; + sun4H:SunOS:5.*:*) + echo sparc-hal-solaris2"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')" + exit ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + echo sparc-sun-solaris2"$(echo "$UNAME_RELEASE" | sed -e 's/[^.]*//')" + exit ;; + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux"$UNAME_RELEASE" + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + set_cc_for_build + SUN_ARCH=i386 + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH=x86_64 + fi + fi + echo "$SUN_ARCH"-pc-solaris2"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')" + exit ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')" + exit ;; + sun4*:SunOS:*:*) + case "$(/usr/bin/arch -k)" in + Series*|S4*) + UNAME_RELEASE=$(uname -v) + ;; + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + echo sparc-sun-sunos"$(echo "$UNAME_RELEASE"|sed -e 's/-/_/')" + exit ;; + sun3*:SunOS:*:*) + echo m68k-sun-sunos"$UNAME_RELEASE" + exit ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=$( (sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null) + test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3 + case "$(/bin/arch)" in + sun3) + echo m68k-sun-sunos"$UNAME_RELEASE" + ;; + sun4) + echo sparc-sun-sunos"$UNAME_RELEASE" + ;; + esac + exit ;; + aushp:SunOS:*:*) + echo sparc-auspex-sunos"$UNAME_RELEASE" + exit ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor + # > m68000). The system name ranges from "MiNT" over "FreeMiNT" + # to the lowercase version "mint" (or "freemint"). Finally + # the system name "TOS" denotes a system which is actually not + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint"$UNAME_RELEASE" + exit ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint"$UNAME_RELEASE" + exit ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + echo m68k-atari-mint"$UNAME_RELEASE" + exit ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + echo m68k-milan-mint"$UNAME_RELEASE" + exit ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + echo m68k-hades-mint"$UNAME_RELEASE" + exit ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + echo m68k-unknown-mint"$UNAME_RELEASE" + exit ;; + m68k:machten:*:*) + echo m68k-apple-machten"$UNAME_RELEASE" + exit ;; + powerpc:machten:*:*) + echo powerpc-apple-machten"$UNAME_RELEASE" + exit ;; + RISC*:Mach:*:*) + echo mips-dec-mach_bsd4.3 + exit ;; + RISC*:ULTRIX:*:*) + echo mips-dec-ultrix"$UNAME_RELEASE" + exit ;; + VAX*:ULTRIX*:*:*) + echo vax-dec-ultrix"$UNAME_RELEASE" + exit ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + echo clipper-intergraph-clix"$UNAME_RELEASE" + exit ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" +#ifdef __cplusplus +#include /* for printf() prototype */ + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif + #if defined (host_mips) && defined (MIPSEB) + #if defined (SYSTYPE_SYSV) + printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_SVR4) + printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) + printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0); + #endif + #endif + exit (-1); + } +EOF + $CC_FOR_BUILD -o "$dummy" "$dummy.c" && + dummyarg=$(echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p') && + SYSTEM_NAME=$("$dummy" "$dummyarg") && + { echo "$SYSTEM_NAME"; exit; } + echo mips-mips-riscos"$UNAME_RELEASE" + exit ;; + Motorola:PowerMAX_OS:*:*) + echo powerpc-motorola-powermax + exit ;; + Motorola:*:4.3:PL8-*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:Power_UNIX:*:*) + echo powerpc-harris-powerunix + exit ;; + m88k:CX/UX:7*:*) + echo m88k-harris-cxux7 + exit ;; + m88k:*:4*:R4*) + echo m88k-motorola-sysv4 + exit ;; + m88k:*:3*:R3*) + echo m88k-motorola-sysv3 + exit ;; + AViiON:dgux:*:*) + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=$(/usr/bin/uname -p) + if test "$UNAME_PROCESSOR" = mc88100 || test "$UNAME_PROCESSOR" = mc88110 + then + if test "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx || \ + test "$TARGET_BINARY_INTERFACE"x = x + then + echo m88k-dg-dgux"$UNAME_RELEASE" + else + echo m88k-dg-dguxbcs"$UNAME_RELEASE" + fi + else + echo i586-dg-dgux"$UNAME_RELEASE" + fi + exit ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + echo m88k-dolphin-sysv3 + exit ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + echo m88k-motorola-sysv3 + exit ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + echo m88k-tektronix-sysv3 + exit ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + echo m68k-tektronix-bsd + exit ;; + *:IRIX*:*:*) + echo mips-sgi-irix"$(echo "$UNAME_RELEASE"|sed -e 's/-/_/g')" + exit ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit ;; # Note that: echo "'$(uname -s)'" gives 'AIX ' + i*86:AIX:*:*) + echo i386-ibm-aix + exit ;; + ia64:AIX:*:*) + if test -x /usr/bin/oslevel ; then + IBM_REV=$(/usr/bin/oslevel) + else + IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" + fi + echo "$UNAME_MACHINE"-ibm-aix"$IBM_REV" + exit ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + #include + + main() + { + if (!__power_pc()) + exit(1); + puts("powerpc-ibm-aix3.2.5"); + exit(0); + } +EOF + if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=$("$dummy") + then + echo "$SYSTEM_NAME" + else + echo rs6000-ibm-aix3.2.5 + fi + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + echo rs6000-ibm-aix3.2.4 + else + echo rs6000-ibm-aix3.2 + fi + exit ;; + *:AIX:*:[4567]) + IBM_CPU_ID=$(/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }') + if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 + else + IBM_ARCH=powerpc + fi + if test -x /usr/bin/lslpp ; then + IBM_REV=$(/usr/bin/lslpp -Lqc bos.rte.libc | + awk -F: '{ print $3 }' | sed s/[0-9]*$/0/) + else + IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" + fi + echo "$IBM_ARCH"-ibm-aix"$IBM_REV" + exit ;; + *:AIX:*:*) + echo rs6000-ibm-aix + exit ;; + ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*) + echo romp-ibm-bsd4.4 + exit ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + echo romp-ibm-bsd"$UNAME_RELEASE" # 4.3 with uname added to + exit ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + echo rs6000-bull-bosx + exit ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 + exit ;; + 9000/[34]??:4.3bsd:1.*:*) + echo m68k-hp-bsd + exit ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + echo m68k-hp-bsd4.4 + exit ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//') + case "$UNAME_MACHINE" in + 9000/31?) HP_ARCH=m68000 ;; + 9000/[34]??) HP_ARCH=m68k ;; + 9000/[678][0-9][0-9]) + if test -x /usr/bin/getconf; then + sc_cpu_version=$(/usr/bin/getconf SC_CPU_VERSION 2>/dev/null) + sc_kernel_bits=$(/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null) + case "$sc_cpu_version" in + 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0 + 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "$sc_kernel_bits" in + 32) HP_ARCH=hppa2.0n ;; + 64) HP_ARCH=hppa2.0w ;; + '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20 + esac ;; + esac + fi + if test "$HP_ARCH" = ""; then + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + + #define _HPUX_SOURCE + #include + #include + + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); + + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } +EOF + (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=$("$dummy") + test -z "$HP_ARCH" && HP_ARCH=hppa + fi ;; + esac + if test "$HP_ARCH" = hppa2.0w + then + set_cc_for_build + + # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating + # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler + # generating 64-bit code. GNU and HP use different nomenclature: + # + # $ CC_FOR_BUILD=cc ./config.guess + # => hppa2.0w-hp-hpux11.23 + # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess + # => hppa64-hp-hpux11.23 + + if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | + grep -q __LP64__ + then + HP_ARCH=hppa2.0w + else + HP_ARCH=hppa64 + fi + fi + echo "$HP_ARCH"-hp-hpux"$HPUX_REV" + exit ;; + ia64:HP-UX:*:*) + HPUX_REV=$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//') + echo ia64-hp-hpux"$HPUX_REV" + exit ;; + 3050*:HI-UX:*:*) + set_cc_for_build + sed 's/^ //' << EOF > "$dummy.c" + #include + int + main () + { + long cpu = sysconf (_SC_CPU_VERSION); + /* The order matters, because CPU_IS_HP_MC68K erroneously returns + true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct + results, however. */ + if (CPU_IS_PA_RISC (cpu)) + { + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; + case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; + default: puts ("hppa-hitachi-hiuxwe2"); break; + } + } + else if (CPU_IS_HP_MC68K (cpu)) + puts ("m68k-hitachi-hiuxwe2"); + else puts ("unknown-hitachi-hiuxwe2"); + exit (0); + } +EOF + $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=$("$dummy") && + { echo "$SYSTEM_NAME"; exit; } + echo unknown-hitachi-hiuxwe2 + exit ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*) + echo hppa1.1-hp-bsd + exit ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd + exit ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix + exit ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*) + echo hppa1.1-hp-osf + exit ;; + hp8??:OSF1:*:*) + echo hppa1.0-hp-osf + exit ;; + i*86:OSF1:*:*) + if test -x /usr/sbin/sysversion ; then + echo "$UNAME_MACHINE"-unknown-osf1mk + else + echo "$UNAME_MACHINE"-unknown-osf1 + fi + exit ;; + parisc*:Lites*:*:*) + echo hppa1.1-hp-lites + exit ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + echo c1-convex-bsd + exit ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + echo c34-convex-bsd + exit ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + echo c38-convex-bsd + exit ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + echo c4-convex-bsd + exit ;; + CRAY*Y-MP:*:*:*) + echo ymp-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*[A-Z]90:*:*:*) + echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*TS:*:*:*) + echo t90-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*T3E:*:*:*) + echo alphaev5-cray-unicosmk"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*SV1:*:*:*) + echo sv1-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + *:UNICOS/mp:*:*) + echo craynv-cray-unicosmp"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' + exit ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=$(uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz) + FUJITSU_SYS=$(uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///') + FUJITSU_REL=$(echo "$UNAME_RELEASE" | sed -e 's/ /_/') + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + 5000:UNIX_System_V:4.*:*) + FUJITSU_SYS=$(uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///') + FUJITSU_REL=$(echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/') + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + echo "$UNAME_MACHINE"-pc-bsdi"$UNAME_RELEASE" + exit ;; + sparc*:BSD/OS:*:*) + echo sparc-unknown-bsdi"$UNAME_RELEASE" + exit ;; + *:BSD/OS:*:*) + echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE" + exit ;; + arm:FreeBSD:*:*) + UNAME_PROCESSOR=$(uname -p) + set_cc_for_build + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo "${UNAME_PROCESSOR}"-unknown-freebsd"$(echo ${UNAME_RELEASE}|sed -e 's/[-(].*//')"-gnueabi + else + echo "${UNAME_PROCESSOR}"-unknown-freebsd"$(echo ${UNAME_RELEASE}|sed -e 's/[-(].*//')"-gnueabihf + fi + exit ;; + *:FreeBSD:*:*) + UNAME_PROCESSOR=$(/usr/bin/uname -p) + case "$UNAME_PROCESSOR" in + amd64) + UNAME_PROCESSOR=x86_64 ;; + i386) + UNAME_PROCESSOR=i586 ;; + esac + echo "$UNAME_PROCESSOR"-unknown-freebsd"$(echo "$UNAME_RELEASE"|sed -e 's/[-(].*//')" + exit ;; + i*:CYGWIN*:*) + echo "$UNAME_MACHINE"-pc-cygwin + exit ;; + *:MINGW64*:*) + echo "$UNAME_MACHINE"-pc-mingw64 + exit ;; + *:MINGW*:*) + echo "$UNAME_MACHINE"-pc-mingw32 + exit ;; + *:MSYS*:*) + echo "$UNAME_MACHINE"-pc-msys + exit ;; + i*:PW*:*) + echo "$UNAME_MACHINE"-pc-pw32 + exit ;; + *:Interix*:*) + case "$UNAME_MACHINE" in + x86) + echo i586-pc-interix"$UNAME_RELEASE" + exit ;; + authenticamd | genuineintel | EM64T) + echo x86_64-unknown-interix"$UNAME_RELEASE" + exit ;; + IA64) + echo ia64-unknown-interix"$UNAME_RELEASE" + exit ;; + esac ;; + i*:UWIN*:*) + echo "$UNAME_MACHINE"-pc-uwin + exit ;; + amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) + echo x86_64-pc-cygwin + exit ;; + prep*:SunOS:5.*:*) + echo powerpcle-unknown-solaris2"$(echo "$UNAME_RELEASE"|sed -e 's/[^.]*//')" + exit ;; + *:GNU:*:*) + # the GNU system + echo "$(echo "$UNAME_MACHINE"|sed -e 's,[-/].*$,,')-unknown-$LIBC$(echo "$UNAME_RELEASE"|sed -e 's,/.*$,,')" + exit ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + echo "$UNAME_MACHINE-unknown-$(echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]")$(echo "$UNAME_RELEASE"|sed -e 's/[-(].*//')-$LIBC" + exit ;; + *:Minix:*:*) + echo "$UNAME_MACHINE"-unknown-minix + exit ;; + aarch64:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + alpha:Linux:*:*) + case $(sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' /proc/cpuinfo 2>/dev/null) in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC=gnulibc1 ; fi + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + arc:Linux:*:* | arceb:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + arm*:Linux:*:*) + set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabi + else + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabihf + fi + fi + exit ;; + avr32*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + cris:Linux:*:*) + echo "$UNAME_MACHINE"-axis-linux-"$LIBC" + exit ;; + crisv32:Linux:*:*) + echo "$UNAME_MACHINE"-axis-linux-"$LIBC" + exit ;; + e2k:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + frv:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + hexagon:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + i*86:Linux:*:*) + echo "$UNAME_MACHINE"-pc-linux-"$LIBC" + exit ;; + ia64:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + k1om:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + loongarch32:Linux:*:* | loongarch64:Linux:*:* | loongarchx32:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + m32r*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + m68*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + mips:Linux:*:* | mips64:Linux:*:*) + set_cc_for_build + IS_GLIBC=0 + test x"${LIBC}" = xgnu && IS_GLIBC=1 + sed 's/^ //' << EOF > "$dummy.c" + #undef CPU + #undef mips + #undef mipsel + #undef mips64 + #undef mips64el + #if ${IS_GLIBC} && defined(_ABI64) + LIBCABI=gnuabi64 + #else + #if ${IS_GLIBC} && defined(_ABIN32) + LIBCABI=gnuabin32 + #else + LIBCABI=${LIBC} + #endif + #endif + + #if ${IS_GLIBC} && defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 + CPU=mipsisa64r6 + #else + #if ${IS_GLIBC} && !defined(__mips64) && defined(__mips_isa_rev) && __mips_isa_rev>=6 + CPU=mipsisa32r6 + #else + #if defined(__mips64) + CPU=mips64 + #else + CPU=mips + #endif + #endif + #endif + + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + MIPS_ENDIAN=el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + MIPS_ENDIAN= + #else + MIPS_ENDIAN= + #endif + #endif +EOF + eval "$($CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU\|^MIPS_ENDIAN\|^LIBCABI')" + test "x$CPU" != x && { echo "$CPU${MIPS_ENDIAN}-unknown-linux-$LIBCABI"; exit; } + ;; + mips64el:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + openrisc*:Linux:*:*) + echo or1k-unknown-linux-"$LIBC" + exit ;; + or32:Linux:*:* | or1k*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + padre:Linux:*:*) + echo sparc-unknown-linux-"$LIBC" + exit ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-"$LIBC" + exit ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case $(grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2) in + PA7*) echo hppa1.1-unknown-linux-"$LIBC" ;; + PA8*) echo hppa2.0-unknown-linux-"$LIBC" ;; + *) echo hppa-unknown-linux-"$LIBC" ;; + esac + exit ;; + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-"$LIBC" + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-"$LIBC" + exit ;; + ppc64le:Linux:*:*) + echo powerpc64le-unknown-linux-"$LIBC" + exit ;; + ppcle:Linux:*:*) + echo powerpcle-unknown-linux-"$LIBC" + exit ;; + riscv32:Linux:*:* | riscv32be:Linux:*:* | riscv64:Linux:*:* | riscv64be:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo "$UNAME_MACHINE"-ibm-linux-"$LIBC" + exit ;; + sh64*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + sh*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + tile*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + vax:Linux:*:*) + echo "$UNAME_MACHINE"-dec-linux-"$LIBC" + exit ;; + x86_64:Linux:*:*) + set_cc_for_build + LIBCABI=$LIBC + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __ILP32__'; echo IS_X32; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_X32 >/dev/null + then + LIBCABI="$LIBC"x32 + fi + fi + echo "$UNAME_MACHINE"-pc-linux-"$LIBCABI" + exit ;; + xtensa*:Linux:*:*) + echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" + exit ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + echo i386-sequent-sysv4 + exit ;; + i*86:UNIX_SV:4.2MP:2.*) + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, + # I just have to hope. -- rms. + # Use sysv4.2uw... so that sysv4* matches it. + echo "$UNAME_MACHINE"-pc-sysv4.2uw"$UNAME_VERSION" + exit ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + echo "$UNAME_MACHINE"-pc-os2-emx + exit ;; + i*86:XTS-300:*:STOP) + echo "$UNAME_MACHINE"-unknown-stop + exit ;; + i*86:atheos:*:*) + echo "$UNAME_MACHINE"-unknown-atheos + exit ;; + i*86:syllable:*:*) + echo "$UNAME_MACHINE"-pc-syllable + exit ;; + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) + echo i386-unknown-lynxos"$UNAME_RELEASE" + exit ;; + i*86:*DOS:*:*) + echo "$UNAME_MACHINE"-pc-msdosdjgpp + exit ;; + i*86:*:4.*:*) + UNAME_REL=$(echo "$UNAME_RELEASE" | sed 's/\/MP$//') + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + echo "$UNAME_MACHINE"-univel-sysv"$UNAME_REL" + else + echo "$UNAME_MACHINE"-pc-sysv"$UNAME_REL" + fi + exit ;; + i*86:*:5:[678]*) + # UnixWare 7.x, OpenUNIX and OpenServer 6. + case $(/bin/uname -X | grep "^Machine") in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION}" + exit ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=$(sed -n 's/.*Version //p' /dev/null >/dev/null ; then + UNAME_REL=$( (/bin/uname -X|grep Release|sed -e 's/.*= //')) + (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 + (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ + && UNAME_MACHINE=i586 + (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ + && UNAME_MACHINE=i686 + (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ + && UNAME_MACHINE=i686 + echo "$UNAME_MACHINE"-pc-sco"$UNAME_REL" + else + echo "$UNAME_MACHINE"-pc-sysv32 + fi + exit ;; + pc:*:*:*) + # Left here for compatibility: + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configure will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; + Intel:Mach:3*:*) + echo i386-pc-mach3 + exit ;; + paragon:*:*:*) + echo i860-intel-osf1 + exit ;; + i860:*:4.*:*) # i860-SVR4 + if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then + echo i860-stardent-sysv"$UNAME_RELEASE" # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + echo i860-unknown-sysv"$UNAME_RELEASE" # Unknown i860-SVR4 + fi + exit ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + echo m68010-convergent-sysv + exit ;; + mc68k:UNIX:SYSTEM5:3.51m) + echo m68k-convergent-sysv + exit ;; + M680?0:D-NIX:5.3:*) + echo m68k-diab-dnix + exit ;; + M68*:*:R3V[5678]*:*) + test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.$(sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.$(sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + echo m68k-unknown-lynxos"$UNAME_RELEASE" + exit ;; + mc68030:UNIX_System_V:4.*:*) + echo m68k-atari-sysv4 + exit ;; + TSUNAMI:LynxOS:2.*:*) + echo sparc-unknown-lynxos"$UNAME_RELEASE" + exit ;; + rs6000:LynxOS:2.*:*) + echo rs6000-unknown-lynxos"$UNAME_RELEASE" + exit ;; + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) + echo powerpc-unknown-lynxos"$UNAME_RELEASE" + exit ;; + SM[BE]S:UNIX_SV:*:*) + echo mips-dde-sysv"$UNAME_RELEASE" + exit ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + RM*:SINIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=$( (uname -p) 2>/dev/null) + echo "$UNAME_MACHINE"-sni-sysv4 + else + echo ns32k-sni-sysv + fi + exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says + echo i586-unisys-sysv4 + exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes . + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 + exit ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + echo i860-stratus-sysv4 + exit ;; + i*86:VOS:*:*) + # From Paul.Green@stratus.com. + echo "$UNAME_MACHINE"-stratus-vos + exit ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + echo hppa1.1-stratus-vos + exit ;; + mc68*:A/UX:*:*) + echo m68k-apple-aux"$UNAME_RELEASE" + exit ;; + news*:NEWS-OS:6*:*) + echo mips-sony-newsos6 + exit ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if test -d /usr/nec; then + echo mips-nec-sysv"$UNAME_RELEASE" + else + echo mips-unknown-sysv"$UNAME_RELEASE" + fi + exit ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + echo powerpc-be-beos + exit ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + echo powerpc-apple-beos + exit ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + echo i586-pc-beos + exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux"$UNAME_RELEASE" + exit ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux"$UNAME_RELEASE" + exit ;; + SX-6:SUPER-UX:*:*) + echo sx6-nec-superux"$UNAME_RELEASE" + exit ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux"$UNAME_RELEASE" + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux"$UNAME_RELEASE" + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-nec-superux"$UNAME_RELEASE" + exit ;; + SX-ACE:SUPER-UX:*:*) + echo sxace-nec-superux"$UNAME_RELEASE" + exit ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody"$UNAME_RELEASE" + exit ;; + *:Rhapsody:*:*) + echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE" + exit ;; + arm64:Darwin:*:*) + echo aarch64-apple-darwin"$UNAME_RELEASE" + exit ;; + *:Darwin:*:*) + UNAME_PROCESSOR=$(uname -p) + case $UNAME_PROCESSOR in + unknown) UNAME_PROCESSOR=powerpc ;; + esac + if command -v xcode-select > /dev/null 2> /dev/null && \ + ! xcode-select --print-path > /dev/null 2> /dev/null ; then + # Avoid executing cc if there is no toolchain installed as + # cc will be a stub that puts up a graphical alert + # prompting the user to install developer tools. + CC_FOR_BUILD=no_compiler_found + else + set_cc_for_build + fi + if test "$CC_FOR_BUILD" != no_compiler_found; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + case $UNAME_PROCESSOR in + i386) UNAME_PROCESSOR=x86_64 ;; + powerpc) UNAME_PROCESSOR=powerpc64 ;; + esac + fi + # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc + if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \ + (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_PPC >/dev/null + then + UNAME_PROCESSOR=powerpc + fi + elif test "$UNAME_PROCESSOR" = i386 ; then + # uname -m returns i386 or x86_64 + UNAME_PROCESSOR=$UNAME_MACHINE + fi + echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE" + exit ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=$(uname -p) + if test "$UNAME_PROCESSOR" = x86; then + UNAME_PROCESSOR=i386 + UNAME_MACHINE=pc + fi + echo "$UNAME_PROCESSOR"-"$UNAME_MACHINE"-nto-qnx"$UNAME_RELEASE" + exit ;; + *:QNX:*:4*) + echo i386-pc-qnx + exit ;; + NEO-*:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) + echo nse-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSR-*:NONSTOP_KERNEL:*:*) + echo nsr-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSV-*:NONSTOP_KERNEL:*:*) + echo nsv-tandem-nsk"$UNAME_RELEASE" + exit ;; + NSX-*:NONSTOP_KERNEL:*:*) + echo nsx-tandem-nsk"$UNAME_RELEASE" + exit ;; + *:NonStop-UX:*:*) + echo mips-compaq-nonstopux + exit ;; + BS2000:POSIX*:*:*) + echo bs2000-siemens-sysv + exit ;; + DS/*:UNIX_System_V:*:*) + echo "$UNAME_MACHINE"-"$UNAME_SYSTEM"-"$UNAME_RELEASE" + exit ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 + # operating systems. + # shellcheck disable=SC2154 + if test "$cputype" = 386; then + UNAME_MACHINE=i386 + else + UNAME_MACHINE="$cputype" + fi + echo "$UNAME_MACHINE"-unknown-plan9 + exit ;; + *:TOPS-10:*:*) + echo pdp10-unknown-tops10 + exit ;; + *:TENEX:*:*) + echo pdp10-unknown-tenex + exit ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + echo pdp10-dec-tops20 + exit ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + echo pdp10-xkl-tops20 + exit ;; + *:TOPS-20:*:*) + echo pdp10-unknown-tops20 + exit ;; + *:ITS:*:*) + echo pdp10-unknown-its + exit ;; + SEI:*:*:SEIUX) + echo mips-sei-seiux"$UNAME_RELEASE" + exit ;; + *:DragonFly:*:*) + echo "$UNAME_MACHINE"-unknown-dragonfly"$(echo "$UNAME_RELEASE"|sed -e 's/[-(].*//')" + exit ;; + *:*VMS:*:*) + UNAME_MACHINE=$( (uname -p) 2>/dev/null) + case "$UNAME_MACHINE" in + A*) echo alpha-dec-vms ; exit ;; + I*) echo ia64-dec-vms ; exit ;; + V*) echo vax-dec-vms ; exit ;; + esac ;; + *:XENIX:*:SysV) + echo i386-pc-xenix + exit ;; + i*86:skyos:*:*) + echo "$UNAME_MACHINE"-pc-skyos"$(echo "$UNAME_RELEASE" | sed -e 's/ .*$//')" + exit ;; + i*86:rdos:*:*) + echo "$UNAME_MACHINE"-pc-rdos + exit ;; + *:AROS:*:*) + echo "$UNAME_MACHINE"-unknown-aros + exit ;; + x86_64:VMkernel:*:*) + echo "$UNAME_MACHINE"-unknown-esx + exit ;; + amd64:Isilon\ OneFS:*:*) + echo x86_64-unknown-onefs + exit ;; + *:Unleashed:*:*) + echo "$UNAME_MACHINE"-unknown-unleashed"$UNAME_RELEASE" + exit ;; +esac + +# No uname command or uname output not recognized. +set_cc_for_build +cat > "$dummy.c" < +#include +#endif +#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) +#if defined (vax) || defined (__vax) || defined (__vax__) || defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) +#include +#if defined(_SIZE_T_) || defined(SIGLOST) +#include +#endif +#endif +#endif +main () +{ +#if defined (sony) +#if defined (MIPSEB) + /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, + I don't know.... */ + printf ("mips-sony-bsd\n"); exit (0); +#else +#include + printf ("m68k-sony-newsos%s\n", +#ifdef NEWSOS4 + "4" +#else + "" +#endif + ); exit (0); +#endif +#endif + +#if defined (NeXT) +#if !defined (__ARCHITECTURE__) +#define __ARCHITECTURE__ "m68k" +#endif + int version; + version=$( (hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null); + if (version < 4) + printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); + else + printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); + exit (0); +#endif + +#if defined (MULTIMAX) || defined (n16) +#if defined (UMAXV) + printf ("ns32k-encore-sysv\n"); exit (0); +#else +#if defined (CMU) + printf ("ns32k-encore-mach\n"); exit (0); +#else + printf ("ns32k-encore-bsd\n"); exit (0); +#endif +#endif +#endif + +#if defined (__386BSD__) + printf ("i386-pc-bsd\n"); exit (0); +#endif + +#if defined (sequent) +#if defined (i386) + printf ("i386-sequent-dynix\n"); exit (0); +#endif +#if defined (ns32000) + printf ("ns32k-sequent-dynix\n"); exit (0); +#endif +#endif + +#if defined (_SEQUENT_) + struct utsname un; + + uname(&un); + if (strncmp(un.version, "V2", 2) == 0) { + printf ("i386-sequent-ptx2\n"); exit (0); + } + if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ + printf ("i386-sequent-ptx1\n"); exit (0); + } + printf ("i386-sequent-ptx\n"); exit (0); +#endif + +#if defined (vax) +#if !defined (ultrix) +#include +#if defined (BSD) +#if BSD == 43 + printf ("vax-dec-bsd4.3\n"); exit (0); +#else +#if BSD == 199006 + printf ("vax-dec-bsd4.3reno\n"); exit (0); +#else + printf ("vax-dec-bsd\n"); exit (0); +#endif +#endif +#else + printf ("vax-dec-bsd\n"); exit (0); +#endif +#else +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname un; + uname (&un); + printf ("vax-dec-ultrix%s\n", un.release); exit (0); +#else + printf ("vax-dec-ultrix\n"); exit (0); +#endif +#endif +#endif +#if defined(ultrix) || defined(_ultrix) || defined(__ultrix) || defined(__ultrix__) +#if defined(mips) || defined(__mips) || defined(__mips__) || defined(MIPS) || defined(__MIPS__) +#if defined(_SIZE_T_) || defined(SIGLOST) + struct utsname *un; + uname (&un); + printf ("mips-dec-ultrix%s\n", un.release); exit (0); +#else + printf ("mips-dec-ultrix\n"); exit (0); +#endif +#endif +#endif + +#if defined (alliant) && defined (i860) + printf ("i860-alliant-bsd\n"); exit (0); +#endif + + exit (1); +} +EOF + +$CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null && SYSTEM_NAME=$($dummy) && + { echo "$SYSTEM_NAME"; exit; } + +# Apollos put the system type in the environment. +test -d /usr/apollo && { echo "$ISP-apollo-$SYSTYPE"; exit; } + +echo "$0: unable to guess system type" >&2 + +case "$UNAME_MACHINE:$UNAME_SYSTEM" in + mips:Linux | mips64:Linux) + # If we got here on MIPS GNU/Linux, output extra information. + cat >&2 <&2 <&2 </dev/null || echo unknown) +uname -r = $( (uname -r) 2>/dev/null || echo unknown) +uname -s = $( (uname -s) 2>/dev/null || echo unknown) +uname -v = $( (uname -v) 2>/dev/null || echo unknown) + +/usr/bin/uname -p = $( (/usr/bin/uname -p) 2>/dev/null) +/bin/uname -X = $( (/bin/uname -X) 2>/dev/null) + +hostinfo = $( (hostinfo) 2>/dev/null) +/bin/universe = $( (/bin/universe) 2>/dev/null) +/usr/bin/arch -k = $( (/usr/bin/arch -k) 2>/dev/null) +/bin/arch = $( (/bin/arch) 2>/dev/null) +/usr/bin/oslevel = $( (/usr/bin/oslevel) 2>/dev/null) +/usr/convex/getsysinfo = $( (/usr/convex/getsysinfo) 2>/dev/null) + +UNAME_MACHINE = "$UNAME_MACHINE" +UNAME_RELEASE = "$UNAME_RELEASE" +UNAME_SYSTEM = "$UNAME_SYSTEM" +UNAME_VERSION = "$UNAME_VERSION" +EOF +fi + +exit 1 + +# Local variables: +# eval: (add-hook 'before-save-hook 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/config.mk.in b/config.mk.in new file mode 100644 --- /dev/null +++ b/config.mk.in @@ -0,0 +1,17 @@ +# NB: This file lives in the top-level ghc-bignum folder, and not in +# the gmp subfolder, because of #14972, where we MUST NOT create a +# folder named 'gmp' in dist/build/ + +ifeq "$(HaveLibGmp)" "" + HaveLibGmp = @HaveLibGmp@ +endif + +ifeq "$(HaveFrameworkGMP)" "" + HaveFrameworkGMP = @HaveFrameworkGMP@ +endif + +GMP_FORCE_INTREE = @GMP_FORCE_INTREE@ +GMP_PREFER_FRAMEWORK = @GMP_PREFER_FRAMEWORK@ +GMP_INCLUDE_DIRS = @GMP_INCLUDE_DIRS@ +GMP_LIB_DIRS = @GMP_LIB_DIRS@ + diff --git a/config.sub b/config.sub new file mode 100644 --- /dev/null +++ b/config.sub @@ -0,0 +1,1860 @@ +#! /bin/sh +# Configuration validation subroutine script. +# Copyright 1992-2021 Free Software Foundation, Inc. + +timestamp='2021-01-08' + +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, see . +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). + + +# Please send patches to . +# +# Configuration subroutine to validate and canonicalize a configuration type. +# Supply the specified configuration type as an argument. +# If it is invalid, we print an error message on stderr and exit with code 1. +# Otherwise, we print the canonical config type on stdout and succeed. + +# You can get the latest version of this script from: +# https://git.savannah.gnu.org/cgit/config.git/plain/config.sub + +# This file is supposed to be the same for all GNU packages +# and recognize all the CPU types, system types and aliases +# that are meaningful with *any* GNU software. +# Each package is responsible for reporting which valid configurations +# it does not support. The user should be able to distinguish +# a failure to support a valid configuration from a meaningless +# configuration. + +# The goal of this file is to map all the various variations of a given +# machine specification into a single specification in the form: +# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM +# or in some cases, the newer four-part form: +# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM +# It is wrong to echo any other type of specification. + +me=$(echo "$0" | sed -e 's,.*/,,') + +usage="\ +Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS + +Canonicalize a configuration name. + +Options: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.sub ($timestamp) + +Copyright 1992-2021 Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + + *local*) + # First pass through any local machine types. + echo "$1" + exit ;; + + * ) + break ;; + esac +done + +case $# in + 0) echo "$me: missing argument$help" >&2 + exit 1;; + 1) ;; + *) echo "$me: too many arguments$help" >&2 + exit 1;; +esac + +# Split fields of configuration type +# shellcheck disable=SC2162 +IFS="-" read field1 field2 field3 field4 <&2 + exit 1 + ;; + *-*-*-*) + basic_machine=$field1-$field2 + basic_os=$field3-$field4 + ;; + *-*-*) + # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two + # parts + maybe_os=$field2-$field3 + case $maybe_os in + nto-qnx* | linux-* | uclinux-uclibc* \ + | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \ + | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \ + | storm-chaos* | os2-emx* | rtmk-nova*) + basic_machine=$field1 + basic_os=$maybe_os + ;; + android-linux) + basic_machine=$field1-unknown + basic_os=linux-android + ;; + *) + basic_machine=$field1-$field2 + basic_os=$field3 + ;; + esac + ;; + *-*) + # A lone config we happen to match not fitting any pattern + case $field1-$field2 in + decstation-3100) + basic_machine=mips-dec + basic_os= + ;; + *-*) + # Second component is usually, but not always the OS + case $field2 in + # Prevent following clause from handling this valid os + sun*os*) + basic_machine=$field1 + basic_os=$field2 + ;; + # Manufacturers + dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \ + | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \ + | unicom* | ibm* | next | hp | isi* | apollo | altos* \ + | convergent* | ncr* | news | 32* | 3600* | 3100* \ + | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \ + | ultra | tti* | harris | dolphin | highlevel | gould \ + | cbm | ns | masscomp | apple | axis | knuth | cray \ + | microblaze* | sim | cisco \ + | oki | wec | wrs | winbond) + basic_machine=$field1-$field2 + basic_os= + ;; + *) + basic_machine=$field1 + basic_os=$field2 + ;; + esac + ;; + esac + ;; + *) + # Convert single-component short-hands not valid as part of + # multi-component configurations. + case $field1 in + 386bsd) + basic_machine=i386-pc + basic_os=bsd + ;; + a29khif) + basic_machine=a29k-amd + basic_os=udi + ;; + adobe68k) + basic_machine=m68010-adobe + basic_os=scout + ;; + alliant) + basic_machine=fx80-alliant + basic_os= + ;; + altos | altos3068) + basic_machine=m68k-altos + basic_os= + ;; + am29k) + basic_machine=a29k-none + basic_os=bsd + ;; + amdahl) + basic_machine=580-amdahl + basic_os=sysv + ;; + amiga) + basic_machine=m68k-unknown + basic_os= + ;; + amigaos | amigados) + basic_machine=m68k-unknown + basic_os=amigaos + ;; + amigaunix | amix) + basic_machine=m68k-unknown + basic_os=sysv4 + ;; + apollo68) + basic_machine=m68k-apollo + basic_os=sysv + ;; + apollo68bsd) + basic_machine=m68k-apollo + basic_os=bsd + ;; + aros) + basic_machine=i386-pc + basic_os=aros + ;; + aux) + basic_machine=m68k-apple + basic_os=aux + ;; + balance) + basic_machine=ns32k-sequent + basic_os=dynix + ;; + blackfin) + basic_machine=bfin-unknown + basic_os=linux + ;; + cegcc) + basic_machine=arm-unknown + basic_os=cegcc + ;; + convex-c1) + basic_machine=c1-convex + basic_os=bsd + ;; + convex-c2) + basic_machine=c2-convex + basic_os=bsd + ;; + convex-c32) + basic_machine=c32-convex + basic_os=bsd + ;; + convex-c34) + basic_machine=c34-convex + basic_os=bsd + ;; + convex-c38) + basic_machine=c38-convex + basic_os=bsd + ;; + cray) + basic_machine=j90-cray + basic_os=unicos + ;; + crds | unos) + basic_machine=m68k-crds + basic_os= + ;; + da30) + basic_machine=m68k-da30 + basic_os= + ;; + decstation | pmax | pmin | dec3100 | decstatn) + basic_machine=mips-dec + basic_os= + ;; + delta88) + basic_machine=m88k-motorola + basic_os=sysv3 + ;; + dicos) + basic_machine=i686-pc + basic_os=dicos + ;; + djgpp) + basic_machine=i586-pc + basic_os=msdosdjgpp + ;; + ebmon29k) + basic_machine=a29k-amd + basic_os=ebmon + ;; + es1800 | OSE68k | ose68k | ose | OSE) + basic_machine=m68k-ericsson + basic_os=ose + ;; + gmicro) + basic_machine=tron-gmicro + basic_os=sysv + ;; + go32) + basic_machine=i386-pc + basic_os=go32 + ;; + h8300hms) + basic_machine=h8300-hitachi + basic_os=hms + ;; + h8300xray) + basic_machine=h8300-hitachi + basic_os=xray + ;; + h8500hms) + basic_machine=h8500-hitachi + basic_os=hms + ;; + harris) + basic_machine=m88k-harris + basic_os=sysv3 + ;; + hp300 | hp300hpux) + basic_machine=m68k-hp + basic_os=hpux + ;; + hp300bsd) + basic_machine=m68k-hp + basic_os=bsd + ;; + hppaosf) + basic_machine=hppa1.1-hp + basic_os=osf + ;; + hppro) + basic_machine=hppa1.1-hp + basic_os=proelf + ;; + i386mach) + basic_machine=i386-mach + basic_os=mach + ;; + isi68 | isi) + basic_machine=m68k-isi + basic_os=sysv + ;; + m68knommu) + basic_machine=m68k-unknown + basic_os=linux + ;; + magnum | m3230) + basic_machine=mips-mips + basic_os=sysv + ;; + merlin) + basic_machine=ns32k-utek + basic_os=sysv + ;; + mingw64) + basic_machine=x86_64-pc + basic_os=mingw64 + ;; + mingw32) + basic_machine=i686-pc + basic_os=mingw32 + ;; + mingw32ce) + basic_machine=arm-unknown + basic_os=mingw32ce + ;; + monitor) + basic_machine=m68k-rom68k + basic_os=coff + ;; + morphos) + basic_machine=powerpc-unknown + basic_os=morphos + ;; + moxiebox) + basic_machine=moxie-unknown + basic_os=moxiebox + ;; + msdos) + basic_machine=i386-pc + basic_os=msdos + ;; + msys) + basic_machine=i686-pc + basic_os=msys + ;; + mvs) + basic_machine=i370-ibm + basic_os=mvs + ;; + nacl) + basic_machine=le32-unknown + basic_os=nacl + ;; + ncr3000) + basic_machine=i486-ncr + basic_os=sysv4 + ;; + netbsd386) + basic_machine=i386-pc + basic_os=netbsd + ;; + netwinder) + basic_machine=armv4l-rebel + basic_os=linux + ;; + news | news700 | news800 | news900) + basic_machine=m68k-sony + basic_os=newsos + ;; + news1000) + basic_machine=m68030-sony + basic_os=newsos + ;; + necv70) + basic_machine=v70-nec + basic_os=sysv + ;; + nh3000) + basic_machine=m68k-harris + basic_os=cxux + ;; + nh[45]000) + basic_machine=m88k-harris + basic_os=cxux + ;; + nindy960) + basic_machine=i960-intel + basic_os=nindy + ;; + mon960) + basic_machine=i960-intel + basic_os=mon960 + ;; + nonstopux) + basic_machine=mips-compaq + basic_os=nonstopux + ;; + os400) + basic_machine=powerpc-ibm + basic_os=os400 + ;; + OSE68000 | ose68000) + basic_machine=m68000-ericsson + basic_os=ose + ;; + os68k) + basic_machine=m68k-none + basic_os=os68k + ;; + paragon) + basic_machine=i860-intel + basic_os=osf + ;; + parisc) + basic_machine=hppa-unknown + basic_os=linux + ;; + psp) + basic_machine=mipsallegrexel-sony + basic_os=psp + ;; + pw32) + basic_machine=i586-unknown + basic_os=pw32 + ;; + rdos | rdos64) + basic_machine=x86_64-pc + basic_os=rdos + ;; + rdos32) + basic_machine=i386-pc + basic_os=rdos + ;; + rom68k) + basic_machine=m68k-rom68k + basic_os=coff + ;; + sa29200) + basic_machine=a29k-amd + basic_os=udi + ;; + sei) + basic_machine=mips-sei + basic_os=seiux + ;; + sequent) + basic_machine=i386-sequent + basic_os= + ;; + sps7) + basic_machine=m68k-bull + basic_os=sysv2 + ;; + st2000) + basic_machine=m68k-tandem + basic_os= + ;; + stratus) + basic_machine=i860-stratus + basic_os=sysv4 + ;; + sun2) + basic_machine=m68000-sun + basic_os= + ;; + sun2os3) + basic_machine=m68000-sun + basic_os=sunos3 + ;; + sun2os4) + basic_machine=m68000-sun + basic_os=sunos4 + ;; + sun3) + basic_machine=m68k-sun + basic_os= + ;; + sun3os3) + basic_machine=m68k-sun + basic_os=sunos3 + ;; + sun3os4) + basic_machine=m68k-sun + basic_os=sunos4 + ;; + sun4) + basic_machine=sparc-sun + basic_os= + ;; + sun4os3) + basic_machine=sparc-sun + basic_os=sunos3 + ;; + sun4os4) + basic_machine=sparc-sun + basic_os=sunos4 + ;; + sun4sol2) + basic_machine=sparc-sun + basic_os=solaris2 + ;; + sun386 | sun386i | roadrunner) + basic_machine=i386-sun + basic_os= + ;; + sv1) + basic_machine=sv1-cray + basic_os=unicos + ;; + symmetry) + basic_machine=i386-sequent + basic_os=dynix + ;; + t3e) + basic_machine=alphaev5-cray + basic_os=unicos + ;; + t90) + basic_machine=t90-cray + basic_os=unicos + ;; + toad1) + basic_machine=pdp10-xkl + basic_os=tops20 + ;; + tpf) + basic_machine=s390x-ibm + basic_os=tpf + ;; + udi29k) + basic_machine=a29k-amd + basic_os=udi + ;; + ultra3) + basic_machine=a29k-nyu + basic_os=sym1 + ;; + v810 | necv810) + basic_machine=v810-nec + basic_os=none + ;; + vaxv) + basic_machine=vax-dec + basic_os=sysv + ;; + vms) + basic_machine=vax-dec + basic_os=vms + ;; + vsta) + basic_machine=i386-pc + basic_os=vsta + ;; + vxworks960) + basic_machine=i960-wrs + basic_os=vxworks + ;; + vxworks68) + basic_machine=m68k-wrs + basic_os=vxworks + ;; + vxworks29k) + basic_machine=a29k-wrs + basic_os=vxworks + ;; + xbox) + basic_machine=i686-pc + basic_os=mingw32 + ;; + ymp) + basic_machine=ymp-cray + basic_os=unicos + ;; + *) + basic_machine=$1 + basic_os= + ;; + esac + ;; +esac + +# Decode 1-component or ad-hoc basic machines +case $basic_machine in + # Here we handle the default manufacturer of certain CPU types. It is in + # some cases the only manufacturer, in others, it is the most popular. + w89k) + cpu=hppa1.1 + vendor=winbond + ;; + op50n) + cpu=hppa1.1 + vendor=oki + ;; + op60c) + cpu=hppa1.1 + vendor=oki + ;; + ibm*) + cpu=i370 + vendor=ibm + ;; + orion105) + cpu=clipper + vendor=highlevel + ;; + mac | mpw | mac-mpw) + cpu=m68k + vendor=apple + ;; + pmac | pmac-mpw) + cpu=powerpc + vendor=apple + ;; + + # Recognize the various machine names and aliases which stand + # for a CPU type and a company and sometimes even an OS. + 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) + cpu=m68000 + vendor=att + ;; + 3b*) + cpu=we32k + vendor=att + ;; + bluegene*) + cpu=powerpc + vendor=ibm + basic_os=cnk + ;; + decsystem10* | dec10*) + cpu=pdp10 + vendor=dec + basic_os=tops10 + ;; + decsystem20* | dec20*) + cpu=pdp10 + vendor=dec + basic_os=tops20 + ;; + delta | 3300 | motorola-3300 | motorola-delta \ + | 3300-motorola | delta-motorola) + cpu=m68k + vendor=motorola + ;; + dpx2*) + cpu=m68k + vendor=bull + basic_os=sysv3 + ;; + encore | umax | mmax) + cpu=ns32k + vendor=encore + ;; + elxsi) + cpu=elxsi + vendor=elxsi + basic_os=${basic_os:-bsd} + ;; + fx2800) + cpu=i860 + vendor=alliant + ;; + genix) + cpu=ns32k + vendor=ns + ;; + h3050r* | hiux*) + cpu=hppa1.1 + vendor=hitachi + basic_os=hiuxwe2 + ;; + hp3k9[0-9][0-9] | hp9[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + hp9k2[0-9][0-9] | hp9k31[0-9]) + cpu=m68000 + vendor=hp + ;; + hp9k3[2-9][0-9]) + cpu=m68k + vendor=hp + ;; + hp9k6[0-9][0-9] | hp6[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + hp9k7[0-79][0-9] | hp7[0-79][0-9]) + cpu=hppa1.1 + vendor=hp + ;; + hp9k78[0-9] | hp78[0-9]) + # FIXME: really hppa2.0-hp + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) + # FIXME: really hppa2.0-hp + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[0-9][13679] | hp8[0-9][13679]) + cpu=hppa1.1 + vendor=hp + ;; + hp9k8[0-9][0-9] | hp8[0-9][0-9]) + cpu=hppa1.0 + vendor=hp + ;; + i*86v32) + cpu=$(echo "$1" | sed -e 's/86.*/86/') + vendor=pc + basic_os=sysv32 + ;; + i*86v4*) + cpu=$(echo "$1" | sed -e 's/86.*/86/') + vendor=pc + basic_os=sysv4 + ;; + i*86v) + cpu=$(echo "$1" | sed -e 's/86.*/86/') + vendor=pc + basic_os=sysv + ;; + i*86sol2) + cpu=$(echo "$1" | sed -e 's/86.*/86/') + vendor=pc + basic_os=solaris2 + ;; + j90 | j90-cray) + cpu=j90 + vendor=cray + basic_os=${basic_os:-unicos} + ;; + iris | iris4d) + cpu=mips + vendor=sgi + case $basic_os in + irix*) + ;; + *) + basic_os=irix4 + ;; + esac + ;; + miniframe) + cpu=m68000 + vendor=convergent + ;; + *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*) + cpu=m68k + vendor=atari + basic_os=mint + ;; + news-3600 | risc-news) + cpu=mips + vendor=sony + basic_os=newsos + ;; + next | m*-next) + cpu=m68k + vendor=next + case $basic_os in + openstep*) + ;; + nextstep*) + ;; + ns2*) + basic_os=nextstep2 + ;; + *) + basic_os=nextstep3 + ;; + esac + ;; + np1) + cpu=np1 + vendor=gould + ;; + op50n-* | op60c-*) + cpu=hppa1.1 + vendor=oki + basic_os=proelf + ;; + pa-hitachi) + cpu=hppa1.1 + vendor=hitachi + basic_os=hiuxwe2 + ;; + pbd) + cpu=sparc + vendor=tti + ;; + pbb) + cpu=m68k + vendor=tti + ;; + pc532) + cpu=ns32k + vendor=pc532 + ;; + pn) + cpu=pn + vendor=gould + ;; + power) + cpu=power + vendor=ibm + ;; + ps2) + cpu=i386 + vendor=ibm + ;; + rm[46]00) + cpu=mips + vendor=siemens + ;; + rtpc | rtpc-*) + cpu=romp + vendor=ibm + ;; + sde) + cpu=mipsisa32 + vendor=sde + basic_os=${basic_os:-elf} + ;; + simso-wrs) + cpu=sparclite + vendor=wrs + basic_os=vxworks + ;; + tower | tower-32) + cpu=m68k + vendor=ncr + ;; + vpp*|vx|vx-*) + cpu=f301 + vendor=fujitsu + ;; + w65) + cpu=w65 + vendor=wdc + ;; + w89k-*) + cpu=hppa1.1 + vendor=winbond + basic_os=proelf + ;; + none) + cpu=none + vendor=none + ;; + leon|leon[3-9]) + cpu=sparc + vendor=$basic_machine + ;; + leon-*|leon[3-9]-*) + cpu=sparc + vendor=$(echo "$basic_machine" | sed 's/-.*//') + ;; + + *-*) + # shellcheck disable=SC2162 + IFS="-" read cpu vendor <&2 + exit 1 + ;; + esac + ;; +esac + +# Here we canonicalize certain aliases for manufacturers. +case $vendor in + digital*) + vendor=dec + ;; + commodore*) + vendor=cbm + ;; + *) + ;; +esac + +# Decode manufacturer-specific aliases for certain operating systems. + +if test x$basic_os != x +then + +# First recognize some ad-hoc caes, or perhaps split kernel-os, or else just +# set os. +case $basic_os in + gnu/linux*) + kernel=linux + os=$(echo $basic_os | sed -e 's|gnu/linux|gnu|') + ;; + os2-emx) + kernel=os2 + os=$(echo $basic_os | sed -e 's|os2-emx|emx|') + ;; + nto-qnx*) + kernel=nto + os=$(echo $basic_os | sed -e 's|nto-qnx|qnx|') + ;; + *-*) + # shellcheck disable=SC2162 + IFS="-" read kernel os <&2 + exit 1 + ;; +esac + +# As a final step for OS-related things, validate the OS-kernel combination +# (given a valid OS), if there is a kernel. +case $kernel-$os in + linux-gnu* | linux-dietlibc* | linux-android* | linux-newlib* | linux-musl* | linux-uclibc* ) + ;; + uclinux-uclibc* ) + ;; + -dietlibc* | -newlib* | -musl* | -uclibc* ) + # These are just libc implementations, not actual OSes, and thus + # require a kernel. + echo "Invalid configuration \`$1': libc \`$os' needs explicit kernel." 1>&2 + exit 1 + ;; + kfreebsd*-gnu* | kopensolaris*-gnu*) + ;; + vxworks-simlinux | vxworks-simwindows | vxworks-spe) + ;; + nto-qnx*) + ;; + os2-emx) + ;; + *-eabi* | *-gnueabi*) + ;; + -*) + # Blank kernel with real OS is always fine. + ;; + *-*) + echo "Invalid configuration \`$1': Kernel \`$kernel' not known to work with OS \`$os'." 1>&2 + exit 1 + ;; +esac + +# Here we handle the case where we know the os, and the CPU type, but not the +# manufacturer. We pick the logical manufacturer. +case $vendor in + unknown) + case $cpu-$os in + *-riscix*) + vendor=acorn + ;; + *-sunos*) + vendor=sun + ;; + *-cnk* | *-aix*) + vendor=ibm + ;; + *-beos*) + vendor=be + ;; + *-hpux*) + vendor=hp + ;; + *-mpeix*) + vendor=hp + ;; + *-hiux*) + vendor=hitachi + ;; + *-unos*) + vendor=crds + ;; + *-dgux*) + vendor=dg + ;; + *-luna*) + vendor=omron + ;; + *-genix*) + vendor=ns + ;; + *-clix*) + vendor=intergraph + ;; + *-mvs* | *-opened*) + vendor=ibm + ;; + *-os400*) + vendor=ibm + ;; + s390-* | s390x-*) + vendor=ibm + ;; + *-ptx*) + vendor=sequent + ;; + *-tpf*) + vendor=ibm + ;; + *-vxsim* | *-vxworks* | *-windiss*) + vendor=wrs + ;; + *-aux*) + vendor=apple + ;; + *-hms*) + vendor=hitachi + ;; + *-mpw* | *-macos*) + vendor=apple + ;; + *-*mint | *-mint[0-9]* | *-*MiNT | *-MiNT[0-9]*) + vendor=atari + ;; + *-vos*) + vendor=stratus + ;; + esac + ;; +esac + +echo "$cpu-$vendor-${kernel:+$kernel-}$os" +exit + +# Local variables: +# eval: (add-hook 'before-save-hook 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: diff --git a/configure b/configure new file mode 100644 --- /dev/null +++ b/configure @@ -0,0 +1,5121 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.69 for GHC BigNum library 1.0. +# +# Report bugs to . +# +# +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org and +$0: libraries@haskell.org about your system, including any +$0: error possibly output before this message. Then install +$0: a modern shell, or manually run the script under such a +$0: shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='GHC BigNum library' +PACKAGE_TARNAME='ghc-bignum' +PACKAGE_VERSION='1.0' +PACKAGE_STRING='GHC BigNum library 1.0' +PACKAGE_BUGREPORT='libraries@haskell.org' +PACKAGE_URL='' + +ac_unique_file="cbits/gmp_wrappers.c" +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef STDC_HEADERS +# include +# include +#else +# ifdef HAVE_STDLIB_H +# include +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include +# endif +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_subst_vars='LTLIBOBJS +LIBOBJS +GhcGmpVerPl +GhcGmpVerMi +GhcGmpVerMj +UseIntreeGmp +HaveSecurePowm +HaveFrameworkGMP +HaveLibGmp +GMP_FRAMEWORK +GMP_LIB_DIRS +GMP_LIBS +GMP_INCLUDE_DIRS +EGREP +GREP +CPP +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +with_gmp +with_gmp_includes +with_gmp_libraries +with_gmp_framework_preferred +with_intree_gmp +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures GHC BigNum library 1.0 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/ghc-bignum] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of GHC BigNum library 1.0:";; + esac + cat <<\_ACEOF + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --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 + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + CPP C preprocessor + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to . +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +GHC BigNum library configure 1.0 +generated by GNU Autoconf 2.69 + +Copyright (C) 2012 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_cpp LINENO +# ---------------------- +# Try to preprocess conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_cpp () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_cpp conftest.$ac_ext" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR +# accordingly. +ac_fn_c_check_header_mongrel () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if eval \${$3+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} +( $as_echo "## ------------------------------------ ## +## Report this to libraries@haskell.org ## +## ------------------------------------ ##" + ) | sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_mongrel + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES +# -------------------------------------------- +# Tries to find the compile-time value of EXPR in a program that includes +# INCLUDES, setting VAR accordingly. Returns whether the value could be +# computed +ac_fn_c_compute_int () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) >= 0)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=0 ac_mid=0 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid; break +else + as_fn_arith $ac_mid + 1 && ac_lo=$as_val + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) < 0)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=-1 ac_mid=-1 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) >= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=$ac_mid; break +else + as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + ac_lo= ac_hi= +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +# Binary search between lo and hi bounds. +while test "x$ac_lo" != "x$ac_hi"; do + as_fn_arith '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo && ac_mid=$as_val + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid +else + as_fn_arith '(' $ac_mid ')' + 1 && ac_lo=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done +case $ac_lo in #(( +?*) eval "$3=\$ac_lo"; ac_retval=0 ;; +'') ac_retval=1 ;; +esac + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +static long int longval () { return $2; } +static unsigned long int ulongval () { return $2; } +#include +#include +int +main () +{ + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + return 1; + if (($2) < 0) + { + long int i = longval (); + if (i != ($2)) + return 1; + fprintf (f, "%ld", i); + } + else + { + unsigned long int i = ulongval (); + if (i != ($2)) + return 1; + fprintf (f, "%lu", i); + } + /* Do not output a trailing newline, as this causes \r\n confusion + on some platforms. */ + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + echo >>conftest.val; read $3 config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by GHC BigNum library $as_me 1.0, which was +generated by GNU Autoconf 2.69. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + + +# Safety check: Ensure that we are in the correct source directory. + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + + + ac_fn_c_check_header_mongrel "$LINENO" "minix/config.h" "ac_cv_header_minix_config_h" "$ac_includes_default" +if test "x$ac_cv_header_minix_config_h" = xyes; then : + MINIX=yes +else + MINIX= +fi + + + if test "$MINIX" = yes; then + +$as_echo "#define _POSIX_SOURCE 1" >>confdefs.h + + +$as_echo "#define _POSIX_1_SOURCE 2" >>confdefs.h + + +$as_echo "#define _MINIX 1" >>confdefs.h + + fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether it is safe to define __EXTENSIONS__" >&5 +$as_echo_n "checking whether it is safe to define __EXTENSIONS__... " >&6; } +if ${ac_cv_safe_to_define___extensions__+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +# define __EXTENSIONS__ 1 + $ac_includes_default +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_safe_to_define___extensions__=yes +else + ac_cv_safe_to_define___extensions__=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_safe_to_define___extensions__" >&5 +$as_echo "$ac_cv_safe_to_define___extensions__" >&6; } + test $ac_cv_safe_to_define___extensions__ = yes && + $as_echo "#define __EXTENSIONS__ 1" >>confdefs.h + + $as_echo "#define _ALL_SOURCE 1" >>confdefs.h + + $as_echo "#define _GNU_SOURCE 1" >>confdefs.h + + $as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h + + $as_echo "#define _TANDEM_SOURCE 1" >>confdefs.h + + + + + +# Check whether --with-gmp was given. +if test "${with_gmp+set}" = set; then : + withval=$with_gmp; GMP_ENABLED=YES +else + GMP_ENABLED=NO +fi + + + +# Check whether --with-gmp-includes was given. +if test "${with_gmp_includes+set}" = set; then : + withval=$with_gmp_includes; GMP_INCLUDE_DIRS=$withval; CPPFLAGS="-I$withval" +else + GMP_INCLUDE_DIRS= +fi + + + +# Check whether --with-gmp-libraries was given. +if test "${with_gmp_libraries+set}" = set; then : + withval=$with_gmp_libraries; GMP_LIB_DIRS=$withval; LDFLAGS="-L$withval" +else + GMP_LIB_DIRS= +fi + + + +# Check whether --with-gmp-framework-preferred was given. +if test "${with_gmp_framework_preferred+set}" = set; then : + withval=$with_gmp_framework_preferred; GMP_PREFER_FRAMEWORK=YES +else + GMP_PREFER_FRAMEWORK=NO +fi + + + +# Check whether --with-intree-gmp was given. +if test "${with_intree_gmp+set}" = set; then : + withval=$with_intree_gmp; GMP_FORCE_INTREE=YES +else + 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*) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GMP.framework" >&5 +$as_echo_n "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. */ +#ifdef __cplusplus +extern "C" +#endif +char __gmpz_powm_sec (); +int +main () +{ +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$ac_exeext conftest.$ac_ext + LIBS="$save_libs" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $HaveFrameworkGMP" >&5 +$as_echo "$HaveFrameworkGMP" >&6; } + ;; + esac + fi + + + if test "$HaveFrameworkGMP" = "NO" + then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm in -lgmp" >&5 +$as_echo_n "checking for __gmpz_powm in -lgmp... " >&6; } +if ${ac_cv_lib_gmp___gmpz_powm+:} false; then : + $as_echo_n "(cached) " >&6 +else + 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. */ +#ifdef __cplusplus +extern "C" +#endif +char __gmpz_powm (); +int +main () +{ +return __gmpz_powm (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_gmp___gmpz_powm=yes +else + ac_cv_lib_gmp___gmpz_powm=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmpz_powm" >&5 +$as_echo "$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 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm in -lgmp3" >&5 +$as_echo_n "checking for __gmpz_powm in -lgmp3... " >&6; } +if ${ac_cv_lib_gmp3___gmpz_powm+:} false; then : + $as_echo_n "(cached) " >&6 +else + 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. */ +#ifdef __cplusplus +extern "C" +#endif +char __gmpz_powm (); +int +main () +{ +return __gmpz_powm (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_gmp3___gmpz_powm=yes +else + ac_cv_lib_gmp3___gmpz_powm=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp3___gmpz_powm" >&5 +$as_echo "$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=`$as_echo "ac_cv_lib_$GMP_LIBS''___gmpz_powm_sec" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm_sec in -l$GMP_LIBS" >&5 +$as_echo_n "checking for __gmpz_powm_sec in -l$GMP_LIBS... " >&6; } +if eval \${$as_ac_Lib+:} false; then : + $as_echo_n "(cached) " >&6 +else + 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. */ +#ifdef __cplusplus +extern "C" +#endif +char __gmpz_powm_sec (); +int +main () +{ +return __gmpz_powm_sec (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Lib=yes" +else + eval "$as_ac_Lib=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +eval ac_res=\$$as_ac_Lib + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +if eval test \"x\$"$as_ac_Lib"\" = x"yes"; then : + HaveSecurePowm=1 +fi + + fi + fi + + else + + if test "$HaveFrameworkGMP" = "NO" + then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm in -lgmp" >&5 +$as_echo_n "checking for __gmpz_powm in -lgmp... " >&6; } +if ${ac_cv_lib_gmp___gmpz_powm+:} false; then : + $as_echo_n "(cached) " >&6 +else + 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. */ +#ifdef __cplusplus +extern "C" +#endif +char __gmpz_powm (); +int +main () +{ +return __gmpz_powm (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_gmp___gmpz_powm=yes +else + ac_cv_lib_gmp___gmpz_powm=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp___gmpz_powm" >&5 +$as_echo "$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 + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm in -lgmp3" >&5 +$as_echo_n "checking for __gmpz_powm in -lgmp3... " >&6; } +if ${ac_cv_lib_gmp3___gmpz_powm+:} false; then : + $as_echo_n "(cached) " >&6 +else + 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. */ +#ifdef __cplusplus +extern "C" +#endif +char __gmpz_powm (); +int +main () +{ +return __gmpz_powm (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_gmp3___gmpz_powm=yes +else + ac_cv_lib_gmp3___gmpz_powm=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gmp3___gmpz_powm" >&5 +$as_echo "$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=`$as_echo "ac_cv_lib_$GMP_LIBS''___gmpz_powm_sec" | $as_tr_sh` +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for __gmpz_powm_sec in -l$GMP_LIBS" >&5 +$as_echo_n "checking for __gmpz_powm_sec in -l$GMP_LIBS... " >&6; } +if eval \${$as_ac_Lib+:} false; then : + $as_echo_n "(cached) " >&6 +else + 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. */ +#ifdef __cplusplus +extern "C" +#endif +char __gmpz_powm_sec (); +int +main () +{ +return __gmpz_powm_sec (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$as_ac_Lib=yes" +else + eval "$as_ac_Lib=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +eval ac_res=\$$as_ac_Lib + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$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*) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GMP.framework" >&5 +$as_echo_n "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. */ +#ifdef __cplusplus +extern "C" +#endif +char __gmpz_powm_sec (); +int +main () +{ +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$ac_exeext conftest.$ac_ext + LIBS="$save_libs" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $HaveFrameworkGMP" >&5 +$as_echo "$HaveFrameworkGMP" >&6; } + ;; + esac + fi + + fi + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use in-tree GMP" >&5 +$as_echo_n "checking whether to use in-tree GMP... " >&6; } + if test "$HaveFrameworkGMP" = "YES" || test "$HaveLibGmp" = "YES" + then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + UseIntreeGmp=0 + ac_fn_c_check_header_mongrel "$LINENO" "gmp.h" "ac_cv_header_gmp_h" "$ac_includes_default" +if test "x$ac_cv_header_gmp_h" = xyes; then : + +else + as_fn_error $? "Cannot find gmp.h" "$LINENO" 5 +fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking GMP version" >&5 +$as_echo_n "checking GMP version... " >&6; } + if ac_fn_c_compute_int "$LINENO" "__GNU_MP_VERSION" "GhcGmpVerMj" "#include "; then : + +else + 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 "; then : + +else + 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 "; then : + +else + as_fn_error $? "Unable to get value of __GNU_MP_VERSION_PATCHLEVEL" "$LINENO" 5 +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl" >&5 +$as_echo "$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl" >&6; } + + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + UseIntreeGmp=1 + HaveSecurePowm=1 + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking GMP version" >&5 +$as_echo_n "checking GMP version... " >&6; } + GhcGmpVerMj=6 + GhcGmpVerMi=1 + GhcGmpVerPl=2 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl" >&5 +$as_echo "$GhcGmpVerMj.$GhcGmpVerMi.$GhcGmpVerPl" >&6; } + fi + + + + + + + + + + + + + + + + ac_config_files="$ac_config_files ghc-bignum.buildinfo include/HsIntegerGmp.h" + +fi + +ac_config_files="$ac_config_files config.mk" + + + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +# Transform confdefs.h into DEFS. +# Protect against shell expansion while executing Makefile rules. +# Protect against Makefile macro expansion. +# +# If the first sed substitution is executed (which looks for macros that +# take arguments), then branch to the quote section. Otherwise, +# look for a macro that doesn't take arguments. +ac_script=' +:mline +/\\$/{ + N + s,\\\n,, + b mline +} +t clear +:clear +s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g +t quote +s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g +t quote +b any +:quote +s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g +s/\[/\\&/g +s/\]/\\&/g +s/\$/$$/g +H +:any +${ + g + s/^\n// + s/\n/ /g + p +} +' +DEFS=`sed -n "$ac_script" confdefs.h` + + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by GHC BigNum library $as_me 1.0, which was +generated by GNU Autoconf 2.69. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + +Configuration files: +$config_files + +Report bugs to ." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +GHC BigNum library config.status 1.0 +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h | --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "ghc-bignum.buildinfo") CONFIG_FILES="$CONFIG_FILES ghc-bignum.buildinfo" ;; + "include/HsIntegerGmp.h") CONFIG_FILES="$CONFIG_FILES include/HsIntegerGmp.h" ;; + "config.mk") CONFIG_FILES="$CONFIG_FILES config.mk" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + + +eval set X " :F $CONFIG_FILES " +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + + + + esac + +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + diff --git a/configure.ac b/configure.ac new file mode 100644 --- /dev/null +++ b/configure.ac @@ -0,0 +1,123 @@ +AC_PREREQ(2.69) +AC_INIT([GHC BigNum library], [1.0], [libraries@haskell.org], [ghc-bignum]) + +# Safety check: Ensure that we are in the correct source directory. +AC_CONFIG_SRCDIR([cbits/gmp_wrappers.c]) + +dnl make extensions visible to allow feature-tests to detect them lateron +AC_USE_SYSTEM_EXTENSIONS + +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 ], + AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION])) + AC_COMPUTE_INT(GhcGmpVerMi, __GNU_MP_VERSION_MINOR, [#include ], + AC_MSG_ERROR([Unable to get value of __GNU_MP_VERSION_MINOR])) + AC_COMPUTE_INT(GhcGmpVerPl, __GNU_MP_VERSION_PATCHLEVEL, [#include ], + 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 + + +dnl-------------------------------------------------------------------- +dnl * Make sure we got some form of gmp +dnl-------------------------------------------------------------------- + + AC_SUBST(GMP_INCLUDE_DIRS) + AC_SUBST(GMP_LIBS) + AC_SUBST(GMP_LIB_DIRS) + AC_SUBST(GMP_FRAMEWORK) + AC_SUBST(HaveLibGmp) + AC_SUBST(HaveFrameworkGMP) + AC_SUBST(HaveSecurePowm) + AC_SUBST(UseIntreeGmp) + AC_SUBST(GhcGmpVerMj) + AC_SUBST(GhcGmpVerMi) + AC_SUBST(GhcGmpVerPl) + + AC_CONFIG_FILES([ghc-bignum.buildinfo include/HsIntegerGmp.h]) +fi + +AC_CONFIG_FILES([config.mk]) + +dnl-------------------------------------------------------------------- +dnl * Generate output files +dnl-------------------------------------------------------------------- + +AC_OUTPUT diff --git a/ghc-bignum.buildinfo.in b/ghc-bignum.buildinfo.in new file mode 100644 --- /dev/null +++ b/ghc-bignum.buildinfo.in @@ -0,0 +1,5 @@ +include-dirs: @GMP_INCLUDE_DIRS@ +extra-lib-dirs: @GMP_LIB_DIRS@ +extra-libraries: @GMP_LIBS@ +frameworks: @GMP_FRAMEWORK@ +install-includes: HsIntegerGmp.h ghc-gmp.h diff --git a/ghc-bignum.cabal b/ghc-bignum.cabal new file mode 100644 --- /dev/null +++ b/ghc-bignum.cabal @@ -0,0 +1,125 @@ +cabal-version: 2.0 +name: ghc-bignum +version: 1.0 +synopsis: GHC BigNum library +license: BSD3 +license-file: LICENSE +author: Sylvain Henry +maintainer: libraries@haskell.org +bug-reports: https://gitlab.haskell.org/ghc/ghc/issues/new +category: Numeric, Algebra, GHC +build-type: Configure +description: + This package provides the low-level implementation of the standard + 'BigNat', 'Natural' and 'Integer' types. + +extra-source-files: + aclocal.m4 + cbits/gmp_wrappers.c + changelog.md + config.guess + config.sub + configure + configure.ac + config.mk.in + include/WordSize.h + include/HsIntegerGmp.h.in + install-sh + ghc-bignum.buildinfo.in + +source-repository head + type: git + location: https://gitlab.haskell.org/ghc/ghc.git + subdir: libraries/ghc-bignum + + +Flag Native + Description: Enable native backend + Manual: True + Default: False + +Flag FFI + Description: Enable FFI backend + Manual: True + Default: False + +Flag GMP + Description: Enable GMP backend + Manual: True + Default: False + +Flag Check + Description: Validate results of the enabled backend against native backend. + Manual: True + Default: False + +library + + -- check that at least one flag is set + if !flag(native) && !flag(gmp) && !flag(ffi) + buildable: False + + -- check that at most one flag is set + if flag(native) && (flag(gmp) || flag(ffi)) + buildable: False + if flag(gmp) && flag(ffi) + buildable: False + + default-language: Haskell2010 + other-extensions: + BangPatterns + CPP + ExplicitForAll + GHCForeignImportPrim + MagicHash + NegativeLiterals + NoImplicitPrelude + UnboxedTuples + UnliftedFFITypes + ForeignFunctionInterface + + build-depends: + ghc-prim >= 0.5.1.0 && < 0.8 + + hs-source-dirs: src/ + include-dirs: include/ + ghc-options: -Wall + cc-options: -std=c99 -Wall + + -- GHC has wired-in IDs from the ghc-bignum package. Hence the unit-id + -- of the package should not contain the version: i.e. it must be + -- "ghc-bignum" and not "ghc-bignum-1.0". + ghc-options: -this-unit-id ghc-bignum + + include-dirs: include + + if flag(gmp) + cpp-options: -DBIGNUM_GMP + other-modules: + GHC.Num.Backend.GMP + c-sources: + cbits/gmp_wrappers.c + + if flag(ffi) + cpp-options: -DBIGNUM_FFI + other-modules: + GHC.Num.Backend.FFI + + if flag(native) + cpp-options: -DBIGNUM_NATIVE + + if flag(check) + cpp-options: -DBIGNUM_CHECK + other-modules: + GHC.Num.Backend.Check + + + exposed-modules: + GHC.Num.Primitives + GHC.Num.WordArray + GHC.Num.BigNat + GHC.Num.Backend + GHC.Num.Backend.Selected + GHC.Num.Backend.Native + GHC.Num.Natural + GHC.Num.Integer diff --git a/include/HsIntegerGmp.h.in b/include/HsIntegerGmp.h.in new file mode 100644 --- /dev/null +++ b/include/HsIntegerGmp.h.in @@ -0,0 +1,14 @@ +#pragma once + +/* Whether GMP is embedded into ghc-bignum */ +#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@ diff --git a/include/WordSize.h b/include/WordSize.h new file mode 100644 --- /dev/null +++ b/include/WordSize.h @@ -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 + diff --git a/install-sh b/install-sh new file mode 100644 --- /dev/null +++ b/install-sh @@ -0,0 +1,527 @@ +#!/bin/sh +# install - install a program, script, or datafile + +scriptversion=2011-11-20.07; # UTC + +# This originates from X11R5 (mit/util/scripts/install.sh), which was +# later released in X11R6 (xc/config/util/install.sh) with the +# following copyright and license. +# +# Copyright (C) 1994 X Consortium +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN +# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- +# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the name of the X Consortium shall not +# be used in advertising or otherwise to promote the sale, use or other deal- +# ings in this Software without prior written authorization from the X Consor- +# tium. +# +# +# FSF changes to this file are in the public domain. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# 'make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. + +nl=' +' +IFS=" "" $nl" + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit=${DOITPROG-} +if test -z "$doit"; then + doit_exec=exec +else + doit_exec=$doit +fi + +# Put in absolute file names if you don't have them in your path; +# or use environment vars. + +chgrpprog=${CHGRPPROG-chgrp} +chmodprog=${CHMODPROG-chmod} +chownprog=${CHOWNPROG-chown} +cmpprog=${CMPPROG-cmp} +cpprog=${CPPROG-cp} +mkdirprog=${MKDIRPROG-mkdir} +mvprog=${MVPROG-mv} +rmprog=${RMPROG-rm} +stripprog=${STRIPPROG-strip} + +posix_glob='?' +initialize_posix_glob=' + test "$posix_glob" != "?" || { + if (set -f) 2>/dev/null; then + posix_glob= + else + posix_glob=: + fi + } +' + +posix_mkdir= + +# Desired mode of installed file. +mode=0755 + +chgrpcmd= +chmodcmd=$chmodprog +chowncmd= +mvcmd=$mvprog +rmcmd="$rmprog -f" +stripcmd= + +src= +dst= +dir_arg= +dst_arg= + +copy_on_change=false +no_target_directory= + +usage="\ +Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE + or: $0 [OPTION]... SRCFILES... DIRECTORY + or: $0 [OPTION]... -t DIRECTORY SRCFILES... + or: $0 [OPTION]... -d DIRECTORIES... + +In the 1st form, copy SRCFILE to DSTFILE. +In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. +In the 4th, create DIRECTORIES. + +Options: + --help display this help and exit. + --version display version info and exit. + + -c (ignored) + -C install only if different (preserve the last data modification time) + -d create directories instead of installing files. + -g GROUP $chgrpprog installed files to GROUP. + -m MODE $chmodprog installed files to MODE. + -o USER $chownprog installed files to USER. + -s $stripprog installed files. + -t DIRECTORY install into DIRECTORY. + -T report an error if DSTFILE is a directory. + +Environment variables override the default commands: + CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG + RMPROG STRIPPROG +" + +while test $# -ne 0; do + case $1 in + -c) ;; + + -C) copy_on_change=true;; + + -d) dir_arg=true;; + + -g) chgrpcmd="$chgrpprog $2" + shift;; + + --help) echo "$usage"; exit $?;; + + -m) mode=$2 + case $mode in + *' '* | *' '* | *' +'* | *'*'* | *'?'* | *'['*) + echo "$0: invalid mode: $mode" >&2 + exit 1;; + esac + shift;; + + -o) chowncmd="$chownprog $2" + shift;; + + -s) stripcmd=$stripprog;; + + -t) dst_arg=$2 + # Protect names problematic for 'test' and other utilities. + case $dst_arg in + -* | [=\(\)!]) dst_arg=./$dst_arg;; + esac + shift;; + + -T) no_target_directory=true;; + + --version) echo "$0 $scriptversion"; exit $?;; + + --) shift + break;; + + -*) echo "$0: invalid option: $1" >&2 + exit 1;; + + *) break;; + esac + shift +done + +if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then + # When -d is used, all remaining arguments are directories to create. + # When -t is used, the destination is already specified. + # Otherwise, the last argument is the destination. Remove it from $@. + for arg + do + if test -n "$dst_arg"; then + # $@ is not empty: it contains at least $arg. + set fnord "$@" "$dst_arg" + shift # fnord + fi + shift # arg + dst_arg=$arg + # Protect names problematic for 'test' and other utilities. + case $dst_arg in + -* | [=\(\)!]) dst_arg=./$dst_arg;; + esac + done +fi + +if test $# -eq 0; then + if test -z "$dir_arg"; then + echo "$0: no input file specified." >&2 + exit 1 + fi + # It's OK to call 'install-sh -d' without argument. + # This can happen when creating conditional directories. + exit 0 +fi + +if test -z "$dir_arg"; then + do_exit='(exit $ret); exit $ret' + trap "ret=129; $do_exit" 1 + trap "ret=130; $do_exit" 2 + trap "ret=141; $do_exit" 13 + trap "ret=143; $do_exit" 15 + + # Set umask so as not to create temps with too-generous modes. + # However, 'strip' requires both read and write access to temps. + case $mode in + # Optimize common cases. + *644) cp_umask=133;; + *755) cp_umask=22;; + + *[0-7]) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw='% 200' + fi + cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; + *) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw=,u+rw + fi + cp_umask=$mode$u_plus_rw;; + esac +fi + +for src +do + # Protect names problematic for 'test' and other utilities. + case $src in + -* | [=\(\)!]) src=./$src;; + esac + + if test -n "$dir_arg"; then + dst=$src + dstdir=$dst + test -d "$dstdir" + dstdir_status=$? + else + + # Waiting for this to be detected by the "$cpprog $src $dsttmp" command + # might cause directories to be created, which would be especially bad + # if $src (and thus $dsttmp) contains '*'. + if test ! -f "$src" && test ! -d "$src"; then + echo "$0: $src does not exist." >&2 + exit 1 + fi + + if test -z "$dst_arg"; then + echo "$0: no destination specified." >&2 + exit 1 + fi + dst=$dst_arg + + # If destination is a directory, append the input filename; won't work + # if double slashes aren't ignored. + if test -d "$dst"; then + if test -n "$no_target_directory"; then + echo "$0: $dst_arg: Is a directory" >&2 + exit 1 + fi + dstdir=$dst + dst=$dstdir/`basename "$src"` + dstdir_status=0 + else + # Prefer dirname, but fall back on a substitute if dirname fails. + dstdir=` + (dirname "$dst") 2>/dev/null || + expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$dst" : 'X\(//\)[^/]' \| \ + X"$dst" : 'X\(//\)$' \| \ + X"$dst" : 'X\(/\)' \| . 2>/dev/null || + echo X"$dst" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q' + ` + + test -d "$dstdir" + dstdir_status=$? + fi + fi + + obsolete_mkdir_used=false + + if test $dstdir_status != 0; then + case $posix_mkdir in + '') + # Create intermediate dirs using mode 755 as modified by the umask. + # This is like FreeBSD 'install' as of 1997-10-28. + umask=`umask` + case $stripcmd.$umask in + # Optimize common cases. + *[2367][2367]) mkdir_umask=$umask;; + .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; + + *[0-7]) + mkdir_umask=`expr $umask + 22 \ + - $umask % 100 % 40 + $umask % 20 \ + - $umask % 10 % 4 + $umask % 2 + `;; + *) mkdir_umask=$umask,go-w;; + esac + + # With -d, create the new directory with the user-specified mode. + # Otherwise, rely on $mkdir_umask. + if test -n "$dir_arg"; then + mkdir_mode=-m$mode + else + mkdir_mode= + fi + + posix_mkdir=false + case $umask in + *[123567][0-7][0-7]) + # POSIX mkdir -p sets u+wx bits regardless of umask, which + # is incompatible with FreeBSD 'install' when (umask & 300) != 0. + ;; + *) + tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ + trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 + + if (umask $mkdir_umask && + exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 + then + if test -z "$dir_arg" || { + # Check for POSIX incompatibilities with -m. + # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or + # other-writable bit of parent directory when it shouldn't. + # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. + ls_ld_tmpdir=`ls -ld "$tmpdir"` + case $ls_ld_tmpdir in + d????-?r-*) different_mode=700;; + d????-?--*) different_mode=755;; + *) false;; + esac && + $mkdirprog -m$different_mode -p -- "$tmpdir" && { + ls_ld_tmpdir_1=`ls -ld "$tmpdir"` + test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" + } + } + then posix_mkdir=: + fi + rmdir "$tmpdir/d" "$tmpdir" + else + # Remove any dirs left behind by ancient mkdir implementations. + rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null + fi + trap '' 0;; + esac;; + esac + + if + $posix_mkdir && ( + umask $mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" + ) + then : + else + + # The umask is ridiculous, or mkdir does not conform to POSIX, + # or it failed possibly due to a race condition. Create the + # directory the slow way, step by step, checking for races as we go. + + case $dstdir in + /*) prefix='/';; + [-=\(\)!]*) prefix='./';; + *) prefix='';; + esac + + eval "$initialize_posix_glob" + + oIFS=$IFS + IFS=/ + $posix_glob set -f + set fnord $dstdir + shift + $posix_glob set +f + IFS=$oIFS + + prefixes= + + for d + do + test X"$d" = X && continue + + prefix=$prefix$d + if test -d "$prefix"; then + prefixes= + else + if $posix_mkdir; then + (umask=$mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break + # Don't fail if two instances are running concurrently. + test -d "$prefix" || exit 1 + else + case $prefix in + *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; + *) qprefix=$prefix;; + esac + prefixes="$prefixes '$qprefix'" + fi + fi + prefix=$prefix/ + done + + if test -n "$prefixes"; then + # Don't fail if two instances are running concurrently. + (umask $mkdir_umask && + eval "\$doit_exec \$mkdirprog $prefixes") || + test -d "$dstdir" || exit 1 + obsolete_mkdir_used=true + fi + fi + fi + + if test -n "$dir_arg"; then + { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && + { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || + test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 + else + + # Make a couple of temp file names in the proper directory. + dsttmp=$dstdir/_inst.$$_ + rmtmp=$dstdir/_rm.$$_ + + # Trap to clean up those temp files at exit. + trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 + + # Copy the file name to the temp name. + (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && + + # and set any options; do chmod last to preserve setuid bits. + # + # If any of these fail, we abort the whole thing. If we want to + # ignore errors from any of these, just make sure not to ignore + # errors from the above "$doit $cpprog $src $dsttmp" command. + # + { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && + { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && + { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && + + # If -C, don't bother to copy if it wouldn't change the file. + if $copy_on_change && + old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && + new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && + + eval "$initialize_posix_glob" && + $posix_glob set -f && + set X $old && old=:$2:$4:$5:$6 && + set X $new && new=:$2:$4:$5:$6 && + $posix_glob set +f && + + test "$old" = "$new" && + $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 + then + rm -f "$dsttmp" + else + # Rename the file to the real destination. + $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || + + # The rename failed, perhaps because mv can't rename something else + # to itself, or perhaps because mv is so ancient that it does not + # support -f. + { + # Now remove or move aside any old file at destination location. + # We try this two ways since rm can't unlink itself on some + # systems and the destination file might be busy for other + # reasons. In this case, the final cleanup might fail but the new + # file should still install successfully. + { + test ! -f "$dst" || + $doit $rmcmd -f "$dst" 2>/dev/null || + { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && + { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } + } || + { echo "$0: cannot unlink or rename $dst" >&2 + (exit 1); exit 1 + } + } && + + # Now rename the file to the real destination. + $doit $mvcmd "$dsttmp" "$dst" + } + fi || exit 1 + + trap '' 0 + fi +done + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC" +# time-stamp-end: "; # UTC" +# End: diff --git a/src/GHC/Num/Backend.hs b/src/GHC/Num/Backend.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Backend.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Selected backend +module GHC.Num.Backend + ( module Backend + ) +where + +#if defined(BIGNUM_CHECK) +import GHC.Num.Backend.Check as Backend +#else +import GHC.Num.Backend.Selected as Backend +#endif + diff --git a/src/GHC/Num/Backend/Check.hs b/src/GHC/Num/Backend/Check.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Backend/Check.hs @@ -0,0 +1,501 @@ +{-# 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.Num.Backend.Check where + +import GHC.Prim +import GHC.Types +import GHC.Num.WordArray +import GHC.Num.Primitives +import {-# SOURCE #-} GHC.Num.Integer +import {-# SOURCE #-} GHC.Num.Natural +import qualified GHC.Num.Backend.Native as Native +import qualified GHC.Num.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 () + +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# void# + _ -> 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# void# + +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# void# + +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# void# + +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# void# + +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# void# + +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 diff --git a/src/GHC/Num/Backend/FFI.hs b/src/GHC/Num/Backend/FFI.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Backend/FFI.hs @@ -0,0 +1,632 @@ +{-# 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.Num.Backend.FFI where + +import GHC.Prim +import GHC.Types +import GHC.Num.WordArray +import GHC.Num.Primitives +import qualified GHC.Num.Backend.Native as Native +import {-# SOURCE #-} GHC.Num.Natural +import {-# SOURCE #-} GHC.Num.Integer + +default () + +-- | 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. diff --git a/src/GHC/Num/Backend/GMP.hs b/src/GHC/Num/Backend/GMP.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Backend/GMP.hs @@ -0,0 +1,633 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GHCForeignImportPrim #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE LambdaCase #-} + +{-# OPTIONS_GHC -Wno-name-shadowing #-} + +-- | Backend based on the GNU GMP library. +-- +-- This has been adapted from the legacy `integer-gmp` package written by +-- Herbert Valerio Riedel. +module GHC.Num.Backend.GMP where + +#include "MachDeps.h" +#include "WordSize.h" + +import GHC.Num.WordArray +import GHC.Num.Primitives +import GHC.Prim +import GHC.Types +import GHC.Magic (runRW#) +import {-# SOURCE #-} GHC.Num.Integer +import {-# SOURCE #-} GHC.Num.BigNat +import {-# SOURCE #-} GHC.Num.Natural + +default () + +---------------------------------------------------------------------------- +-- type definitions + +-- NB: all code assumes GMP_LIMB_BITS == WORD_SIZE_IN_BITS +-- The C99 code in cbits/gmp_wrappers.c will fail to compile if this doesn't hold + +-- | Type representing a GMP Limb +type GmpLimb = Word -- actually, 'CULong' +type GmpLimb# = Word# + +-- | Count of 'GmpLimb's, must be positive (unless specified otherwise). +type GmpSize = Int -- actually, a 'CLong' +type GmpSize# = Int# + +narrowGmpSize# :: Int# -> Int# +#if SIZEOF_LONG == SIZEOF_HSWORD +narrowGmpSize# x = x +#elif (SIZEOF_LONG == 4) && (SIZEOF_HSWORD == 8) +-- On IL32P64 (i.e. Win64), we have to be careful with CLong not being +-- 64bit. This is mostly an issue on values returned from C functions +-- due to sign-extension. +narrowGmpSize# = narrow32Int# +#endif + +narrowCInt# :: Int# -> Int# +narrowCInt# = narrow32Int# + +bignat_compare :: WordArray# -> WordArray# -> Int# +bignat_compare x y = narrowCInt# (c_mpn_cmp x y (wordArraySize# x)) + +bignat_add + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +{-# INLINE bignat_add #-} +bignat_add mwa wa wb s + -- weird GMP requirement: the biggest comes first + | isTrue# (wordArraySize# wb ># wordArraySize# wa) + = case ioWord# (c_mpn_add mwa wb (wordArraySize# wb) wa (wordArraySize# wa)) s of + (# s', c #) -> mwaWriteMostSignificant mwa c s' + + | True + = case ioWord# (c_mpn_add mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of + (# s', c #) -> mwaWriteMostSignificant mwa c s' + +bignat_add_word + :: MutableWordArray# RealWorld + -> WordArray# + -> Word# + -> State# RealWorld + -> State# RealWorld +{-# INLINE bignat_add_word #-} +bignat_add_word mwa wa b s = do + case ioWord# (c_mpn_add_1 mwa wa (wordArraySize# wa) b) s of + (# s', c #) -> mwaWriteMostSignificant mwa c s' + +bignat_sub + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> (# State# RealWorld, Bool# #) +{-# INLINE bignat_sub #-} +bignat_sub mwa wa wb s = + case ioWord# (c_mpn_sub mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of + (# s', 1## #) -> (# s', 0# #) -- underflow + (# s', _ #) -> (# s', 1# #) -- no underflow + +bignat_sub_word + :: MutableWordArray# RealWorld + -> WordArray# + -> Word# + -> State# RealWorld + -> (# State# RealWorld, Bool# #) +{-# INLINE bignat_sub_word #-} +bignat_sub_word mwa wa b s = + case ioWord# (c_mpn_sub_1 mwa wa (wordArraySize# wa) b) s of + (# s', 1## #) -> (# s', 0# #) -- underflow + (# s', _ #) -> (# s', 1# #) -- no underflow + +bignat_mul + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +{-# INLINE bignat_mul #-} +bignat_mul mwa wa wb s = do + case ioWord# (c_mpn_mul mwa wa (wordArraySize# wa) wb (wordArraySize# wb)) s of + (# s', _msl #) -> s' -- we don't care about the most-significant + -- limb. The caller shrink the mwa if + -- necessary anyway. + +bignat_mul_word + :: MutableWordArray# RealWorld -- ^ Result + -> WordArray# + -> Word# + -> State# RealWorld + -> State# RealWorld +{-# INLINE bignat_mul_word #-} +bignat_mul_word mwa wa b s = + case ioWord# (c_mpn_mul_1 mwa wa (wordArraySize# wa) b) s of + (# s', c #) -> mwaWriteMostSignificant mwa c s' + +bignat_popcount :: WordArray# -> Word# +{-# INLINE bignat_popcount #-} +bignat_popcount wa = c_mpn_popcount wa (wordArraySize# wa) + + +bignat_shiftl + :: MutableWordArray# RealWorld + -> WordArray# + -> Word# + -> State# RealWorld + -> State# RealWorld +{-# INLINE bignat_shiftl #-} +bignat_shiftl mwa wa n s = + case ioWord# (c_mpn_lshift mwa wa (wordArraySize# wa) n) s of + (# s', _msl #) -> s' -- we don't care about the most-significant + -- limb. The caller shrink the mwa if + -- necessary anyway. + +bignat_shiftr + :: MutableWordArray# RealWorld + -> WordArray# + -> Word# + -> State# RealWorld + -> State# RealWorld +{-# INLINE bignat_shiftr #-} +bignat_shiftr mwa wa n s = + case ioWord# (c_mpn_rshift mwa wa (wordArraySize# wa) n) s of + (# s', _msl #) -> s' -- we don't care about the most-significant + -- limb. The caller shrink the mwa if + -- necessary anyway. + +bignat_or + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +{-# INLINE bignat_or #-} +bignat_or mwa wa wb s1 + | isTrue# (szA >=# szB) = go wa szA wb szB s1 + | True = go wb szB wa szA s1 + where + !szA = wordArraySize# wa + !szB = wordArraySize# wb + -- nx >= ny + go wx nx wy ny s = case ioVoid (c_mpn_ior_n mwa wx wy ny) s of + s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s' + +bignat_xor + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +{-# INLINE bignat_xor #-} +bignat_xor mwa wa wb s1 + | isTrue# (szA >=# szB) = go wa szA wb szB s1 + | True = go wb szB wa szA s1 + where + !szA = wordArraySize# wa + !szB = wordArraySize# wb + -- nx >= ny + go wx nx wy ny s = case ioVoid (c_mpn_xor_n mwa wx wy ny) s of + s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s' + +bignat_and + :: MutableWordArray# RealWorld -- ^ Result + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +{-# INLINE bignat_and #-} +bignat_and mwa wa wb s = ioVoid (c_mpn_and_n mwa wa wb sz) s + where + !szA = wordArraySize# wa + !szB = wordArraySize# wb + !sz = minI# szA szB + +bignat_and_not + :: MutableWordArray# RealWorld -- ^ Result + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +{-# INLINE bignat_and_not #-} +bignat_and_not mwa wa wb s = + case ioVoid (c_mpn_andn_n mwa wa wb n) s of + s' -> mwaArrayCopy# mwa szB wa szB (szA -# szB) s' + where + !szA = wordArraySize# wa + !szB = wordArraySize# wb + !n = minI# szA szB + +bignat_quotrem + :: MutableWordArray# RealWorld + -> MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_quotrem mwq mwr wa wb s = + ioVoid (c_mpn_tdiv_qr mwq mwr 0# wa szA wb szB) s + where + szA = wordArraySize# wa + szB = wordArraySize# wb + +bignat_quot + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_quot mwq wa wb s = + ioVoid (c_mpn_tdiv_q mwq wa szA wb szB) s + where + szA = wordArraySize# wa + szB = wordArraySize# wb + +bignat_rem + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_rem mwr wa wb s = + ioVoid (c_mpn_tdiv_r mwr wa szA wb szB) s + where + szA = wordArraySize# wa + szB = wordArraySize# wb + +bignat_quotrem_word + :: MutableWordArray# RealWorld -- ^ Quotient + -> WordArray# + -> Word# + -> State# RealWorld + -> (# State# RealWorld, Word# #) +bignat_quotrem_word mwq wa b s = + ioWord# (c_mpn_divrem_1 mwq 0# wa szA b) s + where + szA = wordArraySize# wa + +bignat_quot_word + :: MutableWordArray# RealWorld -- ^ Quotient + -> WordArray# + -> Word# + -> State# RealWorld + -> State# RealWorld +bignat_quot_word mwq wa b s = + case bignat_quotrem_word mwq wa b s of + (# s', _ #) -> s' + +bignat_rem_word + :: WordArray# + -> Word# + -> Word# +bignat_rem_word wa b = + c_mpn_mod_1 wa (wordArraySize# wa) b + + +bignat_gcd + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_gcd mwr wa wb s = + -- wa > wb + case ioInt# (c_mpn_gcd# mwr wa (wordArraySize# wa) wb (wordArraySize# wb)) s of + (# s', sz #) -> mwaSetSize# mwr (narrowGmpSize# sz) s' + +bignat_gcd_word + :: WordArray# + -> Word# + -> Word# +bignat_gcd_word wa b = c_mpn_gcd_1# wa (wordArraySize# wa) b + +bignat_gcd_word_word + :: Word# + -> Word# + -> Word# +bignat_gcd_word_word = integer_gmp_gcd_word + + +bignat_encode_double :: WordArray# -> Int# -> Double# +bignat_encode_double wa e = c_mpn_get_d wa (wordArraySize# wa) e + +bignat_shiftr_neg + :: MutableWordArray# RealWorld + -> WordArray# + -> Word# + -> State# RealWorld + -> State# RealWorld +bignat_shiftr_neg mwa wa n s = + ioVoid (c_mpn_rshift_2c mwa wa (wordArraySize# wa) n) s + +bignat_powmod_word + :: WordArray# + -> WordArray# + -> Word# + -> Word# +bignat_powmod_word b e m = + integer_gmp_powm1# b (wordArraySize# b) e (wordArraySize# e) m + +bignat_powmod_words + :: Word# + -> Word# + -> Word# + -> Word# +bignat_powmod_words = integer_gmp_powm_word + +bignat_powmod + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_powmod r b e m s = sbignat_powmod r (wordArraySize# b) b e m s + +integer_powmod + :: Integer + -> Natural + -> Natural + -> Natural +integer_powmod b e m = naturalFromBigNat# (withNewWordArray# szm io) + where + !be = naturalToBigNat# e + !bm = naturalToBigNat# m + !(# sb, bb #) = integerToBigNatSign# b + !szb = bigNatSize# bb + !szm = bigNatSize# bm + !ssb = case sb of -- signed size of b + 0# -> szb + _ -> negateInt# szb + + io r s = sbignat_powmod r ssb bb be bm s + + +sbignat_powmod + :: MutableWordArray# RealWorld + -> Int# + -> WordArray# + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +sbignat_powmod r b_signed_size b e m s = + case ioInt# (integer_gmp_powm# r b b_signed_size e (wordArraySize# e) m (wordArraySize# m)) s of + (# s', n #) -> mwaSetSize# r (narrowGmpSize# n) s' + +integer_gcde + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integer_gcde a b = case runRW# io of (# _, a #) -> a + where + !(# sa, ba #) = integerToBigNatSign# a + !(# sb, bb #) = integerToBigNatSign# b + !sza = bigNatSize# ba + !szb = bigNatSize# bb + -- signed sizes of a and b + !ssa = case sa of + 0# -> sza + _ -> negateInt# sza + !ssb = case sb of + 0# -> szb + _ -> negateInt# szb + + -- gcd(a,b) < min(a,b) + !g_init_sz = minI# sza szb + + -- According to https://gmplib.org/manual/Number-Theoretic-Functions.html#index-mpz_005fgcdext + -- a*x + b*y = g + -- abs(x) < abs(b) / (2 g) < abs(b) + -- abs(y) < abs(a) / (2 g) < abs(a) + !x_init_sz = szb + !y_init_sz = sza + + io s = + -- allocate output arrays + case newWordArray# g_init_sz s of { (# s, mbg #) -> + case newWordArray# x_init_sz s of { (# s, mbx #) -> + case newWordArray# y_init_sz s of { (# s, mby #) -> + -- allocate space to return sizes (3x4 = 12) + case newPinnedByteArray# 12# s of { (# s, mszs #) -> + case unsafeFreezeByteArray# mszs s of { (# s, szs #) -> + let !ssx_ptr = byteArrayContents# szs in + let !ssy_ptr = ssx_ptr `plusAddr#` 4# in + let !sg_ptr = ssy_ptr `plusAddr#` 4# in + -- call GMP + case ioVoid (integer_gmp_gcdext# mbx ssx_ptr mby ssy_ptr mbg sg_ptr ba ssa bb ssb) s of { s -> + -- read sizes + case readInt32OffAddr# ssx_ptr 0# s of { (# s, ssx #) -> + case readInt32OffAddr# ssy_ptr 0# s of { (# s, ssy #) -> + case readInt32OffAddr# sg_ptr 0# s of { (# s, sg #) -> + case touch# szs s of { s -> + -- shrink x, y and g to their actual sizes and freeze them + let !sx = absI# ssx in + let !sy = absI# ssy in + case mwaSetSize# mbx sx s of { s -> + case mwaSetSize# mby sy s of { s -> + case mwaSetSize# mbg sg s of { s -> + + -- return x, y and g as Integer + case unsafeFreezeByteArray# mbx s of { (# s, bx #) -> + case unsafeFreezeByteArray# mby s of { (# s, by #) -> + case unsafeFreezeByteArray# mbg s of { (# s, bg #) -> + + (# s, (# integerFromBigNat# bg + , integerFromBigNatSign# (ssx <# 0#) bx + , integerFromBigNatSign# (ssy <# 0#) by #) #) + }}}}}}}}}}}}}}}} + + + +integer_recip_mod + :: Integer + -> Natural + -> (# Natural | () #) +integer_recip_mod x m = + let + !(# sign_x, bx #) = integerToBigNatSign# x + !bm = naturalToBigNat# m + !br = sbignat_recip_mod sign_x bx bm + in if isTrue# (bigNatIsZero# br) + then (# | () #) + else (# naturalFromBigNat# br | #) + + +-- | Return 0 for invalid inputs +sbignat_recip_mod :: Int# -> BigNat# -> BigNat# -> BigNat# +sbignat_recip_mod sign_x x m = withNewWordArray# szm io + where + io r s = case ioInt# (integer_gmp_invert# r x ssx m szm) s of + (# s, rn #) -> mwaSetSize# r (narrowGmpSize# rn) s + !szx = bigNatSize# x + !szm = bigNatSize# m + !ssx = case sign_x of -- signed size of x + 0# -> szx + _ -> negateInt# szx + +---------------------------------------------------------------------- +-- FFI ccall imports + +foreign import ccall unsafe "integer_gmp_gcd_word" + integer_gmp_gcd_word :: GmpLimb# -> GmpLimb# -> GmpLimb# + +foreign import ccall unsafe "integer_gmp_mpn_gcd_1" + c_mpn_gcd_1# :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb# + +foreign import ccall unsafe "integer_gmp_mpn_gcd" + c_mpn_gcd# :: MutableByteArray# s -> ByteArray# -> GmpSize# + -> ByteArray# -> GmpSize# -> IO GmpSize + +foreign import ccall unsafe "integer_gmp_gcdext" integer_gmp_gcdext# + :: MutableByteArray# s -> Addr# + -> MutableByteArray# s -> Addr# + -> MutableByteArray# s -> Addr# + -> ByteArray# -> GmpSize# + -> ByteArray# -> GmpSize# + -> IO () + +foreign import ccall unsafe "integer_gmp_invert" + integer_gmp_invert# :: MutableByteArray# RealWorld + -> ByteArray# -> GmpSize# + -> ByteArray# -> GmpSize# -> IO GmpSize + +-- mp_limb_t mpn_add_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n, +-- mp_limb_t s2limb) +foreign import ccall unsafe "gmp.h __gmpn_add_1" + c_mpn_add_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb# + -> IO GmpLimb + +-- mp_limb_t mpn_sub_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n, +-- mp_limb_t s2limb) +foreign import ccall unsafe "gmp.h __gmpn_sub_1" + c_mpn_sub_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb# + -> IO GmpLimb + +-- mp_limb_t mpn_mul_1 (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t n, +-- mp_limb_t s2limb) +foreign import ccall unsafe "gmp.h __gmpn_mul_1" + c_mpn_mul_1 :: MutableByteArray# s -> ByteArray# -> GmpSize# -> GmpLimb# + -> IO GmpLimb + +-- mp_limb_t mpn_add (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n, +-- const mp_limb_t *s2p, mp_size_t s2n) +foreign import ccall unsafe "gmp.h __gmpn_add" + c_mpn_add :: MutableByteArray# s -> ByteArray# -> GmpSize# + -> ByteArray# -> GmpSize# -> IO GmpLimb + +-- mp_limb_t mpn_sub (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n, +-- const mp_limb_t *s2p, mp_size_t s2n) +foreign import ccall unsafe "gmp.h __gmpn_sub" + c_mpn_sub :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray# + -> GmpSize# -> IO GmpLimb + +-- mp_limb_t mpn_mul (mp_limb_t *rp, const mp_limb_t *s1p, mp_size_t s1n, +-- const mp_limb_t *s2p, mp_size_t s2n) +foreign import ccall unsafe "gmp.h __gmpn_mul" + c_mpn_mul :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray# + -> GmpSize# -> IO GmpLimb + +-- int mpn_cmp (const mp_limb_t *s1p, const mp_limb_t *s2p, mp_size_t n) +foreign import ccall unsafe "gmp.h __gmpn_cmp" + c_mpn_cmp :: ByteArray# -> ByteArray# -> GmpSize# -> Int# + +-- void mpn_tdiv_qr (mp_limb_t *qp, mp_limb_t *rp, mp_size_t qxn, +-- const mp_limb_t *np, mp_size_t nn, +-- const mp_limb_t *dp, mp_size_t dn) +foreign import ccall unsafe "gmp.h __gmpn_tdiv_qr" + c_mpn_tdiv_qr :: MutableByteArray# s -> MutableByteArray# s -> GmpSize# + -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# -> IO () + +foreign import ccall unsafe "integer_gmp_mpn_tdiv_q" + c_mpn_tdiv_q :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray# + -> GmpSize# -> IO () + +foreign import ccall unsafe "integer_gmp_mpn_tdiv_r" + c_mpn_tdiv_r :: MutableByteArray# s -> ByteArray# -> GmpSize# -> ByteArray# + -> GmpSize# -> IO () + +-- mp_limb_t mpn_divrem_1 (mp_limb_t *r1p, mp_size_t qxn, mp_limb_t *s2p, +-- mp_size_t s2n, mp_limb_t s3limb) +foreign import ccall unsafe "gmp.h __gmpn_divrem_1" + c_mpn_divrem_1 :: MutableByteArray# s -> GmpSize# -> ByteArray# -> GmpSize# + -> GmpLimb# -> IO GmpLimb + +-- mp_limb_t mpn_mod_1 (const mp_limb_t *s1p, mp_size_t s1n, mp_limb_t s2limb) +foreign import ccall unsafe "gmp.h __gmpn_mod_1" + c_mpn_mod_1 :: ByteArray# -> GmpSize# -> GmpLimb# -> GmpLimb# + +-- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[], +-- mp_size_t sn, mp_bitcnt_t count) +foreign import ccall unsafe "integer_gmp_mpn_rshift" + c_mpn_rshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> Word# + -> IO GmpLimb + +-- mp_limb_t integer_gmp_mpn_rshift (mp_limb_t rp[], const mp_limb_t sp[], +-- mp_size_t sn, mp_bitcnt_t count) +foreign import ccall unsafe "integer_gmp_mpn_rshift_2c" + c_mpn_rshift_2c :: MutableByteArray# s -> ByteArray# -> GmpSize# -> Word# + -> IO GmpLimb + +-- mp_limb_t integer_gmp_mpn_lshift (mp_limb_t rp[], const mp_limb_t sp[], +-- mp_size_t sn, mp_bitcnt_t count) +foreign import ccall unsafe "integer_gmp_mpn_lshift" + c_mpn_lshift :: MutableByteArray# s -> ByteArray# -> GmpSize# -> Word# + -> IO GmpLimb + +-- void mpn_and_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p, +-- mp_size_t n) +foreign import ccall unsafe "integer_gmp_mpn_and_n" + c_mpn_and_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize# + -> IO () + +-- void mpn_andn_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p, +-- mp_size_t n) +foreign import ccall unsafe "integer_gmp_mpn_andn_n" + c_mpn_andn_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize# + -> IO () + +-- void mpn_ior_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p, +-- mp_size_t n) +foreign import ccall unsafe "integer_gmp_mpn_ior_n" + c_mpn_ior_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize# + -> IO () + +-- void mpn_xor_n (mp_limb_t *rp, const mp_limb_t *s1p, const mp_limb_t *s2p, +-- mp_size_t n) +foreign import ccall unsafe "integer_gmp_mpn_xor_n" + c_mpn_xor_n :: MutableByteArray# s -> ByteArray# -> ByteArray# -> GmpSize# + -> IO () + +-- mp_bitcnt_t mpn_popcount (const mp_limb_t *s1p, mp_size_t n) +foreign import ccall unsafe "gmp.h __gmpn_popcount" + c_mpn_popcount :: ByteArray# -> GmpSize# -> Word# + +-- double integer_gmp_mpn_get_d (const mp_limb_t sp[], const mp_size_t sn) +foreign import ccall unsafe "integer_gmp_mpn_get_d" + c_mpn_get_d :: ByteArray# -> GmpSize# -> Int# -> Double# + +foreign import ccall unsafe "integer_gmp_powm" + integer_gmp_powm# :: MutableByteArray# RealWorld + -> ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# + -> ByteArray# -> GmpSize# -> IO GmpSize + +foreign import ccall unsafe "integer_gmp_powm_word" + integer_gmp_powm_word :: GmpLimb# -> GmpLimb# -> GmpLimb# -> GmpLimb# + +foreign import ccall unsafe "integer_gmp_powm1" + integer_gmp_powm1# :: ByteArray# -> GmpSize# -> ByteArray# -> GmpSize# + -> GmpLimb# -> GmpLimb# diff --git a/src/GHC/Num/Backend/Native.hs b/src/GHC/Num/Backend/Native.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Backend/Native.hs @@ -0,0 +1,776 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE BinaryLiterals #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} + +module GHC.Num.Backend.Native where + +#include "MachDeps.h" +#include "WordSize.h" + +#if defined(BIGNUM_NATIVE) || defined(BIGNUM_CHECK) || defined(BIGNUM_FFI) +import {-# SOURCE #-} GHC.Num.BigNat +import {-# SOURCE #-} GHC.Num.Natural +import {-# SOURCE #-} GHC.Num.Integer +#else +import GHC.Num.BigNat +import GHC.Num.Natural +import GHC.Num.Integer +#endif +import GHC.Num.WordArray +import GHC.Num.Primitives +import GHC.Prim +import GHC.Types + +default () + +count_words_bits :: Word# -> (# Word#, Word# #) +count_words_bits n = (# nw, nb #) + where + nw = n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT# + nb = n `and#` WORD_SIZE_BITS_MASK## + +count_words_bits_int :: Word# -> (# Int#, Int# #) +count_words_bits_int n = case count_words_bits n of + (# nw, nb #) -> (# word2Int# nw, word2Int# nb #) + +bignat_compare :: WordArray# -> WordArray# -> Int# +bignat_compare wa wb = go (sz -# 1#) + where + sz = wordArraySize# wa + go i + | isTrue# (i <# 0#) = 0# + | a <- indexWordArray# wa i + , b <- indexWordArray# wb i + = if | isTrue# (a `eqWord#` b) -> go (i -# 1#) + | isTrue# (a `gtWord#` b) -> 1# + | True -> -1# + +bignat_add + :: MutableWordArray# s -- ^ Result + -> WordArray# + -> WordArray# + -> State# s + -> State# s +bignat_add mwa wa wb = addABc 0# 0## + where + !szA = wordArraySize# wa + !szB = wordArraySize# wb + !szMin = minI# szA szB + + -- we have four cases: + -- 1) we have a digit in A and in B + a potential carry + -- => perform triple addition + -- => result in (carry,word) + -- 2) we have a digit only in A or B and a carry + -- => perform double addition from a single array + -- => result in (carry,word) + -- 3) we have a digit only in A or B and no carry + -- => perform array copy and shrink the array + -- 4) We only have a potential carry + -- => write the carry or shrink the array + + addABc i carry s + | isTrue# (i <# szMin) = + let + !(# carry', r #) = plusWord3# + (indexWordArray# wa i) + (indexWordArray# wb i) + carry + in case mwaWrite# mwa i r s of + s' -> addABc (i +# 1#) carry' s' + + | isTrue# ((i ==# szA) &&# (i ==# szB)) + = mwaWriteOrShrink mwa carry i s + + | isTrue# (i ==# szA) + = addAoBc wb i carry s + + | True + = addAoBc wa i carry s + + addAoBc wab i carry s + | isTrue# (i ==# wordArraySize# wab) + = mwaWriteOrShrink mwa carry i s + + | 0## <- carry + = -- copy the remaining words and remove the word allocated for the + -- potential carry + case mwaArrayCopy# mwa i wab i (wordArraySize# wab -# i) s of + s' -> mwaShrink# mwa 1# s' + + | True + = let !(# carry', r #) = plusWord2# (indexWordArray# wab i) carry + in case mwaWrite# mwa i r s of + s' -> addAoBc wab (i +# 1#) carry' s' + +bignat_add_word + :: MutableWordArray# RealWorld -- ^ Result + -> WordArray# + -> Word# + -> State# RealWorld + -> State# RealWorld +bignat_add_word mwa wa b s = mwaInitArrayPlusWord mwa wa b s + +bignat_sub_word + :: MutableWordArray# RealWorld + -> WordArray# + -> Word# + -> State# RealWorld + -> (# State# RealWorld, Bool# #) +bignat_sub_word mwa wa b = go b 0# + where + !sz = wordArraySize# wa + go carry i s + | isTrue# (i >=# sz) + = (# s, carry `eqWord#` 0## #) + + | 0## <- carry + = case mwaArrayCopy# mwa i wa i (sz -# i) s of + s' -> (# s', 1# #) -- no underflow + + | True + = case subWordC# (indexWordArray# wa i) carry of + (# 0##, 0# #) + | isTrue# (i ==# sz) -> case mwaShrink# mwa 1# s of + s' -> (# s', 1# #) -- no underflow + + (# l , c #) -> case mwaWrite# mwa i l s of + s1 -> go (int2Word# c) (i +# 1#) s1 + +bignat_mul_word + :: MutableWordArray# RealWorld -- ^ Result + -> WordArray# + -> Word# + -> State# RealWorld + -> State# RealWorld +bignat_mul_word mwa wa b = go 0# 0## + where + !szA = wordArraySize# wa + go i carry s + | isTrue# (i ==# szA) = mwaWriteOrShrink mwa carry i s + | True = + let + ai = indexWordArray# wa i + !(# carry', r #) = plusWord12# carry (timesWord2# ai b) + in case mwaWrite# mwa i r s of + s' -> go (i +# 1#) carry' s' + + +bignat_mul + :: MutableWordArray# RealWorld -- ^ Result + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_mul mwa wa wb s1 = + -- initialize the resulting WordArray + case mwaFill# mwa 0## 0## (int2Word# sz) s1 of + s' -> mulEachB ctzB s' -- loop on b Words + where + !szA = wordArraySize# wa + !szB = wordArraySize# wb + !sz = szA +# szB + + !ctzA = word2Int# (bigNatCtzWord# wa) + !ctzB = word2Int# (bigNatCtzWord# wb) + + -- multiply a single bj Word# to the whole wa WordArray + mul bj j i carry s + | isTrue# (i ==# szA) + -- write the carry + = mwaAddInplaceWord# mwa (i +# j) carry s + + | True = let + ai = indexWordArray# wa i + !(# c',r' #) = timesWord2# ai bj + !(# c'',r #) = plusWord2# r' carry + carry' = plusWord# c' c'' + in case mwaAddInplaceWord# mwa (i +# j) r s of + s' -> mul bj j (i +# 1#) carry' s' + + -- for each bj in wb, call `mul bj wa` + mulEachB i s + | isTrue# (i ==# szB) = s + | True = case indexWordArray# wb i of + -- detect bj == 0## and skip the loop + 0## -> mulEachB (i +# 1#) s + bi -> case mul bi i ctzA 0## s of + s' -> mulEachB (i +# 1#) s' + +bignat_sub + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> (# State# RealWorld, Bool# #) +bignat_sub mwa wa wb s = + -- initialize the resulting WordArray + -- Note: we could avoid the copy by subtracting the first non-zero + -- less-significant word of b... + case mwaArrayCopy# mwa 0# wa 0# (wordArraySize# wa) s of + s' -> mwaSubInplaceArray mwa 0# wb s' + +bignat_popcount :: WordArray# -> Word# +bignat_popcount wa = go 0# 0## + where + !sz = wordArraySize# wa + go i c + | isTrue# (i ==# sz) = c + | True = go (i +# 1#) (c `plusWord#` popCnt# (indexWordArray# wa i)) + +bignat_shiftl + :: MutableWordArray# s + -> WordArray# + -> Word# + -> State# s + -> State# s +bignat_shiftl mwa wa n s1 = + -- set the lower words to 0 + case mwaFill# mwa 0## 0## (int2Word# nw) s1 of + s2 -> if + | 0# <- nb -> mwaArrayCopy# mwa nw wa 0# szA s2 + | True -> mwaBitShift 0# 0## s2 + where + !szA = wordArraySize# wa + !(# nw, nb #) = count_words_bits_int n + !sh = WORD_SIZE_IN_BITS# -# nb + + -- Bit granularity (c is the carry from the previous shift) + mwaBitShift i c s + -- write the carry + | isTrue# (i ==# szA) + = mwaWriteOrShrink mwa c (i +# nw) s + + | True = + let + !ai = indexWordArray# wa i + !v = c `or#` (ai `uncheckedShiftL#` nb) + !c' = ai `uncheckedShiftRL#` sh + in case mwaWrite# mwa (i +# nw) v s of + s' -> mwaBitShift (i +# 1#) c' s' + + +bignat_shiftr + :: MutableWordArray# s + -> WordArray# + -> Word# + -> State# s + -> State# s +bignat_shiftr mwa wa n s1 + | isTrue# (nb ==# 0#) = mwaArrayCopy# mwa 0# wa nw sz s1 + | True = mwaBitShift (sz -# 1#) 0## s1 + where + !szA = wordArraySize# wa + !(# nw, nb #) = count_words_bits_int n + !sz = szA -# nw + !sh = WORD_SIZE_IN_BITS# -# nb + + -- Bit granularity (c is the carry from the previous shift) + mwaBitShift i c s + | isTrue# (i <# 0#) = s + | True = + let + !ai = indexWordArray# wa (i +# nw) + !v = c `or#` (ai `uncheckedShiftRL#` nb) + !c' = ai `uncheckedShiftL#` sh + in case mwaWrite# mwa i v s of + s' -> mwaBitShift (i -# 1#) c' s' + +bignat_shiftr_neg + :: MutableWordArray# s + -> WordArray# + -> Word# + -> State# s + -> State# s +bignat_shiftr_neg mwa wa n s1 + -- initialize higher limb + = case mwaWrite# mwa (szA -# 1#) 0## s1 of + s2 -> case bignat_shiftr mwa wa n s2 of + s3 -> if nz_shifted_out + -- round if non-zero bits were shifted out + then mwaAddInplaceWord# mwa 0# 1## s3 + else s3 + where + !szA = wordArraySize# wa + !(# nw, nb #) = count_words_bits_int n + + -- non-zero bits are shifted out? + nz_shifted_out + -- test nb bits + | isTrue# ( + (nb /=# 0#) + &&# (indexWordArray# wa nw `uncheckedShiftL#` + (WORD_SIZE_IN_BITS# -# nb) `neWord#` 0##)) + = True + -- test nw words + | True + = let + go j + | isTrue# (j ==# nw) = False + | isTrue# (indexWordArray# wa j `neWord#` 0##) = True + | True = go (j +# 1#) + in go 0# + + +bignat_or + :: MutableWordArray# RealWorld -- ^ Result + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_or mwa wa wb s1 + | isTrue# (szA >=# szB) = go wa szA wb szB s1 + | True = go wb szB wa szA s1 + where + !szA = wordArraySize# wa + !szB = wordArraySize# wb + -- nx >= ny + go wx nx wy ny s = + case mwaInitArrayBinOp mwa wx wy or# s of + s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s' + +bignat_xor + :: MutableWordArray# RealWorld -- ^ Result + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_xor mwa wa wb s1 + | isTrue# (szA >=# szB) = go wa szA wb szB s1 + | True = go wb szB wa szA s1 + where + !szA = wordArraySize# wa + !szB = wordArraySize# wb + -- nx >= ny + go wx nx wy ny s = + case mwaInitArrayBinOp mwa wx wy xor# s of + s' -> mwaArrayCopy# mwa ny wx ny (nx -# ny) s' + +bignat_and + :: MutableWordArray# RealWorld -- ^ Result + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_and mwa wa wb s = mwaInitArrayBinOp mwa wa wb and# s + +bignat_and_not + :: MutableWordArray# RealWorld -- ^ Result + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_and_not mwa wa wb s = + case mwaInitArrayBinOp mwa wa wb (\x y -> x `and#` not# y) s of + s' -> mwaArrayCopy# mwa szB wa szB (szA -# szB) s' + where + !szA = wordArraySize# wa + !szB = wordArraySize# wb + +bignat_quotrem + :: MutableWordArray# s + -> MutableWordArray# s + -> WordArray# + -> WordArray# + -> State# s + -> State# s +bignat_quotrem mwq mwr uwa uwb s0 = + -- Normalization consists in left-shifting bits in B and A so that the + -- most-significant bit of the most-significant word of B is 1. It makes + -- quotient prediction much more efficient as we only use the two most + -- significant words of A and the most significant word of B to make the + -- prediction. + + -- we will left-shift A and B of "clzb" bits for normalization + let !clzb = clz# (indexWordArray# uwb (wordArraySize# uwb -# 1#)) + + -- we use a single array initially containing A (normalized) and + -- returning the remainder (normalized): mnwa (for "mutable normalized + -- wordarray A") + -- + -- We allocate it here with an additionnal Word compared to A because + -- normalizing can left shift at most (N-1) bits (on N-bit arch). + in case newWordArray# (wordArraySize# uwa +# 1#) s0 of { (# s1, mnwa #) -> + + -- normalized A in mnwa + let normalizeA s = case mwaWrite# mnwa (wordArraySize# uwa) 0## s of -- init potential carry + s -> case bignat_shiftl mnwa uwa clzb s of -- left shift + s -> mwaTrimZeroes# mnwa s -- remove null carry if any + in case normalizeA s1 of { s2 -> + + -- normalize B. We don't do it in a MutableWordArray because it will remain + -- constant during the whole computation. + let !nwb = bigNatShiftL# uwb clzb in + + -- perform quotrem on normalized inputs + case bignat_quotrem_normalized mwq mnwa nwb s2 of { s3 -> + + -- denormalize the remainder now stored in mnwa. We just have to right shift + -- of "clzb" bits. We copy the result into "mwr" array. + let denormalizeR s = case mwaTrimZeroes# mnwa s of + s -> case unsafeFreezeByteArray# mnwa s of + (# s, wr #) -> case mwaSetSize# mwr (wordArraySize# wr) s of + s -> case bignat_shiftr mwr wr clzb s of + s -> mwaTrimZeroes# mwr s + in denormalizeR s3 + }}} + + + +bignat_quot + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_quot mwq wa wb s = + -- allocate a temporary array for the remainder and call quotrem + case newWordArray# (wordArraySize# wb) s of + (# s, mwr #) -> bignat_quotrem mwq mwr wa wb s + +bignat_rem + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_rem mwr wa wb s = + -- allocate a temporary array for the quotient and call quotrem + -- (we could avoid allocating it as it is not used to compute the result but + -- it would require non trivial modification of bignat_quotrem) + case newWordArray# szQ s of + (# s, mwq #) -> bignat_quotrem mwq mwr wa wb s + where + szA = wordArraySize# wa + szB = wordArraySize# wb + szQ = 1# +# szA -# szB + +-- | Perform quotRem on normalized inputs: +-- * highest bit of B is set +-- * A is trimmed +-- * A >= B +-- * B > 1 +bignat_quotrem_normalized + :: MutableWordArray# s + -> MutableWordArray# s + -> WordArray# + -> State# s + -> State# s +bignat_quotrem_normalized mwq mwa b s0 = + + -- n is the size of B + let !n = wordArraySize# b + + -- m+n is the size of A (m >= 0) + in case mwaSize# mwa s0 of { (# s1, szA #) -> + let !m = szA -# n in + + -- Definitions: + -- MSW(x) is the most-significant word of x + -- MSB(x) the most-significant bit of x + + -- We first compute MSW(Q). Thanks to the normalization of B, MSW(Q) can + -- only be 0 or 1 so we only have to perform a prefix comparison to compute + -- MSW(Q). + -- + -- Proof MSW(Q) < 2: + -- * MSB(MSW(B)) = 1 thanks to normalization. + -- * MSW(B) * MSW(Q) <= MSW(A) by definition + -- * suppose MSW(Q) >= 2: + -- MSW(B) * MSW(Q) >= MSW(B) << 1 { MSW(Q) >= 2 } + -- > MAX_WORD_VALUE { MSB(MSW(B)) = 1 } + -- > MSW(A) { MSW(A) <= MAX_WORD_VALUE } + -- contradiction. + -- + -- If A >= (B << m words) + -- then Qm = 1 + -- A := A - (B << m words) + -- else Qm = 0 + -- A unchanged + let computeQm s = case mwaTrimCompare m mwa b s of + (# s, LT #) -> (# s, 0## #) + (# s, _ #) -> (# s, 1## #) + + updateQj j qj qjb s = case mwaWrite# mwq j qj s of -- write Qj + s | 0## <- qj -> s + | True -> case mwaSubInplaceArray mwa j qjb s of -- subtract (qjB << j words) + (# s, _ #) -> s + + -- update the highest word of Q + updateQm s = case computeQm s of + (# s, qm #) -> updateQj m qm b s + + -- the size of Q is szA+szB+1 BEFORE normalization. Normalization may add + -- an additional higher word to A. + -- * If A has an additional limb: + -- * MSW(A) < MSW(B). Because MSB(MSW(A)) can't be set (it would + -- mean that we shifted a whole word, which we didn't) + -- * hence MSW(Q) = 0 but we don't have to write it (and we mustn't) + -- because of the size of Q + -- * If A has no additional limb: + -- * We have to check if MSW(A) >= MSW(B) and to adjust A and MSW(Q) + -- accordingly + -- + -- We detect if A has an additional limb by comparing the size of Q with m + updateQmMaybe s = case mwaSize# mwq s of + (# s, szQ #) | isTrue# (m <# szQ) -> updateQm s + | True -> s + + in case updateQmMaybe s1 of { s2 -> + + + -- main loop: for j from (m-1) downto 0 + -- We estimate a one Word quotient qj: + -- e1e0 <- a(n+j)a(n+j-1) `div` b(n-1) + -- qj | e1 == 0 = e0 + -- | otherwise = maxBound + -- We loop until we find the real quotient: + -- while (A < ((qj*B) << j words)) qj-- + -- We update A and Qj: + -- Qj := qj + -- A := A - (qj*B << j words) + + let bmsw = wordArrayLast# b -- most significant word of B + + estimateQj j s = + case mwaRead# mwa (n +# j) s of + (# s, a1 #) -> case mwaRead# mwa (n +# j -# 1#) s of + (# s, a0 #) -> case quotRemWord3# (# a1, a0 #) bmsw of + (# (# 0##, qj #), _ #) -> (# s, qj #) + (# (# _, _ #), _ #) -> (# s, WORD_MAXBOUND## #) + + -- we perform the qj*B multiplication once and then we subtract B from + -- qj*B as much as needed until (qj'*B << j words) <= A + findRealQj j qj s = findRealQj' j qj (bigNatMulWord# b qj) s + + findRealQj' j qj qjB s = case mwaTrimCompare j mwa qjB s of + (# s, LT #) -> findRealQj' j (qj `minusWord#` 1##) (bigNatSubUnsafe qjB b) s + -- TODO: we could do the sub inplace to + -- reduce allocations + (# s, _ #) -> (# s, qj, qjB #) + + loop j s = case estimateQj j s of + (# s, qj #) -> case findRealQj j qj s of + (# s, qj, qjB #) -> case updateQj j qj qjB s of + s | 0# <- j -> s + | True -> loop (j -# 1#) s + + + in if | 0# <- m -> s2 + | True -> loop (m -# 1#) s2 + }} + +bignat_quotrem_word + :: MutableWordArray# s -- ^ Quotient + -> WordArray# + -> Word# + -> State# s + -> (# State# s, Word# #) +bignat_quotrem_word mwq wa b s = go (sz -# 1#) 0## s + where + sz = wordArraySize# wa + go i r s + | isTrue# (i <# 0#) = (# s, r #) + | True = + let + ai = indexWordArray# wa i + !(# q,r' #) = quotRemWord2# r ai b + in case mwaWrite# mwq i q s of + s' -> go (i -# 1#) r' s' + +bignat_quot_word + :: MutableWordArray# s -- ^ Quotient + -> WordArray# + -> Word# + -> State# s + -> State# s +bignat_quot_word mwq wa b s = go (sz -# 1#) 0## s + where + sz = wordArraySize# wa + go i r s + | isTrue# (i <# 0#) = s + | True = + let + ai = indexWordArray# wa i + !(# q,r' #) = quotRemWord2# r ai b + in case mwaWrite# mwq i q s of + s' -> go (i -# 1#) r' s' + +bignat_rem_word + :: WordArray# + -> Word# + -> Word# +bignat_rem_word wa b = go (sz -# 1#) 0## + where + sz = wordArraySize# wa + go i r + | isTrue# (i <# 0#) = r + | True = + let + ai = indexWordArray# wa i + !(# _,r' #) = quotRemWord2# r ai b + in go (i -# 1#) r' + + +bignat_gcd + :: MutableWordArray# s + -> WordArray# + -> WordArray# + -> State# s + -> State# s +bignat_gcd mwr = go + where + go wmax wmin s + | isTrue# (wordArraySize# wmin ==# 0#) + = mwaInitCopyShrink# mwr wmax s + + | True + = let + wmax' = wmin + !wmin' = bigNatRem wmax wmin + in go wmax' wmin' s + +bignat_gcd_word + :: WordArray# + -> Word# + -> Word# +bignat_gcd_word a b = bignat_gcd_word_word b (bigNatRemWord# a b) + +-- | This operation doesn't really belongs here, but GMP's one is much faster +-- than this simple implementation (basic Euclid algorithm). +-- +-- Ideally we should make an implementation as fast as GMP's one and put it into +-- GHC.Num.Primitives. +bignat_gcd_word_word + :: Word# + -> Word# + -> Word# +bignat_gcd_word_word a 0## = a +bignat_gcd_word_word a b = bignat_gcd_word_word b (a `remWord#` b) + +bignat_encode_double :: WordArray# -> Int# -> Double# +bignat_encode_double wa e0 = go 0.0## e0 0# + where + sz = wordArraySize# wa + go acc e i + | isTrue# (i >=# sz) = acc + | True + = go (acc +## wordEncodeDouble# (indexWordArray# wa i) e) + (e +# WORD_SIZE_IN_BITS#) -- FIXME: we assume that e doesn't overflow... + (i +# 1#) + +bignat_powmod_word :: WordArray# -> WordArray# -> Word# -> Word# +bignat_powmod_word b0 e0 m = go (naturalFromBigNat# b0) (naturalFromBigNat# e0) (naturalFromWord# 1##) + where + go !b e !r + | isTrue# (e `naturalTestBit#` 0##) + = go b' e' ((r `naturalMul` b) `naturalRem` m') + + | naturalIsZero e + = naturalToWord# r + + | True + = go b' e' r + where + b' = (b `naturalMul` b) `naturalRem` m' + m' = naturalFromWord# m + e' = e `naturalShiftR#` 1## -- slightly faster than "e `div` 2" + +bignat_powmod + :: MutableWordArray# RealWorld + -> WordArray# + -> WordArray# + -> WordArray# + -> State# RealWorld + -> State# RealWorld +bignat_powmod r b0 e0 m s = mwaInitCopyShrink# r r' s + where + !r' = go (naturalFromBigNat# b0) + (naturalFromBigNat# e0) + (naturalFromWord# 1##) + + go !b e !r + | isTrue# (e `naturalTestBit#` 0##) + = go b' e' ((r `naturalMul` b) `naturalRem` m') + + | naturalIsZero e + = naturalToBigNat# r + + | True + = go b' e' r + where + b' = (b `naturalMul` b) `naturalRem` m' + m' = naturalFromBigNat# m + e' = e `naturalShiftR#` 1## -- slightly faster than "e `div` 2" + +bignat_powmod_words + :: Word# + -> Word# + -> Word# + -> Word# +bignat_powmod_words b e m = + bignat_powmod_word (wordArrayFromWord# b) + (wordArrayFromWord# e) + m + + +integer_gcde + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integer_gcde a b = f (# a,integerOne,integerZero #) (# b,integerZero,integerOne #) + where + -- returned "g" must be positive + fix (# g, x, y #) + | integerIsNegative g = (# integerNegate g, integerNegate x, integerNegate y #) + | True = (# g,x,y #) + + f old@(# old_g, old_s, old_t #) new@(# g, s, t #) + | integerIsZero g = fix old + | True = case integerQuotRem# old_g g of + !(# q, r #) -> f new (# r , old_s `integerSub` (q `integerMul` s) + , old_t `integerSub` (q `integerMul` t) #) + +integer_recip_mod + :: Integer + -> Natural + -> (# Natural | () #) +integer_recip_mod x m = + let m' = integerFromNatural m + in case integer_gcde x m' of + (# g, a, _b #) + -- gcd(x,m) = ax+mb = 1 + -- ==> ax - 1 = -mb + -- ==> ax = 1 [m] + | g `integerEq` integerOne -> (# integerToNatural (a `integerMod` m') | #) + -- a `mod` m > 0 because m > 0 + | True -> (# | () #) + +integer_powmod + :: Integer + -> Natural + -> Natural + -> Natural +integer_powmod b0 e0 m = go b0 e0 integerOne + where + !m' = integerFromNatural m + + go !b e !r + | isTrue# (e `naturalTestBit#` 0##) + = go b' e' ((r `integerMul` b) `integerMod` m') + + | naturalIsZero e + = integerToNatural r -- r >= 0 by integerMod above + + | True + = go b' e' r + where + b' = (b `integerMul` b) `integerRem` m' + e' = e `naturalShiftR#` 1## diff --git a/src/GHC/Num/Backend/Selected.hs b/src/GHC/Num/Backend/Selected.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Backend/Selected.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | Selected backend +-- +-- We need this module in addition to GHC.Num.Backend to avoid module loops with +-- Check backend. +module GHC.Num.Backend.Selected + ( module Backend + ) +where + +#if defined(BIGNUM_NATIVE) +import GHC.Num.Backend.Native as Backend + +#elif defined(BIGNUM_FFI) +import GHC.Num.Backend.FFI as Backend + +#elif defined(BIGNUM_GMP) +import GHC.Num.Backend.GMP as Backend + +#else +#error Undefined BigNum backend. Use a flag to select it (e.g. gmp, native, ffi)` +#endif diff --git a/src/GHC/Num/BigNat.hs b/src/GHC/Num/BigNat.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/BigNat.hs @@ -0,0 +1,1597 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE BinaryLiterals #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} + +-- | Multi-precision natural +module GHC.Num.BigNat where + +#include "MachDeps.h" +#include "WordSize.h" + +import GHC.Prim +import GHC.Types +import GHC.Classes +import GHC.Magic +import GHC.Num.Primitives +import GHC.Num.WordArray +import GHC.Num.Backend + +#if WORD_SIZE_IN_BITS < 64 +import GHC.IntWord64 +#endif + +default () + +-- | A BigNat +-- +-- Represented as an array of limbs (Word#) stored in little-endian order (Word# +-- themselves use machine order). +-- +-- Invariant (canonical representation): higher Word# is non-zero. +-- +-- As a consequence, zero is represented with a WordArray# whose size is 0. +type BigNat# = WordArray# + -- we use a type-alias instead of an unlifted newtype to make Integer/Natural + -- types easier to wire in the compiler + +-- | A lifted BigNat +-- +-- Represented as an array of limbs (Word#) stored in little-endian order (Word# +-- themselves use machine order). +-- +-- Invariant (canonical representation): higher Word# is non-zero. +-- +-- As a consequence, zero is represented with a WordArray# whose size is 0. +data BigNat = BN# { unBigNat :: BigNat# } + +-- Note [Why Void#?] +-- ~~~~~~~~~~~~~~~~~ +-- +-- We can't have top-level BigNat# for now because they are unlifted ByteArray# +-- (see #17521). So we use functions that take an empty argument Void# that +-- will be discarded at compile time. + + +-- | Check that the BigNat is valid +bigNatCheck# :: BigNat# -> Bool# +bigNatCheck# bn + | 0# <- bigNatSize# bn = 1# + -- check that size is a multiple of Word size + | r <- remInt# (sizeofByteArray# bn) WORD_SIZE_IN_BYTES# + , isTrue# (r /=# 0#) = 0# + -- check that most-significant limb isn't zero + | 0## <- bigNatIndex# bn (bigNatSize# bn -# 1#) = 0# + | True = 1# + +-- | Check that the BigNat is valid +bigNatCheck :: BigNat# -> Bool +bigNatCheck bn = isTrue# (bigNatCheck# bn) + +-- | Number of words in the BigNat +bigNatSize :: BigNat# -> Word +bigNatSize bn = W# (int2Word# (bigNatSize# bn)) + +-- | Number of words in the BigNat +bigNatSize# :: BigNat# -> Int# +bigNatSize# ba = wordArraySize# ba + +{-# NOINLINE bigNatZero #-} +bigNatZero :: BigNat +bigNatZero = BN# (withNewWordArray# 0# (\_ s -> s)) + +{-# NOINLINE bigNatOne #-} +bigNatOne :: BigNat +bigNatOne = BN# (bigNatFromWord# 1##) + +-- | BigNat Zero +bigNatZero# :: Void# -> BigNat# -- cf Note [Why Void#?] +bigNatZero# _ = case bigNatZero of + BN# w -> w + +-- | BigNat one +bigNatOne# :: Void# -> BigNat# -- cf Note [Why Void#?] +bigNatOne# _ = case bigNatOne of + BN# w -> w + +raiseDivZero_BigNat :: Void# -> BigNat# +raiseDivZero_BigNat _ = case raiseDivZero of + !_ -> bigNatZero# void# + -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives + +-- | Indicate if a bigNat is zero +bigNatIsZero :: BigNat# -> Bool +bigNatIsZero bn = isTrue# (bigNatIsZero# bn) + +-- | Indicate if a bigNat is zero +bigNatIsZero# :: BigNat# -> Bool# +bigNatIsZero# ba = wordArraySize# ba ==# 0# + +-- | Indicate if a bigNat is one +bigNatIsOne :: BigNat# -> Bool +bigNatIsOne bn = isTrue# (bigNatIsOne# bn) + +-- | Indicate if a bigNat is one +bigNatIsOne# :: BigNat# -> Bool# +bigNatIsOne# ba = + wordArraySize# ba ==# 1# + &&# indexWordArray# ba 0# `eqWord#` 1## + +-- | Indicate if a bigNat is two +bigNatIsTwo :: BigNat# -> Bool +bigNatIsTwo bn = isTrue# (bigNatIsTwo# bn) + +-- | Indicate if a bigNat is two +bigNatIsTwo# :: BigNat# -> Bool# +bigNatIsTwo# ba = + wordArraySize# ba ==# 1# + &&# indexWordArray# ba 0# `eqWord#` 2## + +-- | Indicate if the value is a power of two and which one +bigNatIsPowerOf2# :: BigNat# -> (# (# #) | Word# #) +bigNatIsPowerOf2# a + | bigNatIsZero a = (# (# #) | #) + | True = case wordIsPowerOf2# msw of + (# (# #) | #) -> (# (# #) | #) + (# | c #) -> case checkAllZeroes (imax -# 1#) of + 0# -> (# (# #) | #) + _ -> (# | c `plusWord#` + (int2Word# imax `uncheckedShiftL#` WORD_SIZE_BITS_SHIFT#) #) + where + msw = bigNatIndex# a imax + sz = bigNatSize# a + imax = sz -# 1# + checkAllZeroes i + | isTrue# (i <# 0#) = 1# + | True = case bigNatIndex# a i of + 0## -> checkAllZeroes (i -# 1#) + _ -> 0# + +-- | Return the Word# at the given index +bigNatIndex# :: BigNat# -> Int# -> Word# +bigNatIndex# x i = indexWordArray# x i + +-- | Return the Word# at the given index +bigNatIndex :: BigNat# -> Int# -> Word +bigNatIndex bn i = W# (bigNatIndex# bn i) + +------------------------------------------------- +-- Conversion +------------------------------------------------- + +-- | Create a BigNat from a Word +bigNatFromWord :: Word -> BigNat# +bigNatFromWord (W# w) = bigNatFromWord# w + +-- | Create a BigNat from a Word +bigNatFromWord# :: Word# -> BigNat# +bigNatFromWord# 0## = bigNatZero# void# +bigNatFromWord# w = wordArrayFromWord# w + +-- | Convert a list of non-zero Words (most-significant first) into a BigNat +bigNatFromWordList :: [Word] -> BigNat# +bigNatFromWordList (W# 0##:xs) = bigNatFromWordList xs +bigNatFromWordList xs = bigNatFromWordListUnsafe xs + +-- | Convert a list of non-zero Words (most-significant first) into a BigNat +bigNatFromWordList# :: [Word] -> WordArray# +{-# NOINLINE bigNatFromWordList# #-} +bigNatFromWordList# xs = bigNatFromWordList xs + +-- | Return the absolute value of the Int# in a BigNat +bigNatFromAbsInt# :: Int# -> BigNat# +bigNatFromAbsInt# i = bigNatFromWord# (wordFromAbsInt# i) + +-- | Convert a list of non-zero Words (most-significant first) into a BigNat. +-- Don't remove most-significant zero words +bigNatFromWordListUnsafe :: [Word] -> BigNat# +bigNatFromWordListUnsafe [] = bigNatZero# void# +bigNatFromWordListUnsafe xs = + let + length i [] = i + length i (_:ys) = length (i +# 1#) ys + !lxs = length 0# xs + writeWordList _mwa _i [] s = s + writeWordList mwa i (W# w:ws) s = + case mwaWrite# mwa i w s of + s1 -> writeWordList mwa (i -# 1#) ws s1 + in withNewWordArray# lxs \mwa -> + writeWordList mwa (lxs -# 1#) xs + +-- | Convert a BigNat into a list of non-zero Words (most-significant first) +bigNatToWordList :: BigNat# -> [Word] +bigNatToWordList bn = go (bigNatSize# bn) + where + go 0# = [] + go n = bigNatIndex bn (n -# 1#) : go (n -# 1#) + + +-- | Convert two Word# (most-significant first) into a BigNat +bigNatFromWord2# :: Word# -> Word# -> BigNat# +bigNatFromWord2# 0## 0## = bigNatZero# void# +bigNatFromWord2# 0## l = bigNatFromWord# l +bigNatFromWord2# h l = wordArrayFromWord2# h l + +-- | Convert a BigNat into a Word# +bigNatToWord# :: BigNat# -> Word# +bigNatToWord# a + | bigNatIsZero a = 0## + | True = bigNatIndex# a 0# + +-- | Convert a BigNat into a Word# if it fits +bigNatToWordMaybe# :: BigNat# -> (# (# #) | Word# #) +bigNatToWordMaybe# a + | bigNatIsZero a = (# | 0## #) + | isTrue# (bigNatSize# a ># 1#) = (# (# #) | #) + | True = (# | bigNatIndex# a 0# #) + +-- | Convert a BigNat into a Word +bigNatToWord :: BigNat# -> Word +bigNatToWord bn = W# (bigNatToWord# bn) + +-- | Convert a BigNat into a Int# +bigNatToInt# :: BigNat# -> Int# +bigNatToInt# a + | bigNatIsZero a = 0# + | True = indexIntArray# a 0# + +-- | Convert a BigNat into a Int +bigNatToInt :: BigNat# -> Int +bigNatToInt bn = I# (bigNatToInt# bn) + +#if WORD_SIZE_IN_BITS == 32 + +-- | Convert a Word64# into a BigNat on 32-bit architectures +bigNatFromWord64# :: Word64# -> BigNat# +bigNatFromWord64# w64 = bigNatFromWord2# wh# wl# + where + wh# = word64ToWord# (uncheckedShiftRL64# w64 32#) + wl# = word64ToWord# w64 + +-- | Convert a BigNat into a Word64# on 32-bit architectures +bigNatToWord64# :: BigNat# -> Word64# +bigNatToWord64# b + | bigNatIsZero b = wordToWord64# 0## + | wl <- wordToWord64# (bigNatToWord# b) + = if isTrue# (bigNatSize# b ># 1#) + then + let wh = wordToWord64# (bigNatIndex# b 1#) + in uncheckedShiftL64# wh 32# `or64#` wl + else wl + +#endif + +-- | Encode (# BigNat mantissa, Int# exponent #) into a Double# +bigNatEncodeDouble# :: BigNat# -> Int# -> Double# +bigNatEncodeDouble# a e + | bigNatIsZero a + = word2Double# 0## -- FIXME: isn't it NaN on 0# exponent? + + | True + = inline bignat_encode_double a e + +------------------------------------------------- +-- Predicates +------------------------------------------------- + +-- | Test if a BigNat is greater than a Word +bigNatGtWord# :: BigNat# -> Word# -> Bool# +bigNatGtWord# bn w = + notB# (bigNatIsZero# bn) + &&# ( bigNatSize# bn ># 1# + ||# bigNatIndex# bn 0# `gtWord#` w + ) + +-- | Test if a BigNat is equal to a Word +bigNatEqWord# :: BigNat# -> Word# -> Bool# +bigNatEqWord# bn w + | 0## <- w + = bigNatIsZero# bn + + | isTrue# (bigNatSize# bn ==# 1#) + = bigNatIndex# bn 0# `eqWord#` w + + | True + = 0# + +-- | Test if a BigNat is greater than a Word +bigNatGtWord :: BigNat# -> Word -> Bool +bigNatGtWord bn (W# w) = isTrue# (bigNatGtWord# bn w) + +-- | Test if a BigNat is lower than or equal to a Word +bigNatLeWord# :: BigNat# -> Word# -> Bool# +bigNatLeWord# bn w = notB# (bigNatGtWord# bn w) + +-- | Test if a BigNat is lower than or equal to a Word +bigNatLeWord :: BigNat# -> Word -> Bool +bigNatLeWord bn (W# w) = isTrue# (bigNatLeWord# bn w) + +-- | Equality test for BigNat +bigNatEq# :: BigNat# -> BigNat# -> Bool# +bigNatEq# wa wb + | isTrue# (wordArraySize# wa /=# wordArraySize# wb) = 0# + | isTrue# (wordArraySize# wa ==# 0#) = 1# + | True = inline bignat_compare wa wb ==# 0# + +-- | Equality test for BigNat +bigNatEq :: BigNat# -> BigNat# -> Bool +bigNatEq a b = isTrue# (bigNatEq# a b) + +-- | Inequality test for BigNat +bigNatNe# :: BigNat# -> BigNat# -> Bool# +bigNatNe# a b = notB# (bigNatEq# a b) + +-- | Equality test for BigNat +bigNatNe :: BigNat# -> BigNat# -> Bool +bigNatNe a b = isTrue# (bigNatNe# a b) + +-- | Compare a BigNat and a Word# +bigNatCompareWord# :: BigNat# -> Word# -> Ordering +bigNatCompareWord# a b + | bigNatIsZero a = cmpW# 0## b + | isTrue# (wordArraySize# a ># 1#) = GT + | True + = cmpW# (indexWordArray# a 0#) b + +-- | Compare a BigNat and a Word +bigNatCompareWord :: BigNat# -> Word -> Ordering +bigNatCompareWord a (W# b) = bigNatCompareWord# a b + +-- | Compare two BigNat +bigNatCompare :: BigNat# -> BigNat# -> Ordering +bigNatCompare a b = + let + szA = wordArraySize# a + szB = wordArraySize# b + in if + | isTrue# (szA ># szB) -> GT + | isTrue# (szA <# szB) -> LT + | isTrue# (szA ==# 0#) -> EQ + | True -> compareInt# (inline bignat_compare a b) 0# + + +-- | Predicate: a < b +bigNatLt# :: BigNat# -> BigNat# -> Bool# +bigNatLt# a b + | LT <- bigNatCompare a b = 1# + | True = 0# + +-- | Predicate: a < b +bigNatLt :: BigNat# -> BigNat# -> Bool +bigNatLt a b = isTrue# (bigNatLt# a b) + +-- | Predicate: a <= b +bigNatLe# :: BigNat# -> BigNat# -> Bool# +bigNatLe# a b + | GT <- bigNatCompare a b = 0# + | True = 1# + +-- | Predicate: a <= b +bigNatLe :: BigNat# -> BigNat# -> Bool +bigNatLe a b = isTrue# (bigNatLe# a b) + +-- | Predicate: a > b +bigNatGt# :: BigNat# -> BigNat# -> Bool# +bigNatGt# a b + | GT <- bigNatCompare a b = 1# + | True = 0# + +-- | Predicate: a > b +bigNatGt :: BigNat# -> BigNat# -> Bool +bigNatGt a b = isTrue# (bigNatGt# a b) + +-- | Predicate: a >= b +bigNatGe# :: BigNat# -> BigNat# -> Bool# +bigNatGe# a b + | LT <- bigNatCompare a b = 0# + | True = 1# + +-- | Predicate: a >= b +bigNatGe :: BigNat# -> BigNat# -> Bool +bigNatGe a b = isTrue# (bigNatGe# a b) + +------------------------------------------------- +-- Addition +------------------------------------------------- + +-- | Add a bigNat and a Word# +bigNatAddWord# :: BigNat# -> Word# -> BigNat# +bigNatAddWord# a b + | 0## <- b + = a + + | bigNatIsZero a + = bigNatFromWord# b + + | True + = withNewWordArrayTrimed# (wordArraySize# a +# 1#) \mwa s -> + inline bignat_add_word mwa a b s + +-- | Add a bigNat and a Word +bigNatAddWord :: BigNat# -> Word -> BigNat# +bigNatAddWord a (W# b) = bigNatAddWord# a b + +-- | Add two bigNats +bigNatAdd :: BigNat# -> BigNat# -> BigNat# +bigNatAdd a b + | bigNatIsZero a = b + | bigNatIsZero b = a + | True = + let + !szA = wordArraySize# a + !szB = wordArraySize# b + !szMax = maxI# szA szB + !sz = szMax +# 1# -- for the potential carry + in withNewWordArrayTrimed# sz \mwa s -> + inline bignat_add mwa a b s + +------------------------------------------------- +-- Multiplication +------------------------------------------------- + +-- | Multiply a BigNat by a Word# +bigNatMulWord# :: BigNat# -> Word# -> BigNat# +bigNatMulWord# a w + | 0## <- w = bigNatZero# void# + | 1## <- w = a + | bigNatIsZero a = bigNatZero# void# + | bigNatIsOne a = bigNatFromWord# w + | isTrue# (bigNatSize# a ==# 1#) + = case timesWord2# (bigNatIndex# a 0#) w of + (# h, l #) -> bigNatFromWord2# h l + | True = withNewWordArrayTrimed# (bigNatSize# a +# 1#) \mwa s -> + inline bignat_mul_word mwa a w s + +-- | Multiply a BigNAt by a Word +bigNatMulWord :: BigNat# -> Word -> BigNat# +bigNatMulWord a (W# w) = bigNatMulWord# a w + +-- | Square a BigNat +bigNatSqr :: BigNat# -> BigNat# +bigNatSqr a = bigNatMul a a + -- This can be replaced by a backend primitive in the future (e.g. to use + -- GMP's mpn_sqr) + +-- | Multiplication (classical algorithm) +bigNatMul :: BigNat# -> BigNat# -> BigNat# +bigNatMul a b + | bigNatSize b > bigNatSize a = bigNatMul b a -- optimize loops + | bigNatIsZero a = a + | bigNatIsZero b = b + | bigNatIsOne a = b + | bigNatIsOne b = a + | True = + let + !szA = wordArraySize# a + !szB = wordArraySize# b + !sz = szA +# szB + in withNewWordArrayTrimed# sz \mwa s-> + inline bignat_mul mwa a b s + + +------------------------------------------------- +-- Subtraction +------------------------------------------------- + +-- | Subtract a Word# from a BigNat +-- +-- The BigNat must be bigger than the Word#. +bigNatSubWordUnsafe# :: BigNat# -> Word# -> BigNat# +bigNatSubWordUnsafe# x y + | 0## <- y = x + | True = withNewWordArrayTrimed# sz \mwa -> go mwa y 0# + where + !sz = wordArraySize# x + + go mwa carry i s + | isTrue# (i >=# sz) + = s + + | 0## <- carry + = mwaArrayCopy# mwa i x i (sz -# i) s + + | True + = case subWordC# (indexWordArray# x i) carry of + (# l, c #) -> case mwaWrite# mwa i l s of + s1 -> go mwa (int2Word# c) (i +# 1#) s1 + +-- | Subtract a Word# from a BigNat +-- +-- The BigNat must be bigger than the Word#. +bigNatSubWordUnsafe :: BigNat# -> Word -> BigNat# +bigNatSubWordUnsafe x (W# y) = bigNatSubWordUnsafe# x y + +-- | Subtract a Word# from a BigNat +bigNatSubWord# :: BigNat# -> Word# -> (# (# #) | BigNat# #) +bigNatSubWord# a b + | 0## <- b = (# | a #) + | bigNatIsZero a = (# (# #) | #) + | True + = withNewWordArrayTrimedMaybe# (bigNatSize# a) \mwa s -> + inline bignat_sub_word mwa a b s + + +-- | Subtract two BigNat (don't check if a >= b) +bigNatSubUnsafe :: BigNat# -> BigNat# -> BigNat# +bigNatSubUnsafe a b + | bigNatIsZero b = a + | True = + let szA = wordArraySize# a + in withNewWordArrayTrimed# szA \mwa s-> + case inline bignat_sub mwa a b s of + (# s', 1# #) -> s' + (# s', _ #) -> case raiseUnderflow of + !_ -> s' + -- see Note [ghc-bignum exceptions] in + -- GHC.Num.Primitives + +-- | Subtract two BigNat +bigNatSub :: BigNat# -> BigNat# -> (# (# #) | BigNat# #) +bigNatSub a b + | bigNatIsZero b = (# | a #) + | isTrue# (bigNatSize# a <# bigNatSize# b) + = (# (# #) | #) + + | True + = withNewWordArrayTrimedMaybe# (bigNatSize# a) \mwa s -> + inline bignat_sub mwa a b s + + +------------------------------------------------- +-- Division +------------------------------------------------- + +-- | Divide a BigNat by a Word, return the quotient +-- +-- Require: +-- b /= 0 +bigNatQuotWord# :: BigNat# -> Word# -> BigNat# +bigNatQuotWord# a b + | 1## <- b = a + | 0## <- b = raiseDivZero_BigNat void# + | True = + let + sz = wordArraySize# a + in withNewWordArrayTrimed# sz \mwq s -> + inline bignat_quot_word mwq a b s + +-- | Divide a BigNat by a Word, return the quotient +-- +-- Require: +-- b /= 0 +bigNatQuotWord :: BigNat# -> Word -> BigNat# +bigNatQuotWord a (W# b) = bigNatQuotWord# a b + +-- | Divide a BigNat by a Word, return the remainder +-- +-- Require: +-- b /= 0 +bigNatRemWord# :: BigNat# -> Word# -> Word# +bigNatRemWord# a b + | 0## <- b = raiseDivZero_Word# void# + | 1## <- b = 0## + | bigNatIsZero a = 0## + | True = inline bignat_rem_word a b + +-- | Divide a BigNat by a Word, return the remainder +-- +-- Require: +-- b /= 0 +bigNatRemWord :: BigNat# -> Word -> Word +bigNatRemWord a (W# b) = W# (bigNatRemWord# a b) + +-- | QuotRem a BigNat by a Word +-- +-- Require: +-- b /= 0 +bigNatQuotRemWord# :: BigNat# -> Word# -> (# BigNat#, Word# #) +bigNatQuotRemWord# a b + | 0## <- b = case raiseDivZero of + !_ -> (# bigNatZero# void#, 0## #) + -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives + | 1## <- b = (# a, 0## #) + | isTrue# (bigNatSize# a ==# 1#) + , a0 <- indexWordArray# a 0# + = case compareWord# a0 b of + LT -> (# bigNatZero# void#, a0 #) + EQ -> (# bigNatOne# void#, 0## #) + GT -> case quotRemWord# a0 b of + (# q, r #) -> (# bigNatFromWord# q, r #) + | True = + let + sz = wordArraySize# a + io s = + case newWordArray# sz s of { (# s1, mwq #) -> + case inline bignat_quotrem_word mwq a b s1 of { (# s2, r #) -> + case mwaTrimZeroes# mwq s2 of { s3 -> + case unsafeFreezeByteArray# mwq s3 of { (# s4, wq #) -> + (# s4, (# wq, r #) #) + }}}} + in case runRW# io of + (# _, (# wq,r #) #) -> (# wq, r #) + + +-- | BigNat division returning (quotient,remainder) +bigNatQuotRem# :: BigNat# -> BigNat# -> (# BigNat#, BigNat# #) +bigNatQuotRem# a b + | bigNatIsZero b = case raiseDivZero of + !_ -> (# bigNatZero# void#, bigNatZero# void# #) + -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives + | bigNatIsZero a = (# bigNatZero# void#, bigNatZero# void# #) + | bigNatIsOne b = (# a , bigNatZero# void# #) + | LT <- cmp = (# bigNatZero# void#, a #) + | EQ <- cmp = (# bigNatOne# void#, bigNatZero# void# #) + | isTrue# (szB ==# 1#) = case bigNatQuotRemWord# a (bigNatIndex# b 0#) of + (# q, r #) -> (# q, bigNatFromWord# r #) + + | True = withNewWordArray2Trimed# szQ szR \mwq mwr s -> + inline bignat_quotrem mwq mwr a b s + where + cmp = bigNatCompare a b + szA = wordArraySize# a + szB = wordArraySize# b + szQ = 1# +# szA -# szB + szR = szB + + +-- | BigNat division returning quotient +bigNatQuot :: BigNat# -> BigNat# -> BigNat# +bigNatQuot a b + | bigNatIsZero b = raiseDivZero_BigNat void# + | bigNatIsZero a = bigNatZero# void# + | bigNatIsOne b = a + | LT <- cmp = bigNatZero# void# + | EQ <- cmp = bigNatOne# void# + | isTrue# (szB ==# 1#) = bigNatQuotWord# a (bigNatIndex# b 0#) + | True = withNewWordArrayTrimed# szQ \mwq s -> + inline bignat_quot mwq a b s + where + cmp = bigNatCompare a b + szA = wordArraySize# a + szB = wordArraySize# b + szQ = 1# +# szA -# szB + +-- | BigNat division returning remainder +bigNatRem :: BigNat# -> BigNat# -> BigNat# +bigNatRem a b + | bigNatIsZero b = raiseDivZero_BigNat void# + | bigNatIsZero a = bigNatZero# void# + | bigNatIsOne b = bigNatZero# void# + | LT <- cmp = a + | EQ <- cmp = bigNatZero# void# + | isTrue# (szB ==# 1#) = case bigNatRemWord# a (bigNatIndex# b 0#) of + r -> bigNatFromWord# r + | True = withNewWordArrayTrimed# szR \mwr s -> + inline bignat_rem mwr a b s + where + cmp = bigNatCompare a b + szB = wordArraySize# b + szR = szB + +------------------------------------------------- +-- GCD / LCM +------------------------------------------------- + +-- Word#/Int# GCDs shouldn't be here in BigNat. However GMP provides a very fast +-- implementation so we keep this here at least until we get a native Haskell +-- implementation as fast as GMP's one. Note that these functions are used in +-- `base` (e.g. in GHC.Real) + +-- | Greatest common divisor between two Word# +gcdWord# :: Word# -> Word# -> Word# +gcdWord# = bignat_gcd_word_word + +-- | Greatest common divisor between two Word +gcdWord :: Word -> Word -> Word +gcdWord (W# x) (W# y) = W# (gcdWord# x y) + +-- | Greatest common divisor between two Int# +-- +-- __Warning__: result may become negative if (at least) one argument +-- is 'minBound' +gcdInt# :: Int# -> Int# -> Int# +gcdInt# x y = word2Int# (gcdWord# (wordFromAbsInt# x) (wordFromAbsInt# y)) + +-- | Greatest common divisor between two Int +-- +-- __Warning__: result may become negative if (at least) one argument +-- is 'minBound' +gcdInt :: Int -> Int -> Int +gcdInt (I# x) (I# y) = I# (gcdInt# x y) + +-- | Greatest common divisor +bigNatGcd :: BigNat# -> BigNat# -> BigNat# +bigNatGcd a b + | bigNatIsZero a = b + | bigNatIsZero b = a + | bigNatIsOne a = a + | bigNatIsOne b = b + | True + = case (# bigNatSize# a, bigNatSize# b #) of + (# 1#, 1# #) -> bigNatFromWord# (gcdWord# (bigNatIndex# a 0#) + (bigNatIndex# b 0#)) + (# 1#, _ #) -> bigNatFromWord# (bigNatGcdWord# b (bigNatIndex# a 0#)) + (# _ , 1# #) -> bigNatFromWord# (bigNatGcdWord# a (bigNatIndex# b 0#)) + _ -> + let + go wx wy = -- wx > wy + withNewWordArrayTrimed# (wordArraySize# wy) \mwr s -> + bignat_gcd mwr wx wy s + in case bigNatCompare a b of + EQ -> a + LT -> go b a + GT -> go a b + +-- | Greatest common divisor +bigNatGcdWord# :: BigNat# -> Word# -> Word# +bigNatGcdWord# a b + | bigNatIsZero a = 0## + | 0## <- b = 0## + | bigNatIsOne a = 1## + | 1## <- b = 1## + | True = case bigNatCompareWord# a b of + EQ -> b + _ -> bignat_gcd_word a b + +-- | Least common multiple +bigNatLcm :: BigNat# -> BigNat# -> BigNat# +bigNatLcm a b + | bigNatIsZero a = bigNatZero# void# + | bigNatIsZero b = bigNatZero# void# + | bigNatIsOne a = b + | bigNatIsOne b = a + | True + = case (# bigNatSize# a, bigNatSize# b #) of + (# 1#, 1# #) -> bigNatLcmWordWord# (bigNatIndex# a 0#) (bigNatIndex# b 0#) + (# 1#, _ #) -> bigNatLcmWord# b (bigNatIndex# a 0#) + (# _ , 1# #) -> bigNatLcmWord# a (bigNatIndex# b 0#) + _ -> (a `bigNatQuot` (a `bigNatGcd` b)) `bigNatMul` b + -- TODO: use extended GCD to get a's factor directly + +-- | Least common multiple with a Word# +bigNatLcmWord# :: BigNat# -> Word# -> BigNat# +bigNatLcmWord# a b + | bigNatIsZero a = bigNatZero# void# + | 0## <- b = bigNatZero# void# + | bigNatIsOne a = bigNatFromWord# b + | 1## <- b = a + | 1# <- bigNatSize# a = bigNatLcmWordWord# (bigNatIndex# a 0#) b + | True + = (a `bigNatQuotWord#` (a `bigNatGcdWord#` b)) `bigNatMulWord#` b + -- TODO: use extended GCD to get a's factor directly + +-- | Least common multiple between two Word# +bigNatLcmWordWord# :: Word# -> Word# -> BigNat# +bigNatLcmWordWord# a b + | 0## <- a = bigNatZero# void# + | 0## <- b = bigNatZero# void# + | 1## <- a = bigNatFromWord# b + | 1## <- b = bigNatFromWord# a + | True = case (a `quotWord#` (a `gcdWord#` b)) `timesWord2#` b of + -- TODO: use extended GCD to get a's factor directly + (# h, l #) -> bigNatFromWord2# h l + + +------------------------------------------------- +-- Bitwise operations +------------------------------------------------- + +-- | Bitwise OR +bigNatOr :: BigNat# -> BigNat# -> BigNat# +bigNatOr a b + | bigNatIsZero a = b + | bigNatIsZero b = a + | True = withNewWordArray# sz \mwa s -> + inline bignat_or mwa a b s + where + !szA = wordArraySize# a + !szB = wordArraySize# b + !sz = maxI# szA szB + +-- | Bitwise OR with Word# +bigNatOrWord# :: BigNat# -> Word# -> BigNat# +bigNatOrWord# a b + | bigNatIsZero a = bigNatFromWord# b + | 0## <- b = a + | True = + let sz = wordArraySize# a + in withNewWordArray# sz \mwa s -> + case mwaArrayCopy# mwa 1# a 1# (sz -# 1#) s of + s' -> mwaWrite# mwa 0# (indexWordArray# a 0# `or#` b) s' + +-- | Bitwise AND +bigNatAnd :: BigNat# -> BigNat# -> BigNat# +bigNatAnd a b + | bigNatIsZero a = a + | bigNatIsZero b = b + | True = withNewWordArrayTrimed# sz \mwa s -> + inline bignat_and mwa a b s + where + !szA = wordArraySize# a + !szB = wordArraySize# b + !sz = minI# szA szB + +-- | Bitwise ANDNOT +bigNatAndNot :: BigNat# -> BigNat# -> BigNat# +bigNatAndNot a b + | bigNatIsZero a = a + | bigNatIsZero b = a + | True = withNewWordArrayTrimed# szA \mwa s -> + inline bignat_and_not mwa a b s + where + !szA = wordArraySize# a + +-- | Bitwise AND with Word# +bigNatAndWord# :: BigNat# -> Word# -> BigNat# +bigNatAndWord# a b + | bigNatIsZero a = a + | True = bigNatFromWord# (indexWordArray# a 0# `and#` b) + +-- | Bitwise ANDNOT with Word# +bigNatAndNotWord# :: BigNat# -> Word# -> BigNat# +bigNatAndNotWord# a b + | bigNatIsZero a = a + | szA <- bigNatSize# a + = withNewWordArray# szA \mwa s -> + -- duplicate higher limbs + case mwaArrayCopy# mwa 1# a 1# (szA -# 1#) s of + s' -> writeWordArray# mwa 0# + (indexWordArray# a 0# `and#` not# b) s' + +-- | Bitwise AND with Int# +bigNatAndInt# :: BigNat# -> Int# -> BigNat# +bigNatAndInt# a b + | bigNatIsZero a = a + | isTrue# (b >=# 0#) = bigNatAndWord# a (int2Word# b) + | szA <- bigNatSize# a + = withNewWordArray# szA \mwa s -> + -- duplicate higher limbs (because of sign-extension of b) + case mwaArrayCopy# mwa 1# a 1# (szA -# 1#) s of + s' -> writeWordArray# mwa 0# + (indexWordArray# a 0# `and#` int2Word# b) s' + + +-- | Bitwise XOR +bigNatXor :: BigNat# -> BigNat# -> BigNat# +bigNatXor a b + | bigNatIsZero a = b + | bigNatIsZero b = a + | True = withNewWordArrayTrimed# sz \mwa s -> + inline bignat_xor mwa a b s + where + !szA = wordArraySize# a + !szB = wordArraySize# b + !sz = maxI# szA szB + +-- | Bitwise XOR with Word# +bigNatXorWord# :: BigNat# -> Word# -> BigNat# +bigNatXorWord# a b + | bigNatIsZero a = bigNatFromWord# b + | 0## <- b = a + | True = + let + sz = wordArraySize# a + in withNewWordArray# sz \mwa s -> + case mwaArrayCopy# mwa 1# a 1# (sz -# 1#) s of + s' -> mwaWrite# mwa 0# (indexWordArray# a 0# `xor#` b) s' + +-- | PopCount for BigNat +bigNatPopCount :: BigNat# -> Word +bigNatPopCount a = W# (bigNatPopCount# a) + +-- | PopCount for BigNat +bigNatPopCount# :: BigNat# -> Word# +bigNatPopCount# a + | bigNatIsZero a = 0## + | True = inline bignat_popcount a + +-- | Bit shift right +bigNatShiftR# :: BigNat# -> Word# -> BigNat# +bigNatShiftR# a n + | 0## <- n + = a + + | isTrue# (wordArraySize# a ==# 0#) + = a + + | nw <- word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) + , isTrue# (nw >=# wordArraySize# a) + = bigNatZero# void# + + | True + = let + !szA = wordArraySize# a + !nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) + !sz = szA -# nw + in withNewWordArrayTrimed# sz \mwa s -> + inline bignat_shiftr mwa a n s + +-- | Bit shift right (two's complement) +bigNatShiftRNeg# :: BigNat# -> Word# -> BigNat# +bigNatShiftRNeg# a n + | 0## <- n + = a + + | isTrue# (wordArraySize# a ==# 0#) + = a + + | nw <- word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) + , isTrue# (nw >=# wordArraySize# a) + = bigNatZero# void# + + | True + = let + !szA = wordArraySize# a + !nw = (word2Int# n -# 1#) `uncheckedIShiftRL#` WORD_SIZE_BITS_SHIFT# + !sz = szA -# nw + in withNewWordArrayTrimed# sz \mwa s -> + inline bignat_shiftr_neg mwa a n s + + +-- | Bit shift right +bigNatShiftR :: BigNat# -> Word -> BigNat# +bigNatShiftR a (W# n) = bigNatShiftR# a n + +-- | Bit shift left +bigNatShiftL :: BigNat# -> Word -> BigNat# +bigNatShiftL a (W# n) = bigNatShiftL# a n + +-- | Bit shift left +bigNatShiftL# :: BigNat# -> Word# -> BigNat# +bigNatShiftL# a n + | 0## <- n + = a + + | isTrue# (wordArraySize# a ==# 0#) + = a + + | True + = let + !szA = wordArraySize# a + !nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) + !nb = word2Int# (n `and#` WORD_SIZE_BITS_MASK##) + !sz = szA +# nw +# (nb /=# 0#) + + in withNewWordArrayTrimed# sz \mwa s -> + inline bignat_shiftl mwa a n s + + +-- | BigNat bit test +bigNatTestBit# :: BigNat# -> Word# -> Bool# +bigNatTestBit# a n = + let + !sz = wordArraySize# a + !nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) + !nb = n `and#` WORD_SIZE_BITS_MASK## + in if + | isTrue# (nw >=# sz) -> 0# + | True -> testBitW# (indexWordArray# a nw) nb + +-- | BigNat bit test +bigNatTestBit :: BigNat# -> Word -> Bool +bigNatTestBit a (W# n) = isTrue# (bigNatTestBit# a n) + + +-- | Return a BigNat whose bit `i` is the only one set. +-- +-- Specialized version of `bigNatShiftL (bigNatFromWord# 1##)` +-- +bigNatBit# :: Word# -> BigNat# +bigNatBit# i + | 0## <- i = bigNatOne# void# + | True = + let + !nw = word2Int# (i `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) + !nb = word2Int# (i `and#` WORD_SIZE_BITS_MASK##) + !sz = nw +# 1# + !v = 1## `uncheckedShiftL#` nb + in withNewWordArray# sz \mwa s -> + -- clear the array + case mwaFill# mwa 0## 0## (int2Word# sz) s of + -- set the bit in the most-significant word + s2 -> mwaWrite# mwa (sz -# 1#) v s2 + +-- | Return a BigNat whose bit `i` is the only one set. +-- +-- Specialized version of `bigNatShiftL (bigNatFromWord# 1##)` +-- +bigNatBit :: Word -> BigNat# +bigNatBit (W# i) = bigNatBit# i + +-- | BigNat clear bit +bigNatClearBit# :: BigNat# -> Word# -> BigNat# +bigNatClearBit# a n + -- check the range validity and the current bit value + | isTrue# (bigNatTestBit# a n ==# 0#) = a + | True + = let + !sz = wordArraySize# a + !nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) + !nb = word2Int# (n `and#` WORD_SIZE_BITS_MASK##) + !nv = bigNatIndex# a nw `xor#` bitW# nb + in if + | isTrue# (sz ==# 1#) + -> bigNatFromWord# nv + + -- special case, operating on most-significant Word + | 0## <- nv + , isTrue# (nw +# 1# ==# sz) + -> case sz -# (waClzAt a (sz -# 2#) +# 1#) of + 0# -> bigNatZero# void# + nsz -> withNewWordArray# nsz \mwa s -> + mwaArrayCopy# mwa 0# a 0# nsz s + + | True -> + withNewWordArray# sz \mwa s -> + case mwaArrayCopy# mwa 0# a 0# sz s of + s' -> writeWordArray# mwa nw nv s' + +-- | BigNat set bit +bigNatSetBit# :: BigNat# -> Word# -> BigNat# +bigNatSetBit# a n + -- check the current bit value + | isTrue# (bigNatTestBit# a n) = a + | True + = let + !sz = wordArraySize# a + !nw = word2Int# (n `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) + !nb = word2Int# (n `and#` WORD_SIZE_BITS_MASK##) + d = nw +# 1# -# sz + in if + -- result BigNat will have more limbs + | isTrue# (d ># 0#) + -> withNewWordArray# (nw +# 1#) \mwa s -> + case mwaArrayCopy# mwa 0# a 0# sz s of + s' -> case mwaFill# mwa 0## (int2Word# sz) (int2Word# (d -# 1#)) s' of + s'' -> writeWordArray# mwa nw (bitW# nb) s'' + + | nv <- bigNatIndex# a nw `or#` bitW# nb + -> withNewWordArray# sz \mwa s -> + case mwaArrayCopy# mwa 0# a 0# sz s of + s' -> writeWordArray# mwa nw nv s' + +-- | Reverse the given bit +bigNatComplementBit# :: BigNat# -> Word# -> BigNat# +bigNatComplementBit# bn i + | isTrue# (bigNatTestBit# bn i) = bigNatClearBit# bn i + | True = bigNatSetBit# bn i + +------------------------------------------------- +-- Log operations +------------------------------------------------- + +-- | Base 2 logarithm +bigNatLog2# :: BigNat# -> Word# +bigNatLog2# a + | bigNatIsZero a = 0## + | True = + let i = int2Word# (bigNatSize# a) `minusWord#` 1## + in wordLog2# (bigNatIndex# a (word2Int# i)) + `plusWord#` (i `uncheckedShiftL#` WORD_SIZE_BITS_SHIFT#) + +-- | Base 2 logarithm +bigNatLog2 :: BigNat# -> Word +bigNatLog2 a = W# (bigNatLog2# a) + +-- | Logarithm for an arbitrary base +bigNatLogBase# :: BigNat# -> BigNat# -> Word# +bigNatLogBase# base a + | bigNatIsZero base || bigNatIsOne base + = unexpectedValue_Word# void# + + | 1# <- bigNatSize# base + , 2## <- bigNatIndex# base 0# + = bigNatLog2# a + + -- TODO: optimize log base power of 2 (256, etc.) + + | True + = case go base of (# _, e' #) -> e' + where + go pw = if a `bigNatLt` pw + then (# a, 0## #) + else case go (bigNatSqr pw) of + (# q, e #) -> if q `bigNatLt` pw + then (# q, 2## `timesWord#` e #) + else (# q `bigNatQuot` pw + , (2## `timesWord#` e) `plusWord#` 1## #) + +-- | Logarithm for an arbitrary base +bigNatLogBase :: BigNat# -> BigNat# -> Word +bigNatLogBase base a = W# (bigNatLogBase# base a) + +-- | Logarithm for an arbitrary base +bigNatLogBaseWord# :: Word# -> BigNat# -> Word# +bigNatLogBaseWord# base a + | 0## <- base = unexpectedValue_Word# void# + | 1## <- base = unexpectedValue_Word# void# + | 2## <- base = bigNatLog2# a + -- TODO: optimize log base power of 2 (256, etc.) + | True = bigNatLogBase# (bigNatFromWord# base) a + +-- | Logarithm for an arbitrary base +bigNatLogBaseWord :: Word -> BigNat# -> Word +bigNatLogBaseWord (W# base) a = W# (bigNatLogBaseWord# base a) + +------------------------------------------------- +-- Various +------------------------------------------------- + +-- | Compute the number of digits of the BigNat in the given base. +-- +-- `base` must be > 1 +bigNatSizeInBase# :: Word# -> BigNat# -> Word# +bigNatSizeInBase# base a + | isTrue# (base `leWord#` 1##) + = unexpectedValue_Word# void# + + | bigNatIsZero a + = 0## + + | True + = bigNatLogBaseWord# base a `plusWord#` 1## + +-- | Compute the number of digits of the BigNat in the given base. +-- +-- `base` must be > 1 +bigNatSizeInBase :: Word -> BigNat# -> Word +bigNatSizeInBase (W# w) a = W# (bigNatSizeInBase# w a) + +------------------------------------------------- +-- PowMod +------------------------------------------------- + +-- Word# powMod shouldn't be here in BigNat. However GMP provides a very fast +-- implementation so we keep this here at least until we get a native Haskell +-- implementation as fast as GMP's one. + +powModWord# :: Word# -> Word# -> Word# -> Word# +powModWord# = bignat_powmod_words + + +-- | \"@'bigNatPowModWord#' /b/ /e/ /m/@\" computes base @/b/@ raised to +-- exponent @/e/@ modulo @/m/@. +bigNatPowModWord# :: BigNat# -> BigNat# -> Word# -> Word# +bigNatPowModWord# !_ !_ 0## = raiseDivZero_Word# void# +bigNatPowModWord# _ _ 1## = 0## +bigNatPowModWord# b e m + | bigNatIsZero e = 1## + | bigNatIsZero b = 0## + | bigNatIsOne b = 1## + | True = bignat_powmod_word b e m + +-- | \"@'bigNatPowMod' /b/ /e/ /m/@\" computes base @/b/@ raised to +-- exponent @/e/@ modulo @/m/@. +bigNatPowMod :: BigNat# -> BigNat# -> BigNat# -> BigNat# +bigNatPowMod !b !e !m + | (# | m' #) <- bigNatToWordMaybe# m + = bigNatFromWord# (bigNatPowModWord# b e m') + | bigNatIsZero m = raiseDivZero_BigNat void# + | bigNatIsOne m = bigNatFromWord# 0## + | bigNatIsZero e = bigNatFromWord# 1## + | bigNatIsZero b = bigNatFromWord# 0## + | bigNatIsOne b = bigNatFromWord# 1## + | True = withNewWordArrayTrimed# (bigNatSize# m) \mwa s -> + inline bignat_powmod mwa b e m s + +-- | Return count of trailing zero bits +-- +-- Return 0 for zero BigNat +bigNatCtz# :: BigNat# -> Word# +bigNatCtz# a + | bigNatIsZero a = 0## + | True = go 0# 0## + where + go i c = case indexWordArray# a i of + 0## -> go (i +# 1#) (c `plusWord#` WORD_SIZE_IN_BITS##) + w -> ctz# w `plusWord#` c + +-- | Return count of trailing zero bits +-- +-- Return 0 for zero BigNat +bigNatCtz :: BigNat# -> Word +bigNatCtz a = W# (bigNatCtz# a) + + +-- | Return count of trailing zero words +-- +-- Return 0 for zero BigNat +bigNatCtzWord# :: BigNat# -> Word# +bigNatCtzWord# a + | bigNatIsZero a = 0## + | True = go 0# 0## + where + go i c = case indexWordArray# a i of + 0## -> go (i +# 1#) (c `plusWord#` 1##) + _ -> c + +-- | Return count of trailing zero words +-- +-- Return 0 for zero BigNat +bigNatCtzWord :: BigNat# -> Word +bigNatCtzWord a = W# (bigNatCtzWord# a) + +------------------------------------------------- +-- Export to memory +------------------------------------------------- + +-- | Write a BigNat in base-256 little-endian representation and return the +-- number of bytes written. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +bigNatToAddrLE# :: BigNat# -> Addr# -> State# s -> (# State# s, Word# #) +bigNatToAddrLE# a addr s0 + | isTrue# (sz ==# 0#) = (# s0, 0## #) + | True = case writeMSB s0 of + (# s1, k #) -> case go 0# s1 of + s2 -> (# s2, k `plusWord#` (int2Word# li `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #) + where + !sz = wordArraySize# a + !li = sz -# 1# + + writeMSB = wordToAddrLE# (indexWordArray# a li) + (addr `plusAddr#` (li `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#)) + + go i s + | isTrue# (i <# li) + , off <- i `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT# + , w <- indexWordArray# a i + = case wordWriteAddrLE# w (addr `plusAddr#` off) s of + s -> go (i +# 1#) s + + | True + = s + +-- | Write a BigNat in base-256 big-endian representation and return the +-- number of bytes written. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +bigNatToAddrBE# :: BigNat# -> Addr# -> State# s -> (# State# s, Word# #) +bigNatToAddrBE# a addr s0 + | isTrue# (sz ==# 0#) = (# s0, 0## #) + | msw <- indexWordArray# a (sz -# 1#) + = case wordToAddrBE# msw addr s0 of + (# s1, k #) -> case go (sz -# 1#) (addr `plusAddr#` word2Int# k) s1 of + s2 -> (# s2, k `plusWord#` (int2Word# (sz -# 1#) `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #) + where + sz = wordArraySize# a + + go i adr s + | 0# <- i + = s + + | w <- indexWordArray# a (i -# 1#) + = case wordWriteAddrBE# w adr s of + s' -> go (i -# 1#) + (adr `plusAddr#` WORD_SIZE_IN_BYTES# ) s' + + +-- | Write a BigNat in base-256 representation and return the +-- number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +bigNatToAddr# :: BigNat# -> Addr# -> Bool# -> State# s -> (# State# s, Word# #) +bigNatToAddr# a addr 0# s = bigNatToAddrLE# a addr s +bigNatToAddr# a addr _ s = bigNatToAddrBE# a addr s + +-- | Write a BigNat in base-256 representation and return the +-- number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +bigNatToAddr :: BigNat# -> Addr# -> Bool# -> IO Word +bigNatToAddr a addr e = IO \s -> case bigNatToAddr# a addr e s of + (# s', w #) -> (# s', W# w #) + + + +------------------------------------------------- +-- Import from memory +------------------------------------------------- + +-- | Read a BigNat in base-256 little-endian representation from an Addr#. +-- +-- The size is given in bytes. +-- +-- Higher limbs equal to 0 are automatically trimed. +bigNatFromAddrLE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat# #) +bigNatFromAddrLE# 0## _ s = (# s, bigNatZero# void# #) +bigNatFromAddrLE# sz addr s = + let + !nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT# + !nb = sz `and#` WORD_SIZE_BYTES_MASK## + + readMSB mwa s + | 0## <- nb + = s + + | off <- word2Int# (nw `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) + = case wordFromAddrLE# nb (addr `plusAddr#` off) s of + (# s, w #) -> mwaWrite# mwa (word2Int# nw) w s + + go mwa i s + | isTrue# (i ==# word2Int# nw) + = s + + | off <- i `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT# + = case wordFromAddrLE# WORD_SIZE_IN_BYTES## (addr `plusAddr#` off) s of + (# s, w #) -> case mwaWrite# mwa i w s of + s -> go mwa (i +# 1#) s + + in case newWordArray# (word2Int# nw +# (word2Int# nb /=# 0#)) s of + (# s, mwa #) -> case readMSB mwa s of + s -> case go mwa 0# s of + s -> case mwaTrimZeroes# mwa s of + s -> unsafeFreezeByteArray# mwa s + +-- | Read a BigNat in base-256 big-endian representation from an Addr#. +-- +-- The size is given in bytes. +-- +-- Null higher limbs are automatically trimed. +bigNatFromAddrBE# :: Word# -> Addr# -> State# s -> (# State# s, BigNat# #) +bigNatFromAddrBE# 0## _ s = (# s, bigNatZero# void# #) +bigNatFromAddrBE# sz addr s = + let + !nw = word2Int# (sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT#) + !nb = sz `and#` WORD_SIZE_BYTES_MASK## + + goMSB mwa s + | 0## <- nb + = s + + | True + = case wordFromAddrBE# nb addr s of + (# s, w #) -> mwaWrite# mwa nw w s + + go mwa i s + | isTrue# (i ==# nw) + = s + + | k <- nw -# 1# -# i + , off <- (k `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#) +# word2Int# nb + = case wordFromAddrBE# WORD_SIZE_IN_BYTES## (addr `plusAddr#` off) s of + (# s, w #) -> case mwaWrite# mwa i w s of + s -> go mwa (i +# 1#) s + + in case newWordArray# (nw +# (word2Int# nb /=# 0#)) s of + (# s, mwa #) -> case goMSB mwa s of + s -> case go mwa 0# s of + s -> case mwaTrimZeroes# mwa s of + s -> unsafeFreezeByteArray# mwa s + +-- | Read a BigNat in base-256 representation from an Addr#. +-- +-- The size is given in bytes. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Null higher limbs are automatically trimed. +bigNatFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, BigNat# #) +bigNatFromAddr# sz addr 0# s = bigNatFromAddrLE# sz addr s +bigNatFromAddr# sz addr _ s = bigNatFromAddrBE# sz addr s + +------------------------------------------------- +-- Export to ByteArray +------------------------------------------------- + +-- | Write a BigNat in base-256 little-endian representation and return the +-- number of bytes written. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +bigNatToMutableByteArrayLE# :: BigNat# -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #) +bigNatToMutableByteArrayLE# a mba moff s0 + | isTrue# (sz ==# 0#) = (# s0, 0## #) + | True = case writeMSB s0 of + (# s1, k #) -> case go 0# s1 of + s2 -> (# s2, k `plusWord#` (int2Word# li `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #) + where + !sz = wordArraySize# a + !li = sz -# 1# + + writeMSB = wordToMutableByteArrayLE# (indexWordArray# a li) + mba (moff `plusWord#` int2Word# (li `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT#)) + + go i s + | isTrue# (i <# li) + , off <- int2Word# i `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT# + , w <- indexWordArray# a i + = case wordWriteMutableByteArrayLE# w mba (moff `plusWord#` off) s of + s -> go (i +# 1#) s + + | True + = s + +-- | Write a BigNat in base-256 big-endian representation and return the +-- number of bytes written. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +bigNatToMutableByteArrayBE# :: BigNat# -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #) +bigNatToMutableByteArrayBE# a mba moff s0 + | isTrue# (sz ==# 0#) = (# s0, 0## #) + | msw <- indexWordArray# a (sz -# 1#) + = case wordToMutableByteArrayBE# msw mba moff s0 of + (# s1, k #) -> case go (sz -# 1#) k s1 of + s2 -> (# s2, k `plusWord#` (int2Word# (sz -# 1#) `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) #) + where + sz = wordArraySize# a + + go i c s + | 0# <- i + = s + + | w <- indexWordArray# a (i -# 1#) + = case wordWriteMutableByteArrayBE# w mba (moff `plusWord#` c) s of + s' -> go (i -# 1#) + (c `plusWord#` WORD_SIZE_IN_BYTES## ) s' + + +-- | Write a BigNat in base-256 representation and return the +-- number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Use \"@'bigNatSizeInBase' 256# /i/@\" to compute the exact number of bytes +-- written in advance. In case of @/i/ == 0@, the function will write and report +-- zero bytes written. +bigNatToMutableByteArray# :: BigNat# -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #) +bigNatToMutableByteArray# a mba off 0# s = bigNatToMutableByteArrayLE# a mba off s +bigNatToMutableByteArray# a mba off _ s = bigNatToMutableByteArrayBE# a mba off s + +------------------------------------------------- +-- Import from ByteArray +------------------------------------------------- + +-- | Read a BigNat in base-256 little-endian representation from a ByteArray#. +-- +-- The size is given in bytes. +-- +-- Null higher limbs are automatically trimed. +bigNatFromByteArrayLE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat# #) +bigNatFromByteArrayLE# 0## _ _ s = (# s, bigNatZero# void# #) +bigNatFromByteArrayLE# sz ba moff s = + let + !nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT# + !nb = sz `and#` WORD_SIZE_BYTES_MASK## + + readMSB mwa s + | 0## <- nb + = s + + | off <- nw `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT# + = case wordFromByteArrayLE# nb ba (moff `plusWord#` off) of + w -> mwaWrite# mwa (word2Int# nw) w s + + go mwa i s + | isTrue# (i `eqWord#` nw) + = s + + | off <- i `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT# + = case wordFromByteArrayLE# WORD_SIZE_IN_BYTES## ba (moff `plusWord#` off) of + w -> case mwaWrite# mwa (word2Int# i) w s of + s -> go mwa (i `plusWord#` 1##) s + + in case newWordArray# (word2Int# nw +# (word2Int# nb /=# 0#)) s of + (# s, mwa #) -> case readMSB mwa s of + s -> case go mwa 0## s of + s -> case mwaTrimZeroes# mwa s of + s -> unsafeFreezeByteArray# mwa s + +-- | Read a BigNat in base-256 big-endian representation from a ByteArray#. +-- +-- The size is given in bytes. +-- +-- Null higher limbs are automatically trimed. +bigNatFromByteArrayBE# :: Word# -> ByteArray# -> Word# -> State# s -> (# State# s, BigNat# #) +bigNatFromByteArrayBE# 0## _ _ s = (# s, bigNatZero# void# #) +bigNatFromByteArrayBE# sz ba moff s = + let + !nw = sz `uncheckedShiftRL#` WORD_SIZE_BYTES_SHIFT# + !nb = sz `and#` WORD_SIZE_BYTES_MASK## + + goMSB mwa s + | 0## <- nb + = s + + | True + = case wordFromByteArrayBE# nb ba moff of + w -> mwaWrite# mwa (word2Int# nw) w s + + go mwa i s + | isTrue# (i `eqWord#` nw) + = s + + | k <- nw `minusWord#` 1## `minusWord#` i + , off <- (k `uncheckedShiftL#` WORD_SIZE_BYTES_SHIFT#) `plusWord#` nb + = case wordFromByteArrayBE# WORD_SIZE_IN_BYTES## ba (moff `plusWord#` off) of + w -> case mwaWrite# mwa (word2Int# i) w s of + s -> go mwa (i `plusWord#` 1##) s + + in case newWordArray# (word2Int# nw +# (word2Int# nb /=# 0#)) s of + (# s, mwa #) -> case goMSB mwa s of + s -> case go mwa 0## s of + s -> case mwaTrimZeroes# mwa s of + s -> unsafeFreezeByteArray# mwa s + +-- | Read a BigNat in base-256 representation from a ByteArray#. +-- +-- The size is given in bytes. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Null higher limbs are automatically trimed. +bigNatFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, BigNat# #) +bigNatFromByteArray# sz ba off 0# s = bigNatFromByteArrayLE# sz ba off s +bigNatFromByteArray# sz ba off _ s = bigNatFromByteArrayBE# sz ba off s + + + + +-- | Create a BigNat# from a WordArray# containing /n/ limbs in +-- least-significant-first order. +-- +-- If possible 'WordArray#', will be used directly (i.e. shared +-- /without/ cloning the 'WordArray#' into a newly allocated one) +bigNatFromWordArray# :: WordArray# -> Word# -> BigNat# +bigNatFromWordArray# wa n0 + | isTrue# (n `eqWord#` 0##) + = bigNatZero# void# + + | isTrue# (r `eqWord#` 0##) -- i.e. wa is multiple of limb-size + , isTrue# (q `eqWord#` n) + = wa + + | True = withNewWordArray# (word2Int# n) \mwa s -> + mwaArrayCopy# mwa 0# wa 0# (word2Int# n) s + where + !(# q, r #) = quotRemWord# (int2Word# (sizeofByteArray# wa)) + WORD_SIZE_IN_BYTES## + -- find real size in Words by removing trailing null limbs + !n = real_size n0 + real_size 0## = 0## + real_size i + | 0## <- bigNatIndex# wa (word2Int# (i `minusWord#` 1##)) + = real_size (i `minusWord#` 1##) + real_size i = i + + +-- | Create a BigNat from a WordArray# containing /n/ limbs in +-- least-significant-first order. +-- +-- If possible 'WordArray#', will be used directly (i.e. shared +-- /without/ cloning the 'WordArray#' into a newly allocated one) +bigNatFromWordArray :: WordArray# -> Word# -> BigNat +bigNatFromWordArray wa n = BN# (bigNatFromWordArray# wa n) diff --git a/src/GHC/Num/BigNat.hs-boot b/src/GHC/Num/BigNat.hs-boot new file mode 100644 --- /dev/null +++ b/src/GHC/Num/BigNat.hs-boot @@ -0,0 +1,23 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} + +module GHC.Num.BigNat where + +import GHC.Num.WordArray +import GHC.Num.Primitives +import GHC.Prim + +type BigNat# = WordArray# +data BigNat = BN# { unBigNat :: BigNat# } + +bigNatIsZero# :: BigNat# -> Bool# +bigNatSize# :: BigNat# -> Int# +bigNatSubUnsafe :: BigNat# -> BigNat# -> BigNat# +bigNatMulWord# :: BigNat# -> Word# -> BigNat# +bigNatRem :: BigNat# -> BigNat# -> BigNat# +bigNatRemWord# :: BigNat# -> Word# -> Word# +bigNatShiftR# :: BigNat# -> Word# -> BigNat# +bigNatShiftL# :: BigNat# -> Word# -> BigNat# +bigNatCtz# :: BigNat# -> Word# +bigNatCtzWord# :: BigNat# -> Word# diff --git a/src/GHC/Num/Integer.hs b/src/GHC/Num/Integer.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Integer.hs @@ -0,0 +1,1286 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE BinaryLiterals #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE LambdaCase #-} + +-- | +-- Module : GHC.Num.Integer +-- Copyright : (c) Sylvain Henry 2019, +-- (c) Herbert Valerio Riedel 2014 +-- License : BSD3 +-- +-- Maintainer : sylvain@haskus.fr +-- Stability : provisional +-- Portability : non-portable (GHC Extensions) +-- +-- The 'Integer' type. + +module GHC.Num.Integer where + +#include "MachDeps.h" +#include "WordSize.h" + +import GHC.Prim +import GHC.Types +import GHC.Classes +import GHC.Magic +import GHC.Num.Primitives +import GHC.Num.BigNat +import GHC.Num.Natural +import qualified GHC.Num.Backend as Backend + +#if WORD_SIZE_IN_BITS < 64 +import GHC.IntWord64 +#endif + +default () + +-- | Arbitrary precision integers. In contrast with fixed-size integral types +-- such as 'Int', the 'Integer' type represents the entire infinite range of +-- integers. +-- +-- Integers are stored in a kind of sign-magnitude form, hence do not expect +-- two's complement form when using bit operations. +-- +-- If the value is small (fit into an 'Int'), 'IS' constructor is used. +-- Otherwise 'IP' and 'IN' constructors are used to store a 'BigNat' +-- representing respectively the positive or the negative value magnitude. +-- +-- Invariant: 'IP' and 'IN' are used iff value doesn't fit in 'IS' +data Integer + = IS !Int# -- ^ iff value in @[minBound::'Int', maxBound::'Int']@ range + | IP !BigNat# -- ^ iff value in @]maxBound::'Int', +inf[@ range + | IN !BigNat# -- ^ iff value in @]-inf, minBound::'Int'[@ range + + +-- | Check Integer invariants +integerCheck# :: Integer -> Bool# +integerCheck# (IS _) = 1# +integerCheck# (IP bn) = bigNatCheck# bn &&# (bn `bigNatGtWord#` INT_MAXBOUND##) +integerCheck# (IN bn) = bigNatCheck# bn &&# (bn `bigNatGtWord#` ABS_INT_MINBOUND##) + +-- | Check Integer invariants +integerCheck :: Integer -> Bool +integerCheck i = isTrue# (integerCheck# i) + +-- | Integer Zero +integerZero :: Integer +integerZero = IS 0# + +-- | Integer One +integerOne :: Integer +integerOne = IS 1# + +--------------------------------------------------------------------- +-- Conversions +--------------------------------------------------------------------- + +-- | Create a positive Integer from a BigNat +integerFromBigNat# :: BigNat# -> Integer +integerFromBigNat# !bn + | bigNatIsZero bn + = integerZero + + | isTrue# (bn `bigNatLeWord#` INT_MAXBOUND##) + = IS (word2Int# (bigNatIndex# bn 0#)) + + | True + = IP bn + +-- | Create a negative Integer from a BigNat +integerFromBigNatNeg# :: BigNat# -> Integer +integerFromBigNatNeg# !bn + | bigNatIsZero bn + = integerZero + + | 1# <- bigNatSize# bn + , i <- negateInt# (word2Int# (bigNatIndex# bn 0#)) + , isTrue# (i <=# 0#) + = IS i + + | True + = IN bn + +-- | Create an Integer from a sign-bit and a BigNat +integerFromBigNatSign# :: Int# -> BigNat# -> Integer +integerFromBigNatSign# !sign !bn + | 0# <- sign + = integerFromBigNat# bn + + | True + = integerFromBigNatNeg# bn + +-- | Convert an Integer into a sign-bit and a BigNat +integerToBigNatSign# :: Integer -> (# Int#, BigNat# #) +integerToBigNatSign# = \case + IS x + | isTrue# (x >=# 0#) + -> (# 0#, bigNatFromWord# (int2Word# x) #) + | True + -> (# 1#, bigNatFromWord# (int2Word# (negateInt# x)) #) + IP x -> (# 0#, x #) + IN x -> (# 1#, x #) + +-- | Convert an Integer into a BigNat. +-- +-- Return 0 for negative Integers. +integerToBigNatClamp# :: Integer -> BigNat# +integerToBigNatClamp# (IP x) = x +integerToBigNatClamp# (IS x) + | isTrue# (x >=# 0#) = bigNatFromWord# (int2Word# x) +integerToBigNatClamp# _ = bigNatZero# void# + +-- | Create an Integer from an Int# +integerFromInt# :: Int# -> Integer +integerFromInt# i = IS i + +-- | Create an Integer from an Int +integerFromInt :: Int -> Integer +integerFromInt (I# i) = IS i + +-- | Truncates 'Integer' to least-significant 'Int#' +integerToInt# :: Integer -> Int# +{-# NOINLINE integerToInt# #-} +integerToInt# (IS i) = i +integerToInt# (IP b) = word2Int# (bigNatToWord# b) +integerToInt# (IN b) = negateInt# (word2Int# (bigNatToWord# b)) + +-- | Truncates 'Integer' to least-significant 'Int#' +integerToInt :: Integer -> Int +integerToInt i = I# (integerToInt# i) + +-- | Convert a Word# into an Integer +integerFromWord# :: Word# -> Integer +{-# NOINLINE integerFromWord# #-} +integerFromWord# w + | i <- word2Int# w + , isTrue# (i >=# 0#) + = IS i + + | True + = IP (bigNatFromWord# w) + +-- | Convert a Word into an Integer +integerFromWord :: Word -> Integer +integerFromWord (W# w) = integerFromWord# w + +-- | Create a negative Integer with the given Word magnitude +integerFromWordNeg# :: Word# -> Integer +integerFromWordNeg# w + | isTrue# (w `leWord#` ABS_INT_MINBOUND##) + = IS (negateInt# (word2Int# w)) + + | True + = IN (bigNatFromWord# w) + +-- | Create an Integer from a sign and a Word magnitude +integerFromWordSign# :: Int# -> Word# -> Integer +integerFromWordSign# 0# w = integerFromWord# w +integerFromWordSign# _ w = integerFromWordNeg# w + +-- | Truncate an Integer into a Word +integerToWord# :: Integer -> Word# +{-# NOINLINE integerToWord# #-} +integerToWord# (IS i) = int2Word# i +integerToWord# (IP bn) = bigNatToWord# bn +integerToWord# (IN bn) = int2Word# (negateInt# (word2Int# (bigNatToWord# bn))) + +-- | Truncate an Integer into a Word +integerToWord :: Integer -> Word +integerToWord !i = W# (integerToWord# i) + +-- | Convert a Natural into an Integer +integerFromNatural :: Natural -> Integer +{-# NOINLINE integerFromNatural #-} +integerFromNatural (NS x) = integerFromWord# x +integerFromNatural (NB x) = integerFromBigNat# x + +-- | Convert a list of Word into an Integer +integerFromWordList :: Bool -> [Word] -> Integer +integerFromWordList True ws = integerFromBigNatNeg# (bigNatFromWordList ws) +integerFromWordList False ws = integerFromBigNat# (bigNatFromWordList ws) + +-- | Convert an Integer into a Natural +-- +-- Return 0 for negative Integers. +integerToNaturalClamp :: Integer -> Natural +{-# NOINLINE integerToNaturalClamp #-} +integerToNaturalClamp (IS x) + | isTrue# (x <# 0#) = naturalZero + | True = naturalFromWord# (int2Word# x) +integerToNaturalClamp (IP x) = naturalFromBigNat# x +integerToNaturalClamp (IN _) = naturalZero + +-- | Convert an Integer into a Natural +-- +-- Return absolute value +integerToNatural :: Integer -> Natural +{-# NOINLINE integerToNatural #-} +integerToNatural (IS x) = naturalFromWord# (wordFromAbsInt# x) +integerToNatural (IP x) = naturalFromBigNat# x +integerToNatural (IN x) = naturalFromBigNat# x + +-- | Convert an Integer into a Natural +-- +-- Throw an Underflow exception if input is negative. +integerToNaturalThrow :: Integer -> Natural +{-# NOINLINE integerToNaturalThrow #-} +integerToNaturalThrow (IS x) + | isTrue# (x <# 0#) = raiseUnderflow + | True = naturalFromWord# (int2Word# x) +integerToNaturalThrow (IP x) = naturalFromBigNat# x +integerToNaturalThrow (IN _) = raiseUnderflow + +--------------------------------------------------------------------- +-- Predicates +--------------------------------------------------------------------- + +-- | Negative predicate +integerIsNegative# :: Integer -> Bool# +integerIsNegative# (IS i#) = i# <# 0# +integerIsNegative# (IP _) = 0# +integerIsNegative# (IN _) = 1# + +-- | Negative predicate +integerIsNegative :: Integer -> Bool +integerIsNegative !i = isTrue# (integerIsNegative# i) + +-- | Zero predicate +integerIsZero :: Integer -> Bool +integerIsZero (IS 0#) = True +integerIsZero _ = False + +-- | One predicate +integerIsOne :: Integer -> Bool +integerIsOne (IS 1#) = True +integerIsOne _ = False + +-- | Not-equal predicate. +integerNe :: Integer -> Integer -> Bool +integerNe !x !y = isTrue# (integerNe# x y) + +-- | Equal predicate. +integerEq :: Integer -> Integer -> Bool +integerEq !x !y = isTrue# (integerEq# x y) + +-- | Lower-or-equal predicate. +integerLe :: Integer -> Integer -> Bool +integerLe !x !y = isTrue# (integerLe# x y) + +-- | Lower predicate. +integerLt :: Integer -> Integer -> Bool +integerLt !x !y = isTrue# (integerLt# x y) + +-- | Greater predicate. +integerGt :: Integer -> Integer -> Bool +integerGt !x !y = isTrue# (integerGt# x y) + +-- | Greater-or-equal predicate. +integerGe :: Integer -> Integer -> Bool +integerGe !x !y = isTrue# (integerGe# x y) + +-- | Equal predicate. +integerEq# :: Integer -> Integer -> Bool# +{-# NOINLINE integerEq# #-} +integerEq# (IS x) (IS y) = x ==# y +integerEq# (IN x) (IN y) = bigNatEq# x y +integerEq# (IP x) (IP y) = bigNatEq# x y +integerEq# _ _ = 0# + +-- | Not-equal predicate. +integerNe# :: Integer -> Integer -> Bool# +{-# NOINLINE integerNe# #-} +integerNe# (IS x) (IS y) = x /=# y +integerNe# (IN x) (IN y) = bigNatNe# x y +integerNe# (IP x) (IP y) = bigNatNe# x y +integerNe# _ _ = 1# + +-- | Greater predicate. +integerGt# :: Integer -> Integer -> Bool# +{-# NOINLINE integerGt# #-} +integerGt# (IS x) (IS y) = x ># y +integerGt# x y | GT <- integerCompare' x y = 1# +integerGt# _ _ = 0# + +-- | Lower-or-equal predicate. +integerLe# :: Integer -> Integer -> Bool# +{-# NOINLINE integerLe# #-} +integerLe# (IS x) (IS y) = x <=# y +integerLe# x y | GT <- integerCompare' x y = 0# +integerLe# _ _ = 1# + +-- | Lower predicate. +integerLt# :: Integer -> Integer -> Bool# +{-# NOINLINE integerLt# #-} +integerLt# (IS x) (IS y) = x <# y +integerLt# x y | LT <- integerCompare' x y = 1# +integerLt# _ _ = 0# + +-- | Greater-or-equal predicate. +integerGe# :: Integer -> Integer -> Bool# +{-# NOINLINE integerGe# #-} +integerGe# (IS x) (IS y) = x >=# y +integerGe# x y | LT <- integerCompare' x y = 0# +integerGe# _ _ = 1# + +instance Eq Integer where + (==) = integerEq + (/=) = integerNe + +-- | Compare two Integer +integerCompare :: Integer -> Integer -> Ordering +{-# NOINLINE integerCompare #-} +integerCompare = integerCompare' + +integerCompare' :: Integer -> Integer -> Ordering +{-# INLINE integerCompare' #-} +integerCompare' (IS x) (IS y) = compareInt# x y +integerCompare' (IP x) (IP y) = bigNatCompare x y +integerCompare' (IN x) (IN y) = bigNatCompare y x +integerCompare' (IS _) (IP _) = LT +integerCompare' (IS _) (IN _) = GT +integerCompare' (IP _) (IS _) = GT +integerCompare' (IN _) (IS _) = LT +integerCompare' (IP _) (IN _) = GT +integerCompare' (IN _) (IP _) = LT + +instance Ord Integer where + compare = integerCompare + (<) = integerLt + (<=) = integerLe + (>) = integerGt + (>=) = integerGe + +--------------------------------------------------------------------- +-- Operations +--------------------------------------------------------------------- + +-- | Subtract one 'Integer' from another. +integerSub :: Integer -> Integer -> Integer +{-# NOINLINE integerSub #-} +integerSub !x (IS 0#) = x +integerSub (IS x#) (IS y#) + = case subIntC# x# y# of + (# z#, 0# #) -> IS z# + (# 0#, _ #) -> IN (bigNatFromWord2# 1## 0##) + (# z#, _ #) + | isTrue# (z# ># 0#) + -> IN (bigNatFromWord# ( (int2Word# (negateInt# z#)))) + | True + -> IP (bigNatFromWord# ( (int2Word# z#))) +integerSub (IS x#) (IP y) + | isTrue# (x# >=# 0#) + = integerFromBigNatNeg# (bigNatSubWordUnsafe# y (int2Word# x#)) + | True + = IN (bigNatAddWord# y (int2Word# (negateInt# x#))) +integerSub (IS x#) (IN y) + | isTrue# (x# >=# 0#) + = IP (bigNatAddWord# y (int2Word# x#)) + | True + = integerFromBigNat# (bigNatSubWordUnsafe# y (int2Word# (negateInt# x#))) +integerSub (IP x) (IP y) + = case bigNatCompare x y of + LT -> integerFromBigNatNeg# (bigNatSubUnsafe y x) + EQ -> IS 0# + GT -> integerFromBigNat# (bigNatSubUnsafe x y) +integerSub (IP x) (IN y) = IP (bigNatAdd x y) +integerSub (IN x) (IP y) = IN (bigNatAdd x y) +integerSub (IN x) (IN y) + = case bigNatCompare x y of + LT -> integerFromBigNat# (bigNatSubUnsafe y x) + EQ -> IS 0# + GT -> integerFromBigNatNeg# (bigNatSubUnsafe x y) +integerSub (IP x) (IS y#) + | isTrue# (y# >=# 0#) + = integerFromBigNat# (bigNatSubWordUnsafe# x (int2Word# y#)) + | True + = IP (bigNatAddWord# x (int2Word# (negateInt# y#))) +integerSub (IN x) (IS y#) + | isTrue# (y# >=# 0#) + = IN (bigNatAddWord# x (int2Word# y#)) + | True + = integerFromBigNatNeg# (bigNatSubWordUnsafe# x (int2Word# (negateInt# y#))) + +-- | Add two 'Integer's +integerAdd :: Integer -> Integer -> Integer +{-# NOINLINE integerAdd #-} +integerAdd !x (IS 0#) = x +integerAdd (IS 0#) y = y +integerAdd (IS x#) (IS y#) + = case addIntC# x# y# of + (# z#, 0# #) -> IS z# + (# 0#, _ #) -> IN (bigNatFromWord2# 1## 0##) -- 2*minBound::Int + (# z#, _ #) + | isTrue# (z# ># 0#) -> IN (bigNatFromWord# ( (int2Word# (negateInt# z#)))) + | True -> IP (bigNatFromWord# ( (int2Word# z#))) +integerAdd y@(IS _) x = integerAdd x y +integerAdd (IP x) (IP y) = IP (bigNatAdd x y) +integerAdd (IN x) (IN y) = IN (bigNatAdd x y) +integerAdd (IP x) (IS y#) -- edge-case: @(maxBound+1) + minBound == 0@ + | isTrue# (y# >=# 0#) = IP (bigNatAddWord# x (int2Word# y#)) + | True = integerFromBigNat# (bigNatSubWordUnsafe# x (int2Word# + (negateInt# y#))) +integerAdd (IN x) (IS y#) -- edge-case: @(minBound-1) + maxBound == -2@ + | isTrue# (y# >=# 0#) = integerFromBigNatNeg# (bigNatSubWordUnsafe# x (int2Word# y#)) + | True = IN (bigNatAddWord# x (int2Word# (negateInt# y#))) +integerAdd y@(IN _) x@(IP _) = integerAdd x y +integerAdd (IP x) (IN y) + = case bigNatCompare x y of + LT -> integerFromBigNatNeg# (bigNatSubUnsafe y x) + EQ -> IS 0# + GT -> integerFromBigNat# (bigNatSubUnsafe x y) + +-- | Multiply two 'Integer's +integerMul :: Integer -> Integer -> Integer +{-# NOINLINE integerMul #-} +integerMul !_ (IS 0#) = IS 0# +integerMul (IS 0#) _ = IS 0# +integerMul x (IS 1#) = x +integerMul (IS 1#) y = y +integerMul x (IS -1#) = integerNegate x +integerMul (IS -1#) y = integerNegate y +#if __GLASGOW_HASKELL__ < 811 +integerMul (IS x) (IS y) = case mulIntMayOflo# x y of + 0# -> IS (x *# y) + _ -> case (# isTrue# (x >=# 0#), isTrue# (y >=# 0#) #) of + (# False, False #) -> case timesWord2# (int2Word# (negateInt# x)) + (int2Word# (negateInt# y)) of + (# 0##,l #) -> integerFromWord# l + (# h ,l #) -> IP (bigNatFromWord2# h l) + + (# True, False #) -> case timesWord2# (int2Word# x) + (int2Word# (negateInt# y)) of + (# 0##,l #) -> integerFromWordNeg# l + (# h ,l #) -> IN (bigNatFromWord2# h l) + + (# False, True #) -> case timesWord2# (int2Word# (negateInt# x)) + (int2Word# y) of + (# 0##,l #) -> integerFromWordNeg# l + (# h ,l #) -> IN (bigNatFromWord2# h l) + + (# True, True #) -> case timesWord2# (int2Word# x) + (int2Word# y) of + (# 0##,l #) -> integerFromWord# l + (# h ,l #) -> IP (bigNatFromWord2# h l) +#else +integerMul (IS x) (IS y) = case timesInt2# x y of + (# 0#, _h, l #) -> IS l + (# _ , h, l #) + | isTrue# (h >=# 0#) + -> IP (bigNatFromWord2# (int2Word# h) (int2Word# l)) + | True + -> let + -- two's complement of a two-word negative Int: + -- l' = complement l + 1 + -- h' = complement h + carry + !(# l',c #) = addWordC# (not# (int2Word# l)) 1## + !h' = int2Word# c `plusWord#` not# (int2Word# h) + in IN (bigNatFromWord2# h' l') +#endif +integerMul x@(IS _) y = integerMul y x +integerMul (IP x) (IP y) = IP (bigNatMul x y) +integerMul (IP x) (IN y) = IN (bigNatMul x y) +integerMul (IP x) (IS y) + | isTrue# (y >=# 0#) = IP (bigNatMulWord# x (int2Word# y)) + | True = IN (bigNatMulWord# x (int2Word# (negateInt# y))) +integerMul (IN x) (IN y) = IP (bigNatMul x y) +integerMul (IN x) (IP y) = IN (bigNatMul x y) +integerMul (IN x) (IS y) + | isTrue# (y >=# 0#) = IN (bigNatMulWord# x (int2Word# y)) + | True = IP (bigNatMulWord# x (int2Word# (negateInt# y))) + +-- | Negate 'Integer'. +-- +-- One edge-case issue to take into account is that Int's range is not +-- symmetric around 0. I.e. @minBound+maxBound = -1@ +-- +-- IP is used iff n > maxBound::Int +-- IN is used iff n < minBound::Int +integerNegate :: Integer -> Integer +{-# NOINLINE integerNegate #-} +integerNegate (IN b) = IP b +integerNegate (IS INT_MINBOUND#) = IP (bigNatFromWord# ABS_INT_MINBOUND##) +integerNegate (IS i) = IS (negateInt# i) +integerNegate (IP b) + | isTrue# (bigNatEqWord# b ABS_INT_MINBOUND##) = IS INT_MINBOUND# + | True = IN b + +{-# RULES +"integerNegate/integerNegate" forall x. integerNegate (integerNegate x) = x +#-} + +-- | Compute absolute value of an 'Integer' +integerAbs :: Integer -> Integer +{-# NOINLINE integerAbs #-} +integerAbs (IN i) = IP i +integerAbs n@(IP _) = n +integerAbs n@(IS i) + | isTrue# (i >=# 0#) = n + | INT_MINBOUND# <- i = IP (bigNatFromWord# ABS_INT_MINBOUND##) + | True = IS (negateInt# i) + + +-- | Return @-1@, @0@, and @1@ depending on whether argument is +-- negative, zero, or positive, respectively +integerSignum :: Integer -> Integer +{-# NOINLINE integerSignum #-} +integerSignum !j = IS (integerSignum# j) + +-- | Return @-1#@, @0#@, and @1#@ depending on whether argument is +-- negative, zero, or positive, respectively +integerSignum# :: Integer -> Int# +{-# NOINLINE integerSignum# #-} +integerSignum# (IN _) = -1# +integerSignum# (IS i#) = sgnI# i# +integerSignum# (IP _ ) = 1# + +-- | Count number of set bits. For negative arguments returns +-- the negated population count of the absolute value. +integerPopCount# :: Integer -> Int# +{-# NOINLINE integerPopCount# #-} +integerPopCount# (IS i) + | isTrue# (i >=# 0#) = word2Int# (popCntI# i) + | True = negateInt# (word2Int# (popCntI# (negateInt# i))) +integerPopCount# (IP bn) = word2Int# (bigNatPopCount# bn) +integerPopCount# (IN bn) = negateInt# (word2Int# (bigNatPopCount# bn)) + +-- | Positive 'Integer' for which only /n/-th bit is set +integerBit# :: Word# -> Integer +{-# NOINLINE integerBit# #-} +integerBit# i + | isTrue# (i `ltWord#` (WORD_SIZE_IN_BITS## `minusWord#` 1##)) + = IS (uncheckedIShiftL# 1# (word2Int# i)) + + | True = IP (bigNatBit# i) + +-- | 'Integer' for which only /n/-th bit is set +integerBit :: Word -> Integer +integerBit (W# i) = integerBit# i + +-- | Test if /n/-th bit is set. +-- +-- Fake 2's complement for negative values (might be slow) +integerTestBit# :: Integer -> Word# -> Bool# +{-# NOINLINE integerTestBit# #-} +integerTestBit# (IS x) i + | isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##) + = testBitI# x i + | True + = x <# 0# +integerTestBit# (IP x) i = bigNatTestBit# x i +integerTestBit# (IN x) i + | isTrue# (iw >=# n) + = 1# + -- if all the limbs j with j < iw are null, then we have to consider the + -- carry of the 2's complement convertion. Otherwise we just have to return + -- the inverse of the bit test + | allZ iw = testBitW# (xi `minusWord#` 1##) ib ==# 0# + | True = testBitW# xi ib ==# 0# + where + !xi = bigNatIndex# x iw + !n = bigNatSize# x + !iw = word2Int# (i `uncheckedShiftRL#` WORD_SIZE_BITS_SHIFT#) + !ib = i `and#` WORD_SIZE_BITS_MASK## + + allZ 0# = True + allZ j | isTrue# (bigNatIndex# x (j -# 1#) `eqWord#` 0##) = allZ (j -# 1#) + | True = False + +-- | Test if /n/-th bit is set. For negative Integers it tests the n-th bit of +-- the negated argument. +-- +-- Fake 2's complement for negative values (might be slow) +integerTestBit :: Integer -> Word -> Bool +integerTestBit !i (W# n) = isTrue# (integerTestBit# i n) + +-- | Shift-right operation +-- +-- Fake 2's complement for negative values (might be slow) +integerShiftR# :: Integer -> Word# -> Integer +{-# NOINLINE integerShiftR# #-} +integerShiftR# !x 0## = x +integerShiftR# (IS i) n = IS (iShiftRA# i (word2Int# n)) + where + iShiftRA# a b + | isTrue# (b >=# WORD_SIZE_IN_BITS#) = (a <# 0#) *# (-1#) + | True = a `uncheckedIShiftRA#` b +integerShiftR# (IP bn) n = integerFromBigNat# (bigNatShiftR# bn n) +integerShiftR# (IN bn) n = + case integerFromBigNatNeg# (bigNatShiftRNeg# bn n) of + IS 0# -> IS -1# + r -> r + +-- | Shift-right operation +-- +-- Fake 2's complement for negative values (might be slow) +integerShiftR :: Integer -> Word -> Integer +integerShiftR !x (W# w) = integerShiftR# x w + +-- | Shift-left operation +integerShiftL# :: Integer -> Word# -> Integer +{-# NOINLINE integerShiftL# #-} +integerShiftL# !x 0## = x +integerShiftL# (IS 0#) _ = IS 0# +integerShiftL# (IS 1#) n = integerBit# n +integerShiftL# (IS i) n + | isTrue# (i >=# 0#) = integerFromBigNat# (bigNatShiftL# (bigNatFromWord# (int2Word# i)) n) + | True = integerFromBigNatNeg# (bigNatShiftL# (bigNatFromWord# (int2Word# (negateInt# i))) n) +integerShiftL# (IP bn) n = IP (bigNatShiftL# bn n) +integerShiftL# (IN bn) n = IN (bigNatShiftL# bn n) + +-- | Shift-left operation +-- +-- Remember that bits are stored in sign-magnitude form, hence the behavior of +-- negative Integers is different from negative Int's behavior. +integerShiftL :: Integer -> Word -> Integer +integerShiftL !x (W# w) = integerShiftL# x w + +-- | Bitwise OR operation +-- +-- Fake 2's complement for negative values (might be slow) +integerOr :: Integer -> Integer -> Integer +{-# NOINLINE integerOr #-} +integerOr a b = case a of + IS 0# -> b + IS -1# -> IS -1# + IS x -> case b of + IS 0# -> a + IS -1# -> IS -1# + IS y -> IS (orI# x y) + IP y + | isTrue# (x >=# 0#) -> integerFromBigNat# (bigNatOrWord# y (int2Word# x)) + | True -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatAndNot -- use De Morgan's laws + (bigNatFromWord# + (int2Word# (negateInt# x) `minusWord#` 1##)) + y) + 1##) + IN y + | isTrue# (x >=# 0#) -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatAndNotWord# -- use De Morgan's laws + (bigNatSubWordUnsafe# y 1##) + (int2Word# x)) + 1##) + | True -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatAndWord# -- use De Morgan's laws + (bigNatSubWordUnsafe# y 1##) + (int2Word# (negateInt# x) `minusWord#` 1##)) + 1##) + IP x -> case b of + IS _ -> integerOr b a + IP y -> integerFromBigNat# (bigNatOr x y) + IN y -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatAndNot -- use De Morgan's laws + (bigNatSubWordUnsafe# y 1##) + x) + 1##) + IN x -> case b of + IS _ -> integerOr b a + IN y -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatAnd -- use De Morgan's laws + (bigNatSubWordUnsafe# x 1##) + (bigNatSubWordUnsafe# y 1##)) + 1##) + IP y -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatAndNot -- use De Morgan's laws + (bigNatSubWordUnsafe# x 1##) + y) + 1##) + + +-- | Bitwise XOR operation +-- +-- Fake 2's complement for negative values (might be slow) +integerXor :: Integer -> Integer -> Integer +{-# NOINLINE integerXor #-} +integerXor a b = case a of + IS 0# -> b + IS -1# -> integerComplement b + IS x -> case b of + IS 0# -> a + IS -1# -> integerComplement a + IS y -> IS (xorI# x y) + IP y + | isTrue# (x >=# 0#) -> integerFromBigNat# (bigNatXorWord# y (int2Word# x)) + | True -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatXorWord# + y + (int2Word# (negateInt# x) `minusWord#` 1##)) + 1##) + IN y + | isTrue# (x >=# 0#) -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatXorWord# + (bigNatSubWordUnsafe# y 1##) + (int2Word# x)) + 1##) + | True -> integerFromBigNat# + (bigNatXorWord# -- xor (not x) (not y) = xor x y + (bigNatSubWordUnsafe# y 1##) + (int2Word# (negateInt# x) `minusWord#` 1##)) + IP x -> case b of + IS _ -> integerXor b a + IP y -> integerFromBigNat# (bigNatXor x y) + IN y -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatXor + x + (bigNatSubWordUnsafe# y 1##)) + 1##) + IN x -> case b of + IS _ -> integerXor b a + IN y -> integerFromBigNat# + (bigNatXor -- xor (not x) (not y) = xor x y + (bigNatSubWordUnsafe# x 1##) + (bigNatSubWordUnsafe# y 1##)) + IP y -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatXor + y + (bigNatSubWordUnsafe# x 1##)) + 1##) + + + +-- | Bitwise AND operation +-- +-- Fake 2's complement for negative values (might be slow) +integerAnd :: Integer -> Integer -> Integer +{-# NOINLINE integerAnd #-} +integerAnd a b = case a of + IS 0# -> IS 0# + IS -1# -> b + IS x -> case b of + IS 0# -> IS 0# + IS -1# -> a + IS y -> IS (andI# x y) + IP y -> integerFromBigNat# (bigNatAndInt# y x) + IN y + | isTrue# (x >=# 0#) -> integerFromWord# (int2Word# x `andNot#` (indexWordArray# y 0# `minusWord#` 1##)) + | True -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatOrWord# -- use De Morgan's laws + (bigNatSubWordUnsafe# y 1##) + (wordFromAbsInt# x `minusWord#` 1##)) + 1##) + IP x -> case b of + IS _ -> integerAnd b a + IP y -> integerFromBigNat# (bigNatAnd x y) + IN y -> integerFromBigNat# (bigNatAndNot x (bigNatSubWordUnsafe# y 1##)) + IN x -> case b of + IS _ -> integerAnd b a + IN y -> integerFromBigNatNeg# + (bigNatAddWord# + (bigNatOr -- use De Morgan's laws + (bigNatSubWordUnsafe# x 1##) + (bigNatSubWordUnsafe# y 1##)) + 1##) + IP y -> integerFromBigNat# (bigNatAndNot y (bigNatSubWordUnsafe# x 1##)) + + + +-- | Binary complement of the +integerComplement :: Integer -> Integer +{-# NOINLINE integerComplement #-} +integerComplement (IS x) = IS (notI# x) +integerComplement (IP x) = IN (bigNatAddWord# x 1##) +integerComplement (IN x) = IP (bigNatSubWordUnsafe# x 1##) + + +-- | Simultaneous 'integerQuot' and 'integerRem'. +-- +-- Divisor must be non-zero otherwise the GHC runtime will terminate +-- with a division-by-zero fault. +integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #) +{-# NOINLINE integerQuotRem# #-} +integerQuotRem# !n (IS 1#) = (# n, IS 0# #) +integerQuotRem# !n (IS -1#) = let !q = integerNegate n in (# q, (IS 0#) #) +integerQuotRem# !_ (IS 0#) = case raiseDivZero of + !_ -> (# IS 0#, IS 0# #) + -- see Note [ghc-bignum exceptions] in GHC.Num.Primitives +integerQuotRem# (IS 0#) _ = (# IS 0#, IS 0# #) +integerQuotRem# (IS n#) (IS d#) = case quotRemInt# n# d# of + (# q#, r# #) -> (# IS q#, IS r# #) +integerQuotRem# (IP n) (IP d) = case bigNatQuotRem# n d of + (# q, r #) -> (# integerFromBigNat# q, integerFromBigNat# r #) +integerQuotRem# (IP n) (IN d) = case bigNatQuotRem# n d of + (# q, r #) -> (# integerFromBigNatNeg# q, integerFromBigNat# r #) +integerQuotRem# (IN n) (IN d) = case bigNatQuotRem# n d of + (# q, r #) -> (# integerFromBigNat# q, integerFromBigNatNeg# r #) +integerQuotRem# (IN n) (IP d) = case bigNatQuotRem# n d of + (# q, r #) -> (# integerFromBigNatNeg# q, integerFromBigNatNeg# r #) +integerQuotRem# (IP n) (IS d#) + | isTrue# (d# >=# 0#) = case bigNatQuotRemWord# n (int2Word# d#) of + (# q, r# #) -> (# integerFromBigNat# q, integerFromWord# r# #) + | True = case bigNatQuotRemWord# n (int2Word# (negateInt# d#)) of + (# q, r# #) -> (# integerFromBigNatNeg# q, integerFromWord# r# #) +integerQuotRem# (IN n) (IS d#) + | isTrue# (d# >=# 0#) = case bigNatQuotRemWord# n (int2Word# d#) of + (# q, r# #) -> (# integerFromBigNatNeg# q, integerFromWordNeg# r# #) + | True = case bigNatQuotRemWord# n (int2Word# (negateInt# d#)) of + (# q, r# #) -> (# integerFromBigNat# q, integerFromWordNeg# r# #) +integerQuotRem# n@(IS _) (IN _) = (# IS 0#, n #) -- since @n < d@ +integerQuotRem# n@(IS n#) (IP d) -- need to account for (IS minBound) + | isTrue# (n# ># 0#) = (# IS 0#, n #) + | isTrue# (bigNatGtWord# d (int2Word# (negateInt# n#))) = (# IS 0#, n #) + | True {- abs(n) == d -} = (# IS -1#, IS 0# #) + +-- | Simultaneous 'integerQuot' and 'integerRem'. +-- +-- Divisor must be non-zero otherwise the GHC runtime will terminate +-- with a division-by-zero fault. +integerQuotRem :: Integer -> Integer -> (Integer, Integer) +integerQuotRem !x !y = case integerQuotRem# x y of + (# q, r #) -> (q, r) + + +integerQuot :: Integer -> Integer -> Integer +{-# NOINLINE integerQuot #-} +integerQuot !n (IS 1#) = n +integerQuot !n (IS -1#) = integerNegate n +integerQuot !_ (IS 0#) = raiseDivZero +integerQuot (IS 0#) _ = IS 0# +integerQuot (IS n#) (IS d#) = IS (quotInt# n# d#) +integerQuot (IP n) (IS d#) + | isTrue# (d# >=# 0#) = integerFromBigNat# (bigNatQuotWord# n (int2Word# d#)) + | True = integerFromBigNatNeg# (bigNatQuotWord# n + (int2Word# (negateInt# d#))) +integerQuot (IN n) (IS d#) + | isTrue# (d# >=# 0#) = integerFromBigNatNeg# (bigNatQuotWord# n (int2Word# d#)) + | True = integerFromBigNat# (bigNatQuotWord# n + (int2Word# (negateInt# d#))) +integerQuot (IP n) (IP d) = integerFromBigNat# (bigNatQuot n d) +integerQuot (IP n) (IN d) = integerFromBigNatNeg# (bigNatQuot n d) +integerQuot (IN n) (IP d) = integerFromBigNatNeg# (bigNatQuot n d) +integerQuot (IN n) (IN d) = integerFromBigNat# (bigNatQuot n d) +integerQuot n d = case integerQuotRem# n d of (# q, _ #) -> q + +integerRem :: Integer -> Integer -> Integer +{-# NOINLINE integerRem #-} +integerRem !_ (IS 1#) = IS 0# +integerRem _ (IS -1#) = IS 0# +integerRem _ (IS 0#) = IS (remInt# 0# 0#) +integerRem (IS 0#) _ = IS 0# +integerRem (IS n#) (IS d#) = IS (remInt# n# d#) +integerRem (IP n) (IS d#) + = integerFromWord# (bigNatRemWord# n (int2Word# (absI# d#))) +integerRem (IN n) (IS d#) + = integerFromWordNeg# (bigNatRemWord# n (int2Word# (absI# d#))) +integerRem (IP n) (IP d) = integerFromBigNat# (bigNatRem n d) +integerRem (IP n) (IN d) = integerFromBigNat# (bigNatRem n d) +integerRem (IN n) (IP d) = integerFromBigNatNeg# (bigNatRem n d) +integerRem (IN n) (IN d) = integerFromBigNatNeg# (bigNatRem n d) +integerRem n d = case integerQuotRem# n d of (# _, r #) -> r + + +-- | Simultaneous 'integerDiv' and 'integerMod'. +-- +-- Divisor must be non-zero otherwise the GHC runtime will terminate +-- with a division-by-zero fault. +integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) +{-# NOINLINE integerDivMod# #-} +integerDivMod# !n !d + | isTrue# (integerSignum# r ==# negateInt# (integerSignum# d)) + = let !q' = integerSub q (IS 1#) + !r' = integerAdd r d + in (# q', r' #) + | True = qr + where + !qr@(# q, r #) = integerQuotRem# n d + +-- | Simultaneous 'integerDiv' and 'integerMod'. +-- +-- Divisor must be non-zero otherwise the GHC runtime will terminate +-- with a division-by-zero fault. +integerDivMod :: Integer -> Integer -> (Integer, Integer) +integerDivMod !n !d = case integerDivMod# n d of + (# q,r #) -> (q,r) + + +integerDiv :: Integer -> Integer -> Integer +{-# NOINLINE integerDiv #-} +integerDiv !n !d + -- same-sign ops can be handled by more efficient 'integerQuot' + | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerQuot n d + | True = case integerDivMod# n d of (# q, _ #) -> q + + +integerMod :: Integer -> Integer -> Integer +{-# NOINLINE integerMod #-} +integerMod !n !d + -- same-sign ops can be handled by more efficient 'integerRem' + | isTrue# (integerIsNegative# n ==# integerIsNegative# d) = integerRem n d + | True = case integerDivMod# n d of (# _, r #) -> r + +-- | Compute greatest common divisor. +integerGcd :: Integer -> Integer -> Integer +{-# NOINLINE integerGcd #-} +integerGcd (IS 0#) !b = integerAbs b +integerGcd a (IS 0#) = integerAbs a +integerGcd (IS 1#) _ = IS 1# +integerGcd (IS -1#) _ = IS 1# +integerGcd _ (IS 1#) = IS 1# +integerGcd _ (IS -1#) = IS 1# +integerGcd (IS a) (IS b) = integerFromWord# (gcdWord# + (int2Word# (absI# a)) + (int2Word# (absI# b))) +integerGcd a@(IS _) b = integerGcd b a +integerGcd (IN a) b = integerGcd (IP a) b +integerGcd (IP a) (IP b) = integerFromBigNat# (bigNatGcd a b) +integerGcd (IP a) (IN b) = integerFromBigNat# (bigNatGcd a b) +integerGcd (IP a) (IS b) = integerFromWord# (bigNatGcdWord# a (int2Word# (absI# b))) + +-- | Compute least common multiple. +integerLcm :: Integer -> Integer -> Integer +{-# NOINLINE integerLcm #-} +integerLcm (IS 0#) !_ = IS 0# +integerLcm (IS 1#) b = integerAbs b +integerLcm (IS -1#) b = integerAbs b +integerLcm _ (IS 0#) = IS 0# +integerLcm a (IS 1#) = integerAbs a +integerLcm a (IS -1#) = integerAbs a +integerLcm a b = (aa `integerQuot` (aa `integerGcd` ab)) `integerMul` ab + where -- TODO: use extended GCD to get a's factor directly + aa = integerAbs a + ab = integerAbs b + +-- | Square a Integer +integerSqr :: Integer -> Integer +integerSqr !a = integerMul a a + + +-- | Base 2 logarithm (floor) +-- +-- For numbers <= 0, return 0 +integerLog2# :: Integer -> Word# +integerLog2# (IS i) + | isTrue# (i <=# 0#) = 0## + | True = wordLog2# (int2Word# i) +integerLog2# (IN _) = 0## +integerLog2# (IP b) = bigNatLog2# b + +-- | Base 2 logarithm (floor) +-- +-- For numbers <= 0, return 0 +integerLog2 :: Integer -> Word +integerLog2 !i = W# (integerLog2# i) + +-- | Logarithm (floor) for an arbitrary base +-- +-- For numbers <= 0, return 0 +integerLogBaseWord# :: Word# -> Integer -> Word# +integerLogBaseWord# base !i + | integerIsNegative i = 0## + | True = naturalLogBaseWord# base (integerToNatural i) + +-- | Logarithm (floor) for an arbitrary base +-- +-- For numbers <= 0, return 0 +integerLogBaseWord :: Word -> Integer -> Word +integerLogBaseWord (W# base) !i = W# (integerLogBaseWord# base i) + +-- | Logarithm (floor) for an arbitrary base +-- +-- For numbers <= 0, return 0 +integerLogBase# :: Integer -> Integer -> Word# +integerLogBase# !base !i + | integerIsNegative i = 0## + | True = naturalLogBase# (integerToNatural base) + (integerToNatural i) + +-- | Logarithm (floor) for an arbitrary base +-- +-- For numbers <= 0, return 0 +integerLogBase :: Integer -> Integer -> Word +integerLogBase !base !i = W# (integerLogBase# base i) + +-- | Indicate if the value is a power of two and which one +integerIsPowerOf2# :: Integer -> (# (# #) | Word# #) +integerIsPowerOf2# (IS i) + | isTrue# (i <=# 0#) = (# (# #) | #) + | True = wordIsPowerOf2# (int2Word# i) +integerIsPowerOf2# (IN _) = (# (# #) | #) +integerIsPowerOf2# (IP w) = bigNatIsPowerOf2# w + +#if WORD_SIZE_IN_BITS == 32 + +-- | Convert an Int64# into an Integer on 32-bit architectures +integerFromInt64# :: Int64# -> Integer +{-# NOINLINE integerFromInt64# #-} +integerFromInt64# !i + | isTrue# ((i `leInt64#` intToInt64# 0x7FFFFFFF#) + &&# (i `geInt64#` intToInt64# -0x80000000#)) + = IS (int64ToInt# i) + + | isTrue# (i `geInt64#` intToInt64# 0#) + = IP (bigNatFromWord64# (int64ToWord64# i)) + + | True + = IN (bigNatFromWord64# (int64ToWord64# (negateInt64# i))) + +-- | Convert a Word64# into an Integer on 32-bit architectures +integerFromWord64# :: Word64# -> Integer +{-# NOINLINE integerFromWord64# #-} +integerFromWord64# !w + | isTrue# (w `leWord64#` wordToWord64# 0x7FFFFFFF##) + = IS (int64ToInt# (word64ToInt64# w)) + | True + = IP (bigNatFromWord64# w) + +-- | Convert an Integer into an Int64# on 32-bit architectures +integerToInt64# :: Integer -> Int64# +{-# NOINLINE integerToInt64# #-} +integerToInt64# (IS i) = intToInt64# i +integerToInt64# (IP b) = word64ToInt64# (bigNatToWord64# b) +integerToInt64# (IN b) = negateInt64# (word64ToInt64# (bigNatToWord64# b)) + +-- | Convert an Integer into a Word64# on 32-bit architectures +integerToWord64# :: Integer -> Word64# +{-# NOINLINE integerToWord64# #-} +integerToWord64# (IS i) = int64ToWord64# (intToInt64# i) +integerToWord64# (IP b) = bigNatToWord64# b +integerToWord64# (IN b) = int64ToWord64# (negateInt64# (word64ToInt64# (bigNatToWord64# b))) + +#else + +-- | Convert an Int64# into an Integer on 64-bit architectures +integerFromInt64# :: Int# -> Integer +integerFromInt64# !x = IS x + +#endif + +---------------------------------------------------------------------------- +-- Conversions to/from floating point +---------------------------------------------------------------------------- + +-- | Decode a Double# into (# Integer mantissa, Int# exponent #) +integerDecodeDouble# :: Double# -> (# Integer, Int# #) +{-# INLINE integerDecodeDouble# #-} -- decodeDouble_Int64# is constant-folded + -- in GHC.Core.Opt.ConstantFold +integerDecodeDouble# !x = case decodeDouble_Int64# x of + (# m, e #) -> (# integerFromInt64# m, e #) + +-- | Encode (# Integer mantissa, Int# exponent #) into a Double# +integerEncodeDouble# :: Integer -> Int# -> Double# +{-# NOINLINE integerEncodeDouble# #-} +integerEncodeDouble# (IS i) 0# = int2Double# i +integerEncodeDouble# (IS i) e = intEncodeDouble# i e +integerEncodeDouble# (IP b) e = bigNatEncodeDouble# b e +integerEncodeDouble# (IN b) e = negateDouble# (bigNatEncodeDouble# b e) + +-- | Encode (Integer mantissa, Int exponent) into a Double +integerEncodeDouble :: Integer -> Int -> Double +integerEncodeDouble !m (I# e) = D# (integerEncodeDouble# m e) + +-- | Encode an Integer (mantissa) into a Double# +integerToDouble# :: Integer -> Double# +{-# NOINLINE integerToDouble# #-} +integerToDouble# !i = integerEncodeDouble# i 0# + +-- | Encode an Integer (mantissa) into a Float# +integerToFloat# :: Integer -> Float# +{-# NOINLINE integerToFloat# #-} +integerToFloat# !i = integerEncodeFloat# i 0# + +-- | Encode (# Integer mantissa, Int# exponent #) into a Float# +-- +-- TODO: Not sure if it's worth to write 'Float' optimized versions here +integerEncodeFloat# :: Integer -> Int# -> Float# +{-# NOINLINE integerEncodeFloat# #-} +integerEncodeFloat# !m 0# = double2Float# (integerToDouble# m) +integerEncodeFloat# !m e = double2Float# (integerEncodeDouble# m e) + +-- | Compute the number of digits of the Integer (without the sign) in the given base. +-- +-- `base` must be > 1 +integerSizeInBase# :: Word# -> Integer -> Word# +integerSizeInBase# base (IS i) = wordSizeInBase# base (int2Word# (absI# i)) +integerSizeInBase# base (IP n) = bigNatSizeInBase# base n +integerSizeInBase# base (IN n) = bigNatSizeInBase# base n + +-- | Write an 'Integer' (without sign) to @/addr/@ in base-256 representation +-- and return the number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: write most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +integerToAddr# :: Integer -> Addr# -> Bool# -> State# s -> (# State# s, Word# #) +integerToAddr# (IS i) = wordToAddr# (int2Word# (absI# i)) +integerToAddr# (IP n) = bigNatToAddr# n +integerToAddr# (IN n) = bigNatToAddr# n + +-- | Write an 'Integer' (without sign) to @/addr/@ in base-256 representation +-- and return the number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: write most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +integerToAddr :: Integer -> Addr# -> Bool# -> IO Word +integerToAddr a addr e = IO \s -> case integerToAddr# a addr e s of + (# s', w #) -> (# s', W# w #) + +-- | Read an 'Integer' (without sign) in base-256 representation from an Addr#. +-- +-- The size is given in bytes. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Null higher limbs are automatically trimed. +integerFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Integer #) +integerFromAddr# sz addr e s = + case bigNatFromAddr# sz addr e s of + (# s', n #) -> (# s', integerFromBigNat# n #) + +-- | Read an 'Integer' (without sign) in base-256 representation from an Addr#. +-- +-- The size is given in bytes. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Null higher limbs are automatically trimed. +integerFromAddr :: Word# -> Addr# -> Bool# -> IO Integer +integerFromAddr sz addr e = IO (integerFromAddr# sz addr e) + + + +-- | Write an 'Integer' (without sign) in base-256 representation and return the +-- number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +integerToMutableByteArray# :: Integer -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #) +integerToMutableByteArray# (IS i) = wordToMutableByteArray# (int2Word# (absI# i)) +integerToMutableByteArray# (IP a) = bigNatToMutableByteArray# a +integerToMutableByteArray# (IN a) = bigNatToMutableByteArray# a + +-- | Write an 'Integer' (without sign) in base-256 representation and return the +-- number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +integerToMutableByteArray :: Integer -> MutableByteArray# RealWorld -> Word# -> Bool# -> IO Word +integerToMutableByteArray i mba w e = IO \s -> case integerToMutableByteArray# i mba w e s of + (# s', r #) -> (# s', W# r #) + +-- | Read an 'Integer' (without sign) in base-256 representation from a ByteArray#. +-- +-- The size is given in bytes. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Null higher limbs are automatically trimed. +integerFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, Integer #) +integerFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of + (# s', a #) -> (# s', integerFromBigNat# a #) + +-- | Read an 'Integer' (without sign) in base-256 representation from a ByteArray#. +-- +-- The size is given in bytes. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Null higher limbs are automatically trimed. +integerFromByteArray :: Word# -> ByteArray# -> Word# -> Bool# -> Integer +integerFromByteArray sz ba off e = case runRW# (integerFromByteArray# sz ba off e) of + (# _, i #) -> i + + +-- | Get the extended GCD of two integers. +-- +-- `integerGcde# a b` returns (# g,x,y #) where +-- * ax + by = g = |gcd a b| +integerGcde# + :: Integer + -> Integer + -> (# Integer, Integer, Integer #) +integerGcde# a b + | integerIsZero a && integerIsZero b = (# integerZero, integerZero, integerZero #) + | integerIsZero a = fix (# b , integerZero, integerOne #) + | integerIsZero b = fix (# a , integerOne, integerZero #) + | integerAbs a `integerEq` integerAbs b = fix (# b , integerZero, integerOne #) + | True = Backend.integer_gcde a b + where + -- returned "g" must be positive + fix (# g, x, y #) + | integerIsNegative g = (# integerNegate g, integerNegate x, integerNegate y #) + | True = (# g,x,y #) + +-- | Get the extended GCD of two integers. +-- +-- `integerGcde a b` returns (g,x,y) where +-- * ax + by = g = |gcd a b| +integerGcde + :: Integer + -> Integer + -> ( Integer, Integer, Integer) +integerGcde a b = case integerGcde# a b of + (# g,x,y #) -> (g,x,y) + + +-- | Computes the modular inverse. +-- +-- I.e. y = integerRecipMod# x m +-- = x^(-1) `mod` m +-- +-- with 0 < y < |m| +-- +integerRecipMod# + :: Integer + -> Natural + -> (# Natural | () #) +integerRecipMod# x m + | integerIsZero x = (# | () #) + | naturalIsZero m = (# | () #) + | naturalIsOne m = (# | () #) + | True = Backend.integer_recip_mod x m + + +-- | Computes the modular exponentiation. +-- +-- I.e. y = integer_powmod b e m +-- = b^e `mod` m +-- +-- with 0 <= y < abs m +-- +-- If e is negative, we use `integerRecipMod#` to try to find a modular +-- multiplicative inverse (which may not exist). +integerPowMod# :: Integer -> Integer -> Natural -> (# Natural | () #) +integerPowMod# !b !e !m + | naturalIsZero m = (# | () #) + | naturalIsOne m = (# naturalZero | #) + | integerIsZero e = (# naturalOne | #) + | integerIsZero b = (# naturalZero | #) + | integerIsOne b = (# naturalOne | #) + -- when the exponent is negative, try to find the modular multiplicative + -- inverse and use it instead + | integerIsNegative e = case integerRecipMod# b m of + (# | () #) -> (# | () #) + (# b' | #) -> integerPowMod# + (integerFromNatural b') + (integerNegate e) + m + + -- e > 0 by cases above + | True = (# Backend.integer_powmod b (integerToNatural e) m | #) diff --git a/src/GHC/Num/Integer.hs-boot b/src/GHC/Num/Integer.hs-boot new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Integer.hs-boot @@ -0,0 +1,37 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE MagicHash #-} + +module GHC.Num.Integer where + +import GHC.Types +import GHC.Prim +import {-# SOURCE #-} GHC.Num.BigNat +import {-# SOURCE #-} GHC.Num.Natural + +data Integer + +integerZero :: Integer +integerOne :: Integer + +integerEq# :: Integer -> Integer -> Int# +integerEq :: Integer -> Integer -> Bool +integerGt :: Integer -> Integer -> Bool +integerIsZero :: Integer -> Bool +integerIsOne :: Integer -> Bool +integerIsNegative :: Integer -> Bool + +integerSub :: Integer -> Integer -> Integer +integerMul :: Integer -> Integer -> Integer +integerMod :: Integer -> Integer -> Integer +integerRem :: Integer -> Integer -> Integer +integerNegate :: Integer -> Integer +integerAbs :: Integer -> Integer +integerDivMod# :: Integer -> Integer -> (# Integer, Integer #) +integerQuotRem# :: Integer -> Integer -> (# Integer, Integer #) + +integerToBigNatSign# :: Integer -> (# Int#, BigNat# #) +integerFromBigNatSign# :: Int# -> BigNat# -> Integer +integerFromBigNat# :: BigNat# -> Integer +integerToNatural :: Integer -> Natural +integerFromNatural :: Natural -> Integer diff --git a/src/GHC/Num/Natural.hs b/src/GHC/Num/Natural.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Natural.hs @@ -0,0 +1,596 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BlockArguments #-} + +#include "MachDeps.h" +#include "WordSize.h" + +module GHC.Num.Natural where + +import GHC.Prim +import GHC.Types +import GHC.Classes + +import GHC.Num.BigNat +import GHC.Num.Primitives + +default () + +-- | Natural number +-- +-- Invariant: numbers <= WORD_MAXBOUND use the `NS` constructor +data Natural + = NS !Word# + | NB !BigNat# + +instance Eq Natural where + (==) = naturalEq + (/=) = naturalNe + +instance Ord Natural where + compare = naturalCompare + (>) = naturalGt + (>=) = naturalGe + (<) = naturalLt + (<=) = naturalLe + + +-- | Check Natural invariants +naturalCheck# :: Natural -> Bool# +naturalCheck# (NS _) = 1# +naturalCheck# (NB bn) = bigNatCheck# bn &&# bigNatSize# bn ># 1# + +-- | Check Natural invariants +naturalCheck :: Natural -> Bool +naturalCheck !n = isTrue# (naturalCheck# n) + +-- | Zero Natural +naturalZero :: Natural +naturalZero = NS 0## + +-- | One Natural +naturalOne :: Natural +naturalOne = NS 1## + +-- | Test Zero Natural +naturalIsZero :: Natural -> Bool +naturalIsZero (NS 0##) = True +naturalIsZero _ = False + +-- | Test One Natural +naturalIsOne :: Natural -> Bool +naturalIsOne (NS 1##) = True +naturalIsOne _ = False + +-- | Indicate if the value is a power of two and which one +naturalIsPowerOf2# :: Natural -> (# (# #) | Word# #) +naturalIsPowerOf2# (NS w) = wordIsPowerOf2# w +naturalIsPowerOf2# (NB w) = bigNatIsPowerOf2# w + +-- | Create a Natural from a BigNat# (respect the invariants) +naturalFromBigNat# :: BigNat# -> Natural +naturalFromBigNat# x = case bigNatSize# x of + 0# -> naturalZero + 1# -> NS (bigNatIndex# x 0#) + _ -> NB x + +-- | Convert a Natural into a BigNat# +naturalToBigNat# :: Natural -> BigNat# +naturalToBigNat# (NS w) = bigNatFromWord# w +naturalToBigNat# (NB bn) = bn + +-- | Create a Natural from a Word# +naturalFromWord# :: Word# -> Natural +naturalFromWord# x = NS x + +-- | Convert two Word# (most-significant first) into a Natural +naturalFromWord2# :: Word# -> Word# -> Natural +naturalFromWord2# 0## 0## = naturalZero +naturalFromWord2# 0## l = NS l +naturalFromWord2# h l = NB (bigNatFromWord2# h l) + +-- | Create a Natural from a Word +naturalFromWord :: Word -> Natural +naturalFromWord (W# x) = NS x + +-- | Create a Natural from a list of Word +naturalFromWordList :: [Word] -> Natural +naturalFromWordList xs = naturalFromBigNat# (bigNatFromWordList xs) + +-- | Convert the lower bits of a Natural into a Word# +naturalToWord# :: Natural -> Word# +{-# NOINLINE naturalToWord# #-} +naturalToWord# (NS x) = x +naturalToWord# (NB b) = bigNatIndex# b 0# + +-- | Convert the lower bits of a Natural into a Word +naturalToWord :: Natural -> Word +naturalToWord !n = W# (naturalToWord# n) + +-- | Convert a Natural into a Word# clamping to (maxBound :: Word#). +naturalToWordClamp# :: Natural -> Word# +{-# NOINLINE naturalToWordClamp #-} +naturalToWordClamp# (NS x) = x +naturalToWordClamp# (NB _) = WORD_MAXBOUND## + +-- | Convert a Natural into a Word# clamping to (maxBound :: Word). +naturalToWordClamp :: Natural -> Word +naturalToWordClamp !n = W# (naturalToWordClamp# n) + +-- | Try downcasting 'Natural' to 'Word' value. +-- Returns '(##)' if value doesn't fit in 'Word'. +naturalToWordMaybe# :: Natural -> (# (# #) | Word# #) +naturalToWordMaybe# (NS w) = (# | w #) +naturalToWordMaybe# _ = (# (# #) | #) + +-- | Encode (# Natural mantissa, Int# exponent #) into a Double# +naturalEncodeDouble# :: Natural -> Int# -> Double# +naturalEncodeDouble# (NS w) 0# = word2Double# w +naturalEncodeDouble# (NS w) e = wordEncodeDouble# w e +naturalEncodeDouble# (NB b) e = bigNatEncodeDouble# b e + +-- | Encode a Natural (mantissa) into a Double# +naturalToDouble# :: Natural -> Double# +naturalToDouble# !n = naturalEncodeDouble# n 0# + +-- | Encode a Natural (mantissa) into a Float# +naturalToFloat# :: Natural -> Float# +naturalToFloat# !i = naturalEncodeFloat# i 0# + +-- | Encode (# Natural mantissa, Int# exponent #) into a Float# +-- +-- TODO: Not sure if it's worth to write 'Float' optimized versions here +naturalEncodeFloat# :: Natural -> Int# -> Float# +naturalEncodeFloat# !m 0# = double2Float# (naturalToDouble# m) +naturalEncodeFloat# !m e = double2Float# (naturalEncodeDouble# m e) + +-- | Equality test for Natural +naturalEq# :: Natural -> Natural -> Bool# +{-# NOINLINE naturalEq# #-} +naturalEq# (NS x) (NS y) = x `eqWord#` y +naturalEq# (NB x) (NB y) = bigNatEq# x y +naturalEq# _ _ = 0# + +-- | Equality test for Natural +naturalEq :: Natural -> Natural -> Bool +naturalEq !x !y = isTrue# (naturalEq# x y) + +-- | Inequality test for Natural +naturalNe# :: Natural -> Natural -> Bool# +{-# NOINLINE naturalNe# #-} +naturalNe# (NS x) (NS y) = x `neWord#` y +naturalNe# (NB x) (NB y) = bigNatNe# x y +naturalNe# _ _ = 1# + +-- | Inequality test for Natural +naturalNe :: Natural -> Natural -> Bool +naturalNe !x !y = isTrue# (naturalNe# x y) + +-- | Greater or equal test for Natural +naturalGe# :: Natural -> Natural -> Bool# +{-# NOINLINE naturalGe# #-} +naturalGe# (NS x) (NS y) = x `geWord#` y +naturalGe# (NS _) (NB _) = 0# +naturalGe# (NB _) (NS _) = 1# +naturalGe# (NB x) (NB y) = bigNatGe# x y + +-- | Greater or equal test for Natural +naturalGe :: Natural -> Natural -> Bool +naturalGe !x !y = isTrue# (naturalGe# x y) + +-- | Lower or equal test for Natural +naturalLe# :: Natural -> Natural -> Bool# +{-# NOINLINE naturalLe# #-} +naturalLe# (NS x) (NS y) = x `leWord#` y +naturalLe# (NS _) (NB _) = 1# +naturalLe# (NB _) (NS _) = 0# +naturalLe# (NB x) (NB y) = bigNatLe# x y + +-- | Lower or equal test for Natural +naturalLe :: Natural -> Natural -> Bool +naturalLe !x !y = isTrue# (naturalLe# x y) + + +-- | Greater test for Natural +naturalGt# :: Natural -> Natural -> Bool# +{-# NOINLINE naturalGt# #-} +naturalGt# (NS x) (NS y) = x `gtWord#` y +naturalGt# (NS _) (NB _) = 0# +naturalGt# (NB _) (NS _) = 1# +naturalGt# (NB x) (NB y) = bigNatGt# x y + +-- | Greater test for Natural +naturalGt :: Natural -> Natural -> Bool +naturalGt !x !y = isTrue# (naturalGt# x y) + +-- | Lower test for Natural +naturalLt# :: Natural -> Natural -> Bool# +{-# NOINLINE naturalLt# #-} +naturalLt# (NS x) (NS y) = x `ltWord#` y +naturalLt# (NS _) (NB _) = 1# +naturalLt# (NB _) (NS _) = 0# +naturalLt# (NB x) (NB y) = bigNatLt# x y + +-- | Lower test for Natural +naturalLt :: Natural -> Natural -> Bool +naturalLt !x !y = isTrue# (naturalLt# x y) + +-- | Compare two Natural +naturalCompare :: Natural -> Natural -> Ordering +{-# NOINLINE naturalCompare #-} +naturalCompare (NS x) (NS y) = cmpW# x y +naturalCompare (NB x) (NB y) = bigNatCompare x y +naturalCompare (NS _) (NB _) = LT +naturalCompare (NB _) (NS _) = GT + +-- | PopCount for Natural +naturalPopCount# :: Natural -> Word# +{-# NOINLINE naturalPopCount# #-} +naturalPopCount# (NS x) = popCnt# x +naturalPopCount# (NB x) = bigNatPopCount# x + +-- | PopCount for Natural +naturalPopCount :: Natural -> Word +naturalPopCount (NS x) = W# (popCnt# x) +naturalPopCount (NB x) = bigNatPopCount x + +-- | Right shift for Natural +naturalShiftR# :: Natural -> Word# -> Natural +{-# NOINLINE naturalShiftR# #-} +naturalShiftR# (NS x) n = NS (x `shiftRW#` n) +naturalShiftR# (NB x) n = naturalFromBigNat# (x `bigNatShiftR#` n) + +-- | Right shift for Natural +naturalShiftR :: Natural -> Word -> Natural +naturalShiftR x (W# n) = naturalShiftR# x n + +-- | Left shift +naturalShiftL# :: Natural -> Word# -> Natural +{-# NOINLINE naturalShiftL# #-} +naturalShiftL# v@(NS x) n + | 0## <- x = v + | isTrue# (clz# x `geWord#` n) = NS (x `uncheckedShiftL#` word2Int# n) + | True = NB (bigNatFromWord# x `bigNatShiftL#` n) +naturalShiftL# (NB x) n = NB (x `bigNatShiftL#` n) + +-- | Left shift +naturalShiftL :: Natural -> Word -> Natural +naturalShiftL !x (W# n) = naturalShiftL# x n + +-- | Add two naturals +naturalAdd :: Natural -> Natural -> Natural +{-# NOINLINE naturalAdd #-} +naturalAdd (NS x) (NB y) = NB (bigNatAddWord# y x) +naturalAdd (NB x) (NS y) = NB (bigNatAddWord# x y) +naturalAdd (NB x) (NB y) = NB (bigNatAdd x y) +naturalAdd (NS x) (NS y) = + case addWordC# x y of + (# l,0# #) -> NS l + (# l,c #) -> NB (bigNatFromWord2# (int2Word# c) l) + +-- | Sub two naturals +naturalSub :: Natural -> Natural -> (# Void# | Natural #) +{-# NOINLINE naturalSub #-} +naturalSub (NS _) (NB _) = (# void# | #) +naturalSub (NB x) (NS y) = (# | naturalFromBigNat# (bigNatSubWordUnsafe# x y) #) +naturalSub (NS x) (NS y) = + case subWordC# x y of + (# l,0# #) -> (# | NS l #) + (# _,_ #) -> (# void# | #) +naturalSub (NB x) (NB y) = + case bigNatSub x y of + (# (# #) | #) -> (# void# | #) + (# | z #) -> (# | naturalFromBigNat# z #) + +-- | Sub two naturals +-- +-- Throw an Underflow exception if x < y +naturalSubThrow :: Natural -> Natural -> Natural +{-# NOINLINE naturalSubThrow #-} +naturalSubThrow (NS _) (NB _) = raiseUnderflow +naturalSubThrow (NB x) (NS y) = naturalFromBigNat# (bigNatSubWordUnsafe# x y) +naturalSubThrow (NS x) (NS y) = + case subWordC# x y of + (# l,0# #) -> NS l + (# _,_ #) -> raiseUnderflow +naturalSubThrow (NB x) (NB y) = + case bigNatSub x y of + (# (# #) | #) -> raiseUnderflow + (# | z #) -> naturalFromBigNat# z + +-- | Sub two naturals +-- +-- Unsafe: don't check that x >= y +-- Undefined results if it happens +naturalSubUnsafe :: Natural -> Natural -> Natural +{-# NOINLINE naturalSubUnsafe #-} +naturalSubUnsafe (NS x) (NS y) = NS (minusWord# x y) +naturalSubUnsafe (NS _) (NB _) = naturalZero +naturalSubUnsafe (NB x) (NS y) = naturalFromBigNat# (bigNatSubWordUnsafe# x y) +naturalSubUnsafe (NB x) (NB y) = + case bigNatSub x y of + (# (# #) | #) -> naturalZero + (# | z #) -> naturalFromBigNat# z + +-- | Multiplication +naturalMul :: Natural -> Natural -> Natural +{-# NOINLINE naturalMul #-} +naturalMul a b = case a of + NS 0## -> NS 0## + NS 1## -> b + NS x -> case b of + NS 0## -> NS 0## + NS 1## -> a + NS y -> case timesWord2# x y of + (# h,l #) -> naturalFromWord2# h l + NB y -> NB (bigNatMulWord# y x) + NB x -> case b of + NS 0## -> NS 0## + NS 1## -> a + NS y -> NB (bigNatMulWord# x y) + NB y -> NB (bigNatMul x y) + +-- | Square a Natural +naturalSqr :: Natural -> Natural +naturalSqr !a = naturalMul a a + +-- | Signum for Natural +naturalSignum :: Natural -> Natural +{-# NOINLINE naturalSignum #-} +naturalSignum (NS 0##) = NS 0## +naturalSignum _ = NS 1## + +-- | Negate for Natural +naturalNegate :: Natural -> Natural +{-# NOINLINE naturalNegate #-} +naturalNegate (NS 0##) = NS 0## +naturalNegate _ = raiseUnderflow + +-- | Return division quotient and remainder +-- +-- Division by zero is handled by BigNat +naturalQuotRem# :: Natural -> Natural -> (# Natural, Natural #) +{-# NOINLINE naturalQuotRem# #-} +naturalQuotRem# (NS n) (NS d) = case quotRemWord# n d of + (# q, r #) -> (# NS q, NS r #) +naturalQuotRem# (NB n) (NS d) = case bigNatQuotRemWord# n d of + (# q, r #) -> (# naturalFromBigNat# q, NS r #) +naturalQuotRem# (NS n) (NB d) = case bigNatQuotRem# (bigNatFromWord# n) d of + (# q, r #) -> (# naturalFromBigNat# q, naturalFromBigNat# r #) +naturalQuotRem# (NB n) (NB d) = case bigNatQuotRem# n d of + (# q, r #) -> (# naturalFromBigNat# q, naturalFromBigNat# r #) + +-- | Return division quotient and remainder +naturalQuotRem :: Natural -> Natural -> (Natural, Natural) +naturalQuotRem !n !d = case naturalQuotRem# n d of + (# q, r #) -> (q,r) + +-- | Return division quotient +naturalQuot :: Natural -> Natural -> Natural +{-# NOINLINE naturalQuot #-} +naturalQuot (NS n) (NS d) = case quotWord# n d of + q -> NS q +naturalQuot (NB n) (NS d) = case bigNatQuotWord# n d of + q -> naturalFromBigNat# q +naturalQuot (NS n) (NB d) = case bigNatQuot (bigNatFromWord# n) d of + q -> naturalFromBigNat# q +naturalQuot (NB n) (NB d) = case bigNatQuot n d of + q -> naturalFromBigNat# q + +-- | Return division remainder +naturalRem :: Natural -> Natural -> Natural +{-# NOINLINE naturalRem #-} +naturalRem (NS n) (NS d) = case remWord# n d of + r -> NS r +naturalRem (NB n) (NS d) = case bigNatRemWord# n d of + r -> NS r +naturalRem (NS n) (NB d) = case bigNatRem (bigNatFromWord# n) d of + r -> naturalFromBigNat# r +naturalRem (NB n) (NB d) = case bigNatRem n d of + r -> naturalFromBigNat# r + +naturalAnd :: Natural -> Natural -> Natural +{-# NOINLINE naturalAnd #-} +naturalAnd (NS n) (NS m) = NS (n `and#` m) +naturalAnd (NS n) (NB m) = NS (n `and#` bigNatToWord# m) +naturalAnd (NB n) (NS m) = NS (bigNatToWord# n `and#` m) +naturalAnd (NB n) (NB m) = naturalFromBigNat# (bigNatAnd n m) + +naturalAndNot :: Natural -> Natural -> Natural +{-# NOINLINE naturalAndNot #-} +naturalAndNot (NS n) (NS m) = NS (n `and#` not# m) +naturalAndNot (NS n) (NB m) = NS (n `and#` not# (bigNatToWord# m)) +naturalAndNot (NB n) (NS m) = NS (bigNatToWord# n `and#` not# m) +naturalAndNot (NB n) (NB m) = naturalFromBigNat# (bigNatAndNot n m) + +naturalOr :: Natural -> Natural -> Natural +{-# NOINLINE naturalOr #-} +naturalOr (NS n) (NS m) = NS (n `or#` m) +naturalOr (NS n) (NB m) = NB (bigNatOrWord# m n) +naturalOr (NB n) (NS m) = NB (bigNatOrWord# n m) +naturalOr (NB n) (NB m) = NB (bigNatOr n m) + +naturalXor :: Natural -> Natural -> Natural +{-# NOINLINE naturalXor #-} +naturalXor (NS n) (NS m) = NS (n `xor#` m) +naturalXor (NS n) (NB m) = NB (bigNatXorWord# m n) +naturalXor (NB n) (NS m) = NB (bigNatXorWord# n m) +naturalXor (NB n) (NB m) = naturalFromBigNat# (bigNatXor n m) + +naturalTestBit# :: Natural -> Word# -> Bool# +{-# NOINLINE naturalTestBit# #-} +naturalTestBit# (NS w) i = (i `ltWord#` WORD_SIZE_IN_BITS##) &&# + ((w `and#` (1## `uncheckedShiftL#` word2Int# i)) `neWord#` 0##) +naturalTestBit# (NB bn) i = bigNatTestBit# bn i + +naturalTestBit :: Natural -> Word -> Bool +naturalTestBit !n (W# i) = isTrue# (naturalTestBit# n i) + +naturalBit# :: Word# -> Natural +{-# NOINLINE naturalBit# #-} +naturalBit# i + | isTrue# (i `ltWord#` WORD_SIZE_IN_BITS##) = NS (1## `uncheckedShiftL#` word2Int# i) + | True = NB (bigNatBit# i) + +naturalBit :: Word -> Natural +naturalBit (W# i) = naturalBit# i + +-- | Compute greatest common divisor. +naturalGcd :: Natural -> Natural -> Natural +{-# NOINLINE naturalGcd #-} +naturalGcd (NS 0##) !y = y +naturalGcd x (NS 0##) = x +naturalGcd (NS 1##) _ = NS 1## +naturalGcd _ (NS 1##) = NS 1## +naturalGcd (NB x) (NB y) = naturalFromBigNat# (bigNatGcd x y) +naturalGcd (NB x) (NS y) = NS (bigNatGcdWord# x y) +naturalGcd (NS x) (NB y) = NS (bigNatGcdWord# y x) +naturalGcd (NS x) (NS y) = NS (gcdWord# x y) + +-- | Compute least common multiple. +naturalLcm :: Natural -> Natural -> Natural +{-# NOINLINE naturalLcm #-} +naturalLcm (NS 0##) !_ = NS 0## +naturalLcm _ (NS 0##) = NS 0## +naturalLcm (NS 1##) y = y +naturalLcm x (NS 1##) = x +naturalLcm (NS a ) (NS b ) = naturalFromBigNat# (bigNatLcmWordWord# a b) +naturalLcm (NB a ) (NS b ) = naturalFromBigNat# (bigNatLcmWord# a b) +naturalLcm (NS a ) (NB b ) = naturalFromBigNat# (bigNatLcmWord# b a) +naturalLcm (NB a ) (NB b ) = naturalFromBigNat# (bigNatLcm a b) + +-- | Base 2 logarithm +naturalLog2# :: Natural -> Word# +{-# NOINLINE naturalLog2# #-} +naturalLog2# (NS w) = wordLog2# w +naturalLog2# (NB b) = bigNatLog2# b + +-- | Base 2 logarithm +naturalLog2 :: Natural -> Word +naturalLog2 !n = W# (naturalLog2# n) + +-- | Logarithm for an arbitrary base +naturalLogBaseWord# :: Word# -> Natural -> Word# +{-# NOINLINE naturalLogBaseWord# #-} +naturalLogBaseWord# base (NS a) = wordLogBase# base a +naturalLogBaseWord# base (NB a) = bigNatLogBaseWord# base a + +-- | Logarithm for an arbitrary base +naturalLogBaseWord :: Word -> Natural -> Word +naturalLogBaseWord (W# base) !a = W# (naturalLogBaseWord# base a) + +-- | Logarithm for an arbitrary base +naturalLogBase# :: Natural -> Natural -> Word# +{-# NOINLINE naturalLogBase# #-} +naturalLogBase# (NS base) !a = naturalLogBaseWord# base a +naturalLogBase# (NB _ ) (NS _) = 0## +naturalLogBase# (NB base) (NB a) = bigNatLogBase# base a + +-- | Logarithm for an arbitrary base +naturalLogBase :: Natural -> Natural -> Word +naturalLogBase !base !a = W# (naturalLogBase# base a) + +-- | \"@'naturalPowMod' /b/ /e/ /m/@\" computes base @/b/@ raised to +-- exponent @/e/@ modulo @/m/@. +naturalPowMod :: Natural -> Natural -> Natural -> Natural +{-# NOINLINE naturalPowMod #-} +naturalPowMod !_ !_ (NS 0##) = raiseDivZero +naturalPowMod _ _ (NS 1##) = NS 0## +naturalPowMod _ (NS 0##) _ = NS 1## +naturalPowMod (NS 0##) _ _ = NS 0## +naturalPowMod (NS 1##) _ _ = NS 1## +naturalPowMod (NS b) (NS e) (NS m) = NS (powModWord# b e m) +naturalPowMod b e (NS m) = NS (bigNatPowModWord# + (naturalToBigNat# b) + (naturalToBigNat# e) + m) +naturalPowMod b e (NB m) = naturalFromBigNat# + (bigNatPowMod (naturalToBigNat# b) + (naturalToBigNat# e) + m) + +-- | Compute the number of digits of the Natural in the given base. +-- +-- `base` must be > 1 +naturalSizeInBase# :: Word# -> Natural -> Word# +{-# NOINLINE naturalSizeInBase# #-} +naturalSizeInBase# base (NS w) = wordSizeInBase# base w +naturalSizeInBase# base (NB n) = bigNatSizeInBase# base n + +-- | Write a 'Natural' to @/addr/@ in base-256 representation and return the +-- number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: write most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +naturalToAddr# :: Natural -> Addr# -> Bool# -> State# s -> (# State# s, Word# #) +{-# NOINLINE naturalToAddr# #-} +naturalToAddr# (NS i) = wordToAddr# i +naturalToAddr# (NB n) = bigNatToAddr# n + +-- | Write a 'Natural' to @/addr/@ in base-256 representation and return the +-- number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: write most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +naturalToAddr :: Natural -> Addr# -> Bool# -> IO Word +naturalToAddr a addr e = IO \s -> case naturalToAddr# a addr e s of + (# s', w #) -> (# s', W# w #) + + +-- | Read a Natural in base-256 representation from an Addr#. +-- +-- The size is given in bytes. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Null higher limbs are automatically trimed. +naturalFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Natural #) +{-# NOINLINE naturalFromAddr# #-} +naturalFromAddr# sz addr e s = + case bigNatFromAddr# sz addr e s of + (# s', n #) -> (# s', naturalFromBigNat# n #) + +-- | Read a Natural in base-256 representation from an Addr#. +-- +-- The size is given in bytes. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Null higher limbs are automatically trimed. +naturalFromAddr :: Word# -> Addr# -> Bool# -> IO Natural +naturalFromAddr sz addr e = IO (naturalFromAddr# sz addr e) + + +-- | Write a Natural in base-256 representation and return the +-- number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +naturalToMutableByteArray# :: Natural -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #) +{-# NOINLINE naturalToMutableByteArray# #-} +naturalToMutableByteArray# (NS w) = wordToMutableByteArray# w +naturalToMutableByteArray# (NB a) = bigNatToMutableByteArray# a + +-- | Read a Natural in base-256 representation from a ByteArray#. +-- +-- The size is given in bytes. +-- +-- The endianness is selected with the Bool# parameter: most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- Null higher limbs are automatically trimed. +naturalFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> State# s -> (# State# s, Natural #) +{-# NOINLINE naturalFromByteArray# #-} +naturalFromByteArray# sz ba off e s = case bigNatFromByteArray# sz ba off e s of + (# s', a #) -> (# s', naturalFromBigNat# a #) diff --git a/src/GHC/Num/Natural.hs-boot b/src/GHC/Num/Natural.hs-boot new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Natural.hs-boot @@ -0,0 +1,27 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} + +module GHC.Num.Natural where + +import {-# SOURCE #-} GHC.Num.BigNat +import GHC.Num.Primitives +import GHC.Prim +import GHC.Types + +data Natural + = NS !Word# + | NB !BigNat + +naturalToWord# :: Natural -> Word# +naturalFromWord# :: Word# -> Natural +naturalFromBigNat# :: BigNat# -> Natural +naturalToBigNat# :: Natural -> BigNat# + +naturalZero :: Natural +naturalMul :: Natural -> Natural -> Natural +naturalRem :: Natural -> Natural -> Natural +naturalShiftR# :: Natural -> Word# -> Natural + +naturalIsZero :: Natural -> Bool +naturalTestBit# :: Natural -> Word# -> Bool# +naturalEq# :: Natural -> Natural -> Bool# diff --git a/src/GHC/Num/Primitives.hs b/src/GHC/Num/Primitives.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/Primitives.hs @@ -0,0 +1,660 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE ExplicitForAll #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE BinaryLiterals #-} +{-# OPTIONS_GHC -fexpose-all-unfoldings #-} + +module GHC.Num.Primitives + ( + -- * Bool# + Bool# + , (&&#) + , (||#) + , notB# + -- * Int# + , testBitI# + , minI# + , maxI# + , sgnI# + , absI# + , cmpI# + , intEncodeDouble# + , popCntI# + -- * Word# + , andNot# + , cmpW# + , bitW# + , maxW# + , minW# + , testBitW# + , shiftRW# + , plusWord3# + , plusWord12# + , quotRemWord3# + , wordFromAbsInt# + , wordLog2# + , wordLogBase# + , wordSizeInBase# + , wordIsPowerOf2# + , wordEncodeDouble# + , wordReverseBits# + , wordReverseBits32# + , wordReverseBytes# + -- ** Addr import/export + , wordFromAddr# + , wordFromAddrLE# + , wordFromAddrBE# + , wordToAddr# + , wordToAddrLE# + , wordToAddrBE# + , wordWriteAddrLE# + , wordWriteAddrBE# + -- ** ByteArray import/export + , wordFromByteArray# + , wordFromByteArrayLE# + , wordFromByteArrayBE# + , wordToMutableByteArray# + , wordToMutableByteArrayLE# + , wordToMutableByteArrayBE# + , wordWriteMutableByteArrayLE# + , wordWriteMutableByteArrayBE# + -- * Exception + , raiseUnderflow + , raiseUnderflow_Word# + , raiseDivZero + , raiseDivZero_Word# + , unexpectedValue + , unexpectedValue_Int# + , unexpectedValue_Word# + -- * IO + , ioWord# + , ioInt# + , ioVoid + , ioBool + ) +where + +#include "MachDeps.h" +#include "WordSize.h" + +-- Required for WORDS_BIGENDIAN +#include + +#if (__GLASGOW_HASKELL__ < 811) +import GHC.Magic +#else +import GHC.Prim.Exception +#endif + +import GHC.Prim +import GHC.Types +import GHC.Tuple () -- See Note [Depend on GHC.Tuple] in GHC.Base + +default () + +---------------------------------- +-- Bool# +---------------------------------- + +type Bool# = Int# + +(&&#) :: Bool# -> Bool# -> Bool# +(&&#) = andI# + +(||#) :: Bool# -> Bool# -> Bool# +(||#) = orI# + +notB# :: Bool# -> Bool# +notB# x = x `xorI#` 1# + +infixr 3 &&# +infixr 2 ||# + + +---------------------------------- +-- Int# +---------------------------------- + +-- | Branchless `abs` +absI# :: Int# -> Int# +absI# i# = (i# `xorI#` nsign) -# nsign + where + -- nsign = negateInt# (i# <# 0#) + nsign = uncheckedIShiftRA# i# (WORD_SIZE_IN_BITS# -# 1#) + +-- | Branchless `signum` +sgnI# :: Int# -> Int# +sgnI# x# = (x# ># 0#) -# (x# <# 0#) + +-- | Population count +popCntI# :: Int# -> Word# +popCntI# i = popCnt# (int2Word# i) + +-- | Branchless comparison +cmpI# :: Int# -> Int# -> Int# +cmpI# x# y# = (x# ># y#) -# (x# <# y#) + +testBitI# :: Int# -> Word# -> Bool# +testBitI# x i = ((uncheckedIShiftL# 1# (word2Int# i)) `andI#` x) /=# 0# + +minI# :: Int# -> Int# -> Int# +minI# x y | isTrue# (x <=# y) = x + | True = y + +maxI# :: Int# -> Int# -> Int# +maxI# x y | isTrue# (x >=# y) = x + | True = y + +-- | Encode (# Int# mantissa, Int# exponent #) into a Double#. +-- +-- (provided by GHC's RTS) +foreign import ccall unsafe "__int_encodeDouble" + intEncodeDouble# :: Int# -> Int# -> Double# + +---------------------------------- +-- Word# +---------------------------------- + +andNot# :: Word# -> Word# -> Word# +andNot# x y = x `and#` (not# y) + +cmpW# :: Word# -> Word# -> Ordering +{-# INLINE cmpW# #-} +cmpW# x# y# + | isTrue# (x# `ltWord#` y#) = LT + | isTrue# (x# `eqWord#` y#) = EQ + | True = GT + +-- | Return the absolute value of the Int# in a Word# +wordFromAbsInt# :: Int# -> Word# +wordFromAbsInt# i + | isTrue# (i >=# 0#) = int2Word# i + | True = int2Word# (negateInt# i) + +minW# :: Word# -> Word# -> Word# +minW# x# y# | isTrue# (x# `leWord#` y#) = x# + | True = y# + +maxW# :: Word# -> Word# -> Word# +maxW# x# y# | isTrue# (x# `gtWord#` y#) = x# + | True = y# + +bitW# :: Int# -> Word# +bitW# k = 1## `uncheckedShiftL#` k + +testBitW# :: Word# -> Word# -> Bool# +testBitW# w k = w `and#` (1## `uncheckedShiftL#` word2Int# k) `neWord#` 0## + +-- | Safe right shift for Word# +shiftRW# :: Word# -> Word# -> Word# +shiftRW# a b + | isTrue# (b `geWord#` WORD_SIZE_IN_BITS##) = 0## + | True = a `uncheckedShiftRL#` (word2Int# b) + +-- | (h,l) <- a + (hb,lb) +plusWord12# :: Word# -> (# Word#,Word# #) -> (# Word#,Word# #) +{-# INLINABLE plusWord12# #-} +plusWord12# a0 (# b1,b0 #) = (# m1, m0 #) + where + !(# t, m0 #) = plusWord2# a0 b0 + !m1 = plusWord# t b1 + +-- | Add 3 values together +plusWord3# :: Word# -> Word# -> Word# -> (# Word#, Word# #) +{-# INLINABLE plusWord3# #-} +plusWord3# a b c = (# r1, r0 #) + where + !(# t1, t0 #) = plusWord2# a b + !(# t2, r0 #) = plusWord2# t0 c + !r1 = plusWord# t1 t2 + + +-- | 2-by-1 large division +-- +-- Requires: +-- b0 /= 0 +-- a1 >= b0 (not required, but if not q1=0) +quotRemWord3# :: (# Word#,Word# #) -> Word# -> (# (# Word#,Word# #),Word# #) +quotRemWord3# (# a1,a0 #) b0 = (# (# q1, q0 #), r0 #) + where + !(# q1, r' #) = quotRemWord# a1 b0 + !(# q0, r0 #) = quotRemWord2# r' a0 b0 + + + +-- | Encode (# Word# mantissa, Int# exponent #) into a Double#. +-- +-- (provided by GHC's RTS) +foreign import ccall unsafe "__word_encodeDouble" + wordEncodeDouble# :: Word# -> Int# -> Double# + +-- | Compute base-2 log of 'Word#' +-- +-- This is internally implemented as count-leading-zeros machine instruction. +wordLog2# :: Word# -> Word# +wordLog2# w = (WORD_SIZE_IN_BITS## `minusWord#` 1##) `minusWord#` (clz# w) + +-- | Logarithm for an arbitrary base +wordLogBase# :: Word# -> Word# -> Word# +wordLogBase# base a + | isTrue# (base `leWord#` 1##) + = unexpectedValue_Word# void# + + | 2## <- base + = wordLog2# a + + | True + = case go base of (# _, e' #) -> e' + where + goSqr pw = case timesWord2# pw pw of + (# 0##, l #) -> go l + (# _ , _ #) -> (# a, 0## #) + go pw = if isTrue# (a `ltWord#` pw) + then (# a, 0## #) + else case goSqr pw of + (# q, e #) -> if isTrue# (q `ltWord#` pw) + then (# q, 2## `timesWord#` e #) + else (# q `quotWord#` pw + , 2## `timesWord#` e `plusWord#` 1## #) + +wordSizeInBase# :: Word# -> Word# -> Word# +wordSizeInBase# _ 0## = 0## +wordSizeInBase# base w = 1## `plusWord#` wordLogBase# base w + +-- | Indicate if the value is a power of two and which one +wordIsPowerOf2# :: Word# -> (# (# #) | Word# #) +wordIsPowerOf2# w + | isTrue# (popCnt# w `neWord#` 1##) = (# (# #) | #) + | True = (# | ctz# w #) + +-- | Reverse bytes in a Word# +wordReverseBytes# :: Word# -> Word# +wordReverseBytes# x0 = r + where +#if WORD_SIZE_IN_BITS == 64 + x1 = ((x0 `and#` 0x00FF00FF00FF00FF##) `uncheckedShiftL#` 8#) `or#` ((x0 `and#` 0xFF00FF00FF00FF00##) `uncheckedShiftRL#` 8#) + x2 = ((x1 `and#` 0x0000FFFF0000FFFF##) `uncheckedShiftL#` 16#) `or#` ((x1 `and#` 0xFFFF0000FFFF0000##) `uncheckedShiftRL#` 16#) + r = ((x2 `and#` 0x00000000FFFFFFFF##) `uncheckedShiftL#` 32#) `or#` ((x2 `and#` 0xFFFFFFFF00000000##) `uncheckedShiftRL#` 32#) +#else + x1 = ((x0 `and#` 0x00FF00FF##) `uncheckedShiftL#` 8#) `or#` ((x0 `and#` 0xFF00FF00##) `uncheckedShiftRL#` 8#) + r = ((x1 `and#` 0x0000FFFF##) `uncheckedShiftL#` 16#) `or#` ((x1 `and#` 0xFFFF0000##) `uncheckedShiftRL#` 16#) +#endif + + +-- | Reverse bits in a Word# +wordReverseBits# :: Word# -> Word# +wordReverseBits# x0 = r + where +#if WORD_SIZE_IN_BITS == 64 + x1 = ((x0 `and#` 0x5555555555555555##) `uncheckedShiftL#` 1#) `or#` ((x0 `and#` 0xAAAAAAAAAAAAAAAA##) `uncheckedShiftRL#` 1#) + x2 = ((x1 `and#` 0x3333333333333333##) `uncheckedShiftL#` 2#) `or#` ((x1 `and#` 0xCCCCCCCCCCCCCCCC##) `uncheckedShiftRL#` 2#) + x3 = ((x2 `and#` 0x0F0F0F0F0F0F0F0F##) `uncheckedShiftL#` 4#) `or#` ((x2 `and#` 0xF0F0F0F0F0F0F0F0##) `uncheckedShiftRL#` 4#) + x4 = ((x3 `and#` 0x00FF00FF00FF00FF##) `uncheckedShiftL#` 8#) `or#` ((x3 `and#` 0xFF00FF00FF00FF00##) `uncheckedShiftRL#` 8#) + x5 = ((x4 `and#` 0x0000FFFF0000FFFF##) `uncheckedShiftL#` 16#) `or#` ((x4 `and#` 0xFFFF0000FFFF0000##) `uncheckedShiftRL#` 16#) + r = ((x5 `and#` 0x00000000FFFFFFFF##) `uncheckedShiftL#` 32#) `or#` ((x5 `and#` 0xFFFFFFFF00000000##) `uncheckedShiftRL#` 32#) +#else + x1 = ((x0 `and#` 0x55555555##) `uncheckedShiftL#` 1#) `or#` ((x0 `and#` 0xAAAAAAAA##) `uncheckedShiftRL#` 1#) + x2 = ((x1 `and#` 0x33333333##) `uncheckedShiftL#` 2#) `or#` ((x1 `and#` 0xCCCCCCCC##) `uncheckedShiftRL#` 2#) + x3 = ((x2 `and#` 0x0F0F0F0F##) `uncheckedShiftL#` 4#) `or#` ((x2 `and#` 0xF0F0F0F0##) `uncheckedShiftRL#` 4#) + x4 = ((x3 `and#` 0x00FF00FF##) `uncheckedShiftL#` 8#) `or#` ((x3 `and#` 0xFF00FF00##) `uncheckedShiftRL#` 8#) + r = ((x4 `and#` 0x0000FFFF##) `uncheckedShiftL#` 16#) `or#` ((x4 `and#` 0xFFFF0000##) `uncheckedShiftRL#` 16#) +#endif + +-- | Reverse bits in the Word32 subwords composing a Word# +wordReverseBits32# :: Word# -> Word# +#if WORD_SIZE_IN_BITS == 64 +wordReverseBits32# x0 = r + where + x1 = ((x0 `and#` 0x5555555555555555##) `uncheckedShiftL#` 1#) `or#` ((x0 `and#` 0xAAAAAAAAAAAAAAAA##) `uncheckedShiftRL#` 1#) + x2 = ((x1 `and#` 0x3333333333333333##) `uncheckedShiftL#` 2#) `or#` ((x1 `and#` 0xCCCCCCCCCCCCCCCC##) `uncheckedShiftRL#` 2#) + x3 = ((x2 `and#` 0x0F0F0F0F0F0F0F0F##) `uncheckedShiftL#` 4#) `or#` ((x2 `and#` 0xF0F0F0F0F0F0F0F0##) `uncheckedShiftRL#` 4#) + x4 = ((x3 `and#` 0x00FF00FF00FF00FF##) `uncheckedShiftL#` 8#) `or#` ((x3 `and#` 0xFF00FF00FF00FF00##) `uncheckedShiftRL#` 8#) + r = ((x4 `and#` 0x0000FFFF0000FFFF##) `uncheckedShiftL#` 16#) `or#` ((x4 `and#` 0xFFFF0000FFFF0000##) `uncheckedShiftRL#` 16#) +#else +wordReverseBits32# x0 = wordReverseBits# x0 +#endif + + +-- | Write a Word to @/addr/@ in base-256 little-endian representation and +-- return the number of bytes written. +wordToAddrLE# :: Word# -> Addr# -> State# s -> (# State# s, Word# #) +wordToAddrLE# x addr = go x 0# + where + go w c s + | 0## <- w + = (# s, int2Word# c #) + + | True + = case writeWord8OffAddr# addr c (w `and#` 0xFF##) s of + s' -> go (w `uncheckedShiftRL#` 8#) (c +# 1#) s' + +-- | Write a Word to @/addr/@ in base-256 big-endian representation and +-- return the number of bytes written. +wordToAddrBE# :: Word# -> Addr# -> State# s -> (# State# s, Word# #) +wordToAddrBE# w addr = go 0# (WORD_SIZE_IN_BITS# -# clz) + where + !clz = word2Int# (clz# w `and#` (not# 0b0111##)) -- keep complete bytes + + go c sh s + | 0# <- sh + = (# s, int2Word# c #) + + | True + , w' <- (w `uncheckedShiftRL#` (sh -# 8#)) `and#` 0xFF## + = case writeWord8OffAddr# addr c w' s of + s' -> go (c +# 1#) (sh -# 8#) s' + +-- | Write a Word to @/addr/@ in base-256 representation and +-- return the number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: write most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +wordToAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Word# #) +wordToAddr# a addr 0# s = wordToAddrLE# a addr s +wordToAddr# a addr _ s = wordToAddrBE# a addr s + + +-- | Read a Word from @/addr/@ in base-256 little-endian representation. +-- +-- @'n' is the number of bytes to read. +wordFromAddrLE# :: Word# -> Addr# -> State# s -> (# State# s, Word# #) +wordFromAddrLE# n addr s + -- Optimize when we read a full word + | WORD_SIZE_IN_BYTES## <- n + = case readWordOffAddr# addr 0# s of +#if defined(WORDS_BIGENDIAN) + (# s', w #) -> (# s', wordReverseBytes# w #) +#else + (# s', w #) -> (# s', w #) +#endif + +wordFromAddrLE# n addr s0 = go 0## 0# s0 + where + go w c s + | isTrue# (c ==# word2Int# n) + = (# s, w #) + + | True + = case readWord8OffAddr# addr c s of + (# s', b #) -> go (w `or#` (b `uncheckedShiftL#` (c `uncheckedIShiftL#` 3#))) + (c +# 1#) + s' + +-- | Read a Word from @/addr/@ in base-256 big-endian representation. +-- +-- @'n' is the number of bytes to read. +wordFromAddrBE# :: Word# -> Addr# -> State# s -> (# State# s, Word# #) +wordFromAddrBE# n addr s + -- Optimize when we read a full word + | WORD_SIZE_IN_BYTES## <- n + = case readWordOffAddr# addr 0# s of +#if defined(WORDS_BIGENDIAN) + (# s', w #) -> (# s', w #) +#else + (# s', w #) -> (# s', wordReverseBytes# w #) +#endif + +wordFromAddrBE# n addr s0 = go 0## 0# s0 + where + go w c s + | isTrue# (c ==# word2Int# n) + = (# s, w #) + + | True + = case readWord8OffAddr# addr c s of + (# s', b #) -> go ((w `uncheckedShiftL#` 8#) `or#` b) + (c +# 1#) + s' + +-- | Read a Word from @/addr/@ in base-256 representation. +-- +-- @'n' is the number of bytes to read. +-- +-- The endianness is selected with the Bool# parameter: write most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +wordFromAddr# :: Word# -> Addr# -> Bool# -> State# s -> (# State# s, Word# #) +wordFromAddr# a addr 0# s = wordFromAddrLE# a addr s +wordFromAddr# a addr _ s = wordFromAddrBE# a addr s + + + +-- | Write a full word with little-endian encoding +wordWriteAddrLE# :: Word# -> Addr# -> State# s -> State# s +wordWriteAddrLE# w addr = writeWordOffAddr# addr 0# +#if defined(WORDS_BIGENDIAN) + (wordReverseBytes# w) +#else + w +#endif + +-- | Write a full word with little-endian encoding +wordWriteAddrBE# :: Word# -> Addr# -> State# s -> State# s +wordWriteAddrBE# w addr = writeWordOffAddr# addr 0# +#if defined(WORDS_BIGENDIAN) + w +#else + (wordReverseBytes# w) +#endif + +-- | Write a Word to @/MutableByteArray/@ in base-256 little-endian +-- representation and return the number of bytes written. +-- +-- The offset is in bytes. +wordToMutableByteArrayLE# :: Word# -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #) +wordToMutableByteArrayLE# x mba off = go x 0# + where + go w c s + | 0## <- w + = (# s, int2Word# c #) + + | True + = case writeWord8Array# mba (word2Int# off +# c) (w `and#` 0xFF##) s of + s' -> go (w `uncheckedShiftRL#` 8#) (c +# 1#) s' + +-- | Write a Word to @/MutableByteArray/@ in base-256 big-endian representation and +-- return the number of bytes written. +-- +-- The offset is in bytes. +wordToMutableByteArrayBE# :: Word# -> MutableByteArray# s -> Word# -> State# s -> (# State# s, Word# #) +wordToMutableByteArrayBE# w mba off = go 0# (WORD_SIZE_IN_BITS# -# clz) + where + !clz = word2Int# (clz# w `and#` (not# 0b0111##)) -- keep complete bytes + + go c sh s + | 0# <- sh + = (# s, int2Word# c #) + + | True + , w' <- (w `uncheckedShiftRL#` (sh -# 8#)) `and#` 0xFF## + = case writeWord8Array# mba (word2Int# off +# c) w' s of + s' -> go (c +# 1#) (sh -# 8#) s' + +-- | Write a Word to @/MutableByteArray/@ in base-256 representation and +-- return the number of bytes written. +-- +-- The endianness is selected with the Bool# parameter: write most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +-- +-- The offset is in bytes. +wordToMutableByteArray# :: Word# -> MutableByteArray# s -> Word# -> Bool# -> State# s -> (# State# s, Word# #) +wordToMutableByteArray# a mba off 0# s = wordToMutableByteArrayLE# a mba off s +wordToMutableByteArray# a mba off _ s = wordToMutableByteArrayBE# a mba off s + +-- | Write a full word with little-endian encoding +wordWriteMutableByteArrayLE# :: Word# -> MutableByteArray# s -> Word# -> State# s -> State# s +wordWriteMutableByteArrayLE# w mba off = writeWord8ArrayAsWord# mba (word2Int# off) +#if defined(WORDS_BIGENDIAN) + (wordReverseBytes# w) +#else + w +#endif + +-- | Write a full word with little-endian encoding +wordWriteMutableByteArrayBE# :: Word# -> MutableByteArray# s -> Word# -> State# s -> State# s +wordWriteMutableByteArrayBE# w mba off = writeWord8ArrayAsWord# mba (word2Int# off) +#if defined(WORDS_BIGENDIAN) + w +#else + (wordReverseBytes# w) +#endif + +-- | Read a Word from @/ByteArray/@ in base-256 little-endian representation. +-- +-- @'n' is the number of bytes to read. +wordFromByteArrayLE# :: Word# -> ByteArray# -> Word# -> Word# +wordFromByteArrayLE# n ba off = + case n of + -- Optimize when we read a full word + WORD_SIZE_IN_BYTES## -> case indexWord8ArrayAsWord# ba (word2Int# off) of +#if defined(WORDS_BIGENDIAN) + w -> wordReverseBytes# w +#else + w -> w +#endif + + _ -> let + go w c + | isTrue# (c ==# word2Int# n) + = w + + | True + = case indexWord8Array# ba (word2Int# off +# c) of + b -> go (w `or#` (b `uncheckedShiftL#` (c `uncheckedIShiftL#` 3#))) + (c +# 1#) + in go 0## 0# + +-- | Read a Word from @/ByteArray/@ in base-256 big-endian representation. +-- +-- @'n' is the number of bytes to read. +wordFromByteArrayBE# :: Word# -> ByteArray# -> Word# -> Word# +wordFromByteArrayBE# n ba off + -- Optimize when we read a full word + | WORD_SIZE_IN_BYTES## <- n + = case indexWord8ArrayAsWord# ba (word2Int# off) of +#if defined(WORDS_BIGENDIAN) + w -> w +#else + w -> wordReverseBytes# w +#endif + +wordFromByteArrayBE# n ba off = go 0## 0# + where + go w c + | isTrue# (c ==# word2Int# n) + = w + + | True + = case indexWord8Array# ba (word2Int# off +# c) of + b -> go ((w `uncheckedShiftL#` 8#) `or#` b) (c +# 1#) + +-- | Read a Word from @/ByteArray/@ in base-256 representation. +-- +-- @'n' is the number of bytes to read. +-- +-- The endianness is selected with the Bool# parameter: write most significant +-- byte first (big-endian) if @1#@ or least significant byte first +-- (little-endian) if @0#@. +wordFromByteArray# :: Word# -> ByteArray# -> Word# -> Bool# -> Word# +wordFromByteArray# a ba off 0# = wordFromByteArrayLE# a ba off +wordFromByteArray# a ba off _ = wordFromByteArrayBE# a ba off + +---------------------------------- +-- IO +---------------------------------- + +ioVoid :: IO a -> State# RealWorld -> State# RealWorld +ioVoid (IO io) s = case io s of + (# s', _ #) -> s' + +ioWord# :: IO Word -> State# RealWorld -> (# State# RealWorld, Word# #) +ioWord# (IO io) s = case io s of + (# s', W# w #) -> (# s', w #) + +ioInt# :: IO Int -> State# RealWorld -> (# State# RealWorld, Int# #) +ioInt# (IO io) s = case io s of + (# s', I# i #) -> (# s', i #) + +ioBool :: IO Bool -> State# RealWorld -> (# State# RealWorld, Bool# #) +ioBool (IO io) s = case io s of + (# s', False #) -> (# s', 0# #) + (# s', True #) -> (# s', 1# #) + + +---------------------------------- +-- Exception +---------------------------------- + +-- Note [ghc-bignum exceptions] +-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +-- +-- `ghc-bignum` package can't depend on `base` package (it would create a cyclic +-- dependency). Hence it can't import "Control.Exception" and throw exceptions +-- the usual way. Instead it uses some wired-in functions from `ghc-prim` which +-- themselves call wired-in functions from the RTS: raiseOverflow, +-- raiseUnderflow, raiseDivZero. +-- +-- We have to be careful when we want to throw an exception instead of returning +-- an unlifted value (e.g. Word#, unboxed tuple, etc.). We have to ensure the +-- evaluation of the exception throwing function before returning a dummy value, +-- otherwise it will be removed by the simplifier as dead-code. +-- +-- foo :: ... -> Word# +-- foo = ... case raiseDivZero of +-- !_ -> 0## -- the bang-pattern is necessary! +-- -- 0## is a dummy value (unreachable code) +-- + +unexpectedValue_Int# :: Void# -> Int# +unexpectedValue_Int# _ = case unexpectedValue of + !_ -> 0# -- see Note [ghc-bignum exceptions] + +unexpectedValue_Word# :: Void# -> Word# +unexpectedValue_Word# _ = case unexpectedValue of + !_ -> 0## -- see Note [ghc-bignum exceptions] + +raiseDivZero_Word# :: Void# -> Word# +raiseDivZero_Word# _ = case raiseDivZero of + !_ -> 0## -- see Note [ghc-bignum exceptions] + +raiseUnderflow_Word# :: Void# -> Word# +raiseUnderflow_Word# _ = case raiseUnderflow of + !_ -> 0## -- see Note [ghc-bignum exceptions] + +#if (__GLASGOW_HASKELL__ >= 811) + +unexpectedValue :: a +unexpectedValue = raiseOverflow + +#else + +-- Before GHC 8.11 we use the exception trick taken from #14664 +exception :: a +{-# NOINLINE exception #-} +exception = runRW# \s -> + case atomicLoop s of + (# _, a #) -> a + where + atomicLoop s = atomically# atomicLoop s + +raiseUnderflow :: a +raiseUnderflow = exception + +raiseDivZero :: a +raiseDivZero = exception + +unexpectedValue :: a +unexpectedValue = exception + +#endif diff --git a/src/GHC/Num/WordArray.hs b/src/GHC/Num/WordArray.hs new file mode 100644 --- /dev/null +++ b/src/GHC/Num/WordArray.hs @@ -0,0 +1,434 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE BlockArguments #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} + +module GHC.Num.WordArray where + +import GHC.Prim +import GHC.Magic +import GHC.Types +import GHC.Num.Primitives + +#include "MachDeps.h" +#include "WordSize.h" + +default () + +-- | Unlifted array of Word +type WordArray# = ByteArray# +type MutableWordArray# = MutableByteArray# + +data WordArray = WordArray WordArray# +data MutableWordArray s = MutableWordArray (MutableWordArray# s) + +-- | Convert limb count into byte count +wordsToBytes# :: Int# -> Int# +wordsToBytes# i = i `uncheckedIShiftL#` WORD_SIZE_BYTES_SHIFT# + +-- | Convert byte count into limb count +bytesToWords# :: Int# -> Int# +bytesToWords# i = i `uncheckedIShiftRL#` WORD_SIZE_BYTES_SHIFT# + + +-- | Create a new WordArray# of the given size (*in Word#*) and apply the +-- action to it before returning it frozen +withNewWordArray# + :: Int# -- ^ Size in Word + -> (MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld) + -> WordArray# +withNewWordArray# sz act = case runRW# io of (# _, a #) -> a + where + io s = + case newWordArray# sz s of { (# s, mwa #) -> + case act mwa s of { s -> + unsafeFreezeByteArray# mwa s + }} + +-- | Create two new WordArray# of the given sizes (*in Word#*) and apply the +-- action to them before returning them frozen +withNewWordArray2# + :: Int# -- ^ Size in Word + -> Int# -- ^ Ditto + -> (MutableWordArray# RealWorld + -> MutableWordArray# RealWorld + -> State# RealWorld + -> State# RealWorld) + -> (# WordArray#, WordArray# #) +withNewWordArray2# sz1 sz2 act = case runRW# io of (# _, a #) -> a + where + io s = + case newWordArray# sz1 s of { (# s, mwa1 #) -> + case newWordArray# sz2 s of { (# s, mwa2 #) -> + case act mwa1 mwa2 s of { s -> + case unsafeFreezeByteArray# mwa1 s of { (# s, wa1 #) -> + case unsafeFreezeByteArray# mwa2 s of { (# s, wa2 #) -> + (# s, (# wa1, wa2 #) #) + }}}}} + +-- | Create a new WordArray# +newWordArray# :: Int# -> State# s -> (# State# s, MutableWordArray# s #) +newWordArray# sz s = newByteArray# (wordsToBytes# sz) s + +-- | Create a new WordArray# of the given size (*in Word#*), apply the action to +-- it, trim its most significant zeroes, then return it frozen +withNewWordArrayTrimed# + :: Int# -- ^ Size in Word + -> (MutableWordArray# RealWorld -> State# RealWorld -> State# RealWorld) + -> WordArray# +withNewWordArrayTrimed# sz act = withNewWordArray# sz \mwa s -> + case act mwa s of + s' -> mwaTrimZeroes# mwa s' + +-- | Create two new WordArray# of the given sizes (*in Word#*), apply the action +-- to them, trim their most significant zeroes, then return them frozen +withNewWordArray2Trimed# + :: Int# -- ^ Size in Word + -> Int# -- ^ Ditto + -> (MutableWordArray# RealWorld + -> MutableWordArray# RealWorld + -> State# RealWorld + -> State# RealWorld) + -> (# WordArray#, WordArray# #) +withNewWordArray2Trimed# sz1 sz2 act = withNewWordArray2# sz1 sz2 \mwa1 mwa2 s -> + case act mwa1 mwa2 s of + s' -> case mwaTrimZeroes# mwa1 s' of + s'' -> mwaTrimZeroes# mwa2 s'' + +-- | Create a new WordArray# of the given size (*in Word#*), apply the action to +-- it. If the action returns true#, trim its most significant zeroes, then +-- return it frozen. Otherwise, return (). +withNewWordArrayTrimedMaybe# + :: Int# -- ^ Size in Word + -> (MutableWordArray# RealWorld -> State# RealWorld -> (# State# RealWorld, Bool# #)) + -> (# (# #) | WordArray# #) +withNewWordArrayTrimedMaybe# sz act = case runRW# io of (# _, a #) -> a + where + io s = + case newWordArray# sz s of + (# s, mwa #) -> case act mwa s of + (# s, 0# #) -> (# s, (# (# #) | #) #) + (# s, _ #) -> case mwaTrimZeroes# mwa s of + s -> case unsafeFreezeByteArray# mwa s of + (# s, ba #) -> (# s, (# | ba #) #) + +-- | Create a WordArray# from two Word# +-- +-- `wordArrayFromWord2# h l +-- where h is the most significant word +-- l is the least significant word +wordArrayFromWord2# :: Word# -> Word# -> WordArray# +wordArrayFromWord2# h l = + withNewWordArray# 2# \mwa s -> + case mwaWrite# mwa 0# l s of + s -> mwaWrite# mwa 1# h s + +-- | Create a WordArray# from one Word# +wordArrayFromWord# :: Word# -> WordArray# +wordArrayFromWord# w = + withNewWordArray# 1# \mwa s -> + mwaWrite# mwa 0# w s + +-- | Word array size +wordArraySize# :: WordArray# -> Int# +wordArraySize# ba = bytesToWords# (sizeofByteArray# ba) + + +-- | Equality test for WordArray# + +-- | Get size in Words +mwaSize# :: MutableWordArray# s-> State# s -> (# State# s, Int# #) +mwaSize# mba s = case getSizeofMutableByteArray# mba s of + (# s2, sz #) -> (# s2, bytesToWords# sz #) + +-- | Get the last Word (must be non empty!) +wordArrayLast# :: WordArray# -> Word# +wordArrayLast# a = indexWordArray# a (wordArraySize# a -# 1#) + +-- | Copy Words from a WordArray +-- +-- Don't do anything if the number of words to copy is <= 0 +mwaArrayCopy# :: MutableByteArray# s -> Int# -> WordArray# -> Int# -> Int# -> State# s -> State# s +mwaArrayCopy# dst dstIdx src srcIdx n s + | isTrue# (n <=# 0#) = s + | True = copyByteArray# + src (wordsToBytes# srcIdx) + dst (wordsToBytes# dstIdx) + (wordsToBytes# n) s + +-- | Shrink last words of a WordArray +mwaShrink# :: MutableByteArray# s -> Int# -> State# s -> State# s +mwaShrink# _mwa 0# s = s +mwaShrink# mwa i s = + case mwaSize# mwa s of + (# s, n #) -> shrinkMutableByteArray# mwa (wordsToBytes# (n -# i)) s + +-- | Set size +mwaSetSize# :: MutableByteArray# s -> Int# -> State# s -> State# s +mwaSetSize# mwa n s = shrinkMutableByteArray# mwa (wordsToBytes# n) s + +-- | Copy the WordArray into the MWA and shrink the size of MWA to the one of +-- the WordArray +mwaInitCopyShrink# :: MutableByteArray# s -> WordArray# -> State# s -> State# s +mwaInitCopyShrink# mwa wa s = + case mwaArrayCopy# mwa 0# wa 0# (wordArraySize# wa) s of + s -> mwaSetSize# mwa (wordArraySize# wa) s + +-- | Trim ending zeroes +mwaTrimZeroes# :: MutableByteArray# s -> State# s -> State# s +mwaTrimZeroes# mwa s1 = + case mwaClz mwa s1 of + (# s2, 0# #) -> s2 + (# s2, c #) -> mwaShrink# mwa c s2 + +-- | Count leading zero Words +mwaClz :: MutableWordArray# s -> State# s -> (# State# s, Int# #) +mwaClz mwa s1 = case mwaSize# mwa s1 of + (# s2,sz #) -> mwaClzAt mwa (sz -# 1#) s2 + +-- | Count leading zero Words starting at given position +mwaClzAt :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Int# #) +mwaClzAt mwa = go 0# + where + go c i s + | isTrue# (i <# 0#) = (# s, c #) + | True = case readWordArray# mwa i s of + (# s', 0## #) -> go (c +# 1#) (i -# 1#) s' + (# s', _ #) -> (# s', c #) + +-- | Count leading zero Words starting at given position +waClzAt :: WordArray# -> Int# -> Int# +waClzAt wa = go 0# + where + go c i + | isTrue# (i <# 0#) + = c + + | 0## <- indexWordArray# wa i + = go (c +# 1#) (i -# 1#) + + | True + = c + +-- | Compare the most signiciant limbs of a and b. The comparison stops (i.e. +-- returns EQ) when there isn't enough lims in a or b to perform another +-- comparison. +wordArrayCompareMSWords :: WordArray# -> WordArray# -> Ordering +wordArrayCompareMSWords wa wb + | 0# <- szA + , 0# <- szB + = EQ + + | 0# <- szA + = LT + + | 0# <- szB + = GT + + | True + = go (szA -# 1#) (szB -# 1#) + where + szA = wordArraySize# wa + szB = wordArraySize# wb + + go i j + | isTrue# (i <# 0#) = EQ + | isTrue# (j <# 0#) = EQ + | True = + let + a = indexWordArray# wa i + b = indexWordArray# wb j + in if | isTrue# (a `gtWord#` b) -> GT + | isTrue# (b `gtWord#` a) -> LT + | True -> go (i -# 1#) (j -# 1#) + + +-- | Compute MutableWordArray <- WordArray + Word +-- +-- The MutableWordArray may not be initialized and will be erased anyway. +-- +-- Input: Size(MutableWordArray) = Size(WordArray) + 1 +-- Output: Size(MutableWordArray) = Size(WordArray) [+ 1] +mwaInitArrayPlusWord :: MutableWordArray# s -> WordArray# -> Word# -> State# s -> State#s +mwaInitArrayPlusWord mwa wa = go 0# + where + sz = wordArraySize# wa + go i carry s + | isTrue# (i ># sz) = s + | isTrue# (i ==# sz) = mwaWriteOrShrink mwa carry i s + | 0## <- carry = -- copy higher remaining words and shrink the mwa + case mwaArrayCopy# mwa i wa i (sz -# i) s of + s2 -> mwaShrink# mwa 1# s2 + | True = let !(# l,c #) = addWordC# (indexWordArray# wa i) carry + in case mwaWrite# mwa i l s of + s2 -> go (i +# 1#) (int2Word# c) s2 + +-- | Write the most-significant Word: +-- * if it is 0: shrink the array of 1 Word +-- * otherwise: write it +mwaWriteOrShrink :: MutableWordArray# s -> Word# -> Int# -> State# s -> State# s +mwaWriteOrShrink mwa 0## _i s = mwaShrink# mwa 1# s +mwaWriteOrShrink mwa w i s = mwaWrite# mwa i w s + +-- | Compute the index of the most-significant Word and write it. +mwaWriteMostSignificant :: MutableWordArray# s -> Word# -> State# s -> State# s +mwaWriteMostSignificant mwa w s = + case mwaSize# mwa s of + (# s', sz #) -> mwaWriteOrShrink mwa w (sz -# 1#) s' + +-- | MutableWordArray <- zipWith op wa1 wa2 +-- +-- Required output: Size(MutableWordArray) = min Size(wa1) Size(wa2) +mwaInitArrayBinOp :: MutableWordArray# s -> WordArray# -> WordArray# -> (Word# -> Word# -> Word#) -> State# s -> State#s +mwaInitArrayBinOp mwa wa wb op s = go 0# s + where + !sz = minI# (wordArraySize# wa) (wordArraySize# wb) + go i s' + | isTrue# (i ==# sz) = s' + | True = + case indexWordArray# wa i `op` indexWordArray# wb i of + v -> case mwaWrite# mwa i v s' of + s'' -> go (i +# 1#) s'' + +-- | Write an element of the MutableWordArray +mwaWrite# :: MutableWordArray# s -> Int# -> Word# -> State# s -> State# s +mwaWrite# = writeWordArray# + +-- | Fill some part of a MutableWordArray with the given Word# +mwaFill# :: MutableWordArray# s -> Word# -> Word# -> Word# -> State# s -> State# s +mwaFill# _ _ _ 0## s = s +mwaFill# mwa v off n s = case mwaWrite# mwa (word2Int# off) v s of + s' -> mwaFill# mwa v (off `plusWord#` 1##) (n `minusWord#` 1##) s' + +-- | Add Word# inplace (a the specified offset) in the mwa with carry propagation. +mwaAddInplaceWord# :: MutableWordArray# d -> Int# -> Word# -> State# d -> State# d +mwaAddInplaceWord# _ _ 0## s = s +mwaAddInplaceWord# mwa i y s = case readWordArray# mwa i s of + (# s1, x #) -> let !(# h,l #) = plusWord2# x y + in case mwaWrite# mwa i l s1 of + s2 -> mwaAddInplaceWord# mwa (i +# 1#) h s2 + +-- | Sub Word# inplace (at the specified offset) in the mwa with carry +-- propagation. +-- +-- Return False# on underflow +mwaSubInplaceWord# + :: MutableWordArray# d + -> Int# + -> Word# + -> State# d + -> (# State# d, Bool# #) +mwaSubInplaceWord# mwa ii iw s1 = case mwaSize# mwa s1 of + (# is, sz #) -> + let + go _ 0## s = (# s, 1# #) -- no underflow + go i y s + | isTrue# (i >=# sz) = (# s, 0# #) -- underflow + | True = case readWordArray# mwa i s of + (# s1, x #) -> let !(# l,h #) = subWordC# x y + in case mwaWrite# mwa i l s1 of + s2 -> go (i +# 1#) (int2Word# h) s2 + in go ii iw is + + +-- | Trim `a` of `k` less significant limbs and then compare the result with `b` +-- +-- "mwa" doesn't need to be trimmed +mwaTrimCompare :: Int# -> MutableWordArray# s -> WordArray# -> State# s -> (# State# s, Ordering #) +mwaTrimCompare k mwa wb s1 + | (# s, szA #) <- mwaSize# mwa s1 + , szB <- wordArraySize# wb + = + let + go i s + | isTrue# (i <# 0#) = (# s, EQ #) + | True = case readWordArray# mwa (i +# k) s of + (# s2, ai #) -> + let bi = if isTrue# (i >=# szB) + then 0## + else indexWordArray# wb i + in if | isTrue# (ai `gtWord#` bi) -> (# s2, GT #) + | isTrue# (bi `gtWord#` ai) -> (# s2, LT #) + | True -> go (i -# 1#) s2 + + szTrimA = szA -# k + + in if | isTrue# (szTrimA <# szB) -> (# s, LT #) + | True -> go (szA -# k -# 1#) s + + +-- | Sub array inplace (at the specified offset) in the mwa with carry propagation. +-- +-- We don't trim the resulting array! +-- +-- Return False# on underflow. +mwaSubInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> (# State# d, Bool# #) +mwaSubInplaceArray mwa off wb = go (wordArraySize# wb -# 1#) + where + go i s + | isTrue# (i <# 0#) = (# s, 1# #) -- no underflow + | True + = case mwaSubInplaceWord# mwa (off +# i) (indexWordArray# wb i) s of + (# s2, 1# #) -> go (i -# 1#) s2 + (# s2, _ #) -> (# s2, 0# #) -- underflow + +-- | Add array inplace (a the specified offset) in the mwa with carry propagation. +-- +-- Upper bound of the result mutable aray is not checked against overflow. +mwaAddInplaceArray :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> State# d +mwaAddInplaceArray mwa off wb = go 0# 0## + where + !maxi = wordArraySize# wb + go i c s + | isTrue# (i ==# maxi) = mwaAddInplaceWord# mwa (i +# off) c s + | True + = case readWordArray# mwa (i +# off) s of + (# s, v #) -> case plusWord3# v (indexWordArray# wb i) c of + (# c', v' #) -> case writeWordArray# mwa (i +# off) v' s of + s -> go (i +# 1#) c' s + +-- | Sub array inplace (at the specified offset) in the mwa with carry propagation. +-- +-- We don't trim the resulting array! +-- +-- Return False# on underflow. +mwaSubInplaceMutableArray :: MutableWordArray# d -> Int# -> MutableWordArray# d -> State# d -> (# State# d, Bool# #) +mwaSubInplaceMutableArray mwa off mwb s0 = + case mwaSize# mwb s0 of + (# s1, szB #) -> go (szB -# 1#) s1 + where + go i s + | isTrue# (i <# 0#) = (# s, 1# #) -- no underflow + | True + = case readWordArray# mwb i s of + (# s1, bi #) -> case mwaSubInplaceWord# mwa (off +# i) bi s1 of + (# s2, 1# #) -> go (i -# 1#) s2 + (# s2, _ #) -> (# s2, 0# #) -- underflow + +-- | Sub an array inplace and then trim zeroes +-- +-- Don't check overflow. The caller must ensure that a>=b +mwaSubInplaceArrayTrim :: MutableWordArray# d -> Int# -> WordArray# -> State# d -> State# d +mwaSubInplaceArrayTrim mwa off wb s = + case mwaSubInplaceArray mwa off wb s of + (# s', _ #) -> mwaTrimZeroes# mwa s' + + +-- | Read an indexed Word in the MutableWordArray. If the index is out-of-bound, +-- return zero. +mwaReadOrZero :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #) +mwaReadOrZero mwa i s = case mwaSize# mwa s of + (# s2, sz #) + | isTrue# (i >=# sz) -> (# s2, 0## #) + | isTrue# (i <# 0#) -> (# s2, 0## #) + | True -> readWordArray# mwa i s2 + +mwaRead# :: MutableWordArray# s -> Int# -> State# s -> (# State# s, Word# #) +mwaRead# = readWordArray#