{-# LANGUAGE CPP                   #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternSynonyms       #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ViewPatterns          #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#if __GLASGOW_HASKELL__ >= 806
{-# LANGUAGE UndecidableInstances  #-}
#endif
-- |
-- Module      : Data.Array.Accelerate.Data.Monoid
-- Copyright   : [2016..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- Monoid instances for Accelerate
--
-- @since 1.2.0.0
--

module Data.Array.Accelerate.Data.Monoid (

  Monoid(..), (<>),

  Sum(..), pattern Sum_,
  Product(..), pattern Product_,

) where

import Data.Array.Accelerate.Classes.Bounded
import Data.Array.Accelerate.Classes.Eq
import Data.Array.Accelerate.Classes.Num
import Data.Array.Accelerate.Classes.Ord
import Data.Array.Accelerate.Data.Semigroup                         ()
import Data.Array.Accelerate.Language
import Data.Array.Accelerate.Lift
import Data.Array.Accelerate.Pattern
import Data.Array.Accelerate.Smart
import Data.Array.Accelerate.Sugar.Elt
import Data.Array.Accelerate.Type

import Data.Function
import Data.Monoid                                                  hiding ( (<>) )
import Data.Semigroup
import qualified Prelude                                            as P


-- Sum: Monoid under addition
-- --------------------------

pattern Sum_ :: Elt a => Exp a -> Exp (Sum a)
pattern $bSum_ :: Exp a -> Exp (Sum a)
$mSum_ :: forall r a.
Elt a =>
Exp (Sum a) -> (Exp a -> r) -> (Void# -> r) -> r
Sum_ x = Pattern x
{-# COMPLETE Sum_ #-}

instance Elt a => Elt (Sum a)

instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Sum a) where
  type Plain (Sum a) = Sum (Plain a)
  lift :: Sum a -> Exp (Plain (Sum a))
lift (Sum a
a)       = Exp (Plain a) -> Exp (Sum (Plain a))
forall a. Elt a => Exp a -> Exp (Sum a)
Sum_ (a -> Exp (Plain a)
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift a
a)

instance Elt a => Unlift Exp (Sum (Exp a)) where
  unlift :: Exp (Plain (Sum (Exp a))) -> Sum (Exp a)
unlift (Sum_ a) = Exp a -> Sum (Exp a)
forall a. a -> Sum a
Sum Exp a
a

instance Bounded a => P.Bounded (Exp (Sum a)) where
  minBound :: Exp (Sum a)
minBound = Exp a -> Exp (Sum a)
forall a. Elt a => Exp a -> Exp (Sum a)
Sum_ Exp a
forall a. Bounded a => a
minBound
  maxBound :: Exp (Sum a)
maxBound = Exp a -> Exp (Sum a)
forall a. Elt a => Exp a -> Exp (Sum a)
Sum_ Exp a
forall a. Bounded a => a
maxBound

instance Num a => P.Num (Exp (Sum a)) where
  + :: Exp (Sum a) -> Exp (Sum a) -> Exp (Sum a)
(+)             = (Sum (Exp a) -> Sum (Exp a) -> Sum (Exp a))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Sum (Exp a) -> Sum (Exp a) -> Sum (Exp a)
forall a. Num a => a -> a -> a
(+) :: Sum (Exp a) -> Sum (Exp a) -> Sum (Exp a))
  (-)             = (Sum (Exp a) -> Sum (Exp a) -> Sum (Exp a))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 ((-) :: Sum (Exp a) -> Sum (Exp a) -> Sum (Exp a))
  * :: Exp (Sum a) -> Exp (Sum a) -> Exp (Sum a)
(*)             = (Sum (Exp a) -> Sum (Exp a) -> Sum (Exp a))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Sum (Exp a) -> Sum (Exp a) -> Sum (Exp a)
forall a. Num a => a -> a -> a
(*) :: Sum (Exp a) -> Sum (Exp a) -> Sum (Exp a))
  negate :: Exp (Sum a) -> Exp (Sum a)
negate          = (Sum (Exp a) -> Sum (Exp a))
-> Exp (Plain (Sum (Exp a))) -> Exp (Plain (Sum (Exp a)))
forall a b.
(Unlift Exp a, Lift Exp b) =>
(a -> b) -> Exp (Plain a) -> Exp (Plain b)
lift1 (Sum (Exp a) -> Sum (Exp a)
forall a. Num a => a -> a
negate :: Sum (Exp a) -> Sum (Exp a))
  signum :: Exp (Sum a) -> Exp (Sum a)
signum          = (Sum (Exp a) -> Sum (Exp a))
-> Exp (Plain (Sum (Exp a))) -> Exp (Plain (Sum (Exp a)))
forall a b.
(Unlift Exp a, Lift Exp b) =>
(a -> b) -> Exp (Plain a) -> Exp (Plain b)
lift1 (Sum (Exp a) -> Sum (Exp a)
forall a. Num a => a -> a
signum :: Sum (Exp a) -> Sum (Exp a))
  abs :: Exp (Sum a) -> Exp (Sum a)
abs             = (Sum (Exp a) -> Sum (Exp a))
-> Exp (Plain (Sum (Exp a))) -> Exp (Plain (Sum (Exp a)))
forall a b.
(Unlift Exp a, Lift Exp b) =>
(a -> b) -> Exp (Plain a) -> Exp (Plain b)
lift1 (Sum (Exp a) -> Sum (Exp a)
forall a. Num a => a -> a
signum :: Sum (Exp a) -> Sum (Exp a))
  fromInteger :: Integer -> Exp (Sum a)
fromInteger Integer
x   = Sum (Exp a) -> Exp (Plain (Sum (Exp a)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Integer -> Sum (Exp a)
forall a. Num a => Integer -> a
P.fromInteger Integer
x :: Sum (Exp a))

instance Eq a => Eq (Sum a) where
  == :: Exp (Sum a) -> Exp (Sum a) -> Exp Bool
(==) = (Sum (Exp a) -> Sum (Exp a) -> Exp Bool)
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
(==) (Exp a -> Exp a -> Exp Bool)
-> (Sum (Exp a) -> Exp a) -> Sum (Exp a) -> Sum (Exp a) -> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Sum (Exp a) -> Exp a
forall a. Sum a -> a
getSum)
  /= :: Exp (Sum a) -> Exp (Sum a) -> Exp Bool
(/=) = (Sum (Exp a) -> Sum (Exp a) -> Exp Bool)
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
(/=) (Exp a -> Exp a -> Exp Bool)
-> (Sum (Exp a) -> Exp a) -> Sum (Exp a) -> Sum (Exp a) -> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Sum (Exp a) -> Exp a
forall a. Sum a -> a
getSum)

instance Ord a => Ord (Sum a) where
  < :: Exp (Sum a) -> Exp (Sum a) -> Exp Bool
(<)     = (Sum (Exp a) -> Sum (Exp a) -> Exp Bool)
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
(<) (Exp a -> Exp a -> Exp Bool)
-> (Sum (Exp a) -> Exp a) -> Sum (Exp a) -> Sum (Exp a) -> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Sum (Exp a) -> Exp a
forall a. Sum a -> a
getSum)
  > :: Exp (Sum a) -> Exp (Sum a) -> Exp Bool
