{-# LANGUAGE FlexibleContexts #-}
-- |
-- Module      : Data.Array.Accelerate.Classes.Rational
-- Copyright   : [2016..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.Classes.Rational (

  Rational(..)

) where

import Data.Array.Accelerate.Data.Ratio
import Data.Array.Accelerate.Data.Bits

import Data.Array.Accelerate.Language
import Data.Array.Accelerate.Pattern
import Data.Array.Accelerate.Smart
import Data.Array.Accelerate.Type

import Data.Array.Accelerate.Classes.Eq
import Data.Array.Accelerate.Classes.FromIntegral
import Data.Array.Accelerate.Classes.Integral
import Data.Array.Accelerate.Classes.Num
import Data.Array.Accelerate.Classes.Ord
import Data.Array.Accelerate.Classes.RealFloat

import Prelude                                            ( ($) )


-- | Numbers which can be expressed as the quotient of two integers.
--
-- Accelerate does not have an arbitrary precision Integer type, however
-- fixed-length large integers are provide by the @accelerate-bignum@
-- package.
--
class (Num a, Ord a) => Rational a where
  -- | Convert a number to the quotient of two integers
  --
  toRational :: (FromIntegral Int64 b, Integral b) => Exp a -> Exp (Ratio b)

instance Rational Int    where toRational :: Exp Int -> Exp (Ratio b)
toRational = Exp Int -> Exp (Ratio b)
forall a b.
(Integral a, Integral b, FromIntegral a Int64,
 FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
integralToRational
instance Rational Int8   where toRational :: Exp Int8 -> Exp (Ratio b)
toRational = Exp Int8 -> Exp (Ratio b)
forall a b.
(Integral a, Integral b, FromIntegral a Int64,
 FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
integralToRational
instance Rational Int16  where toRational :: Exp Int16 -> Exp (Ratio b)
toRational = Exp Int16 -> Exp (Ratio b)
forall a b.
(Integral a, Integral b, FromIntegral a Int64,
 FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
integralToRational
instance Rational Int32  where toRational :: Exp Int32 -> Exp (Ratio b)
toRational = Exp Int32 -> Exp (Ratio b)
forall a b.
(Integral a, Integral b, FromIntegral a Int64,
 FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
integralToRational
instance Rational Int64  where toRational :: Exp Int64 -> Exp (Ratio b)
toRational = Exp Int64 -> Exp (Ratio b)
forall a b.
(Integral a, Integral b, FromIntegral a Int64,
 FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
integralToRational
instance Rational Word   where toRational :: Exp Word -> Exp (Ratio b)
toRational = Exp Word -> Exp (Ratio b)
forall a b.
(Integral a, Integral b, FromIntegral a Int64,
 FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
integralToRational
instance Rational Word8  where toRational :: Exp Word8 -> Exp (Ratio b)
toRational = Exp Word8 -> Exp (Ratio b)
forall a b.
(Integral a, Integral b, FromIntegral a Int64,
 FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
integralToRational
instance Rational Word16 where toRational :: Exp Word16 -> Exp (Ratio b)
toRational = Exp Word16 -> Exp (Ratio b)
forall a b.
(Integral a, Integral b, FromIntegral a Int64,
 FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
integralToRational
instance Rational Word32 where toRational :: Exp Word32 -> Exp (Ratio b)
toRational = Exp Word32 -> Exp (Ratio b)
forall a b.
(Integral a, Integral b, FromIntegral a Int64,
 FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
integralToRational
instance Rational Word64 where toRational :: Exp Word64 -> Exp (Ratio b)
toRational = Exp Word64 -> Exp (Ratio b)
forall a b.
(Integral a, Integral b, FromIntegral a Int64,
 FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
integralToRational

instance Rational Half   where toRational :: Exp Half -> Exp (Ratio b)
toRational = Exp Half -> Exp (Ratio b)
forall a b.
(RealFloat a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
floatingToRational
instance Rational Float  where toRational :: Exp Float -> Exp (Ratio b)
toRational = Exp Float -> Exp (Ratio b)
forall a b.
(RealFloat a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
floatingToRational
instance Rational Double where toRational :: Exp Double -> Exp (Ratio b)
toRational = Exp Double -> Exp (Ratio b)
forall a b.
(RealFloat a, Integral b, FromIntegral Int64 b) =>
Exp a -> Exp (Ratio b)
floatingToRational


integralToRational
    :: (Integral a, Integral b, FromIntegral a Int64, FromIntegral Int64 b)
    => Exp a
    -> Exp (Ratio b)
integralToRational :: Exp a -> Exp (Ratio b)
integralToRational Exp a
x = Exp Int64 -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral (Exp a -> Exp Int64
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp a
x :: Exp Int64) Exp b -> Exp b -> Exp (Ratio b)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp b
1

floatingToRational
    :: (RealFloat a, Integral b, FromIntegral Int64 b)
    => Exp a
    -> Exp (Ratio b)
floatingToRational :: Exp a -> Exp (Ratio b)
floatingToRational Exp a
x = Exp Int64 -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int64
u Exp b -> Exp b -> Exp (Ratio b)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp Int64 -> Exp b
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int64
v
  where
    (Exp Int64
m, Exp Int
e) = Exp a -> (Exp Int64, Exp Int)
forall a. RealFloat a => Exp a -> (Exp Int64, Exp Int)
decodeFloat Exp a
x
    (Exp Int64
n, Exp Int
d) = Exp Int64 -> Exp Int -> (Exp Int64, Exp Int)
elimZeros Exp Int64
m (Exp Int -> Exp Int
forall a. Num a => a -> a
negate Exp Int
e)
    Exp Int64
u :% Exp Int64
v = Exp Bool
-> Exp (Ratio Int64) -> Exp (Ratio Int64) -> Exp (Ratio Int64)
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int
e Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
>= Exp Int
0)       ((Exp Int64
m Exp Int64 -> Exp Int -> Exp Int64
forall a. Bits a => Exp a -> Exp Int -> Exp a
`shiftL` Exp Int
e) Exp Int64 -> Exp Int64 -> Exp (Ratio Int64)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp Int64
1) (Exp (Ratio Int64) -> Exp (Ratio Int64))
-> Exp (Ratio Int64) -> Exp (Ratio Int64)
forall a b. (a -> b) -> a -> b
$
             Exp Bool
-> Exp (Ratio Int64) -> Exp (Ratio Int64) -> Exp (Ratio Int64)
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int64
m Exp Int64 -> Exp Int64 -> Exp Int64
forall a. Bits a => Exp a -> Exp a -> Exp a
.&. Exp Int64
1 Exp Int64 -> Exp Int64 -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp Int64
0) (Exp Int64
n Exp Int64 -> Exp Int64 -> Exp (Ratio Int64)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp Int64 -> Exp Int -> Exp Int64
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp Int64
1 Exp Int
d)     (Exp (Ratio Int64) -> Exp (Ratio Int64))
-> Exp (Ratio Int64) -> Exp (Ratio Int64)
forall a b. (a -> b) -> a -> b
$
                                 (Exp Int64
m Exp Int64 -> Exp Int64 -> Exp (Ratio Int64)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp Int64 -> Exp Int -> Exp Int64
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftL Exp Int64
1 (Exp Int -> Exp Int
forall a. Num a => a -> a
negate Exp Int
e))

-- Stolen from GHC.Float.ConversionUtils
--
elimZeros :: Exp Int64 -> Exp Int -> (Exp Int64, Exp Int) -- Integer
elimZeros :: Exp Int64 -> Exp Int -> (Exp Int64, Exp Int)
elimZeros Exp Int64
x Exp Int
y = (Exp Int64
u, Exp Int
v)
  where
    T3 Exp Bool
_ Exp Int64
u Exp Int
v = (Exp (Bool, Int64, Int) -> Exp Bool)
-> (Exp (Bool, Int64, Int) -> Exp (Bool, Int64, Int))
-> Exp (Bool, Int64, Int)
-> Exp (Bool, Int64, Int)
forall e.
Elt e =>
(Exp e -> Exp Bool) -> (Exp e -> Exp e) -> Exp e -> Exp e
while (\(T3 Exp Bool
p Exp Int64
_ Exp Int
_) -> Exp Bool
p) Exp (Bool, Int64, Int) -> Exp (Bool, Int64, Int)
elim (Exp Bool -> Exp Int64 -> Exp Int -> Exp (Bool, Int64, Int)
forall (con :: * -> *) x0 x1 x2.
IsPattern con (x0, x1, x2) (con x0, con x1, con x2) =>
con x0 -> con x1 -> con x2 -> con (x0, x1, x2)
T3 Exp Bool
moar Exp Int64
x Exp Int
y)
    kthxbai :: Exp Bool
kthxbai  = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
False
    moar :: Exp Bool
moar     = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
True

    elim :: Exp (Bool, Int64, Int) -> Exp (Bool, Int64, Int)
    elim :: Exp (Bool, Int64, Int) -> Exp (Bool, Int64, Int)
elim (T3 Exp Bool
_ Exp Int64
n Exp Int
e) =
      let t :: Exp Int
t = Exp Word8 -> Exp Int
forall b. FiniteBits b => Exp b -> Exp Int
countTrailingZeros (Exp Int64 -> Exp Word8
forall a b. (FromIntegral a b, Integral a) => Exp a -> Exp b
fromIntegral Exp Int64
n :: Exp Word8)
      in
      Exp Bool
-> Exp (Bool, Int64, Int)
-> Exp (Bool, Int64, Int)
-> Exp (Bool, Int64, Int)
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int
e Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<= Exp Int
t) (Exp Bool -> Exp Int64 -> Exp Int -> Exp (Bool, Int64, Int)
forall (con :: * -> *) x0 x1 x2.
IsPattern con (x0, x1, x2) (con x0, con x1, con x2) =>
con x0 -> con x1 -> con x2 -> con (x0, x1, x2)
T3 Exp Bool
kthxbai (Exp Int64 -> Exp Int -> Exp Int64
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp Int64
n Exp Int
e) Exp Int
0)     (Exp (Bool, Int64, Int) -> Exp (Bool, Int64, Int))
-> Exp (Bool, Int64, Int) -> Exp (Bool, Int64, Int)
forall a b. (a -> b) -> a -> b
$
      Exp Bool
-> Exp (Bool, Int64, Int)
-> Exp (Bool, Int64, Int)
-> Exp (Bool, Int64, Int)
forall t. Elt t => Exp Bool -> Exp t -> Exp t -> Exp t
cond (Exp Int
t Exp Int -> Exp Int -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<  Exp Int
8) (Exp Bool -> Exp Int64 -> Exp Int -> Exp (Bool, Int64, Int)
forall (con :: * -> *) x0 x1 x2.
IsPattern con (x0, x1, x2) (con x0, con x1, con x2) =>
con x0 -> con x1 -> con x2 -> con (x0, x1, x2)
T3 Exp Bool
kthxbai (Exp Int64 -> Exp Int -> Exp Int64
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp Int64
n Exp Int
t) (Exp Int
eExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
-Exp Int
t)) (Exp (Bool, Int64, Int) -> Exp (Bool, Int64, Int))
-> Exp (Bool, Int64, Int) -> Exp (Bool, Int64, Int)
forall a b. (a -> b) -> a -> b
$
                    (Exp Bool -> Exp Int64 -> Exp Int -> Exp (Bool, Int64, Int)
forall (con :: * -> *) x0 x1 x2.
IsPattern con (x0, x1, x2) (con x0, con x1, con x2) =>
con x0 -> con x1 -> con x2 -> con (x0, x1, x2)
T3 Exp Bool
moar    (Exp Int64 -> Exp Int -> Exp Int64
forall a. Bits a => Exp a -> Exp Int -> Exp a
shiftR Exp Int64
n Exp Int
8) (Exp Int
eExp Int -> Exp Int -> Exp Int
forall a. Num a => a -> a -> a
-Exp Int
8))