nats 0.2 → 1.1.2
raw patch · 7 files changed
Files
- .gitignore +19/−0
- .travis.yml +153/−1
- CHANGELOG.markdown +21/−0
- README.markdown +2/−1
- nats.cabal +50/−11
- src/Numeric/Natural.hs +263/−7
- src/Numeric/Natural/Internal.hs +0/−229
.gitignore view
@@ -1,4 +1,5 @@ dist+dist-newstyle docs wiki TAGS@@ -11,3 +12,21 @@ *.hi *~ *#+.stack-work/+cabal-dev+*.chi+*.chs.h+*.dyn_o+*.dyn_hi+.hpc+.hsenv+.cabal-sandbox/+cabal.sandbox.config+*.prof+*.aux+*.hp+*.eventlog+cabal.project.local+cabal.project.local~+.HTF/+.ghc.environment.*
.travis.yml view
@@ -1,4 +1,15 @@-language: haskell+# This Travis job script has been generated by a script via+#+# runghc make_travis_yml_2.hs '-o' '.travis.yml' '--irc-channel=irc.freenode.org#haskell-lens' '--no-no-tests-no-bench' '--no-installed' 'cabal.project'+#+# For more information, see https://github.com/hvr/multi-ghc-travis+#+language: c+sudo: false++git:+ submodules: false # whether to recursively clone submodules+ notifications: irc: channels:@@ -6,3 +17,144 @@ skip_join: true template: - "\x0313nats\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++cache:+ directories:+ - $HOME/.cabal/packages+ - $HOME/.cabal/store++before_cache:+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log+ # remove files that are regenerated by 'cabal update'+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx++ - rm -rfv $HOME/.cabal/packages/head.hackage++matrix:+ include:+ - compiler: "ghc-7.0.4"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.0.4], sources: [hvr-ghc]}}+ - compiler: "ghc-7.0.4"+ env: CABALFLAGS="-f-hashable"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.0.4], sources: [hvr-ghc]}}+ - compiler: "ghc-7.0.4"+ env: CABALFLAGS="-f-template-haskell"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.0.4], sources: [hvr-ghc]}}+ - compiler: "ghc-7.0.4"+ env: CABALFLAGS="-f-binary"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.0.4], sources: [hvr-ghc]}}+ - compiler: "ghc-7.0.4"+ env: CABALFLAGS="-f-hashable -f-template-haskell"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.0.4], sources: [hvr-ghc]}}+ - compiler: "ghc-7.0.4"+ env: CABALFLAGS="-f-hashable -f-binary"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.0.4], sources: [hvr-ghc]}}+ - compiler: "ghc-7.0.4"+ env: CABALFLAGS="-f-binary -f-template-haskell"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.0.4], sources: [hvr-ghc]}}+ - compiler: "ghc-7.2.2"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.2.2], sources: [hvr-ghc]}}+ - compiler: "ghc-7.4.2"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.4.2], sources: [hvr-ghc]}}+ - compiler: "ghc-7.6.3"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.6.3], sources: [hvr-ghc]}}+ - compiler: "ghc-7.8.4"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.8.4], sources: [hvr-ghc]}}+ - compiler: "ghc-7.10.3"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-7.10.3], sources: [hvr-ghc]}}+ - compiler: "ghc-8.0.2"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-8.0.2], sources: [hvr-ghc]}}+ - compiler: "ghc-8.2.2"+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}+ - compiler: "ghc-8.4.1"+ env: GHCHEAD=true+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}+ - compiler: "ghc-head"+ env: GHCHEAD=true+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}}++ allow_failures:+ - compiler: "ghc-8.4.1"+ - compiler: "ghc-head"++before_install:+ - HC=${CC}+ - HCVER=${HC/ghc-/}+ - HCPKG=${HC/ghc/ghc-pkg}+ - unset CC+ - ROOTDIR=$(pwd)+ - mkdir -p $HOME/.local/bin+ - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"+ - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))+ - echo $HCNUMVER++install:+ - cabal --version+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"+ - BENCH=${BENCH---enable-benchmarks}+ - TEST=${TEST---enable-tests}+ - |+ if dpkg --compare-versions "${HCVER}" lt "7.10"; then+ HADDOCK=${HADDOCK-true}+ else # Nothing to do+ HADDOCK=${HADDOCK-false}+ fi+ - INSTALLED=${INSTALLED-true}+ - GHCHEAD=${GHCHEAD-false}+ - travis_retry cabal update -v+ - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"+ - rm -fv cabal.project cabal.project.local+ # Overlay Hackage Package Index for GHC HEAD: https://github.com/hvr/head.hackage+ - |+ if $GHCHEAD; then+ sed -i.bak 's/-- allow-newer:.*/allow-newer: *:base, *:template-haskell, *:ghc, *:Cabal/' ${HOME}/.cabal/config++ echo 'repository head.hackage' >> ${HOME}/.cabal/config+ echo ' url: http://head.hackage.haskell.org/' >> ${HOME}/.cabal/config+ echo ' secure: True' >> ${HOME}/.cabal/config+ echo ' root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740' >> ${HOME}/.cabal/config+ echo ' 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb' >> ${HOME}/.cabal/config+ echo ' 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >> ${HOME}/.cabal/config+ echo ' key-threshold: 3' >> ${HOME}/.cabal.config++ cabal new-update head.hackage -v+ fi+ - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'+ - "printf 'packages: \".\"\\n' > cabal.project"+ - cat cabal.project+ - if [ -f "./configure.ac" ]; then+ (cd "." && autoreconf -i);+ fi+ - rm -f cabal.project.freeze+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all+ - rm -rf "."/.ghc.environment.* "."/dist+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)++# Here starts the actual work to be performed for the package under test;+# any command which exits with a non-zero exit code causes the build to fail.+script:+ # test that source-distributions can be generated+ - (cd "." && cabal sdist)+ - mv "."/dist/nats-*.tar.gz ${DISTDIR}/+ - cd ${DISTDIR} || false+ - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;+ - "printf 'packages: nats-*/*.cabal\\n' > cabal.project"+ - cat cabal.project+++ # build & run tests, build benchmarks+ - cabal new-build -w ${HC} ${TEST} ${BENCH} all++ # cabal check+ - (cd nats-* && cabal check)++ # haddock+ - rm -rf ./dist-newstyle+ - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi++# REGENDATA ["-o",".travis.yml","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-installed","cabal.project"]+# EOF
CHANGELOG.markdown view
@@ -1,3 +1,24 @@+1.1.2 [2018-02-06]+------------------+* Don't enable `Safe` on GHC 7.2.++1.1.1+-----+* Backported a more efficient `Binary` instance for `Nat`+* Allow `binary-0.8`++1.1+---+* Backported `Lift` instances.++1.0+---+* Make `nats` a compat-package since `Numeric.Natural` moved to `base-4.8.0.0`.++0.2.1+-----+* Better `readsPrec` handling when you try to feed it a negative number. Not it is a failed parse rather than an error.+ 0.2 --- * Added `Hashable` and `Data` support.
README.markdown view
@@ -1,7 +1,8 @@ nats ==== -[](http://travis-ci.org/ekmett/nats)+[](https://hackage.haskell.org/package/nats)+[](http://travis-ci.org/ekmett/nats) Haskell 98 natural numbers
nats.cabal view
@@ -1,6 +1,6 @@ name: nats category: Numeric, Algebra-version: 0.2+version: 1.1.2 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -11,8 +11,17 @@ bug-reports: http://github.com/ekmett/nats/issues copyright: Copyright (C) 2011-2014 Edward A. Kmett synopsis: Natural numbers-description: Natural numbers+description: Natural numbers. build-type: Simple+tested-with: GHC == 7.0.4+ , GHC == 7.2.2+ , GHC == 7.4.2+ , GHC == 7.6.3+ , GHC == 7.8.4+ , GHC == 7.10.3+ , GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.1 extra-source-files: .ghci .gitignore@@ -31,20 +40,50 @@ . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. .- If set we will not supply an instance of `Hashable`+ If disabled we will not supply an instance of `Hashable`. default: True manual: True +flag binary+ description:+ You can disable the use of the `binary` package using `-f-binary`.+ .+ Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users.+ .+ If disabled we will not supply an instance of `Binary`.+ default: True+ manual: True++flag template-haskell+ description:+ You can disable the use of the `template-haskell` package using `-f-template-haskell`.+ .+ Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users.+ .+ If disabled we will not supply an instance of `Lift`.+ default: True+ manual: True+ library default-language: Haskell98- hs-source-dirs: src- ghc-options: -Wall+ if impl(ghc<7)+ -- {-# LANGUAGE DeriveDataTypeable #-} is only understood starting w/ GHC-7.0+ default-extensions: DeriveDataTypeable - exposed-modules:- Numeric.Natural- Numeric.Natural.Internal+ if impl(ghc<7.9)+ -- Starting with GHC 7.10/base-4.8, "Numeric.Natural" lives in `base`+ hs-source-dirs: src+ exposed-modules: Numeric.Natural+ ghc-options: -Wall - build-depends: base >= 2 && < 10+ -- the needlessly relaxed bound here is to due to stack shenanigans+ build-depends: base >= 2 && < 5 - if flag(hashable)- build-depends: hashable >= 1.1 && < 1.3+ if flag(binary)+ build-depends: binary >= 0.2 && < 0.9++ if flag(template-haskell)+ build-depends: template-haskell >= 2.2 && < 2.12++ if flag(hashable)+ build-depends: hashable >= 1.1 && < 1.3
src/Numeric/Natural.hs view
@@ -1,7 +1,27 @@+{-# LANGUAGE CPP #-}++#ifdef __GLASGOW_HASKELL__+#define LANGUAGE_DeriveDataTypeable+{-# LANGUAGE DeriveDataTypeable #-}+#endif++#ifndef MIN_VERSION_base+#define MIN_VERSION_base(x,y,z) 1+#endif++#if __GLASGOW_HASKELL__ >= 702+#if defined(MIN_VERSION_hashable) || defined(MIN_VERSION_template_haskell) \+ || __GLASGOW_HASKELL__ == 702+{-# LANGUAGE Trustworthy #-}+#else+{-# LANGUAGE Safe #-}+#endif+#endif+ ----------------------------------------------------------------------------- -- | -- Module : Numeric.Natural--- Copyright : (C) 2011 Edward Kmett,+-- Copyright : (C) 2011-2014 Edward Kmett, -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett <ekmett@gmail.com>@@ -10,11 +30,247 @@ -- -- Natural numbers. --+-- The "Numeric.Natural" module has become part of `base` starting+-- with `base-4.8.0.0`. -----------------------------------------------------------------------------module Numeric.Natural- ( Natural- , Whole(toNatural)- , natural- ) where+module Numeric.Natural ( Natural ) where -import Numeric.Natural.Internal+import Control.Exception ( throw, ArithException(Underflow) )++#ifdef MIN_VERSION_binary+import Control.Monad (liftM)+import Data.Binary (Binary(..), Get, Word8, Word64, putWord8)+import Data.List (foldl', unfoldr)+#endif++import Data.Bits+import Data.Ix++#ifdef LANGUAGE_DeriveDataTypeable+import Data.Data+#endif++#ifdef MIN_VERSION_hashable+import Data.Hashable+#endif++#ifdef MIN_VERSION_template_haskell+import Language.Haskell.TH.Syntax (Lift(..), Exp(LitE), Lit(IntegerL))+#endif++#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))+import Text.Printf (PrintfArg(..), formatInteger)+#endif++-- | Type representing arbitrary-precision non-negative integers.+--+-- Operations whose result would be negative+-- @'throw' ('Underflow' :: 'ArithException')@.+--+-- The 'Natural' type has become part of `base` starting with+-- `base-4.8.0.0`.+newtype Natural = Natural { runNatural :: Integer } deriving+ ( Eq+ , Ord+ , Ix+#ifdef LANGUAGE_DeriveDataTypeable+ , Typeable+#endif+ )++#ifdef MIN_VERSION_hashable+instance Hashable Natural where+#if MIN_VERSION_hashable(1,2,0)+ hashWithSalt p (Natural a) = hashWithSalt p a+#else+ hash (Natural a) = hash a+#endif+#endif++#ifdef LANGUAGE_DeriveDataTypeable+-- This follows the same style as the other integral 'Data' instances+-- defined in "Data.Data"+naturalType :: DataType+naturalType = mkIntType "Numeric.Natural.Natural"++instance Data Natural where+ toConstr x = mkIntegralConstr naturalType x+ gunfold _ z c = case constrRep c of+ IntConstr x -> z (fromIntegral x)+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c+ ++ " is not of type Natural"+ dataTypeOf _ = naturalType+#endif++instance Show Natural where+ showsPrec d (Natural n) = showsPrec d n++instance Read Natural where+ readsPrec d = map (\(n, s) -> (Natural n, s)) . filter ((>= 0) . fst) . readsPrec d++instance Num Natural where+ Natural n + Natural m = Natural (n + m)+ {-# INLINE (+) #-}+ Natural n * Natural m = Natural (n * m)+ {-# INLINE (*) #-}+ Natural n - Natural m | result < 0 = throw Underflow+ | otherwise = Natural result+ where result = n - m+ {-# INLINE (-) #-}+ abs (Natural n) = Natural n+ {-# INLINE abs #-}+ signum (Natural n) = Natural (signum n)+ {-# INLINE signum #-}+ fromInteger n+ | n >= 0 = Natural n+ | otherwise = throw Underflow+ {-# INLINE fromInteger #-}++instance Bits Natural where+ Natural n .&. Natural m = Natural (n .&. m)+ {-# INLINE (.&.) #-}+ Natural n .|. Natural m = Natural (n .|. m)+ {-# INLINE (.|.) #-}+ xor (Natural n) (Natural m) = Natural (xor n m)+ {-# INLINE xor #-}+ complement _ = error "Bits.complement: Natural complement undefined"+ {-# INLINE complement #-}+ shift (Natural n) = Natural . shift n+ {-# INLINE shift #-}+ rotate (Natural n) = Natural . rotate n+ {-# INLINE rotate #-}+ bit = Natural . bit+ {-# INLINE bit #-}+ setBit (Natural n) = Natural . setBit n+ {-# INLINE setBit #-}+ clearBit (Natural n) = Natural . clearBit n+ {-# INLINE clearBit #-}+ complementBit (Natural n) = Natural . complementBit n+ {-# INLINE complementBit #-}+ testBit = testBit . runNatural+ {-# INLINE testBit #-}+#if __GLASGOW_HASKELL__ >= 707+ bitSizeMaybe _ = Nothing+ {-# INLINE bitSizeMaybe #-}+#endif+ bitSize = error "Natural: bitSize"+ {-# INLINE bitSize #-}+ isSigned _ = False+ {-# INLINE isSigned #-}+ shiftL (Natural n) = Natural . shiftL n+ {-# INLINE shiftL #-}+ shiftR (Natural n) = Natural . shiftR n+ {-# INLINE shiftR #-}+ rotateL (Natural n) = Natural . rotateL n+ {-# INLINE rotateL #-}+ rotateR (Natural n) = Natural . rotateR n+ {-# INLINE rotateR #-}+#if MIN_VERSION_base(4,6,0)+ popCount = popCountDefault+ {-# INLINE popCount #-}+#endif++instance Real Natural where+ toRational (Natural a) = toRational a+ {-# INLINE toRational #-}++instance Enum Natural where+ pred (Natural 0) = throw Underflow+ pred (Natural n) = Natural (pred n)+ {-# INLINE pred #-}+ succ (Natural n) = Natural (succ n)+ {-# INLINE succ #-}+ fromEnum (Natural n) = fromEnum n+ {-# INLINE fromEnum #-}+ toEnum n | n < 0 = error "Natural.toEnum: negative"+ | otherwise = Natural (toEnum n)+ {-# INLINE toEnum #-}++ enumFrom = map Natural . enumFrom . runNatural++ enumFromThen x y+ | x <= y = map Natural (enumFromThen (runNatural x) (runNatural y))+ | otherwise = map Natural (enumFromThenTo (runNatural x) (runNatural y) 0)++ enumFromTo x y = map Natural (enumFromTo (runNatural x) (runNatural y))++ enumFromThenTo x x1 y+ = map Natural (enumFromThenTo (runNatural x) (runNatural x1) (runNatural y))++{- NOTE: Using "Data.Coerce", we could instead say:++ enumFrom = coerce (enumFrom :: Integer -> [Integer])+ enumFromThen x y+ | x <= y = coerce (enumFromThen :: Integer -> Integer -> [Integer]) x y+ | otherwise = enumFromThenTo x y 0++ enumFromTo = coerce (enumFromTo :: Integer -> Integer -> [Integer])+ enumFromThenTo+ = coerce (enumFromThenTo :: Integer -> Integer -> Integer -> [Integer])+-}++instance Integral Natural where+ quot (Natural a) (Natural b) = Natural (quot a b)+ {-# INLINE quot #-}+ rem (Natural a) (Natural b) = Natural (rem a b)+ {-# INLINE rem #-}+ div (Natural a) (Natural b) = Natural (div a b)+ {-# INLINE div #-}+ mod (Natural a) (Natural b) = Natural (mod a b)+ {-# INLINE mod #-}+ divMod (Natural a) (Natural b) = (Natural q, Natural r) where (q,r) = divMod a b+ {-# INLINE divMod #-}+ quotRem (Natural a) (Natural b) = (Natural q, Natural r) where (q,r) = quotRem a b+ {-# INLINE quotRem #-}+ toInteger = runNatural+ {-# INLINE toInteger #-}++#if MIN_VERSION_base(4,7,0) && !(MIN_VERSION_base(4,8,0))+instance PrintfArg Natural where+ formatArg = formatInteger . toInteger+ parseFormat _ = parseFormat (undefined :: Integer)+#endif++#ifdef MIN_VERSION_binary+--+-- Fold and unfold an Integer to and from a list of its bytes+--+unroll :: (Integral a, Bits a) => a -> [Word8]+unroll = unfoldr step+ where+ step 0 = Nothing+ step i = Just (fromIntegral i, i `shiftR` 8)++roll :: (Integral a, Bits a) => [Word8] -> a+roll = foldl' unstep 0 . reverse+ where+ unstep a b = a `shiftL` 8 .|. fromIntegral b++-- Fixed-size type for a subset of Natural+type NaturalWord = Word64++instance Binary Natural where+ {-# INLINE put #-}+ put n | n <= hi = do+ putWord8 0+ put (fromIntegral n :: NaturalWord) -- fast path+ where+ hi = fromIntegral (maxBound :: NaturalWord) :: Natural++ put n = do+ putWord8 1+ put (unroll (abs n)) -- unroll the bytes++ {-# INLINE get #-}+ get = do+ tag <- get :: Get Word8+ case tag of+ 0 -> liftM fromIntegral (get :: Get NaturalWord)+ _ -> do bytes <- get+ return $! roll bytes+#endif++#ifdef MIN_VERSION_template_haskell+instance Lift Natural where+ lift x = return (LitE (IntegerL (fromIntegral x)))+#endif
− src/Numeric/Natural/Internal.hs
@@ -1,229 +0,0 @@-{-# LANGUAGE CPP #-}--#ifdef __GLASGOW_HASKELL__-#define LANGUAGE_DeriveDataTypeable-{-# LANGUAGE DeriveDataTypeable #-}-#endif--#ifndef MIN_VERSION_base-#define MIN_VERSION_base(x,y,z) 1-#endif--#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702-#ifdef MIN_VERSION_hashable-{-# LANGUAGE Trustworthy #-}-#else-{-# LANGUAGE Safe #-}-#endif-#endif---------------------------------------------------------------------------------- |--- Module : Numeric.Natural.Internal--- Copyright : (C) 2011-2014 Edward Kmett,--- License : BSD-style (see the file LICENSE)------ Maintainer : Edward Kmett <ekmett@gmail.com>--- Stability : provisional--- Portability : portable------ This module exposes the potentially unsafe operations that are sometimes--- needed for efficiency: The Natural data constructor and unsafePred.---------------------------------------------------------------------------------module Numeric.Natural.Internal- ( Natural(..)- , Whole(..)- , natural- ) where--import Data.Word-import Data.Bits-import Data.Ix-#ifdef LANGUAGE_DeriveDataTypeable-import Data.Data-#endif-#ifdef MIN_VERSION_hashable-import Data.Hashable-#endif--newtype Natural = Natural { runNatural :: Integer } deriving- ( Eq- , Ord- , Ix-#ifdef LANGUAGE_DeriveDataTypeable- , Typeable-#endif- )--#ifdef MIN_VERSION_hashable-instance Hashable Natural where-#if MIN_VERSION_hashable(1,2,0)- hashWithSalt p (Natural a) = hashWithSalt p a-#else- hash (Natural a) = hash a-#endif-#endif--#ifdef LANGUAGE_DeriveDataTypeable-instance Data Natural where- gfoldl f z (Natural n) = z fromInteger `f` n- gunfold k z c = case constrIndex c of- 1 -> k (z fromInteger)- _ -> error "Natural: gunfold: bad constructor"- toConstr _ = fromIntegerConstr- dataTypeOf _ = naturalDataType--fromIntegerConstr :: Constr-fromIntegerConstr = mkConstr naturalDataType "fromInteger" [] Prefix--naturalDataType :: DataType-naturalDataType = mkDataType "Numeric.Natural.Internal.Natural" [fromIntegerConstr]-#endif---- | Church decoding-natural :: a -> (a -> a) -> Natural -> a-natural a _ 0 = a-natural a f n = natural (f a) f (unsafePred n)-{-# INLINEABLE natural #-}--instance Show Natural where- showsPrec d (Natural n) = showsPrec d n--instance Read Natural where- readsPrec d = map (\(n, s) -> (Natural n, s)) . readsPrec d--instance Num Natural where- Natural n + Natural m = Natural (n + m)- {-# INLINE (+) #-}- Natural n * Natural m = Natural (n * m)- {-# INLINE (*) #-}- Natural n - Natural m | result < 0 = error "Natural.(-): negative result"- | otherwise = Natural result- where result = n - m- {-# INLINE (-) #-}- abs (Natural n) = Natural n- {-# INLINE abs #-}- signum (Natural n) = Natural (signum n)- {-# INLINE signum #-}- fromInteger n- | n >= 0 = Natural n- | otherwise = error "Natural.fromInteger: negative"- {-# INLINE fromInteger #-}--instance Bits Natural where- Natural n .&. Natural m = Natural (n .&. m)- {-# INLINE (.&.) #-}- Natural n .|. Natural m = Natural (n .|. m)- {-# INLINE (.|.) #-}- xor (Natural n) (Natural m) = Natural (xor n m)- {-# INLINE xor #-}- complement _ = error "Bits.complement: Natural complement undefined"- {-# INLINE complement #-}- shift (Natural n) = Natural . shift n- {-# INLINE shift #-}- rotate (Natural n) = Natural . rotate n- {-# INLINE rotate #-}- bit = Natural . bit- {-# INLINE bit #-}- setBit (Natural n) = Natural . setBit n- {-# INLINE setBit #-}- clearBit (Natural n) = Natural . clearBit n- {-# INLINE clearBit #-}- complementBit (Natural n) = Natural . complementBit n- {-# INLINE complementBit #-}- testBit = testBit . runNatural- {-# INLINE testBit #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707- bitSizeMaybe _ = Nothing- {-# INLINE bitSizeMaybe #-}-#endif- bitSize = error "Natural: bitSize"- {-# INLINE bitSize #-}- isSigned _ = False- {-# INLINE isSigned #-}- shiftL (Natural n) = Natural . shiftL n- {-# INLINE shiftL #-}- shiftR (Natural n) = Natural . shiftR n- {-# INLINE shiftR #-}- rotateL (Natural n) = Natural . rotateL n- {-# INLINE rotateL #-}- rotateR (Natural n) = Natural . rotateR n- {-# INLINE rotateR #-}-#if MIN_VERSION_base(4,6,0)- popCount = popCountDefault- {-# INLINE popCount #-}-#endif--instance Real Natural where- toRational (Natural a) = toRational a- {-# INLINE toRational #-}--instance Enum Natural where- pred (Natural 0) = error "Natural.pred: 0"- pred (Natural n) = Natural (pred n)- {-# INLINE pred #-}- succ (Natural n) = Natural (succ n)- {-# INLINE succ #-}- fromEnum (Natural n) = fromEnum n- {-# INLINE fromEnum #-}- toEnum n | n < 0 = error "Natural.toEnum: negative"- | otherwise = Natural (toEnum n)- {-# INLINE toEnum #-}--instance Integral Natural where- quot (Natural a) (Natural b) = Natural (quot a b)- {-# INLINE quot #-}- rem (Natural a) (Natural b) = Natural (rem a b)- {-# INLINE rem #-}- div (Natural a) (Natural b) = Natural (div a b)- {-# INLINE div #-}- mod (Natural a) (Natural b) = Natural (mod a b)- {-# INLINE mod #-}- divMod (Natural a) (Natural b) = (Natural q, Natural r) where (q,r) = divMod a b- {-# INLINE divMod #-}- quotRem (Natural a) (Natural b) = (Natural q, Natural r) where (q,r) = quotRem a b- {-# INLINE quotRem #-}- toInteger = runNatural- {-# INLINE toInteger #-}---- | A refinement of 'Integral' to represent types that do not contain negative numbers.-class Integral n => Whole n where- toNatural :: n -> Natural- unsafePred :: n -> n--instance Whole Word where- toNatural = Natural . toInteger- unsafePred n = n - 1- {-# INLINE toNatural #-}- {-# INLINE unsafePred #-}--instance Whole Word8 where- toNatural = Natural . toInteger- unsafePred n = n - 1- {-# INLINE toNatural #-}- {-# INLINE unsafePred #-}--instance Whole Word16 where- toNatural = Natural . toInteger- unsafePred n = n - 1- {-# INLINE toNatural #-}- {-# INLINE unsafePred #-}--instance Whole Word32 where- toNatural = Natural . toInteger- unsafePred n = n - 1- {-# INLINE toNatural #-}- {-# INLINE unsafePred #-}--instance Whole Word64 where- toNatural = Natural . toInteger- unsafePred n = n - 1- {-# INLINE toNatural #-}- {-# INLINE unsafePred #-}--instance Whole Natural where- toNatural = id- unsafePred (Natural n) = Natural (n - 1)- {-# INLINE toNatural #-}- {-# INLINE unsafePred #-}