(>)     = (Sum (Exp a) -> Sum (Exp a) -> Exp Bool)
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
(>) (Exp a -> Exp a -> Exp Bool)
-> (Sum (Exp a) -> Exp a) -> Sum (Exp a) -> Sum (Exp a) -> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Sum (Exp a) -> Exp a
forall a. Sum a -> a
getSum)
  <= :: Exp (Sum a) -> Exp (Sum a) -> Exp Bool
(<=)    = (Sum (Exp a) -> Sum (Exp a) -> Exp Bool)
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
(<=) (Exp a -> Exp a -> Exp Bool)
-> (Sum (Exp a) -> Exp a) -> Sum (Exp a) -> Sum (Exp a) -> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Sum (Exp a) -> Exp a
forall a. Sum a -> a
getSum)
  >= :: Exp (Sum a) -> Exp (Sum a) -> Exp Bool
(>=)    = (Sum (Exp a) -> Sum (Exp a) -> Exp Bool)
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
(>=) (Exp a -> Exp a -> Exp Bool)
-> (Sum (Exp a) -> Exp a) -> Sum (Exp a) -> Sum (Exp a) -> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Sum (Exp a) -> Exp a
forall a. Sum a -> a
getSum)
  min :: Exp (Sum a) -> Exp (Sum a) -> Exp (Sum a)
