{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RebindableSyntax #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.Array.Accelerate.Classes.Ord (
Ord(..),
Ordering(..), pattern LT_, pattern EQ_, pattern GT_,
) where
import Data.Array.Accelerate.Analysis.Match
import Data.Array.Accelerate.Pattern
import Data.Array.Accelerate.Pattern.Ordering
import Data.Array.Accelerate.Representation.Tag
import Data.Array.Accelerate.Smart
import Data.Array.Accelerate.Sugar.Elt
import Data.Array.Accelerate.Sugar.Shape
import Data.Array.Accelerate.Type
import Data.Array.Accelerate.Classes.Eq hiding ( (==) )
import qualified Data.Array.Accelerate.Classes.Eq as A
import Data.Char
import Language.Haskell.TH.Extra hiding ( Exp )
import Prelude ( ($), (>>=), Ordering(..), Num(..), Maybe(..), String, show, error, unlines, return, concat, map, mapM )
import Text.Printf
import qualified Prelude as P
infix 4 <
infix 4 >
infix 4 <=
infix 4 >=
class Eq a => Ord a where
{-# MINIMAL (<=) | compare #-}
(<) :: Exp a -> Exp a -> Exp Bool
(>) :: Exp a -> Exp a -> Exp Bool
(<=) :: Exp a -> Exp a -> Exp Bool
(>=) :: Exp a -> Exp a -> Exp Bool
min :: Exp a -> Exp a -> Exp a
max :: Exp a -> Exp a -> Exp a
compare :: Exp a -> Exp a -> Exp Ordering
Exp a
x < Exp a
y = if Exp a -> Exp a -> Exp Ordering
forall a. Ord a => Exp a -> Exp a -> Exp Ordering
compare Exp a
x Exp a
y Exp Ordering -> Exp Ordering -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
A.== Ordering -> Exp Ordering
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Ordering
LT then Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
True else Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
False
Exp a
x <= Exp a
y = if Exp a -> Exp a -> Exp Ordering
forall a. Ord a => Exp a -> Exp a -> Exp Ordering
compare Exp a
x Exp a
y Exp Ordering -> Exp Ordering -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
A.== Ordering -> Exp Ordering
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Ordering
GT then Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
False else Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
True
Exp a
x > Exp a
y = if Exp a -> Exp a -> Exp Ordering
forall a. Ord a => Exp a -> Exp a -> Exp Ordering
compare Exp a
x Exp a
y Exp Ordering -> Exp Ordering -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
A.== Ordering -> Exp Ordering
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Ordering
GT then Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
True else Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
False
Exp a
x >= Exp a
y = if Exp a -> Exp a -> Exp Ordering
forall a. Ord a => Exp a -> Exp a -> Exp Ordering
compare Exp a
x Exp a
y Exp Ordering -> Exp Ordering -> Exp Bool
forall a. Eq a => Exp a -> Exp a -> Exp Bool
A.== Ordering -> Exp Ordering
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Ordering
LT then Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
False else Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
True
min Exp a
x Exp a
y = if Exp a
x Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<= Exp a
y then Exp a
x else Exp a
y
max Exp a
x Exp a
y = if Exp a
x Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<= Exp a
y then Exp a
y else Exp a
x
compare 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
A.== Exp a
y then Ordering -> Exp Ordering
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Ordering
EQ else
if Exp a
x Exp a -> Exp a -> Exp Bool
forall a. Ord a => Exp a -> Exp a -> Exp Bool
<= Exp a
y then Ordering -> Exp Ordering
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Ordering
LT
else Ordering -> Exp Ordering
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Ordering
GT
ifThenElse :: Elt a => Exp Bool -> Exp a -> Exp a -> Exp a
ifThenElse :: forall a. Elt a => Exp Bool -> Exp a -> Exp a -> Exp a
ifThenElse (Exp SmartExp (EltR Bool)
c) (Exp SmartExp (EltR a)
x) (Exp SmartExp (EltR a)
y) = SmartExp (EltR a) -> Exp a
forall t. SmartExp (EltR t) -> Exp t
Exp (SmartExp (EltR a) -> Exp a) -> SmartExp (EltR a) -> Exp a
forall a b. (a -> b) -> a -> b
$ PreSmartExp SmartAcc SmartExp (EltR a) -> SmartExp (EltR a)
forall t. PreSmartExp SmartAcc SmartExp t -> SmartExp t
SmartExp (PreSmartExp SmartAcc SmartExp (EltR a) -> SmartExp (EltR a))
-> PreSmartExp SmartAcc SmartExp (EltR a) -> SmartExp (EltR a)
forall a b. (a -> b) -> a -> b
$ SmartExp TAG
-> SmartExp (EltR a)
-> SmartExp (EltR a)
-> PreSmartExp SmartAcc SmartExp (EltR a)
forall (exp :: * -> *) t (acc :: * -> *).
exp TAG -> exp t -> exp t -> PreSmartExp acc exp t
Cond (SmartExp (TAG, ()) -> SmartExp TAG
forall a b. Coerce a b => SmartExp a -> SmartExp b
mkCoerce' SmartExp (TAG, ())
SmartExp (EltR Bool)
c) SmartExp (EltR a)
x SmartExp (EltR a)
y
instance Ord () where
< :: Exp () -> Exp () -> Exp Bool
(<) Exp ()
_ Exp ()
_ = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
False
> :: Exp () -> Exp () -> Exp Bool
(>) Exp ()
_ Exp ()
_ = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
False
>= :: Exp () -> Exp () -> Exp Bool
(>=) Exp ()
_ Exp ()
_ = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
True
<= :: Exp () -> Exp () -> Exp Bool
(<=) Exp ()
_ Exp ()
_ = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
True
min :: Exp () -> Exp () -> Exp ()
min Exp ()
_ Exp ()
_ = () -> Exp ()
forall e. (HasCallStack, Elt e) => e -> Exp e
constant ()
max :: Exp () -> Exp () -> Exp ()
max Exp ()
_ Exp ()
_ = () -> Exp ()
forall e. (HasCallStack, Elt e) => e -> Exp e
constant ()
compare :: Exp () -> Exp () -> Exp Ordering
compare Exp ()
_ Exp ()
_ = Ordering -> Exp Ordering
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Ordering
EQ
instance Ord Z where
< :: Exp Z -> Exp Z -> Exp Bool
(<) Exp Z
_ Exp Z
_ = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
False
> :: Exp Z -> Exp Z -> Exp Bool
(>) Exp Z
_ Exp Z
_ = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
False
<= :: Exp Z -> Exp Z -> Exp Bool
(<=) Exp Z
_ Exp Z
_ = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
True
>= :: Exp Z -> Exp Z -> Exp Bool
(>=) Exp Z
_ Exp Z
_ = Bool -> Exp Bool
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Bool
True
min :: Exp Z -> Exp Z -> Exp Z
min Exp Z
_ Exp Z
_ = Z -> Exp Z
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Z
Z
max :: Exp Z -> Exp Z -> Exp Z
max Exp Z
_ Exp Z
_ = Z -> Exp Z
forall e. (HasCallStack, Elt e) => e -> Exp e
constant Z
Z
instance Ord a => P.Ord (Exp a) where
< :: Exp a -> Exp a -> Bool
(<) = String -> String -> Exp a -> Exp a -> Bool
forall a. String -> String -> a
preludeError String
"Ord.(<)" String
"(<)"
<= :: Exp a -> Exp a -> Bool
(<=) = String -> String -> Exp a -> Exp a -> Bool
forall a. String -> String -> a
preludeError String
"Ord.(<=)" String
"(<=)"
> :: Exp a -> Exp a -> Bool
(>) = String -> String -> Exp a -> Exp a -> Bool
forall a. String -> String -> a
preludeError String
"Ord.(>)" String
"(>)"
>= :: Exp a -> Exp a -> Bool
(>=) = String -> String -> Exp a -> Exp a -> Bool
forall a. String -> String -> a
preludeError String
"Ord.(>=)" String
"(>=)"
min :: Exp a -> Exp a -> Exp a
min = Exp a -> Exp a -> Exp a
forall a. Ord a => Exp a -> Exp a -> Exp a
min
max :: Exp a -> Exp a -> Exp a
max = Exp a -> Exp a -> Exp a
forall a. Ord a => Exp a -> Exp a -> Exp a
max
preludeError :: String -> String -> a
preludeError :: forall a. 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 -> String
forall r. PrintfType r => String -> r
printf String
"Prelude.%s applied to EDSL types: use Data.Array.Accelerate.%s instead" String
x String
y
, String
""
, String
"These Prelude.Ord instances are present only to fulfil superclass"
, String
"constraints for subsequent classes in the standard Haskell numeric"
, String
"hierarchy."
]