{-# 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 #-}