min Exp (Sum a)
x Exp (Sum a)
y = Exp a -> Exp (Sum a)
forall a. Elt a => Exp a -> Exp (Sum a)
Sum_ (Exp a -> Exp (Sum a)) -> Exp a -> Exp (Sum a)
forall a b. (a -> b) -> a -> b
$ (Sum (Exp a) -> Sum (Exp a) -> Exp a)
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Exp a))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp a
forall a. Ord a => Exp a -> Exp a -> Exp a
min (Exp a -> Exp a -> Exp a)
-> (Sum (Exp a) -> Exp a) -> Sum (Exp a) -> Sum (Exp a) -> Exp a
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Sum (Exp a) -> Exp a
forall a. Sum a -> a
getSum) Exp (Sum a)
Exp (Plain (Sum (Exp a)))
x Exp (Sum a)
Exp (Plain (Sum (Exp a)))
y
  max :: Exp (Sum a) -> Exp (Sum a) -> Exp (Sum a)
max Exp (Sum a)
x Exp (Sum a)
y = Exp a -> Exp (Sum a)
forall a. Elt a => Exp a -> Exp (Sum a)
Sum_ (Exp a -> Exp (Sum a)) -> Exp a -> Exp (Sum a)
forall a b. (a -> b) -> a -> b
$ (Sum (Exp a) -> Sum (Exp a) -> Exp a)
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Sum (Exp a)))
-> Exp (Plain (Exp a))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp a
forall a. Ord a => Exp a -> Exp a -> Exp a
max (Exp a -> Exp a -> Exp a)
-> (Sum (Exp a) -> Exp a) -> Sum (Exp a) -> Sum (Exp a) -> Exp a
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Sum (Exp a) -> Exp a
forall a. Sum a -> a
getSum) Exp (Sum a)
Exp (Plain (Sum (Exp a)))
x Exp (Sum a)
Exp (Plain (Sum (Exp a)))
y

instance Num a => Monoid (Exp (Sum a)) where
  mempty :: Exp (Sum a)
mempty = Exp (Sum a)
0

-- | @since 1.2.0.0
instance Num a => Semigroup (Exp (Sum a)) where
  <> :: Exp (Sum a) -> Exp (Sum a) -> Exp (Sum a)
(<>)              = Exp (Sum a) -> Exp (Sum a) -> Exp (Sum a)
forall a. Num a => a -> a -> a
(+)
  stimes :: b -> Exp (Sum a) -> Exp (Sum a)
stimes b
n (Sum_ Exp a
x) = Exp a -> Exp (Sum a)
forall a. Elt a => Exp a -> Exp (Sum a)
Sum_ (Exp a -> Exp (Sum a)) -> Exp a -> Exp (Sum a)
forall a b. (a -> b) -> a -> b
$ b -> Exp a
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral b
n Exp a -> Exp a -> Exp a
forall a. Num a => a -> a -> a
* Exp a
x


-- Product: Monoid under multiplication
-- ------------------------------------

