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

-- | Run an operation over some 'FReal', with a concrete function for each kind.
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)

-- | Run an operation over some 'FReal'.
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

-- | Run an inplace operation over some 'FReal', with a concrete function for
--   each kind.
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)

-- | Run an inplace operation over some 'FReal'.
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

-- | Combine two Fortran reals with a binary operation, coercing different
--   kinds.
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