{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Array.Accelerate.Classes.RealFrac (
RealFrac(..),
div', mod', divMod',
) where
import Data.Array.Accelerate.Language ( (^), cond, even )
import Data.Array.Accelerate.Lift ( unlift )
import Data.Array.Accelerate.Pattern
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Smart
import Data.Array.Accelerate.Sugar.Elt
import Data.Array.Accelerate.Type
import Data.Array.Accelerate.Classes.Eq
import Data.Array.Accelerate.Classes.Ord
import Data.Array.Accelerate.Classes.Floating
import Data.Array.Accelerate.Classes.Fractional
import Data.Array.Accelerate.Classes.FromIntegral
import Data.Array.Accelerate.Classes.Integral
import Data.Array.Accelerate.Classes.Num
import Data.Array.Accelerate.Classes.ToFloating
import {-# SOURCE #-} Data.Array.Accelerate.Classes.RealFloat
import Data.Maybe
import Text.Printf
import Prelude ( ($), String, error, unlines, otherwise )
import qualified Prelude as P
div' :: (RealFrac a, FromIntegral Int64 b, Integral b) => Exp a -> Exp a -> Exp b
div' :: Exp a -> Exp a -> Exp b
div' Exp a
n Exp a
d = Exp a -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
floor (Exp a
n Exp a -> Exp a -> Exp a
forall a. Fractional a => a -> a -> a
/ Exp a
d)
mod' :: (Floating a, RealFrac a, ToFloating Int64 a) => Exp a -> Exp a -> Exp a
mod' :: Exp a -> Exp a -> Exp a
mod' Exp a
n Exp a
d = Exp a
n Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
- (Exp Int64 -> Exp a
forall a b. (ToFloating a b, Num a, Floating b) => Exp a -> Exp b
toFloating Exp Int64
f) Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a
d
where
f :: Exp Int64
f :: Exp Int64
f = Exp a -> Exp a -> Exp Int64
forall a b.
(RealFrac a, FromIntegral Int64 b, Integral b) =>
Exp a -> Exp a -> Exp b
div' Exp a
n Exp a
d
divMod'
:: (Floating a, RealFrac a, Integral b, FromIntegral Int64 b, ToFloating b a)
=> Exp a
-> Exp a
-> (Exp b, Exp a)
divMod' :: Exp a -> Exp a -> (Exp b, Exp a)
divMod' Exp a
n Exp a
d = (Exp b
f, Exp a
n Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
- (Exp b -> Exp a
forall a b. (ToFloating a b, Num a, Floating b) => Exp a -> Exp b
toFloating Exp b
f) Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a
d)
where
f :: Exp b
f = Exp a -> Exp a -> Exp b
forall a b.
(RealFrac a, FromIntegral Int64 b, Integral b) =>
Exp a -> Exp a -> Exp b
div' Exp a
n Exp a
d
class (Ord a, Fractional a) => RealFrac a where
properFraction :: (Integral b, FromIntegral Int64 b) => Exp a -> (Exp b, Exp a)
truncate :: (Integral b, FromIntegral Int64 b) => Exp a -> Exp b
truncate = Exp a -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultTruncate
round :: (Integral b, FromIntegral Int64 b) => Exp a -> Exp b
round = Exp a -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultRound
ceiling :: (Integral b, FromIntegral Int64 b) => Exp a -> Exp b
ceiling = Exp a -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultCeiling
floor :: (Integral b, FromIntegral Int64 b) => Exp a -> Exp b
floor = Exp a -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultFloor
instance RealFrac Half where
properFraction :: Exp Half -> (Exp b, Exp Half)
properFraction = Exp Half -> (Exp b, Exp Half)
forall a b.
(RealFloat a, FromIntegral Int64 b, Integral b) =>
Exp a -> (Exp b, Exp a)
defaultProperFraction
instance RealFrac Float where
properFraction :: Exp Float -> (Exp b, Exp Float)
properFraction = Exp Float -> (Exp b, Exp Float)
forall a b.
(RealFloat a, FromIntegral Int64 b, Integral b) =>
Exp a -> (Exp b, Exp a)
defaultProperFraction
instance RealFrac Double where
properFraction :: Exp Double -> (Exp b, Exp Double)
properFraction = Exp Double -> (Exp b, Exp Double)
forall a b.
(RealFloat a, FromIntegral Int64 b, Integral b) =>
Exp a -> (Exp b, Exp a)
defaultProperFraction
instance RealFrac CFloat where
properFraction :: Exp CFloat -> (Exp b, Exp CFloat)
properFraction = Exp CFloat -> (Exp b, Exp CFloat)
forall a b.
(RealFloat a, FromIntegral Int64 b, Integral b) =>
Exp a -> (Exp b, Exp a)
defaultProperFraction
truncate :: Exp CFloat -> Exp b
truncate = Exp CFloat -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultTruncate
round :: Exp CFloat -> Exp b
round = Exp CFloat -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultRound
ceiling :: Exp CFloat -> Exp b
ceiling = Exp CFloat -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultCeiling
floor :: Exp CFloat -> Exp b
floor = Exp CFloat -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultFloor
instance RealFrac CDouble where
properFraction :: Exp CDouble -> (Exp b, Exp CDouble)
properFraction = Exp CDouble -> (Exp b, Exp CDouble)
forall a b.
(RealFloat a, FromIntegral Int64 b, Integral b) =>
Exp a -> (Exp b, Exp a)
defaultProperFraction
truncate :: Exp CDouble -> Exp b
truncate = Exp CDouble -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultTruncate
round :: Exp CDouble -> Exp b
round = Exp CDouble -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultRound
ceiling :: Exp CDouble -> Exp b
ceiling = Exp CDouble -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultCeiling
floor :: Exp CDouble -> Exp b
floor = Exp CDouble -> Exp b
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp b
defaultFloor
defaultProperFraction
:: (RealFloat a, FromIntegral Int64 b, Integral b)
=> Exp a
-> (Exp b, Exp a)
defaultProperFraction :: Exp a -> (Exp b, Exp a)
defaultProperFraction Exp a
x
= Exp (Plain (Exp b, Exp a)) -> (Exp b, Exp a)
forall (c :: * -> *) e. Unlift c e => c (Plain e) -> e
unlift
(Exp (Plain (Exp b, Exp a)) -> (Exp b, Exp a))
-> Exp (Plain (Exp b, Exp a)) -> (Exp b, Exp a)
forall a b. (a -> b) -> a -> b
$ Exp Bool -> Exp (b, a) -> Exp (b, a) -> Exp (b, a)
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int
n Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0)
(Exp b -> Exp a -> Exp (b, a)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp Int64 -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int64
m Exp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
* (Exp b
2 Exp b -> Exp Int -> Exp b
forall a b. (Num a, Integral b) => Exp a -> Exp b -> Exp a
^ Exp Int
n)) Exp a
0.0)
(Exp b -> Exp a -> Exp (b, a)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 (Exp Int64 -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int64
q) (Exp Int64 -> Exp Int -> Exp a
forall a. RealFloat a => Exp Int64 -> Exp Int -> Exp a
encodeFloat Exp Int64
r Exp Int
n))
where
(Exp Int64
m, Exp Int
n) = Exp a -> (Exp Int64, Exp Int)
forall a. RealFloat a => Exp a -> (Exp Int64, Exp Int)
decodeFloat Exp a
x
(Exp Int64
q, Exp Int64
r) = Exp Int64 -> Exp Int64 -> (Exp Int64, Exp Int64)
forall a. Integral a => a -> a -> (a, a)
quotRem Exp Int64
m (Exp Int64
2 Exp Int64 -> Exp Int -> Exp Int64
forall a b. (Num a, Integral b) => Exp a -> Exp b -> Exp a
^ (Exp Int -> Exp Int
forall a. Num a => a -> a
negate Exp Int
n))
defaultTruncate :: forall a b. (RealFrac a, Integral b, FromIntegral Int64 b) => Exp a -> Exp b
defaultTruncate :: Exp a -> Exp b
defaultTruncate Exp a
x
| Just IsFloatingDict (EltR a)
IsFloatingDict <- Elt a => Maybe (IsFloatingDict (EltR a))
forall a. Elt a => Maybe (IsFloatingDict (EltR a))
isFloating @a
, Just IsIntegralDict (EltR b)
IsIntegralDict <- Elt b => Maybe (IsIntegralDict (EltR b))
forall a. Elt a => Maybe (IsIntegralDict (EltR a))
isIntegral @b
= Exp a -> Exp b
forall a b.
(Elt a, Elt b, IsFloating (EltR a), IsIntegral (EltR b)) =>
Exp a -> Exp b
mkTruncate Exp a
x
| Bool
otherwise
= let (Exp b
n, Exp a
_) = Exp a -> (Exp b, Exp a)
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> (Exp b, Exp a)
properFraction Exp a
x in Exp b
n
defaultCeiling :: forall a b. (RealFrac a, Integral b, FromIntegral Int64 b) => Exp a -> Exp b
defaultCeiling :: Exp a -> Exp b
defaultCeiling Exp a
x
| Just IsFloatingDict (EltR a)
IsFloatingDict <- Elt a => Maybe (IsFloatingDict (EltR a))
forall a. Elt a => Maybe (IsFloatingDict (EltR a))
isFloating @a
, Just IsIntegralDict (EltR b)
IsIntegralDict <- Elt b => Maybe (IsIntegralDict (EltR b))
forall a. Elt a => Maybe (IsIntegralDict (EltR a))
isIntegral @b
= Exp a -> Exp b
forall a b.
(Elt a, Elt b, IsFloating (EltR a), IsIntegral (EltR b)) =>
Exp a -> Exp b
mkCeiling Exp a
x
| Bool
otherwise
= let (Exp b
n, Exp a
r) = Exp a -> (Exp b, Exp a)
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> (Exp b, Exp a)
properFraction Exp a
x in Exp Bool -> Exp b -> Exp b -> Exp b
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp a
r Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
> Exp a
0) (Exp b
nExp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+Exp b
1) Exp b
n
defaultFloor :: forall a b. (RealFrac a, Integral b, FromIntegral Int64 b) => Exp a -> Exp b
defaultFloor :: Exp a -> Exp b
defaultFloor Exp a
x
| Just IsFloatingDict (EltR a)
IsFloatingDict <- Elt a => Maybe (IsFloatingDict (EltR a))
forall a. Elt a => Maybe (IsFloatingDict (EltR a))
isFloating @a
, Just IsIntegralDict (EltR b)
IsIntegralDict <- Elt b => Maybe (IsIntegralDict (EltR b))
forall a. Elt a => Maybe (IsIntegralDict (EltR a))
isIntegral @b
= Exp a -> Exp b
forall a b.
(Elt a, Elt b, IsFloating (EltR a), IsIntegral (EltR b)) =>
Exp a -> Exp b
mkFloor Exp a
x
| Bool
otherwise
= let (Exp b
n, Exp a
r) = Exp a -> (Exp b, Exp a)
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> (Exp b, Exp a)
properFraction Exp a
x in Exp Bool -> Exp b -> Exp b -> Exp b
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp a
r Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
0) (Exp b
nExp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
-Exp b
1) Exp b
n
defaultRound :: forall a b. (RealFrac a, Integral b, FromIntegral Int64 b) => Exp a -> Exp b
defaultRound :: Exp a -> Exp b
defaultRound Exp a
x
| Just IsFloatingDict (EltR a)
IsFloatingDict <- Elt a => Maybe (IsFloatingDict (EltR a))
forall a. Elt a => Maybe (IsFloatingDict (EltR a))
isFloating @a
, Just IsIntegralDict (EltR b)
IsIntegralDict <- Elt b => Maybe (IsIntegralDict (EltR b))
forall a. Elt a => Maybe (IsIntegralDict (EltR a))
isIntegral @b
= Exp a -> Exp b
forall a b.
(Elt a, Elt b, IsFloating (EltR a), IsIntegral (EltR b)) =>
Exp a -> Exp b
mkRound Exp a
x
| Bool
otherwise
= let (Exp b
n, Exp a
r) = Exp a -> (Exp b, Exp a)
forall a b.
(RealFrac a, Integral b, FromIntegral Int64 b) =>
Exp a -> (Exp b, Exp a)
properFraction Exp a
x
m :: Exp b
m = Exp Bool -> Exp b -> Exp b -> Exp b
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp a
r Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
< Exp a
0.0) (Exp b
nExp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
-Exp b
1) (Exp b
nExp b -> Exp b -> Exp b
forall a. Num a => a -> a -> a
+Exp b
1)
half_down :: Exp a
half_down = Exp a -> Exp a
forall a. Num a => a -> a
abs Exp a
r Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
- Exp a
0.5
p :: Exp Ordering
p = Exp a -> Exp a -> Exp Ordering
forall a. Ord a => Exp a -> Exp a -> Exp Ordering
compare Exp a
half_down Exp a
0.0
in
Exp Bool -> Exp b -> Exp b -> Exp b
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Ordering -> Exp Ordering
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Ordering
LT Exp Ordering -> Exp Ordering -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Ordering
p) Exp b
n (Exp b -> Exp b) -> Exp b -> Exp b
forall a b. (a -> b) -> a -> b
$
Exp Bool -> Exp b -> Exp b -> Exp b
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Ordering -> Exp Ordering
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Ordering
EQ Exp Ordering -> Exp Ordering -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Ordering
p) (Exp Bool -> Exp b -> Exp b -> Exp b
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp b -> Exp Bool
forall a. Integral a => Exp a -> Exp Bool
even Exp b
n) Exp b
n Exp b
m) (Exp b -> Exp b) -> Exp b -> Exp b
forall a b. (a -> b) -> a -> b
$
Exp b
m
data IsFloatingDict a where
IsFloatingDict :: IsFloating a => IsFloatingDict a
data IsIntegralDict a where
IsIntegralDict :: IsIntegral a => IsIntegralDict a
isFloating :: forall a. Elt a => Maybe (IsFloatingDict (EltR a))
isFloating :: Maybe (IsFloatingDict (EltR a))
isFloating
| TupRsingle ScalarType (EltR a)
t <- Elt a => TupR ScalarType (EltR a)
forall a. Elt a => TypeR (EltR a)
eltR @a
, SingleScalarType SingleType (EltR a)
s <- ScalarType (EltR a)
t
, NumSingleType NumType (EltR a)
n <- SingleType (EltR a)
s
, FloatingNumType FloatingType (EltR a)
f <- NumType (EltR a)
n
= case FloatingType (EltR a)
f of
TypeHalf{} -> IsFloatingDict Half -> Maybe (IsFloatingDict Half)
forall a. a -> Maybe a
Just IsFloatingDict Half
forall a. IsFloating a => IsFloatingDict a
IsFloatingDict
TypeFloat{} -> IsFloatingDict Float -> Maybe (IsFloatingDict Float)
forall a. a -> Maybe a
Just IsFloatingDict Float
forall a. IsFloating a => IsFloatingDict a
IsFloatingDict
TypeDouble{} -> IsFloatingDict Double -> Maybe (IsFloatingDict Double)
forall a. a -> Maybe a
Just IsFloatingDict Double
forall a. IsFloating a => IsFloatingDict a
IsFloatingDict
| Bool
otherwise
= Maybe (IsFloatingDict (EltR a))
forall a. Maybe a
Nothing
isIntegral :: forall a. Elt a => Maybe (IsIntegralDict (EltR a))
isIntegral :: Maybe (IsIntegralDict (EltR a))
isIntegral
| TupRsingle ScalarType (EltR a)
t <- Elt a => TupR ScalarType (EltR a)
forall a. Elt a => TypeR (EltR a)
eltR @a
, SingleScalarType SingleType (EltR a)
s <- ScalarType (EltR a)
t
, NumSingleType NumType (EltR a)
n <- SingleType (EltR a)
s
, IntegralNumType IntegralType (EltR a)
i <- NumType (EltR a)
n
= case IntegralType (EltR a)
i of
TypeInt{} -> IsIntegralDict Int -> Maybe (IsIntegralDict Int)
forall a. a -> Maybe a
Just IsIntegralDict Int
forall a. IsIntegral a => IsIntegralDict a
IsIntegralDict
TypeInt8{} -> IsIntegralDict Int8 -> Maybe (IsIntegralDict Int8)
forall a. a -> Maybe a
Just IsIntegralDict Int8
forall a. IsIntegral a => IsIntegralDict a
IsIntegralDict
TypeInt16{} -> IsIntegralDict Int16 -> Maybe (IsIntegralDict Int16)
forall a. a -> Maybe a
Just IsIntegralDict Int16
forall a. IsIntegral a => IsIntegralDict a
IsIntegralDict
TypeInt32{} -> IsIntegralDict Int32 -> Maybe (IsIntegralDict Int32)
forall a. a -> Maybe a
Just IsIntegralDict Int32
forall a. IsIntegral a => IsIntegralDict a
IsIntegralDict
TypeInt64{} -> IsIntegralDict Int64 -> Maybe (IsIntegralDict Int64)
forall a. a -> Maybe a
Just IsIntegralDict Int64
forall a. IsIntegral a => IsIntegralDict a
IsIntegralDict
TypeWord{} -> IsIntegralDict Word -> Maybe (IsIntegralDict Word)
forall a. a -> Maybe a
Just IsIntegralDict Word
forall a. IsIntegral a => IsIntegralDict a
IsIntegralDict
TypeWord8{} -> IsIntegralDict Word8 -> Maybe (IsIntegralDict Word8)
forall a. a -> Maybe a
Just IsIntegralDict Word8
forall a. IsIntegral a => IsIntegralDict a
IsIntegralDict
TypeWord16{} -> IsIntegralDict Word16 -> Maybe (IsIntegralDict Word16)
forall a. a -> Maybe a
Just IsIntegralDict Word16
forall a. IsIntegral a => IsIntegralDict a
IsIntegralDict
TypeWord32{} -> IsIntegralDict Word32 -> Maybe (IsIntegralDict Word32)
forall a. a -> Maybe a
Just IsIntegralDict Word32
forall a. IsIntegral a => IsIntegralDict a
IsIntegralDict
TypeWord64{} -> IsIntegralDict Word64 -> Maybe (IsIntegralDict Word64)
forall a. a -> Maybe a
Just IsIntegralDict Word64
forall a. IsIntegral a => IsIntegralDict a
IsIntegralDict
| Bool
otherwise
= Maybe (IsIntegralDict (EltR a))
forall a. Maybe a
Nothing
instance RealFrac a => P.RealFrac (Exp a) where
properFraction :: Exp a -> (b, Exp a)
properFraction = String -> Exp a -> (b, Exp a)
forall a. String -> a
preludeError String
"properFraction"
truncate :: Exp a -> b
truncate = String -> Exp a -> b
forall a. String -> a
preludeError String
"truncate"
round :: Exp a -> b
round = String -> Exp a -> b
forall a. String -> a
preludeError String
"round"
ceiling :: Exp a -> b
ceiling = String -> Exp a -> b
forall a. String -> a
preludeError String
"ceiling"
floor :: Exp a -> b
floor = String -> Exp a -> b
forall a. String -> a
preludeError String
"floor"
preludeError :: String -> a
preludeError :: String -> a
preludeError String
x
= String -> a
forall a. HasCallStack => String -> a
error
(String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Prelude.%s applied to EDSL types: use Data.Array.Accelerate.%s instead" String
x String
x
, String
""
, String
"These Prelude.RealFrac instances are present only to fulfil superclass"
, String
"constraints for subsequent classes in the standard Haskell numeric hierarchy."
]