{-# LANGUAGE ConstraintKinds   #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- |
-- Module      : Data.Array.Accelerate.Numeric.Sum.Arithmetic
-- Copyright   : [2017..2020] Trevor L. McDonell
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.Numeric.Sum.Arithmetic (

  fadd, fsub, fmul,

) where

import Data.Array.Accelerate
import Data.Array.Accelerate.Type

import qualified Data.Array.Accelerate.Numeric.Sum.LLVM.Native      as Native
import qualified Data.Array.Accelerate.Numeric.Sum.LLVM.PTX         as PTX


infixl 6 `fadd`
fadd :: (Num a, IsFloating a) => Exp a -> Exp a -> Exp a
fadd :: Exp a -> Exp a -> Exp a
fadd = (Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
forall a.
(Elt a, IsFloating a) =>
(Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
Native.fadd ((Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a)
-> (Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
forall a b. (a -> b) -> a -> b
$ (Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
forall a.
(Elt a, IsFloating a) =>
(Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
PTX.fadd Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
(+)

infixl 6 `fsub`
fsub :: (Num a, IsFloating a) => Exp a -> Exp a -> Exp a
fsub :: Exp a -> Exp a -> Exp a
fsub = (Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
forall a.
(Elt a, IsFloating a) =>
(Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
Native.fsub ((Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a)
-> (Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
forall a b. (a -> b) -> a -> b
$ (Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
forall a.
(Elt a, IsFloating a) =>
(Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
PTX.fsub (-)

infixl 7 `fmul`
fmul :: (Num a, IsFloating a) => Exp a -> Exp a -> Exp a
fmul :: Exp a -> Exp a -> Exp a
fmul = (Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
forall a.
(Elt a, IsFloating a) =>
(Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
Native.fmul ((Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a)
-> (Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
forall a b. (a -> b) -> a -> b
$ (Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
forall a.
(Elt a, IsFloating a) =>
(Exp a -> Exp a -> Exp a) -> Exp a -> Exp a -> Exp a
PTX.fmul Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
(*)