module Language.Fortran.Repr.Eval.Value.Op where
import Language.Fortran.Repr.Eval.Value.Op.Some
import Language.Fortran.Repr.Value.Scalar.Machine
import Language.Fortran.Repr.Value.Scalar.Common
import Language.Fortran.Repr.Value.Scalar.Int.Machine
import Language.Fortran.Repr.Value.Scalar.Real
import Language.Fortran.Repr.Value.Scalar.Complex
import Language.Fortran.Repr.Value.Scalar.Logical.Machine
import Language.Fortran.Repr.Value.Scalar.String
import Language.Fortran.Repr.Type.Scalar
import Language.Fortran.Repr.Type.Scalar.Real
import GHC.Float ( float2Double )
import Data.Int
import Data.Bits
import Data.Singletons
data Error
= EBadArgType1 [String] FScalarType
| EBadArgType2 [String] FScalarType FScalarType
| EGeneric String
deriving stock (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> Error -> ShowS
Show, Error -> Error -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error -> Error -> Bool
$c/= :: Error -> Error -> Bool
== :: Error -> Error -> Bool
$c== :: Error -> Error -> Bool
Eq)
opIcDble :: FScalarValue -> Either Error (FReal 'FTReal8)
opIcDble :: FScalarValue -> Either Error (FReal 'FTReal8)
opIcDble = \case
FSVComplex (SomeFKinded FComplex fk
c) -> case FComplex fk
c of
FComplex8 Float
r Float
_i -> forall {a}. Double -> Either a (FReal 'FTReal8)
rfr8 forall a b. (a -> b) -> a -> b
$ Float -> Double
float2Double Float
r
FComplex16 Double
r Double
_i -> forall {a}. Double -> Either a (FReal 'FTReal8)
rfr8 Double
r
FSVReal (SomeFKinded FReal fk
r) -> case FReal fk
r of
FReal4 Float
r' -> forall {a}. Double -> Either a (FReal 'FTReal8)
rfr8 forall a b. (a -> b) -> a -> b
$ Float -> Double
float2Double Float
r'
FReal8 Double
_r' -> forall a b. b -> Either a b
Right FReal fk
r
FSVInt (SomeFKinded FInt fk
i) -> forall {a}. Double -> Either a (FReal 'FTReal8)
rfr8 forall a b. (a -> b) -> a -> b
$ forall a (k :: FTInt). Num a => FInt k -> a
withFInt FInt fk
i
FScalarValue
v -> forall a. [String] -> FScalarValue -> Either Error a
eBadArgType1 [String
"COMPLEX", String
"REAL", String
"INT"] FScalarValue
v
where rfr8 :: Double -> Either a (FReal 'FTReal8)
rfr8 = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FReal 'FTReal8
FReal8
eBadArgType1 :: [String] -> FScalarValue -> Either Error a
eBadArgType1 :: forall a. [String] -> FScalarValue -> Either Error a
eBadArgType1 [String]
expected = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> FScalarType -> Error
EBadArgType1 [String]
expected forall b c a. (b -> c) -> (a -> b) -> a -> c
. FScalarValue -> FScalarType
fScalarValueType
eBadArgType2 :: [String] -> FScalarValue -> FScalarValue -> Either Error a
eBadArgType2 :: forall a.
[String] -> FScalarValue -> FScalarValue -> Either Error a
eBadArgType2 [String]
expected FScalarValue
l FScalarValue
r =
forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [String] -> FScalarType -> FScalarType -> Error
EBadArgType2 [String]
expected (FScalarValue -> FScalarType
fScalarValueType FScalarValue
l) (FScalarValue -> FScalarType
fScalarValueType FScalarValue
r)
eGeneric :: String -> Either Error a
eGeneric :: forall a. String -> Either Error a
eGeneric = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Error
EGeneric
opIcNumericBOp
:: (forall a. (Num a, Ord a) => a -> a -> a)
-> FScalarValue -> FScalarValue -> Either Error FScalarValue
opIcNumericBOp :: (forall a. (Num a, Ord a) => a -> a -> a)
-> FScalarValue -> FScalarValue -> Either Error FScalarValue
opIcNumericBOp forall a. (Num a, Ord a) => a -> a -> a
bop = FScalarValue -> FScalarValue -> Either Error FScalarValue
go
where
go :: FScalarValue -> FScalarValue -> Either Error FScalarValue
go (FSVInt SomeFKinded FTInt FInt
l) (FSVInt SomeFKinded FTInt FInt
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SomeFKinded FTInt FInt -> FScalarValue
FSVInt forall a b. (a -> b) -> a -> b
$ (forall a. IsFInt a => a -> a -> a)
-> SomeFKinded FTInt FInt
-> SomeFKinded FTInt FInt
-> SomeFKinded FTInt FInt
someFIntBOpWrap forall a. (Num a, Ord a) => a -> a -> a
bop SomeFKinded FTInt FInt
l SomeFKinded FTInt FInt
r
go (FSVInt (SomeFKinded FInt fk
l)) (FSVReal SomeFKinded FTReal FReal
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SomeFKinded FTReal FReal -> FScalarValue
FSVReal forall a b. (a -> b) -> a -> b
$ (forall a. RealFloat a => a -> a)
-> SomeFKinded FTReal FReal -> SomeFKinded FTReal FReal
someFRealUOpWrap (\a
x -> forall a (k :: FTInt). Num a => FInt k -> a
withFInt FInt fk
l forall a. (Num a, Ord a) => a -> a -> a
`bop` a
x) SomeFKinded FTReal FReal
r
go (FSVReal SomeFKinded FTReal FReal
l) (FSVReal SomeFKinded FTReal FReal
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SomeFKinded FTReal FReal -> FScalarValue
FSVReal forall a b. (a -> b) -> a -> b
$ (forall a. RealFloat a => a -> a -> a)
-> SomeFKinded FTReal FReal
-> SomeFKinded FTReal FReal
-> SomeFKinded FTReal FReal
someFRealBOpWrap forall a. (Num a, Ord a) => a -> a -> a
bop SomeFKinded FTReal FReal
l SomeFKinded FTReal FReal
r
go (FSVReal SomeFKinded FTReal FReal
l) (FSVInt SomeFKinded FTInt FInt
r) = FScalarValue -> FScalarValue -> Either Error FScalarValue
go (SomeFKinded FTInt FInt -> FScalarValue
FSVInt SomeFKinded FTInt FInt
r) (SomeFKinded FTReal FReal -> FScalarValue
FSVReal SomeFKinded FTReal FReal
l)
go (FSVReal SomeFKinded FTReal FReal
l) (FSVComplex SomeFKinded FTReal FComplex
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SomeFKinded FTReal FComplex -> FScalarValue
FSVComplex forall a b. (a -> b) -> a -> b
$ (forall a. RealFloat a => a -> a -> a)
-> SomeFKinded FTReal FComplex
-> SomeFKinded FTReal FComplex
-> SomeFKinded FTReal FComplex
someFComplexBOpWrap forall a. (Num a, Ord a) => a -> a -> a
bop (SomeFKinded FTReal FReal -> SomeFKinded FTReal FComplex
someFComplexFromReal SomeFKinded FTReal FReal
l) SomeFKinded FTReal FComplex
r
opIcNumericBOpRealIntSep
:: (forall a. Integral a => a -> a -> a)
-> (forall a. RealFloat a => a -> a -> a)
-> FScalarValue -> FScalarValue -> Either Error FScalarValue
opIcNumericBOpRealIntSep :: (forall a. Integral a => a -> a -> a)
-> (forall a. RealFloat a => a -> a -> a)
-> FScalarValue
-> FScalarValue
-> Either Error FScalarValue
opIcNumericBOpRealIntSep forall a. Integral a => a -> a -> a
bopInt forall a. RealFloat a => a -> a -> a
bopReal = FScalarValue -> FScalarValue -> Either Error FScalarValue
go
where
go :: FScalarValue -> FScalarValue -> Either Error FScalarValue
go (FSVInt SomeFKinded FTInt FInt
l) (FSVInt SomeFKinded FTInt FInt
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SomeFKinded FTInt FInt -> FScalarValue
FSVInt forall a b. (a -> b) -> a -> b
$ (forall a. IsFInt a => a -> a -> a)
-> SomeFKinded FTInt FInt
-> SomeFKinded FTInt FInt
-> SomeFKinded FTInt FInt
someFIntBOpWrap forall a. Integral a => a -> a -> a
bopInt SomeFKinded FTInt FInt
l SomeFKinded FTInt FInt
r
go (FSVInt (SomeFKinded FInt fk
l)) (FSVReal SomeFKinded FTReal FReal
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SomeFKinded FTReal FReal -> FScalarValue
FSVReal forall a b. (a -> b) -> a -> b
$ (forall a. RealFloat a => a -> a)
-> SomeFKinded FTReal FReal -> SomeFKinded FTReal FReal
someFRealUOpWrap (\a
x -> forall a (k :: FTInt). Num a => FInt k -> a
withFInt FInt fk
l forall a. RealFloat a => a -> a -> a
`bopReal` a
x) SomeFKinded FTReal FReal
r
go (FSVReal SomeFKinded FTReal FReal
l) (FSVReal SomeFKinded FTReal FReal
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SomeFKinded FTReal FReal -> FScalarValue
FSVReal forall a b. (a -> b) -> a -> b
$ (forall a. RealFloat a => a -> a -> a)
-> SomeFKinded FTReal FReal
-> SomeFKinded FTReal FReal
-> SomeFKinded FTReal FReal
someFRealBOpWrap forall a. RealFloat a => a -> a -> a
bopReal SomeFKinded FTReal FReal
l SomeFKinded FTReal FReal
r
go (FSVReal SomeFKinded FTReal FReal
l) (FSVInt SomeFKinded FTInt FInt
r) = FScalarValue -> FScalarValue -> Either Error FScalarValue
go (SomeFKinded FTInt FInt -> FScalarValue
FSVInt SomeFKinded FTInt FInt
r) (SomeFKinded FTReal FReal -> FScalarValue
FSVReal SomeFKinded FTReal FReal
l)
go (FSVReal SomeFKinded FTReal FReal
l) (FSVComplex SomeFKinded FTReal FComplex
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SomeFKinded FTReal FComplex -> FScalarValue
FSVComplex forall a b. (a -> b) -> a -> b
$ (forall a. RealFloat a => a -> a -> a)
-> SomeFKinded FTReal FComplex
-> SomeFKinded FTReal FComplex
-> SomeFKinded FTReal FComplex
someFComplexBOpWrap forall a. RealFloat a => a -> a -> a
bopReal (SomeFKinded FTReal FReal -> SomeFKinded FTReal FComplex
someFComplexFromReal SomeFKinded FTReal FReal
l) SomeFKinded FTReal FComplex
r
opIcNumRelBOp
:: (forall a. Ord a => a -> a -> r)
-> FScalarValue -> FScalarValue -> Either Error r
opIcNumRelBOp :: forall r.
(forall a. Ord a => a -> a -> r)
-> FScalarValue -> FScalarValue -> Either Error r
opIcNumRelBOp forall a. Ord a => a -> a -> r
bop = FScalarValue -> FScalarValue -> Either Error r
go
where
go :: FScalarValue -> FScalarValue -> Either Error r
go (FSVInt SomeFKinded FTInt FInt
l) (FSVInt SomeFKinded FTInt FInt
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r.
(forall a. IsFInt a => a -> a -> r)
-> SomeFKinded FTInt FInt -> SomeFKinded FTInt FInt -> r
someFIntBOp forall a. Ord a => a -> a -> r
bop SomeFKinded FTInt FInt
l SomeFKinded FTInt FInt
r
go (FSVInt (SomeFKinded FInt fk
l)) (FSVReal SomeFKinded FTReal FReal
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r.
(forall a. RealFloat a => a -> r) -> SomeFKinded FTReal FReal -> r
someFRealUOp (\a
x -> forall a (k :: FTInt). Num a => FInt k -> a
withFInt FInt fk
l forall a. Ord a => a -> a -> r
`bop` a
x) SomeFKinded FTReal FReal
r
go (FSVReal SomeFKinded FTReal FReal
l) (FSVReal SomeFKinded FTReal FReal
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r.
(forall a. RealFloat a => a -> a -> r)
-> SomeFKinded FTReal FReal -> SomeFKinded FTReal FReal -> r
someFRealBOp forall a. Ord a => a -> a -> r
bop SomeFKinded FTReal FReal
l SomeFKinded FTReal FReal
r
go (FSVReal SomeFKinded FTReal FReal
l) (FSVInt SomeFKinded FTInt FInt
r) = FScalarValue -> FScalarValue -> Either Error r
go (SomeFKinded FTInt FInt -> FScalarValue
FSVInt SomeFKinded FTInt FInt
r) (SomeFKinded FTReal FReal -> FScalarValue
FSVReal SomeFKinded FTReal FReal
l)
go (FSVString SomeFString
l) (FSVString SomeFString
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r. (Text -> Text -> r) -> SomeFString -> SomeFString -> r
someFStringBOp forall a. Ord a => a -> a -> r
bop SomeFString
l SomeFString
r
opIcNumericUOpInplace
:: (forall a. Num a => a -> a)
-> FScalarValue -> Either Error FScalarValue
opIcNumericUOpInplace :: (forall a. Num a => a -> a)
-> FScalarValue -> Either Error FScalarValue
opIcNumericUOpInplace forall a. Num a => a -> a
uop = \case
FSVInt (SomeFKinded FInt fk
v) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SomeFKinded FTInt FInt -> FScalarValue
FSVInt forall a b. (a -> b) -> a -> b
$ forall k (ft :: k -> *) (fk :: k).
(SingKind k, SingI fk) =>
ft fk -> SomeFKinded k ft
SomeFKinded forall a b. (a -> b) -> a -> b
$ forall (k :: FTInt).
(forall a. IsFInt a => a -> a) -> FInt k -> FInt k
fIntUOpInplace forall a. Num a => a -> a
uop FInt fk
v
FSVReal (SomeFKinded FReal fk
v) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ SomeFKinded FTReal FReal -> FScalarValue
FSVReal forall a b. (a -> b) -> a -> b
$ forall k (ft :: k -> *) (fk :: k).
(SingKind k, SingI fk) =>
ft fk -> SomeFKinded k ft
SomeFKinded forall a b. (a -> b) -> a -> b
$ forall (k :: FTReal).
(forall a. RealFloat a => a -> a) -> FReal k -> FReal k
fRealUOpInplace forall a. Num a => a -> a
uop FReal fk
v
FScalarValue
v -> forall a. [String] -> FScalarValue -> Either Error a
eBadArgType1 [String
"INT", String
"REAL"] FScalarValue
v
opIcLogicalBOp
:: (Bool -> Bool -> r)
-> FScalarValue -> FScalarValue -> Either Error r
opIcLogicalBOp :: forall r.
(Bool -> Bool -> r)
-> FScalarValue -> FScalarValue -> Either Error r
opIcLogicalBOp Bool -> Bool -> r
bop = FScalarValue -> FScalarValue -> Either Error r
go
where
go :: FScalarValue -> FScalarValue -> Either Error r
go (FSVLogical (SomeFKinded FInt fk
l)) (FSVLogical (SomeFKinded FInt fk
r)) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> r
bop (forall (k :: FTInt). FInt k -> Bool
fLogicalToBool FInt fk
l) (forall (k :: FTInt). FInt k -> Bool
fLogicalToBool FInt fk
r)
go FScalarValue
l FScalarValue
r = forall a.
[String] -> FScalarValue -> FScalarValue -> Either Error a
eBadArgType2 [String
"LOGICAL"] FScalarValue
l FScalarValue
r
opEq :: FScalarValue -> FScalarValue -> Either Error Bool
opEq :: FScalarValue -> FScalarValue -> Either Error Bool
opEq = forall {a}. FScalarValue -> FScalarValue -> Either a Bool
go
where
go :: FScalarValue -> FScalarValue -> Either a Bool
go (FSVInt SomeFKinded FTInt FInt
l) (FSVInt SomeFKinded FTInt FInt
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r.
(forall a. IsFInt a => a -> a -> r)
-> SomeFKinded FTInt FInt -> SomeFKinded FTInt FInt -> r
someFIntBOp forall a. Eq a => a -> a -> Bool
(==) SomeFKinded FTInt FInt
l SomeFKinded FTInt FInt
r
go (FSVReal SomeFKinded FTReal FReal
l) (FSVReal SomeFKinded FTReal FReal
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r.
(forall a. RealFloat a => a -> a -> r)
-> SomeFKinded FTReal FReal -> SomeFKinded FTReal FReal -> r
someFRealBOp forall a. Eq a => a -> a -> Bool
(==) SomeFKinded FTReal FReal
l SomeFKinded FTReal FReal
r
go (FSVInt (SomeFKinded FInt fk
l)) (FSVReal SomeFKinded FTReal FReal
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r.
(forall a. RealFloat a => a -> r) -> SomeFKinded FTReal FReal -> r
someFRealUOp (\a
x -> forall a (k :: FTInt). Num a => FInt k -> a
withFInt FInt fk
l forall a. Eq a => a -> a -> Bool
== a
x) SomeFKinded FTReal FReal
r
go (FSVReal SomeFKinded FTReal FReal
l) (FSVInt SomeFKinded FTInt FInt
r) = FScalarValue -> FScalarValue -> Either a Bool
go (SomeFKinded FTInt FInt -> FScalarValue
FSVInt SomeFKinded FTInt FInt
r) (SomeFKinded FTReal FReal -> FScalarValue
FSVReal SomeFKinded FTReal FReal
l)
go (FSVString SomeFString
l) (FSVString SomeFString
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r. (Text -> Text -> r) -> SomeFString -> SomeFString -> r
someFStringBOp forall a. Eq a => a -> a -> Bool
(==) SomeFString
l SomeFString
r
opIor' :: FInt k -> FInt k -> FInt k
opIor' :: forall (k :: FTInt). FInt k -> FInt k -> FInt k
opIor' = forall (kl :: FTInt) (kr :: FTInt).
(forall a. IsFInt a => a -> a -> a)
-> FInt kl -> FInt kr -> FInt (FTIntCombine kl kr)
fIntBOpInplace forall a. Bits a => a -> a -> a
(.|.)
opIor :: FScalarValue -> FScalarValue -> Either Error SomeFInt
opIor :: FScalarValue
-> FScalarValue -> Either Error (SomeFKinded FTInt FInt)
opIor (FSVInt (SomeFKinded FInt fk
l)) (FSVInt (SomeFKinded FInt fk
r)) =
case (FInt fk
l, FInt fk
r) of
(FInt4{}, FInt4{}) -> do
let out :: FInt fk
out = forall (k :: FTInt). FInt k -> FInt k -> FInt k
opIor' FInt fk
l FInt fk
r
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k (ft :: k -> *) (fk :: k).
(SingKind k, SingI fk) =>
ft fk -> SomeFKinded k ft
SomeFKinded FInt fk
out
(FInt8{}, FInt8{}) -> do
let out :: FInt fk
out = forall (k :: FTInt). FInt k -> FInt k -> FInt k
opIor' FInt fk
l FInt fk
r
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k (ft :: k -> *) (fk :: k).
(SingKind k, SingI fk) =>
ft fk -> SomeFKinded k ft
SomeFKinded FInt fk
out
(FInt2{}, FInt2{}) -> do
let out :: FInt fk
out = forall (k :: FTInt). FInt k -> FInt k -> FInt k
opIor' FInt fk
l FInt fk
r
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k (ft :: k -> *) (fk :: k).
(SingKind k, SingI fk) =>
ft fk -> SomeFKinded k ft
SomeFKinded FInt fk
out
(FInt1{}, FInt1{}) -> do
let out :: FInt fk
out = forall (k :: FTInt). FInt k -> FInt k -> FInt k
opIor' FInt fk
l FInt fk
r
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k (ft :: k -> *) (fk :: k).
(SingKind k, SingI fk) =>
ft fk -> SomeFKinded k ft
SomeFKinded FInt fk
out
opIor FScalarValue
l FScalarValue
r = forall a.
[String] -> FScalarValue -> FScalarValue -> Either Error a
eBadArgType2 [String
"INT", String
"INT"] FScalarValue
l FScalarValue
r