{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
module Numeric.MixedTypes.Div
(
CanDiv(..), CanDivBy, CanDivSameType
, CanRecip, CanRecipSameType
, (/), recip
, specCanDiv, specCanDivNotMixed
)
where
import Utils.TH.DeclForTypes
import Numeric.MixedTypes.PreludeHiding
import qualified Prelude as P
import Text.Printf
import Test.Hspec
import Test.QuickCheck
import Numeric.CollectErrors ( CN, cn )
import qualified Numeric.CollectErrors as CN
import Numeric.MixedTypes.Literals
import Numeric.MixedTypes.Bool
import Numeric.MixedTypes.Eq
import Numeric.MixedTypes.Ring
class CanDiv t1 t2 where
type DivType t1 t2
type DivType t1 t2 = t1
divide :: t1 -> t2 -> DivType t1 t2
divideCN ::
(CanTestZero t2)
=>
(t1 -> t2 -> t3) ->
CN t1 -> CN t2 -> CN t3
divideCN :: (t1 -> t2 -> t3) -> CN t1 -> CN t2 -> CN t3
divideCN t1 -> t2 -> t3
unsafeDivide CN t1
a CN t2
b
| CN t2 -> Bool
forall t. CanTestZero t => t -> Bool
isCertainlyZero CN t2
b = CN t3 -> NumError -> CN t3
forall t. CN t -> NumError -> CN t
CN.removeValueErrorCertain CN t3
r NumError
e
| CN t2 -> Bool
forall t. CanTestZero t => t -> Bool
isCertainlyNonZero CN t2
b = CN t3
r
| Bool
otherwise = CN t3 -> NumError -> CN t3
forall t. CN t -> NumError -> CN t
CN.removeValueErrorPotential CN t3
r NumError
e
where
r :: CN t3
r = (t1 -> t2 -> t3) -> CN t1 -> CN t2 -> CN t3
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CN.lift2 t1 -> t2 -> t3
unsafeDivide CN t1
a CN t2
b
e :: CN.NumError
e :: NumError
e = NumError
CN.DivByZero
infixl 7 /
(/) :: (CanDiv t1 t2) => t1 -> t2 -> DivType t1 t2
/ :: t1 -> t2 -> DivType t1 t2
(/) = t1 -> t2 -> DivType t1 t2
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide
type CanRecip t =
(CanDiv Integer t)
type CanRecipSameType t =
(CanDiv Integer t, DivType Integer t ~ t)
recip :: (CanRecip t) => t -> DivType Integer t
recip :: t -> DivType Integer t
recip = Integer -> t -> DivType Integer t
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide Integer
1
type CanDivBy t1 t2 =
(CanDiv t1 t2, DivType t1 t2 ~ t1)
type CanDivSameType t =
CanDivBy t t
specCanDiv ::
_ => T t1 -> T t2 -> Spec
specCanDiv :: T t1 -> T t2 -> Spec
specCanDiv (T String
typeName1 :: T t1) (T String
typeName2 :: T t2) =
String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CanDiv %s %s" String
typeName1 String
typeName2) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"recip(recip x) = x" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t1 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> Property) -> Property) -> (t1 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) ->
(t1 -> Bool
forall t. CanTestZero t => t -> Bool
isCertainlyNonZero t1
x Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& DivType Integer t1 -> Bool
forall t. CanTestZero t => t -> Bool
isCertainlyNonZero (t1 -> DivType Integer t1
forall t. CanRecip t => t -> DivType Integer t
recip t1
x)) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
DivType Integer t1 -> DivType Integer (DivType Integer t1)
forall t. CanRecip t => t -> DivType Integer t
recip (t1 -> DivType Integer t1
forall t. CanRecip t => t -> DivType Integer t
recip t1
x) DivType Integer (DivType Integer t1) -> t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
x
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x/1 = x" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t1 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> Property) -> Property) -> (t1 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> let one :: t2
one = (Integer -> t2
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t2) in (t1
x t1 -> t2 -> DivType t1 t2
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ t2
one) DivType t1 t2 -> t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
x
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x/x = 1" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t1 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> Property) -> Property) -> (t1 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) ->
(t1 -> Bool
forall t. CanTestZero t => t -> Bool
isCertainlyNonZero t1
x) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
let one :: t1
one = (Integer -> t1
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t1) in (t1
x t1 -> t1 -> DivType t1 t1
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ t1
x) DivType t1 t1 -> t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
one
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x/y = x*(1/y)" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
(t1 -> t2 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> t2 -> Property) -> Property)
-> (t1 -> t2 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) ->
(t2 -> Bool
forall t. CanTestZero t => t -> Bool
isCertainlyNonZero t2
y) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
let one :: t1
one = (Integer -> t1
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t1) in (t1
x t1 -> t2 -> DivType t1 t2
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ t2
y) DivType t1 t2 -> MulType t1 (DivType t1 t2) -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
x t1 -> DivType t1 t2 -> MulType t1 (DivType t1 t2)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (t1
onet1 -> t2 -> DivType t1 t2
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/t2
y)
where
infix 4 ?==?$
(?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
?==?$ :: a -> b -> Property
(?==?$) = String -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)
specCanDivNotMixed ::
_ => T t -> Spec
specCanDivNotMixed :: T t -> Spec
specCanDivNotMixed (T t
t :: T t) = T t -> T t -> Spec
forall t1 t2.
(CanDiv t1 t2, CanDiv t1 t1, CanDiv Integer t1,
CanDiv Integer (DivType Integer t1), Arbitrary t1, Arbitrary t2,
CanTestZero t1, CanTestZero (DivType Integer t1), CanTestZero t2,
HasEqAsymmetric (DivType Integer (DivType Integer t1)) t1,
HasEqAsymmetric (DivType t1 t1) t1,
HasEqAsymmetric (DivType t1 t2) t1,
HasEqAsymmetric (DivType t1 t2) (MulType t1 (DivType t1 t2)),
CanTestCertainly
(EqCompareType (DivType Integer (DivType Integer t1)) t1),
CanTestCertainly (EqCompareType (DivType t1 t2) t1),
CanTestCertainly (EqCompareType (DivType t1 t1) t1),
CanTestCertainly
(EqCompareType (DivType t1 t2) (MulType t1 (DivType t1 t2))),
Show t1, Show (DivType Integer (DivType Integer t1)),
Show (DivType t1 t2), Show (DivType t1 t1), Show t2,
Show (MulType t1 (DivType t1 t2)),
CanMulAsymmetric t1 (DivType t1 t2), ConvertibleExactly Integer t2,
ConvertibleExactly Integer t1) =>
T t1 -> T t2 -> Spec
specCanDiv T t
t T t
t
instance CanDiv Int Int where
type DivType Int Int = Rational
divide :: Int -> Int -> DivType Int Int
divide Int
a Int
b = Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(P./) (Int -> Rational
forall t. CanBeRational t => t -> Rational
rational Int
a) (Int -> Rational
forall t. CanBeRational t => t -> Rational
rational Int
b)
instance CanDiv Integer Integer where
type DivType Integer Integer = Rational
divide :: Integer -> Integer -> DivType Integer Integer
divide Integer
a Integer
b = Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(P./) (Integer -> Rational
forall t. CanBeRational t => t -> Rational
rational Integer
a) (Integer -> Rational
forall t. CanBeRational t => t -> Rational
rational Integer
b)
instance CanDiv Rational Rational where
type DivType Rational Rational = Rational
divide :: Rational -> Rational -> DivType Rational Rational
divide = Rational -> Rational -> DivType Rational Rational
forall a. Fractional a => a -> a -> a
(P./)
instance CanDiv Int Integer where
type DivType Int Integer = Rational
divide :: Int -> Integer -> DivType Int Integer
divide Int
a Integer
b = Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(P./) (Int -> Rational
forall t. CanBeRational t => t -> Rational
rational Int
a) (Integer -> Rational
forall t. CanBeRational t => t -> Rational
rational Integer
b)
instance CanDiv Integer Int where
type DivType Integer Int = Rational
divide :: Integer -> Int -> DivType Integer Int
divide Integer
a Int
b = Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
(P./) (Integer -> Rational
forall t. CanBeRational t => t -> Rational
rational Integer
a) (Int -> Rational
forall t. CanBeRational t => t -> Rational
rational Int
b)
instance CanDiv Int Rational where
type DivType Int Rational = Rational
divide :: Int -> Rational -> DivType Int Rational
divide = (Rational -> Rational -> Rational) -> Int -> Rational -> Rational
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst Rational -> Rational -> Rational
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide
instance CanDiv Rational Int where
divide :: Rational -> Int -> DivType Rational Int
divide = (Rational -> Rational -> Rational) -> Rational -> Int -> Rational
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond Rational -> Rational -> Rational
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide
instance CanDiv Integer Rational where
type DivType Integer Rational = Rational
divide :: Integer -> Rational -> DivType Integer Rational
divide = (Rational -> Rational -> Rational)
-> Integer -> Rational -> Rational
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst Rational -> Rational -> Rational
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide
instance CanDiv Rational Integer where
divide :: Rational -> Integer -> DivType Rational Integer
divide = (Rational -> Rational -> Rational)
-> Rational -> Integer -> Rational
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond Rational -> Rational -> Rational
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide
instance CanDiv Double Double where
divide :: Double -> Double -> DivType Double Double
divide = Double -> Double -> DivType Double Double
forall a. Fractional a => a -> a -> a
(P./)
$(declForTypes
[[t| Integer |], [t| Int |], [t| Rational |]]
(\ t -> [d|
instance CanDiv $t Double where
type DivType $t Double = Double
divide n d = divide (double n) d
instance CanDiv Double $t where
type DivType Double $t = Double
divide d n = divide d (double n)
|]))
instance (CanDiv a b) => CanDiv [a] [b] where
type DivType [a] [b] = [DivType a b]
divide :: [a] -> [b] -> DivType [a] [b]
divide (a
x:[a]
xs) (b
y:[b]
ys) = (a -> b -> DivType a b
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide a
x b
y) DivType a b -> [DivType a b] -> [DivType a b]
forall a. a -> [a] -> [a]
: ([a] -> [b] -> DivType [a] [b]
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide [a]
xs [b]
ys)
divide [a]
_ [b]
_ = []
instance (CanDiv a b) => CanDiv (Maybe a) (Maybe b) where
type DivType (Maybe a) (Maybe b) = Maybe (DivType a b)
divide :: Maybe a -> Maybe b -> DivType (Maybe a) (Maybe b)
divide (Just a
x) (Just b
y) = DivType a b -> Maybe (DivType a b)
forall a. a -> Maybe a
Just (a -> b -> DivType a b
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide a
x b
y)
divide Maybe a
_ Maybe b
_ = DivType (Maybe a) (Maybe b)
forall a. Maybe a
Nothing
instance
(CanDiv a b, CanTestZero b)
=>
CanDiv (CN a) (CN b)
where
type DivType (CN a) (CN b) = CN (DivType a b)
divide :: CN a -> CN b -> DivType (CN a) (CN b)
divide = (a -> b -> DivType a b) -> CN a -> CN b -> CN (DivType a b)
forall t2 t1 t3.
CanTestZero t2 =>
(t1 -> t2 -> t3) -> CN t1 -> CN t2 -> CN t3
divideCN a -> b -> DivType a b
forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide
$(declForTypes
[[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]
(\ t -> [d|
instance
(CanDiv $t b, CanTestZero b)
=>
CanDiv $t (CN b)
where
type DivType $t (CN b) = CN (DivType $t b)
divide a b = divideCN divide (cn a) b
instance
(CanDiv a $t)
=>
CanDiv (CN a) $t
where
type DivType (CN a) $t = CN (DivType a $t)
divide a b = divideCN divide a (cn b)
|]))