module Language.Fortran.Repr.Value.Scalar.Real
( FReal(..)
, SomeFReal
, fRealUOp
, fRealUOp'
, fRealUOpInplace
, fRealUOpInplace'
, fRealUOpInternal
, fRealBOp
, fRealBOp'
, fRealBOpInplace
, fRealBOpInplace'
, fRealBOpInternal
) where
import Language.Fortran.Repr.Type.Scalar.Real
import Language.Fortran.Repr.Value.Scalar.Common
import GHC.Float ( float2Double )
import Data.Functor.Const
data FReal (k :: FTReal) where
FReal4 :: Float -> FReal 'FTReal4
FReal8 :: Double -> FReal 'FTReal8
deriving stock instance Show (FReal k)
deriving stock instance Eq (FReal k)
deriving stock instance Ord (FReal k)
fRealUOpInternal
:: (Float -> ft 'FTReal4)
-> (Double -> ft 'FTReal8)
-> FReal k -> ft k
fRealUOpInternal :: forall (ft :: FTReal -> *) (k :: FTReal).
(Float -> ft 'FTReal4)
-> (Double -> ft 'FTReal8) -> FReal k -> ft k
fRealUOpInternal Float -> ft 'FTReal4
k4f Double -> ft 'FTReal8
k8f = \case
FReal4 Float
fl -> Float -> ft 'FTReal4
k4f Float
fl
FReal8 Double
db -> Double -> ft 'FTReal8
k8f Double
db
fRealUOp'
:: (Float -> r)
-> (Double -> r)
-> FReal k -> r
fRealUOp' :: forall r (k :: FTReal).
(Float -> r) -> (Double -> r) -> FReal k -> r
fRealUOp' Float -> r
k4f Double -> r
k8f = forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ft :: FTReal -> *) (k :: FTReal).
(Float -> ft 'FTReal4)
-> (Double -> ft 'FTReal8) -> FReal k -> ft k
fRealUOpInternal (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> r
k4f) (forall {k} a (b :: k). a -> Const a b
Const forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> r
k8f)
fRealUOp
:: (forall a. RealFloat a => a -> r)
-> FReal k -> r
fRealUOp :: forall r (k :: FTReal).
(forall a. RealFloat a => a -> r) -> FReal k -> r
fRealUOp forall a. RealFloat a => a -> r
f = forall r (k :: FTReal).
(Float -> r) -> (Double -> r) -> FReal k -> r
fRealUOp' forall a. RealFloat a => a -> r
f forall a. RealFloat a => a -> r
f
fRealUOpInplace'
:: (Float -> Float)
-> (Double -> Double)
-> FReal k -> FReal k
fRealUOpInplace' :: forall (k :: FTReal).
(Float -> Float) -> (Double -> Double) -> FReal k -> FReal k
fRealUOpInplace' Float -> Float
k4f Double -> Double
k8f = forall (ft :: FTReal -> *) (k :: FTReal).
(Float -> ft 'FTReal4)
-> (Double -> ft 'FTReal8) -> FReal k -> ft k
fRealUOpInternal (Float -> FReal 'FTReal4
FReal4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float
k4f) (Double -> FReal 'FTReal8
FReal8forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
k8f)
fRealUOpInplace
:: (forall a. RealFloat a => a -> a)
-> FReal k -> FReal k
fRealUOpInplace :: forall (k :: FTReal).
(forall a. RealFloat a => a -> a) -> FReal k -> FReal k
fRealUOpInplace forall a. RealFloat a => a -> a
f = forall (k :: FTReal).
(Float -> Float) -> (Double -> Double) -> FReal k -> FReal k
fRealUOpInplace' forall a. RealFloat a => a -> a
f forall a. RealFloat a => a -> a
f
fRealBOpInternal
:: (Float -> Float -> ft 'FTReal4)
-> (Double -> Double -> ft 'FTReal8)
-> FReal kl -> FReal kr -> ft (FTRealCombine kl kr)
fRealBOpInternal :: forall (ft :: FTReal -> *) (kl :: FTReal) (kr :: FTReal).
(Float -> Float -> ft 'FTReal4)
-> (Double -> Double -> ft 'FTReal8)
-> FReal kl
-> FReal kr
-> ft (FTRealCombine kl kr)
fRealBOpInternal Float -> Float -> ft 'FTReal4
k4f Double -> Double -> ft 'FTReal8
k8f FReal kl
l FReal kr
r = case (FReal kl
l, FReal kr
r) of
(FReal4 Float
lr, FReal4 Float
rr) -> Float -> Float -> ft 'FTReal4
k4f Float
lr Float
rr
(FReal8 Double
lr, FReal8 Double
rr) -> Double -> Double -> ft 'FTReal8
k8f Double
lr Double
rr
(FReal4 Float
lr, FReal8 Double
rr) -> Double -> Double -> ft 'FTReal8
k8f (Float -> Double
float2Double Float
lr) Double
rr
(FReal8 Double
lr, FReal4 Float
rr) -> Double -> Double -> ft 'FTReal8
k8f Double
lr (Float -> Double
float2Double Float
rr)
fRealBOp'
:: (Float -> Float -> r)
-> (Double -> Double -> r)
-> FReal kl -> FReal kr -> r
fRealBOp' :: forall r (kl :: FTReal) (kr :: FTReal).
(Float -> Float -> r)
-> (Double -> Double -> r) -> FReal kl -> FReal kr -> r
fRealBOp' Float -> Float -> r
k4f Double -> Double -> r
k8f FReal kl
l FReal kr
r = forall {k} a (b :: k). Const a b -> a
getConst forall a b. (a -> b) -> a -> b
$ forall (ft :: FTReal -> *) (kl :: FTReal) (kr :: FTReal).
(Float -> Float -> ft 'FTReal4)
-> (Double -> Double -> ft 'FTReal8)
-> FReal kl
-> FReal kr
-> ft (FTRealCombine kl kr)
fRealBOpInternal (forall {k} {t} {t} {a} {b :: k}.
(t -> t -> a) -> t -> t -> Const a b
go Float -> Float -> r
k4f) (forall {k} {t} {t} {a} {b :: k}.
(t -> t -> a) -> t -> t -> Const a b
go Double -> Double -> r
k8f) FReal kl
l FReal kr
r
where go :: (t -> t -> a) -> t -> t -> Const a b
go t -> t -> a
g t
l' t
r' = forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ t -> t -> a
g t
l' t
r'
fRealBOp
:: (forall a. RealFloat a => a -> a -> r)
-> FReal kl -> FReal kr -> r
fRealBOp :: forall r (kl :: FTReal) (kr :: FTReal).
(forall a. RealFloat a => a -> a -> r) -> FReal kl -> FReal kr -> r
fRealBOp forall a. RealFloat a => a -> a -> r
f = forall r (kl :: FTReal) (kr :: FTReal).
(Float -> Float -> r)
-> (Double -> Double -> r) -> FReal kl -> FReal kr -> r
fRealBOp' forall a. RealFloat a => a -> a -> r
f forall a. RealFloat a => a -> a -> r
f
fRealBOpInplace'
:: (Float -> Float -> Float)
-> (Double -> Double -> Double)
-> FReal kl -> FReal kr -> FReal (FTRealCombine kl kr)
fRealBOpInplace' :: forall (kl :: FTReal) (kr :: FTReal).
(Float -> Float -> Float)
-> (Double -> Double -> Double)
-> FReal kl
-> FReal kr
-> FReal (FTRealCombine kl kr)
fRealBOpInplace' Float -> Float -> Float
k4f Double -> Double -> Double
k8f = forall (ft :: FTReal -> *) (kl :: FTReal) (kr :: FTReal).
(Float -> Float -> ft 'FTReal4)
-> (Double -> Double -> ft 'FTReal8)
-> FReal kl
-> FReal kr
-> ft (FTRealCombine kl kr)
fRealBOpInternal (forall {a} {b} {t} {t}. (a -> b) -> (t -> t -> a) -> t -> t -> b
go Float -> FReal 'FTReal4
FReal4 Float -> Float -> Float
k4f) (forall {a} {b} {t} {t}. (a -> b) -> (t -> t -> a) -> t -> t -> b
go Double -> FReal 'FTReal8
FReal8 Double -> Double -> Double
k8f)
where go :: (a -> b) -> (t -> t -> a) -> t -> t -> b
go a -> b
f t -> t -> a
g t
l t
r = a -> b
f forall a b. (a -> b) -> a -> b
$ t -> t -> a
g t
l t
r
fRealBOpInplace
:: (forall a. RealFloat a => a -> a -> a)
-> FReal kl -> FReal kr -> FReal (FTRealCombine kl kr)
fRealBOpInplace :: forall (kl :: FTReal) (kr :: FTReal).
(forall a. RealFloat a => a -> a -> a)
-> FReal kl -> FReal kr -> FReal (FTRealCombine kl kr)
fRealBOpInplace forall a. RealFloat a => a -> a -> a
f = forall (kl :: FTReal) (kr :: FTReal).
(Float -> Float -> Float)
-> (Double -> Double -> Double)
-> FReal kl
-> FReal kr
-> FReal (FTRealCombine kl kr)
fRealBOpInplace' forall a. RealFloat a => a -> a -> a
f forall a. RealFloat a => a -> a -> a
f
type SomeFReal = SomeFKinded FTReal FReal
deriving stock instance Show SomeFReal
instance Eq SomeFReal where
(SomeFKinded FReal fk
l) == :: SomeFReal -> SomeFReal -> Bool
== (SomeFKinded FReal fk
r) = forall r (kl :: FTReal) (kr :: FTReal).
(forall a. RealFloat a => a -> a -> r) -> FReal kl -> FReal kr -> r
fRealBOp forall a. Eq a => a -> a -> Bool
(==) FReal fk
l FReal fk
r
instance Ord SomeFReal where
compare :: SomeFReal -> SomeFReal -> Ordering
compare (SomeFKinded FReal fk
l) (SomeFKinded FReal fk
r) = forall r (kl :: FTReal) (kr :: FTReal).
(forall a. RealFloat a => a -> a -> r) -> FReal kl -> FReal kr -> r
fRealBOp forall a. Ord a => a -> a -> Ordering
compare FReal fk
l FReal fk
r