pattern Product_ :: Elt a => Exp a -> Exp (Product a)
pattern $bProduct_ :: Exp a -> Exp (Product a)
$mProduct_ :: forall r a.
Elt a =>
Exp (Product a) -> (Exp a -> r) -> (Void# -> r) -> r
Product_ x = Pattern x
{-# COMPLETE Product_ #-}

instance Elt a => Elt (Product a)

instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Product a) where
  type Plain (Product a) = Product (Plain a)
  lift :: Product a -> Exp (Plain (Product a))
lift (Product a
a)       = Exp (Plain a) -> Exp (Product (Plain a))
forall a. Elt a => Exp a -> Exp (Product a)
Product_ (a -> Exp (Plain a)
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift a
a)

instance Elt a => Unlift Exp (Product (Exp a)) where
  unlift :: Exp (Plain (Product (Exp a))) -> Product (Exp a)
unlift (Product_ a) = Exp a -> Product (Exp a)
forall a. a -> Product a
Product Exp a
a

instance Bounded a => P.Bounded (Exp (Product a)) where
  minBound :: Exp (Product a)
minBound = Exp a -> Exp (Product a)
forall a. Elt a => Exp a -> Exp (Product a)
Product_ Exp a
forall a. Bounded a => a
minBound
  maxBound :: Exp (Product a)
maxBound = Exp a -> Exp (Product a)
forall a. Elt a => Exp a -> Exp (Product a)
Product_ Exp a
forall a. Bounded a => a
maxBound

instance Num a => P.Num (Exp (Product a)) where
  + :: Exp (Product a) -> Exp (Product a) -> Exp (Product a)
(+)             = (Product (Exp a) -> Product (Exp a) -> Product (Exp a))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Product (Exp a) -> Product (Exp a) -> Product (Exp a)
forall a. Num a => a -> a -> a
(+) :: Product (Exp a) -> Product (Exp a) -> Product (Exp a))
  (-)             = (Product (Exp a) -> Product (Exp a) -> Product (Exp a))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 ((-) :: Product (Exp a) -> Product (Exp a) -> Product (Exp a))
  * :: Exp (Product a) -> Exp (Product a) -> Exp (Product a)
(*)             = (Product (Exp a) -> Product (Exp a) -> Product (Exp a))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Product (Exp a) -> Product (Exp a) -> Product (Exp a)
forall a. Num a => a -> a -> a
(*) :: Product (Exp a) -> Product (Exp a) -> Product (Exp a))
  negate :: Exp (Product a) -> Exp (Product a)
negate          = (Product (Exp a) -> Product (Exp a))
-> Exp (Plain (Product (Exp a))) -> Exp (Plain (Product (Exp a)))
forall a b.
(Unlift Exp a, Lift Exp b) =>
(a -> b) -> Exp (Plain a) -> Exp (Plain b)
lift1 (Product (Exp a) -> Product (Exp a)
forall a. Num a => a -> a
negate :: Product (Exp a) -> Product (Exp a))
  signum :: Exp (Product a) -> Exp (Product a)
signum          = (Product (Exp a) -> Product (Exp a))
-> Exp (Plain (Product (Exp a))) -> Exp (Plain (Product (Exp a)))
forall a b.
(Unlift Exp a, Lift Exp b) =>
(a -> b) -> Exp (Plain a) -> Exp (Plain b)
lift1 (Product (Exp a) -> Product (Exp a)
forall a. Num a => a -> a
signum :: Product (Exp a) -> Product (Exp a))
  abs :: Exp (Product a) -> Exp (Product a)
abs             = (Product (Exp a) -> Product (Exp a))
-> Exp (Plain (Product (Exp a))) -> Exp (Plain (Product (Exp a)))
forall a b.
(Unlift Exp a, Lift Exp b) =>
(a -> b) -> Exp (Plain a) -> Exp (Plain b)
lift1 (Product (Exp a) -> Product (Exp a)
forall a. Num a => a -> a
signum :: Product (Exp a) -> Product (Exp a))
  fromInteger :: Integer -> Exp (Product a)
fromInteger Integer
x   = Product (Exp a) -> Exp (Plain (Product (Exp a)))
forall (c :: * -> *) e. Lift c e => e -> c (Plain e)
lift (Integer -> Product (Exp a)
forall a. Num a => Integer -> a
P.fromInteger Integer
x :: Product (Exp a))

instance Eq a => Eq (Product a) where
  == :: Exp (Product a) -> Exp (Product a) -> Exp Bool
(==) = (Product (Exp a) -> Product (Exp a) -> Exp Bool)
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
(==) (Exp a -> Exp a -> Exp Bool)
-> (Product (Exp a) -> Exp a)
-> Product (Exp a)
-> Product (Exp a)
-> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Product (Exp a) -> Exp a
forall a. Product a -> a
getProduct)
  /= :: Exp (Product a) -> Exp (Product a) -> Exp Bool
