module CPython.Protocols.Number
( Number (..)
, SomeNumber
, castToNumber
, add
, subtract
, multiply
, floorDivide
, trueDivide
, remainder
, divmod
, power
, negative
, positive
, absolute
, invert
, shiftL
, shiftR
, and
, xor
, or
, inPlaceAdd
, inPlaceSubtract
, inPlaceMultiply
, inPlaceFloorDivide
, inPlaceTrueDivide
, inPlaceRemainder
, inPlacePower
, inPlaceShiftL
, inPlaceShiftR
, inPlaceAnd
, inPlaceXor
, inPlaceOr
, toInteger
, toFloat
, toBase
) where
import Prelude hiding (Integer, Float, subtract, and, or, toInteger)
import qualified Prelude as Prelude
import CPython.Constants (none)
import CPython.Internal hiding (xor, shiftR, shiftL)
import CPython.Types.Complex (Complex)
import CPython.Types.Float (Float)
import CPython.Types.Integer (Integer)
import CPython.Types.Set (Set, FrozenSet)
import CPython.Types.Unicode (Unicode)
data SomeNumber = forall a. (Number a) => SomeNumber (ForeignPtr a)
class Object a => Number a where
toNumber :: a -> SomeNumber
instance Object SomeNumber where
toObject (SomeNumber x) = SomeObject x
fromForeignPtr = SomeNumber
instance Number SomeNumber where
toNumber = id
instance Number Integer where
toNumber = unsafeCastToNumber
instance Number Float where
toNumber = unsafeCastToNumber
instance Number Complex where
toNumber = unsafeCastToNumber
instance Number Set where
toNumber = unsafeCastToNumber
instance Number FrozenSet where
toNumber = unsafeCastToNumber
unsafeCastToNumber :: Object a => a -> SomeNumber
unsafeCastToNumber x = case toObject x of
SomeObject ptr -> let
ptr' = castForeignPtr ptr :: ForeignPtr SomeNumber
in SomeNumber ptr'
castToNumber :: Object a => a -> IO (Maybe SomeNumber)
castToNumber obj =
withObject obj $ \objPtr -> do
isNumber <- fmap cToBool $ pyNumberCheck objPtr
return $ if isNumber
then Just $ unsafeCastToNumber obj
else Nothing
add :: (Number a, Number b) => a -> b -> IO (SomeNumber)
add a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
add'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
subtract :: (Number a, Number b) => a -> b -> IO (SomeNumber)
subtract a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
subtract'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
multiply :: (Number a, Number b) => a -> b -> IO (SomeNumber)
multiply a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
multiply'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
floorDivide :: (Number a, Number b) => a -> b -> IO (SomeNumber)
floorDivide a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
floorDivide'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
trueDivide :: (Number a, Number b) => a -> b -> IO (SomeNumber)
trueDivide a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
trueDivide'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
remainder :: (Number a, Number b) => a -> b -> IO (SomeNumber)
remainder a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
remainder'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
divmod :: (Number a, Number b) => a -> b -> IO (SomeNumber)
divmod a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
divmod'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
power :: (Number a, Number b, Number c) => a -> b -> Maybe c -> IO SomeNumber
power a b mc =
withObject a $ \aPtr ->
withObject b $ \bPtr ->
maybe none (return . toObject) mc >>= \c ->
withObject c $ \cPtr ->
pyNumberPower aPtr bPtr cPtr
>>= stealObject
negative :: Number a => a -> IO (SomeNumber)
negative a1 =
withObject a1 $ \a1' ->
negative'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
positive :: Number a => a -> IO (SomeNumber)
positive a1 =
withObject a1 $ \a1' ->
positive'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
absolute :: Number a => a -> IO (SomeNumber)
absolute a1 =
withObject a1 $ \a1' ->
absolute'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
invert :: Number a => a -> IO (SomeNumber)
invert a1 =
withObject a1 $ \a1' ->
invert'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
shiftL :: (Number a, Number b) => a -> b -> IO (SomeNumber)
shiftL a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
shiftL'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
shiftR :: (Number a, Number b) => a -> b -> IO (SomeNumber)
shiftR a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
shiftR'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
and :: (Number a, Number b) => a -> b -> IO (SomeNumber)
and a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
and'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
xor :: (Number a, Number b) => a -> b -> IO (SomeNumber)
xor a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
xor'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
or :: (Number a, Number b) => a -> b -> IO (SomeNumber)
or a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
or'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
inPlaceAdd :: (Number a, Number b) => a -> b -> IO (SomeNumber)
inPlaceAdd a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
inPlaceAdd'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
inPlaceSubtract :: (Number a, Number b) => a -> b -> IO (SomeNumber)
inPlaceSubtract a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
inPlaceSubtract'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
inPlaceMultiply :: (Number a, Number b) => a -> b -> IO (SomeNumber)
inPlaceMultiply a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
inPlaceMultiply'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
inPlaceFloorDivide :: (Number a, Number b) => a -> b -> IO (SomeNumber)
inPlaceFloorDivide a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
inPlaceFloorDivide'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
inPlaceTrueDivide :: (Number a, Number b) => a -> b -> IO (SomeNumber)
inPlaceTrueDivide a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
inPlaceTrueDivide'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
inPlaceRemainder :: (Number a, Number b) => a -> b -> IO (SomeNumber)
inPlaceRemainder a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
inPlaceRemainder'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
inPlacePower ::(Number a, Number b, Number c) => a -> b -> Maybe c -> IO SomeNumber
inPlacePower a b mc =
withObject a $ \aPtr ->
withObject b $ \bPtr ->
maybe none (return . toObject) mc >>= \c ->
withObject c $ \cPtr ->
pyNumberInPlacePower aPtr bPtr cPtr
>>= stealObject
inPlaceShiftL :: (Number a, Number b) => a -> b -> IO (SomeNumber)
inPlaceShiftL a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
inPlaceShiftL'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
inPlaceShiftR :: (Number a, Number b) => a -> b -> IO (SomeNumber)
inPlaceShiftR a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
inPlaceShiftR'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
inPlaceAnd :: (Number a, Number b) => a -> b -> IO (SomeNumber)
inPlaceAnd a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
inPlaceAnd'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
inPlaceXor :: (Number a, Number b) => a -> b -> IO (SomeNumber)
inPlaceXor a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
inPlaceXor'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
inPlaceOr :: (Number a, Number b) => a -> b -> IO (SomeNumber)
inPlaceOr a1 a2 =
withObject a1 $ \a1' ->
withObject a2 $ \a2' ->
inPlaceOr'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
toInteger :: Number a => a -> IO (Integer)
toInteger a1 =
withObject a1 $ \a1' ->
toInteger'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
toFloat :: Number a => a -> IO (Float)
toFloat a1 =
withObject a1 $ \a1' ->
toFloat'_ a1' >>= \res ->
stealObject res >>= \res' ->
return (res')
toBase :: Number a => a -> Prelude.Integer -> IO (Unicode)
toBase a1 a2 =
withObject a1 $ \a1' ->
let {a2' = fromIntegral a2} in
toBase'_ a1' a2' >>= \res ->
stealObject res >>= \res' ->
return (res')
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Check"
pyNumberCheck :: ((Ptr ()) -> (IO CInt))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Add"
add'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Subtract"
subtract'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Multiply"
multiply'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_FloorDivide"
floorDivide'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_TrueDivide"
trueDivide'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Remainder"
remainder'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Divmod"
divmod'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Power"
pyNumberPower :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ())))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Negative"
negative'_ :: ((Ptr ()) -> (IO (Ptr ())))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Positive"
positive'_ :: ((Ptr ()) -> (IO (Ptr ())))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Absolute"
absolute'_ :: ((Ptr ()) -> (IO (Ptr ())))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Invert"
invert'_ :: ((Ptr ()) -> (IO (Ptr ())))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Lshift"
shiftL'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Rshift"
shiftR'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_And"
and'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Xor"
xor'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Or"
or'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlaceAdd"
inPlaceAdd'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlaceSubtract"
inPlaceSubtract'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlaceMultiply"
inPlaceMultiply'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlaceFloorDivide"
inPlaceFloorDivide'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlaceTrueDivide"
inPlaceTrueDivide'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlaceRemainder"
inPlaceRemainder'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlacePower"
pyNumberInPlacePower :: ((Ptr ()) -> ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ())))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlaceLshift"
inPlaceShiftL'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlaceRshift"
inPlaceShiftR'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlaceAnd"
inPlaceAnd'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlaceXor"
inPlaceXor'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_InPlaceOr"
inPlaceOr'_ :: ((Ptr ()) -> ((Ptr ()) -> (IO (Ptr ()))))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Long"
toInteger'_ :: ((Ptr ()) -> (IO (Ptr ())))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_Float"
toFloat'_ :: ((Ptr ()) -> (IO (Ptr ())))
foreign import ccall safe "CPython/Protocols/Number.chs.h PyNumber_ToBase"
toBase'_ :: ((Ptr ()) -> (CInt -> (IO (Ptr ()))))