{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MonoLocalBinds        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE RebindableSyntax      #-}
{-# LANGUAGE StandaloneDeriving    #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Array.Accelerate.Data.Ratio
-- Copyright   : [2019..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- Standard functions on rational numbers
--
-- @since 1.3.0.0
--

module Data.Array.Accelerate.Data.Ratio (

  Ratio, (%),
  pattern (:%), numerator, denominator,

) where

import Data.Array.Accelerate.Language
import Data.Array.Accelerate.Pattern
import Data.Array.Accelerate.Prelude
import Data.Array.Accelerate.Smart
import Data.Array.Accelerate.Sugar.Elt
import Data.Array.Accelerate.Type

import Data.Array.Accelerate.Classes.Enum
import Data.Array.Accelerate.Classes.Eq
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.Ord
import Data.Array.Accelerate.Classes.RealFrac
import Data.Array.Accelerate.Classes.ToFloating

import Text.Printf
import Data.Ratio                                                   ( Ratio )
import Prelude                                                      ( ($), String, error, unlines )
import qualified Data.Ratio                                         as P
import qualified Prelude                                            as P


instance Elt a => Elt (Ratio a)

pattern (:%) :: Elt a => Exp a -> Exp a -> Exp (Ratio a)
pattern $b:% :: Exp a -> Exp a -> Exp (Ratio a)
$m:% :: forall r a.
Elt a =>
Exp (Ratio a) -> (Exp a -> Exp a -> r) -> (Void# -> r) -> r
(:%) { Exp (Ratio a) -> Elt a => Exp a
numerator, Exp (Ratio a) -> Elt a => Exp a
denominator } = Pattern (numerator, denominator)
{-# COMPLETE (:%) #-}


-- | 'reduce' is a subsidiary function used only in this module. It normalises
-- a ratio by dividing both numerator and denominator by their greatest common
-- divisor.
--
reduce ::  Integral a => Exp a -> Exp a -> Exp (Ratio a)
reduce :: Exp a -> Exp a -> Exp (Ratio a)
reduce Exp a
x Exp a
y =
  if Exp a
y Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
0
    then Exp (Ratio a)
forall a. Integral a => Exp (Ratio a)
infinity
    else let d :: Exp a
d = Exp a -> Exp a -> Exp a
forall a. Integral a => Exp a -> Exp a -> Exp a
gcd Exp a
x Exp a
y
         in  (Exp a
x Exp a -> Exp a -> Exp a
forall a. Integral a => a -> a -> a
`quot` Exp a
d) Exp a -> Exp a -> Exp (Ratio a)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% (Exp a
y Exp a -> Exp a -> Exp a
forall a. Integral a => a -> a -> a
`quot` Exp a
d)

-- | Form the ratio of two integral numbers
--
infixl 7 %
(%) :: Integral a => Exp a -> Exp a -> Exp (Ratio a)
Exp a
x % :: Exp a -> Exp a -> Exp (Ratio a)
% Exp a
y =  Exp a -> Exp a -> Exp (Ratio a)
forall a. Integral a => Exp a -> Exp a -> Exp (Ratio a)
reduce (Exp a
x Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a -> Exp a
forall a. Num a => a -> a
signum Exp a
y) (Exp a -> Exp a
forall a. Num a => a -> a
abs Exp a
y)

infinity :: Integral a => Exp (Ratio a)
infinity :: Exp (Ratio a)
infinity = Exp a
1 Exp a -> Exp a -> Exp (Ratio a)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp a
0


-- Instances
-- ---------

instance Integral a => Eq (Ratio a) where
  (Exp a
x :% Exp a
y) == :: Exp (Ratio a) -> Exp (Ratio a) -> Exp Bool
== (Exp a
z :% Exp a
w) = Exp a
x Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
z Exp Bool -> Exp Bool -> Exp Bool
&& Exp a
y Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
w
  (Exp a
x :% Exp a
y) /= :: Exp (Ratio a) -> Exp (Ratio a) -> Exp Bool
/= (Exp a
z :% Exp a
w) = Exp a
x Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp a
z Exp Bool -> Exp Bool -> Exp Bool
|| Exp a
y Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
/= Exp a
w

instance Integral a => Ord (Ratio a)  where
  (Exp a
x :% Exp a
y) <= :: Exp (Ratio a) -> Exp (Ratio a) -> Exp Bool
<= (Exp a
z :% Exp a
w)  =  Exp a
x Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a
w Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<= Exp a
z Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a
y
  (Exp a
x :% Exp a
y) < :: Exp (Ratio a) -> Exp (Ratio a) -> Exp Bool
<  (Exp a
z :% Exp a
w)  =  Exp a
x Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a
w Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<  Exp a
z Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a
y

instance Integral a => P.Num (Exp (Ratio a)) where
  (Exp a
x :% Exp a
y) + :: Exp (Ratio a) -> Exp (Ratio a) -> Exp (Ratio a)
+ (Exp a
z :% Exp a
w) = Exp a -> Exp a -> Exp (Ratio a)
forall a. Integral a => Exp a -> Exp a -> Exp (Ratio a)
reduce (Exp a
xExp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
*Exp a
w Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
+ Exp a
zExp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
*Exp a
y) (Exp a
yExp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
*Exp a
w)
  (Exp a
x :% Exp a
y) - :: Exp (Ratio a) -> Exp (Ratio a) -> Exp (Ratio a)
- (Exp a
z :% Exp a
w) = Exp a -> Exp a -> Exp (Ratio a)
forall a. Integral a => Exp a -> Exp a -> Exp (Ratio a)
reduce (Exp a
xExp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
*Exp a
w Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
- Exp a
zExp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
*Exp a
y) (Exp a
yExp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
*Exp a
w)
  (Exp a
x :% Exp a
y) * :: Exp (Ratio a) -> Exp (Ratio a) -> Exp (Ratio a)
* (Exp a
z :% Exp a
w) = Exp a -> Exp a -> Exp (Ratio a)
forall a. Integral a => Exp a -> Exp a -> Exp (Ratio a)
reduce (Exp a
x Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a
z) (Exp a
y Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a
w)
  negate :: Exp (Ratio a) -> Exp (Ratio a)
negate (Exp a
x:%Exp a
y)       = (-Exp a
x) Exp a -> Exp a -> Exp (Ratio a)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp a
y
  abs :: Exp (Ratio a) -> Exp (Ratio a)
abs (Exp a
x:%Exp a
y)          = Exp a -> Exp a
forall a. Num a => a -> a
abs Exp a
x Exp a -> Exp a -> Exp (Ratio a)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp a
y
  signum :: Exp (Ratio a) -> Exp (Ratio a)
signum (Exp a
x:%Exp a
_)       = Exp a -> Exp a
forall a. Num a => a -> a
signum Exp a
x Exp a -> Exp a -> Exp (Ratio a)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp a
1
  fromInteger :: Integer -> Exp (Ratio a)
fromInteger Integer
x       = Integer -> Exp a
forall a. Num a => Integer -> a
fromInteger Integer
x Exp a -> Exp a -> Exp (Ratio a)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp a
1

instance Integral a => P.Fractional (Exp (Ratio a))  where
  (Exp a
x :% Exp a
y) / :: Exp (Ratio a) -> Exp (Ratio a) -> Exp (Ratio a)
/ (Exp a
z :% Exp a
w) = (Exp a
xExp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
*Exp a
w) Exp a -> Exp a -> Exp (Ratio a)
forall a. Integral a => Exp a -> Exp a -> Exp (Ratio a)
% (Exp a
yExp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
*Exp a
z)
  recip :: Exp (Ratio a) -> Exp (Ratio a)
recip (Exp a
x :% Exp a
y)      =
    if Exp a
x Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
== Exp a
0 then Exp (Ratio a)
forall a. Integral a => Exp (Ratio a)
infinity else
    if Exp a
x Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<  Exp a
0 then Exp a -> Exp a
forall a. Num a => a -> a
negate Exp a
y Exp a -> Exp a -> Exp (Ratio a)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp a -> Exp a
forall a. Num a => a -> a
negate Exp a
x
              else Exp a
y Exp a -> Exp a -> Exp (Ratio a)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp a
x
  fromRational :: Rational -> Exp (Ratio a)
fromRational Rational
r = Integer -> Exp a
forall a. Num a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
P.numerator Rational
r) Exp a -> Exp a -> Exp (Ratio a)
forall a. Integral a => Exp a -> Exp a -> Exp (Ratio a)
% Integer -> Exp a
forall a. Num a => Integer -> a
fromInteger (Rational -> Integer
forall a. Ratio a -> a
P.denominator Rational
r)

instance (Integral a, FromIntegral a Int64) => RealFrac (Ratio a) where
  properFraction :: Exp (Ratio a) -> (Exp b, Exp (Ratio a))
properFraction (Exp a
x :% Exp a
y) =
    let (Exp a
q,Exp a
r) = Exp a -> Exp a -> (Exp a, Exp a)
forall a. Integral a => a -> a -> (a, a)
quotRem Exp a
x Exp a
y
    in  (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
q :: Exp Int64), Exp a
r Exp a -> Exp a -> Exp (Ratio a)
forall a. Elt a => Exp a -> Exp a -> Exp (Ratio a)
:% Exp a
y)


instance (Integral a, ToFloating a b) => ToFloating (Ratio a) b where
  toFloating :: Exp (Ratio a) -> Exp b
toFloating (Exp a
x :% Exp a
y) =
    let Exp a
x' :% Exp a
y' = Exp a -> Exp a -> Exp (Ratio a)
forall a. Integral a => Exp a -> Exp a -> Exp (Ratio a)
reduce Exp a
x Exp a
y
    in  Exp a -> Exp b
forall a b. (ToFloating a b, Num a, Floating b) => Exp a -> Exp b
toFloating Exp a
x' Exp b -> Exp b -> Exp b
forall a. Fractional a => a -> a -> a
/ Exp a -> Exp b
forall a b. (ToFloating a b, Num a, Floating b) => Exp a -> Exp b
toFloating Exp a
y'

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

instance Integral a => P.Enum (Exp (Ratio a))  where
  succ :: Exp (Ratio a) -> Exp (Ratio a)
succ Exp (Ratio a)
x   = Exp (Ratio a)
x Exp (Ratio a) -> Exp (Ratio a) -> Exp (Ratio a)
forall a. Num a => a -> a -> a
+ Exp (Ratio a)
1
  pred :: Exp (Ratio a) -> Exp (Ratio a)
pred Exp (Ratio a)
x   = Exp (Ratio a)
x Exp (Ratio a) -> Exp (Ratio a) -> Exp (Ratio a)
forall a. Num a => a -> a -> a
- Exp (Ratio a)
1
  toEnum :: Int -> Exp (Ratio a)
toEnum   = String -> String -> Int -> Exp (Ratio a)
forall a. String -> String -> a
preludeError String
"Enum" String
"toEnum"
  fromEnum :: Exp (Ratio a) -> Int
fromEnum = String -> String -> Exp (Ratio a) -> Int
forall a. String -> String -> a
preludeError String
"Enum" String
"fromEnum"


preludeError :: String -> String -> a
preludeError :: String -> String -> a
preludeError String
x String
y
  = 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
forall r. PrintfType r => String -> r
printf String
"Prelude.%s is not supported for Accelerate types" String
y
            , String
""
            , String -> String -> String
forall r. PrintfType r => String -> r
printf String
"These Prelude.%s instances are present only to fulfil superclass" String
x
            , String
"constraints for subsequent classes in the standard Haskell numeric hierarchy."
            ]