(/=) = (Product (Exp a) -> Product (Exp a) -> Exp Bool)
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
(/=) (Exp a -> Exp a -> Exp Bool)
-> (Product (Exp a) -> Exp a)
-> Product (Exp a)
-> Product (Exp a)
-> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Product (Exp a) -> Exp a
forall a. Product a -> a
getProduct)

instance Ord a => Ord (Product a) where
  < :: Exp (Product a) -> Exp (Product a) -> Exp Bool
(<)     = (Product (Exp a) -> Product (Exp a) -> Exp Bool)
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
(<) (Exp a -> Exp a -> Exp Bool)
-> (Product (Exp a) -> Exp a)
-> Product (Exp a)
-> Product (Exp a)
-> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Product (Exp a) -> Exp a
forall a. Product a -> a
getProduct)
  > :: Exp (Product a) -> Exp (Product a) -> Exp Bool
(>)     = (Product (Exp a) -> Product (Exp a) -> Exp Bool)
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
(>) (Exp a -> Exp a -> Exp Bool)
-> (Product (Exp a) -> Exp a)
-> Product (Exp a)
-> Product (Exp a)
-> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Product (Exp a) -> Exp a
forall a. Product a -> a
getProduct)
  <= :: Exp (Product a) -> Exp (Product a) -> Exp Bool
(<=)    = (Product (Exp a) -> Product (Exp a) -> Exp Bool)
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
(<=) (Exp a -> Exp a -> Exp Bool)
-> (Product (Exp a) -> Exp a)
-> Product (Exp a)
-> Product (Exp a)
-> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Product (Exp a) -> Exp a
forall a. Product a -> a
getProduct)
  >= :: Exp (Product a) -> Exp (Product a) -> Exp Bool
(>=)    = (Product (Exp a) -> Product (Exp a) -> Exp Bool)
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Exp Bool))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
(>=) (Exp a -> Exp a -> Exp Bool)
-> (Product (Exp a) -> Exp a)
-> Product (Exp a)
-> Product (Exp a)
-> Exp Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Product (Exp a) -> Exp a
forall a. Product a -> a
getProduct)
  min :: Exp (Product a) -> Exp (Product a) -> Exp (Product a)
min Exp (Product a)
x Exp (Product a)
y = Exp a -> Exp (Product a)
forall a. Elt a => Exp a -> Exp (Product a)
Product_ (Exp a -> Exp (Product a)) -> Exp a -> Exp (Product a)
forall a b. (a -> b) -> a -> b
$ (Product (Exp a) -> Product (Exp a) -> Exp a)
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Exp a))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp a
forall a. Ord a => Exp a -> Exp a -> Exp a
min (Exp a -> Exp a -> Exp a)
-> (Product (Exp a) -> Exp a)
-> Product (Exp a)
-> Product (Exp a)
-> Exp a
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Product (Exp a) -> Exp a
forall a. Product a -> a
getProduct) Exp (Product a)
Exp (Plain (Product (Exp a)))
x Exp (Product a)
Exp (Plain (Product (Exp a)))
y
  max :: Exp (Product a) -> Exp (Product a) -> Exp (Product a)
max Exp (Product a)
x Exp (Product a)
y = Exp a -> Exp (Product a)
forall a. Elt a => Exp a -> Exp (Product a)
Product_ (Exp a -> Exp (Product a)) -> Exp a -> Exp (Product a)
forall a b. (a -> b) -> a -> b
$ (Product (Exp a) -> Product (Exp a) -> Exp a)
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Product (Exp a)))
-> Exp (Plain (Exp a))
forall a b c.
(Unlift Exp a, Unlift Exp b, Lift Exp c) =>
(a -> b -> c) -> Exp (Plain a) -> Exp (Plain b) -> Exp (Plain c)
lift2 (Exp a -> Exp a -> Exp a
forall a. Ord a => Exp a -> Exp a -> Exp a
max (Exp a -> Exp a -> Exp a)
-> (Product (Exp a) -> Exp a)
-> Product (Exp a)
-> Product (Exp a)
-> Exp a
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Product (Exp a) -> Exp a
forall a. Product a -> a
getProduct) Exp (Product a)
Exp (Plain (Product (Exp a)))
x Exp (Product a)
Exp (Plain (Product (Exp a)))
y

