packages feed

hgmp (empty) → 0.1.0.0

raw patch · 9 files changed

+635/−0 lines, 9 filesdep +QuickCheckdep +basedep +ghc-primsetup-changed

Dependencies added: QuickCheck, base, ghc-prim, hgmp, integer-gmp

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2016, Claude Heiland-Allen++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 the name of Claude Heiland-Allen nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT+OWNER OR 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.
+ README.md view
@@ -0,0 +1,25 @@+hgmp+====++Haskell interface to GMP.  Contains type definitions and marshalling functions,+to be able to write FFI bindings using Haskell's Integer and Rational types.+Function bindings may come in a future version.++A simple example illustrating binding to GMP's next probable-prime function:++    {-# LANGUAGE ForeignFunctionInterface #-}++    import Foreign.Ptr (Ptr(..))+    import Numeric.GMP.Types (MPZ)+    import Numeric.GMP.Utils (withInInteger, withOutInteger_)+    import System.IO.Unsafe (unsafePerformIO)++    foreign import ccall safe "__gmpz_nextprime"+      mpz_nextprime :: Ptr MPZ -> Ptr MPZ -> IO ()++    nextPrime :: Integer -> Integer+    nextPrime n =+      unsafePerformIO $+        withOutInteger_ $ \rop ->+          withInInteger n $ \op ->+            mpz_nextprime rop op
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits/wrappers.c view
@@ -0,0 +1,18 @@+#include <assert.h>+#include <HsFFI.h>+#include <ghc-gmp.h>++void mpz_set_HsInt(mpz_ptr dst, const HsInt n) {+  if (sizeof(HsInt) == sizeof(signed long int)) {+    mpz_set_si(dst, n);+  } else if (sizeof(HsInt) == sizeof(signed long int) + sizeof(unsigned long int)) {+    // Win64, see comments in integer-gmp/src/GHC/Integer/Type.hs+#define lobits (8 * sizeof(unsigned long int))+#define lomask (lobits - 1)+    mpz_set_si(dst, n >> lobits); // warns when branch will be unused+    mpz_mul_2exp(dst, dst, lobits);+    mpz_add_ui(dst, dst, n & lomask);+  } else {+    assert(! "supported HsInt size");+  }+}
+ examples/primes.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Main (main) where++import Foreign.Ptr (Ptr(..))+import Numeric.GMP.Types (MPZ)+import Numeric.GMP.Utils (withInInteger, withOutInteger_)+import System.Environment (getArgs)+import System.IO.Unsafe (unsafePerformIO)++foreign import ccall safe "__gmpz_nextprime"+  mpz_nextprime :: Ptr MPZ -> Ptr MPZ -> IO ()++nextPrimeIO :: Integer -> IO Integer+nextPrimeIO n = do+  withOutInteger_ $ \rop ->+    withInInteger n $ \op ->+      mpz_nextprime rop op++nextPrime :: Integer -> Integer+nextPrime n = unsafePerformIO $ nextPrimeIO n++primes :: Integer -> [Integer]+primes = drop 1 . iterate nextPrime++main :: IO ()+main = do+  [sn] <- getArgs+  n <- readIO sn+  mapM_ print . take 10 . primes $ n
+ hgmp.cabal view
@@ -0,0 +1,59 @@+name:                hgmp+version:             0.1.0.0+synopsis:            Haskell interface to GMP+description:         Currently, types and instances, and marshalling between+                     Integer and Rational and the corresponding GMP types.+                     That is, enough to allow FFI to GMP code (whether in GMP+                     itself or in third-party code that uses GMP).+                     .+                     Supports only GHC with integer-gmp, this might change if+                     there's any demand.++homepage:            https://code.mathr.co.uk/hgmp+-- future function bindings to be machine-translated from gmp.h (LGPL-3/GPL-2)?+license:             BSD3+license-file:        LICENSE++author:              Claude Heiland-Allen+maintainer:          claude@mathr.co.uk+copyright:           2016 Claude Heiland-Allen+category:            Numeric+build-type:          Simple+extra-source-files:  README.md examples/primes.hs+cabal-version:       >=1.10++library+  exposed-modules:     Numeric.GMP.Utils, Numeric.GMP.Types+  build-depends:       base >=4.8 && <4.10+                     , integer-gmp >= 1.0 && < 1.1+                     , ghc-prim >= 0.4 && < 0.6+  build-tools:         hsc2hs+  hs-source-dirs:      src+  c-sources:           cbits/wrappers.c+  default-language:    Haskell2010+  other-extensions:    DeriveDataTypeable+                       GeneralizedNewtypeDeriving+                       ForeignFunctionInterface+                       MagicHash+                       UnboxedTuples+  ghc-options:         -Wall++test-suite Main+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  main-is:             Main.hs+  build-depends:       base+                     , hgmp+                     , QuickCheck >= 2.8 && < 2.10+  default-language:    Haskell2010+  other-extensions:    ForeignFunctionInterface+                       TemplateHaskell++source-repository head+  type:                git+  location:            https://code.mathr.co.uk/hgmp.git++source-repository this+  type:                git+  location:            https://code.mathr.co.uk/hgmp.git+  tag:                 v0.1.0.0
+ src/Numeric/GMP/Types.hsc view
@@ -0,0 +1,126 @@+#include <ghc-gmp.h>++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | GMP types.+module Numeric.GMP.Types where++import Data.Data+import Data.Typeable+import Data.Bits+import Data.Ix+import Data.Int+import Data.Word++import Foreign (Storable(..), Ptr, nullPtr, plusPtr)+import Foreign.C (CInt)++-- | @mpz_t@+data MPZ = MPZ+  { mpzAlloc :: !CInt+  , mpzSize :: !CInt+  , mpzD :: !(Ptr MPLimb)+  }++instance Storable MPZ where+  sizeOf _ = (#size __mpz_struct)+  alignment _ = alignment nullPtr -- TODO verify+  peek ptr = do+    alloc <- (#peek __mpz_struct, _mp_alloc) ptr+    size <- (#peek __mpz_struct, _mp_size) ptr+    d <- (#peek __mpz_struct, _mp_d) ptr+    return (MPZ{ mpzAlloc = alloc, mpzSize = size, mpzD = d })+  poke ptr (MPZ{ mpzAlloc = alloc, mpzSize = size, mpzD = d }) = do+    (#poke __mpz_struct, _mp_alloc) ptr alloc+    (#poke __mpz_struct, _mp_size) ptr size+    (#poke __mpz_struct, _mp_d) ptr d++-- | @mpq_t@+data MPQ = MPQ+  { mpqNum :: !MPZ+  , mpqDen :: !MPZ+  }++instance Storable MPQ where+  sizeOf _ = (#size __mpq_struct)+  alignment _ = alignment (undefined :: MPZ)+  peek ptr = do+    num <- (#peek __mpq_struct, _mp_num) ptr+    den <- (#peek __mpq_struct, _mp_den) ptr+    return (MPQ{ mpqNum = num, mpqDen = den })+  poke ptr (MPQ{ mpqNum = num, mpqDen = den }) = do+    (#poke __mpq_struct, _mp_num) ptr num+    (#poke __mpq_struct, _mp_den) ptr den++-- | Get pointers to numerator and denominator (these are macros in the C API).+mpq_numref, mpq_denref :: Ptr MPQ -> Ptr MPZ+mpq_numref ptr = plusPtr ptr (#offset __mpq_struct, _mp_num)+mpq_denref ptr = plusPtr ptr (#offset __mpq_struct, _mp_den)++-- | @mpf_t@+data MPF = MPF+  { mpfPrec :: !CInt+  , mpfSize :: !CInt+  , mpfExp :: !MPExp+  , mpfD :: !(Ptr MPLimb)+  }++instance Storable MPF where+  sizeOf _ = (#size __mpf_struct)+  alignment _ = alignment nullPtr -- TODO verify+  peek ptr = do+    prec <- (#peek __mpf_struct, _mp_prec) ptr+    size <- (#peek __mpf_struct, _mp_size) ptr+    expo <- (#peek __mpf_struct, _mp_exp) ptr+    d <- (#peek __mpf_struct, _mp_d) ptr+    return (MPF{ mpfPrec = prec, mpfSize = size, mpfExp = expo, mpfD = d })+  poke ptr (MPF{ mpfPrec = prec, mpfSize = size, mpfExp = expo, mpfD = d }) = do+    (#poke __mpf_struct, _mp_prec) ptr prec+    (#poke __mpf_struct, _mp_size) ptr size+    (#poke __mpf_struct, _mp_exp) ptr expo+    (#poke __mpf_struct, _mp_d) ptr d++-- | @gmp_randstate_t@+data GMPRandState = GMPRandState+  { gmprsSeed :: !MPZ+  , gmprsAlg :: !GMPRandAlg+  , gmprsAlgData :: !(Ptr ())+  }++instance Storable GMPRandState where+  sizeOf _ = (#size __gmp_randstate_struct)+  alignment _ = alignment nullPtr -- TOOD verify+  peek ptr = do+    seed <- (#peek __gmp_randstate_struct, _mp_seed) ptr+    alg <- (#peek __gmp_randstate_struct, _mp_alg) ptr+    algdata <- (#peek __gmp_randstate_struct, _mp_algdata._mp_lc) ptr+    return (GMPRandState{ gmprsSeed = seed, gmprsAlg = alg, gmprsAlgData = algdata })+  poke ptr (GMPRandState{ gmprsSeed = seed, gmprsAlg = alg, gmprsAlgData = algdata }) = do+    (#poke __gmp_randstate_struct, _mp_seed) ptr seed+    (#poke __gmp_randstate_struct, _mp_alg) ptr alg+    (#poke __gmp_randstate_struct, _mp_algdata) ptr algdata++-- | @mp_limb_t@+newtype MPLimb = MPLimb (#type mp_limb_t)+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Num, Integral, Real, Ix, Bits, FiniteBits, Data, Typeable, Storable)++-- | @mp_limb_signed_t@+newtype MPLimbSigned = MPLimbSigned (#type mp_limb_signed_t)+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Num, Integral, Real, Ix, Bits, FiniteBits, Data, Typeable, Storable)++-- | @mp_size_t@+newtype MPSize = MPSize (#type mp_size_t)+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Num, Integral, Real, Ix, Bits, FiniteBits, Data, Typeable, Storable)++-- | @mp_exp_t@+newtype MPExp = MPExp (#type mp_exp_t)+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Num, Integral, Real, Ix, Bits, FiniteBits, Data, Typeable, Storable)++-- | @mp_bitcnt_t@+newtype MPBitCnt = MPBitCnt (#type mp_bitcnt_t)+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Num, Integral, Real, Ix, Bits, FiniteBits, Data, Typeable, Storable)++-- | @gmp_randalg_t@+newtype GMPRandAlg = GMPRandAlg (#type gmp_randalg_t)+  deriving (Eq, Ord, Read, Show, Enum, Bounded, Num, Integral, Real, Ix, Bits, FiniteBits, Data, Typeable, Storable)
+ src/Numeric/GMP/Utils.hs view
@@ -0,0 +1,266 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-}+-- | GMP utilities.  A simple example with probable primes:+--+-- > foreign import ccall safe "__gmpz_nextprime"+-- >   mpz_nextprime :: Ptr MPZ -> Ptr MPZ -> IO ()+-- >+-- > nextPrime :: Integer -> Integer+-- > nextPrime n =+-- >   unsafePerformIO $+-- >     withOutInteger_ $ \rop ->+-- >       withInInteger n $ \op ->+-- >         mpz_nextprime rop op+module Numeric.GMP.Utils+  ( -- * Integer marshalling+    withInInteger'+  , withInInteger+  , withInOutInteger+  , withInOutInteger_+  , withOutInteger+  , withOutInteger_+  , peekInteger'+  , peekInteger+  , pokeInteger+    -- * Rational marshalling+  , withInRational'+  , withInRational+  , withInOutRational+  , withInOutRational_+  , withOutRational+  , withOutRational_+  , peekRational'+  , peekRational+  , pokeRational+  ) where++import Control.Exception (bracket_)+import Data.Ratio ((%), numerator, denominator)+import Foreign (allocaBytes, alloca, with, sizeOf, peek)++import GHC.Integer.GMP.Internals+  ( Integer(..)+  , BigNat(..)+  , sizeofBigNat#+  , byteArrayToBigNat#+  , bigNatToInteger+  , bigNatToNegInteger+  )+import GHC.Prim+  ( ByteArray#+  , sizeofByteArray#+  , copyByteArrayToAddr#+  , newByteArray#+  , copyAddrToByteArray#+  , unsafeFreezeByteArray#+  )+import GHC.Exts (Int(..), Ptr(..))+import GHC.Types (IO(..))++import Numeric.GMP.Types++foreign import ccall unsafe "__gmpz_init"+  mpz_init :: Ptr MPZ -> IO ()++foreign import ccall unsafe "__gmpz_clear"+  mpz_clear :: Ptr MPZ -> IO ()++foreign import ccall unsafe "__gmpq_init"+  mpq_init :: Ptr MPQ -> IO ()++foreign import ccall unsafe "__gmpq_clear"+  mpq_clear :: Ptr MPQ -> IO ()++foreign import ccall unsafe "__gmpz_set"+  mpz_set :: Ptr MPZ -> Ptr MPZ -> IO ()++foreign import ccall unsafe "mpz_set_HsInt" -- implemented in wrappers.c+  mpz_set_HsInt :: Ptr MPZ -> Int -> IO ()+++-- | Store an 'Integer' into a temporary 'MPZ'.  The action must use it only+--   as an @mpz_srcptr@ (ie, constant/immutable), and must not allow references+--   to it to escape its scope.+withInInteger' :: Integer -> (MPZ -> IO r) -> IO r+withInInteger' i action = case i of+  S# n# -> alloca $ \src -> bracket_ (mpz_init src) (mpz_clear src) $ do+    -- a bit awkward, TODO figure out how to do this without foreign calls?+    mpz_set_HsInt src (I# n#)+    z <- peek src+    r <- action z+    return r+  Jp# bn@(BN# ba#) -> withByteArray ba# $ \d _ -> action MPZ+        { mpzAlloc = 0+        , mpzSize = fromIntegral (I# (sizeofBigNat# bn))+        , mpzD = d+        }+  Jn# bn@(BN# ba#) -> withByteArray ba# $ \d _ -> action MPZ+        { mpzAlloc = 0+        , mpzSize = - fromIntegral (I# (sizeofBigNat# bn))+        , mpzD = d+        }++withByteArray :: ByteArray# -> (Ptr a -> Int -> IO r) -> IO r+withByteArray ba# f = do+  let bytes = I# (sizeofByteArray# ba#)+  allocaBytes bytes $ \ptr@(Ptr addr#) -> do+    IO (\s -> (# copyByteArrayToAddr# ba# 0# addr# (sizeofByteArray# ba#) s, () #))+    f ptr bytes+++-- | Combination of 'withInInteger'' and 'with'.  The action must use it only+--   as an @mpz_srcptr@ (ie, constant/immutable), and must not allow the pointer+--   to escape its scope.  If in doubt about potential mutation by the action,+--   use 'withInOutInteger' instead.+withInInteger :: Integer -> (Ptr MPZ -> IO r) -> IO r+withInInteger i action = withInInteger' i $ \z -> with z action+++-- | Allocates and initializes an @mpz_t@, pokes the value, and peeks and clears+--   it after the action.  The pointer must not escape the scope of the action.+withInOutInteger :: Integer -> (Ptr MPZ -> IO a) -> IO (Integer, a)+withInOutInteger n action = withOutInteger $ \z -> do+  pokeInteger z n+  action z+++-- | Allocates and initializes an @mpz_t@, pokes the value, and peeks and clears+--   it after the action.  The pointer must not escape the scope of the action.+--   The result of the action is discarded.+withInOutInteger_ :: Integer -> (Ptr MPZ -> IO a) -> IO Integer+withInOutInteger_ n action = do+  (z, _) <- withInOutInteger n action+  return z+++-- | Allocates and initializes an @mpz_t@, then peeks and clears it after the+--   action.  The pointer must not escape the scope of the action.+withOutInteger :: (Ptr MPZ -> IO a) -> IO (Integer, a)+withOutInteger action = alloca $ \ptr ->+  bracket_ (mpz_init ptr) (mpz_clear ptr) $ do+    a <- action ptr+    z <- peekInteger ptr+    return (z, a)+++-- | Allocates and initializes an @mpz_t@, then peeks and clears it after the+--   action.  The pointer must not escape the scope of the action.  The result+--   of the action is discarded.+withOutInteger_ :: (Ptr MPZ -> IO a) -> IO Integer+withOutInteger_ action = do+  (z, _) <- withOutInteger action+  return z+++-- | Store an 'Integer' into an @mpz_t@, which must have been initialized with+--   @mpz_init@.+pokeInteger :: Ptr MPZ -> Integer -> IO ()+pokeInteger dst (S# n#) = mpz_set_HsInt dst (I# n#)+-- copies twice, once in withInteger, and again in @mpz_set@.+-- could maybe rewrite to do one copy, using gmp's own alloc functions?+pokeInteger dst j = withInInteger j $ mpz_set dst+++-- | Read an 'Integer' from an 'MPZ'.+peekInteger' :: MPZ -> IO Integer+peekInteger' MPZ{ mpzSize = size, mpzD = d } = do+  if size == 0 then return 0 else+-- This copies once, from 'Ptr' 'MPLimb' to 'ByteArray#'+-- 'byteArrayToBigNat#' hopefully won't need to copy it again+    asByteArray d (fromIntegral (abs size) * sizeOf (undefined :: MPLimb))+      (\ba# -> return $ case fromIntegral (abs size) of+        I# size# -> (if size < 0 then bigNatToNegInteger else bigNatToInteger)+            (byteArrayToBigNat# ba# size#)+      )++asByteArray :: Ptr a -> Int -> (ByteArray# -> IO r) -> IO r+asByteArray (Ptr addr#) (I# bytes#) f = do+  IO $ \s# -> case newByteArray# bytes# s# of+    (# s'#, mba# #) ->+      case unsafeFreezeByteArray# mba# (copyAddrToByteArray# addr# mba# 0# bytes# s'#) of+        (# s''#, ba# #) -> case f ba# of IO r -> r s''#+++-- | Combination of 'peek' and 'peekInteger''.+peekInteger :: Ptr MPZ -> IO Integer+peekInteger src = do+  z <- peek src+  peekInteger' z+++-- | Store a 'Rational' into a temporary 'MPQ'.  The action must use it only+--   as an @mpq_srcptr@ (ie, constant/immutable), and must not allow the pointer+--   to escape its scope.+withInRational' :: Rational -> (MPQ -> IO r) -> IO r+withInRational' q action =+  withInInteger' (numerator q) $ \nz ->+  withInInteger' (denominator q) $ \dz ->+  action (MPQ nz dz)+++-- | Combination of 'withInRational'' and 'with'.  The action must use it only+--   as an @mpq_srcptr@ (ie, constant/immutable), and must not allow the pointer+--   to escape its scope.  If in doubt about potential mutation by the action,+--   use 'withInOutRational' instead.+withInRational :: Rational -> (Ptr MPQ -> IO r) -> IO r+withInRational q action = withInRational' q $ \qq -> with qq action+++-- | Allocates and initializes an @mpq_t@, pokes the value, and peeks and clears+--   it after the action.  The pointer must not escaep the scope of the action.+withInOutRational :: Rational -> (Ptr MPQ -> IO a) -> IO (Rational, a)+withInOutRational n action = withOutRational $ \q -> do+  pokeRational q n+  action q+++-- | Allocates and initializes an @mpq_t@, pokes the value, and peeks and clears+--   it after the action.  The pointer must not escaep the scope of the action.+--   The result of the action is discarded.+withInOutRational_ :: Rational -> (Ptr MPQ -> IO a) -> IO Rational+withInOutRational_ n action = do+  (q, _) <- withInOutRational n action+  return q+++-- | Allocates and initializes an @mpq_t@, then peeks and clears it after the+--   action.  The pointer must not escape the scope of the action.+withOutRational :: (Ptr MPQ -> IO a) -> IO (Rational, a)+withOutRational action = alloca $ \ptr ->+  bracket_ (mpq_init ptr) (mpq_clear ptr) $ do+    a <- action ptr+    q <- peekRational ptr+    return (q, a)+++-- | Allocates and initializes an @mpq_t@, then peeks and clears it after the+--   action.  The pointer must not escape the scope of the action.  The result+--   of the action is discarded.+withOutRational_ :: (Ptr MPQ -> IO a) -> IO Rational+withOutRational_ action = do+  (q, _) <- withOutRational action+  return q+++-- | Store a 'Rational' into an @mpq_t@, which must have been initialized with+--   @mpq_init@.+pokeRational :: Ptr MPQ -> Rational -> IO ()+pokeRational ptr q = do+  pokeInteger (mpq_numref ptr) (numerator q)+  pokeInteger (mpq_denref ptr) (denominator q)+++-- | Read a 'Rational' from an 'MPQ'.+peekRational' :: MPQ -> IO Rational+peekRational' (MPQ n d) = do+  num <- peekInteger' n+  den <- peekInteger' d+  return (num % den)+++-- | Combination of 'peek' and 'peekRational''.+peekRational :: Ptr MPQ -> IO Rational+peekRational src = do+  q <- peek src+  peekRational' q
+ tests/Main.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE TemplateHaskell #-}+import Test.QuickCheck+import Test.QuickCheck.Arbitrary+import Control.Monad (unless)+import System.Exit (exitFailure)+import Foreign+import Numeric.GMP.Types+import Numeric.GMP.Utils+++foreign import ccall safe "__gmpz_mul"+  mpz_mul :: Ptr MPZ -> Ptr MPZ -> Ptr MPZ -> IO ()++foreign import ccall safe "__gmpq_mul"+  mpq_mul :: Ptr MPQ -> Ptr MPQ -> Ptr MPQ -> IO ()+++-- instance Arbitrary Integer has small range+newtype Big = Big{ getBig :: Integer } deriving (Show)+instance Arbitrary Big where+  arbitrary = fmap Big $ choose (-bit 100, bit 100)+  shrink = fmap Big . shrinkIntegral . getBig+++prop_IntegerWithPeek' n = ioProperty $ do+  m <- withInInteger' n peekInteger'+  return (n == m)++prop_IntegerWithPeek n = ioProperty $ do+  m <- withInInteger n peekInteger+  return (n == m)++prop_IntegerMultiply a b = ioProperty $ do+  (c, _) <-+    withOutInteger $ \cz ->+      withInInteger a $ \az ->+        withInInteger b $ \bz ->+          mpz_mul cz az bz+  return (a * b == c)+++prop_BigIntegerWithPeek' (Big n) = ioProperty $ do+  m <- withInInteger' n peekInteger'+  return (n == m)++prop_BigIntegerWithPeek (Big n) = ioProperty $ do+  m <- withInInteger n peekInteger+  return (n == m)++prop_BigIntegerMultiply (Big a) (Big b) = ioProperty $ do+  (c, _) <-+    withOutInteger $ \cz ->+      withInInteger a $ \az ->+        withInInteger b $ \bz ->+          mpz_mul cz az bz+  return (a * b == c)+++prop_RationalWithPeek' n = ioProperty $ do+  m <- withInRational' n peekRational'+  return (n == m)++prop_RationalWithPeek n = ioProperty $ do+  m <- withInRational n peekRational+  return (n == m)++prop_RationalMultiply a b = ioProperty $ do+  (c, _) <-+    withOutRational $ \cq ->+      withInRational a $ \aq ->+        withInRational b $ \bq ->+          mpq_mul cq aq bq+  return (a * b == c)+++return []+main = do+  r <- $quickCheckAll+  unless r exitFailure