instance Num a => Monoid (Exp (Product a)) where
  mempty :: Exp (Product a)
mempty = Exp (Product a)
1

-- | @since 1.2.0.0
instance Num a => Semigroup (Exp (Product a)) where
  <> :: Exp (Product a) -> Exp (Product a) -> Exp (Product a)
(<>)                  = Exp (Product a) -> Exp (Product a) -> Exp (Product a)
forall a. Num a => a -> a -> a
(*)
  stimes :: b -> Exp (Product a) -> Exp (Product a)
stimes b
n (Product_ Exp a
x) = Exp a -> Exp (Product a)
forall a. Elt a => Exp a -> Exp (Product a)
Product_ (Exp a -> Exp (Product a)) -> Exp a -> Exp (Product a)
forall a b. (a -> b) -> a -> b
$ Exp a
x Exp a -> Exp Int -> Exp a
forall a b. (Num a, Integral b) => Exp a -> Exp b -> Exp a
^ (b -> Exp Int
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral b
n :: Exp Int)


-- Instances for unit and tuples
-- -----------------------------

instance Monoid (Exp ()) where
  mempty :: Exp ()
mempty = () -> Exp ()
forall e. (HasCallStack, Elt e) => e -> Exp e
constant ()

instance (Elt a, Elt b, Monoid (Exp a), Monoid (Exp b)) => Monoid (Exp (a,b)) where
  mempty :: Exp (a, b)
mempty = Exp a -> Exp b -> Exp (a, b)
forall (con :: * -> *) x0 x1.
IsPattern con (x0, x1) (con x0, con x1) =>
con x0 -> con x1 -> con (x0, x1)
T2 Exp a
forall a. Monoid a => a
mempty Exp b
forall a. Monoid a => a
mempty

instance (Elt a, Elt b, Elt c, Monoid (Exp a), Monoid (Exp b), Monoid (Exp c)) => Monoid (Exp (a,b,c)) where
  mempty :: Exp (a, b, c)
mempty = Exp a -> Exp b -> Exp c -> Exp (a, b, c)
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 a
forall a. Monoid a => a
mempty Exp b
forall a. Monoid a => a
mempty Exp c
forall a. Monoid a => a
mempty

instance (Elt a, Elt b, Elt c, Elt d, Monoid (Exp a), Monoid (Exp b), Monoid (Exp c), Monoid (Exp d)) => Monoid (Exp (a,b,c,d)) where
  mempty :: Exp (a, b, c, d)
mempty = Exp a -> Exp b -> Exp c -> Exp d -> Exp (a, b, c, d)
forall (con :: * -> *) x0 x1 x2 x3.
IsPattern con (x0, x1, x2, x3) (con x0, con x1, con x2, con x3) =>
con x0 -> con x1 -> con x2 -> con x3 -> con (x0, x1, x2, x3)
T4 Exp a
forall a. Monoid a => a
mempty Exp b
forall a. Monoid a => a
mempty Exp c
forall a. Monoid a => a
mempty Exp d
forall a. Monoid a => a
mempty

instance (Elt a, Elt b, Elt c, Elt d, Elt e, Monoid (Exp a), Monoid (Exp b), Monoid (Exp c), Monoid (Exp d), Monoid (Exp e)) => Monoid (Exp (a,b,c,d,e)) where
  mempty :: Exp (a, b, c, d, e)
mempty = Exp a -> Exp b -> Exp c -> Exp d -> Exp e -> Exp (a, b, c, d, e)
forall (con :: * -> *) x0 x1 x2 x3 x4.
IsPattern
  con
  (x0, x1, x2, x3, x4)
  (con x0, con x1, con x2, con x3, con x4) =>
con x0
-> con x1 -> con x2 -> con x3 -> con x4 -> con (x0, x1, x2, x3, x4)
T5 Exp a
forall a. Monoid a => a
mempty Exp b
forall a. Monoid a => a
mempty Exp c
forall a. Monoid a => a
mempty Exp d
forall a. Monoid a => a
mempty Exp e
forall a. Monoid a => a
mempty