module Language.Fortran.Repr.Eval.Value.Op where
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
opIcDble :: FScalarValue -> Either Error FReal
opIcDble = \case
FSVComplex FComplex
c -> case FComplex
c of
FComplex8 Float
r Float
_i -> forall {a}. Double -> Either a FReal
rfr8 forall a b. (a -> b) -> a -> b
$ Float -> Double
float2Double Float
r
FComplex16 Double
r Double
_i -> forall {a}. Double -> Either a FReal
rfr8 Double
r
FSVReal FReal
r -> case FReal
r of
FReal4 Float
r' -> forall {a}. Double -> Either a FReal
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
r
FSVInt FInt
i -> forall {a}. Double -> Either a FReal
rfr8 forall a b. (a -> b) -> a -> b
$ forall a. Num a => FInt -> a
withFInt FInt
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
rfr8 = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> FReal
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 FInt
l) (FSVInt FInt
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FInt -> FScalarValue
FSVInt forall a b. (a -> b) -> a -> b
$ (forall a. FKindedC FInt a => a -> a -> a) -> FInt -> FInt -> FInt
fIntBOpInplace forall a. (Num a, Ord a) => a -> a -> a
bop FInt
l FInt
r
go (FSVInt FInt
l) (FSVReal FReal
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FReal -> FScalarValue
FSVReal forall a b. (a -> b) -> a -> b
$ (forall a. FKindedC FReal a => a -> a) -> FReal -> FReal
fRealUOpInplace (\a
x -> forall a. Num a => FInt -> a
withFInt FInt
l forall a. (Num a, Ord a) => a -> a -> a
`bop` a
x) FReal
r
go (FSVReal FReal
l) (FSVReal FReal
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FReal -> FScalarValue
FSVReal forall a b. (a -> b) -> a -> b
$ (forall a. FKindedC FReal a => a -> a -> a)
-> FReal -> FReal -> FReal
fRealBOpInplace forall a. (Num a, Ord a) => a -> a -> a
bop FReal
l FReal
r
go (FSVReal FReal
l) (FSVInt FInt
r) = FScalarValue -> FScalarValue -> Either Error FScalarValue
go (FInt -> FScalarValue
FSVInt FInt
r) (FReal -> FScalarValue
FSVReal FReal
l)
go (FSVReal FReal
l) (FSVComplex FComplex
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FComplex -> FScalarValue
FSVComplex forall a b. (a -> b) -> a -> b
$ (forall a. FKindedC FComplex a => a -> a -> a)
-> FComplex -> FComplex -> FComplex
fComplexBOpInplace forall a. (Num a, Ord a) => a -> a -> a
bop (FReal -> FComplex
fComplexFromReal FReal
l) 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 FInt
l) (FSVInt FInt
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FInt -> FScalarValue
FSVInt forall a b. (a -> b) -> a -> b
$ (forall a. FKindedC FInt a => a -> a -> a) -> FInt -> FInt -> FInt
fIntBOpInplace forall a. Integral a => a -> a -> a
bopInt FInt
l FInt
r
go (FSVInt FInt
l) (FSVReal FReal
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FReal -> FScalarValue
FSVReal forall a b. (a -> b) -> a -> b
$ (forall a. FKindedC FReal a => a -> a) -> FReal -> FReal
fRealUOpInplace (\a
x -> forall a. Num a => FInt -> a
withFInt FInt
l forall a. RealFloat a => a -> a -> a
`bopReal` a
x) FReal
r
go (FSVReal FReal
l) (FSVReal FReal
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FReal -> FScalarValue
FSVReal forall a b. (a -> b) -> a -> b
$ (forall a. FKindedC FReal a => a -> a -> a)
-> FReal -> FReal -> FReal
fRealBOpInplace forall a. RealFloat a => a -> a -> a
bopReal FReal
l FReal
r
go (FSVReal FReal
l) (FSVInt FInt
r) = FScalarValue -> FScalarValue -> Either Error FScalarValue
go (FInt -> FScalarValue
FSVInt FInt
r) (FReal -> FScalarValue
FSVReal FReal
l)
go (FSVReal FReal
l) (FSVComplex FComplex
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FComplex -> FScalarValue
FSVComplex forall a b. (a -> b) -> a -> b
$ (forall a. FKindedC FComplex a => a -> a -> a)
-> FComplex -> FComplex -> FComplex
fComplexBOpInplace forall a. RealFloat a => a -> a -> a
bopReal (FReal -> FComplex
fComplexFromReal FReal
l) 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 FInt
l) (FSVInt FInt
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r.
(forall a. FKindedC FInt a => a -> a -> r) -> FInt -> FInt -> r
fIntBOp forall a. Ord a => a -> a -> r
bop FInt
l FInt
r
go (FSVInt FInt
l) (FSVReal FReal
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r. (forall a. FKindedC FReal a => a -> r) -> FReal -> r
fRealUOp (\a
x -> forall a. Num a => FInt -> a
withFInt FInt
l forall a. Ord a => a -> a -> r
`bop` a
x) FReal
r
go (FSVReal FReal
l) (FSVReal FReal
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r.
(forall a. FKindedC FReal a => a -> a -> r) -> FReal -> FReal -> r
fRealBOp forall a. Ord a => a -> a -> r
bop FReal
l FReal
r
go (FSVReal FReal
l) (FSVInt FInt
r) = FScalarValue -> FScalarValue -> Either Error r
go (FInt -> FScalarValue
FSVInt FInt
r) (FReal -> FScalarValue
FSVReal FReal
l)
go (FSVString Text
l) (FSVString Text
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text
l forall a. Ord a => a -> a -> r
`bop` Text
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 FInt
v -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FInt -> FScalarValue
FSVInt forall a b. (a -> b) -> a -> b
$ (forall a. FKindedC FInt a => a -> a) -> FInt -> FInt
fIntUOpInplace forall a. Num a => a -> a
uop FInt
v
FSVReal FReal
v -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FReal -> FScalarValue
FSVReal forall a b. (a -> b) -> a -> b
$ (forall a. FKindedC FReal a => a -> a) -> FReal -> FReal
fRealUOpInplace forall a. Num a => a -> a
uop FReal
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 FInt
l) (FSVLogical FInt
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> r
bop (FInt -> Bool
fLogicalToBool FInt
l) (FInt -> Bool
fLogicalToBool FInt
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 FInt
l) (FSVInt FInt
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r.
(forall a. FKindedC FInt a => a -> a -> r) -> FInt -> FInt -> r
fIntBOp forall a. Eq a => a -> a -> Bool
(==) FInt
l FInt
r
go (FSVReal FReal
l) (FSVReal FReal
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r.
(forall a. FKindedC FReal a => a -> a -> r) -> FReal -> FReal -> r
fRealBOp forall a. Eq a => a -> a -> Bool
(==) FReal
l FReal
r
go (FSVInt FInt
i) (FSVReal FReal
r) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r. (forall a. FKindedC FReal a => a -> r) -> FReal -> r
fRealUOp (\a
x -> forall a. Num a => FInt -> a
withFInt FInt
i forall a. Eq a => a -> a -> Bool
== a
x) FReal
r
go (FSVReal FReal
r) (FSVInt FInt
i) =
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall r. (forall a. FKindedC FReal a => a -> r) -> FReal -> r
fRealUOp (\a
x -> forall a. Num a => FInt -> a
withFInt FInt
i forall a. Eq a => a -> a -> Bool
== a
x) FReal
r
go (FSVString Text
l) (FSVString Text
r) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Text
l forall a. Eq a => a -> a -> Bool
== Text
r
opIor' :: FInt -> FInt -> FInt
opIor' :: FInt -> FInt -> FInt
opIor' = (forall a. FKindedC FInt a => a -> a -> a) -> FInt -> FInt -> FInt
fIntBOpInplace forall a. Bits a => a -> a -> a
(.|.)
opIor :: FInt -> FInt -> Either Error FInt
opIor :: FInt -> FInt -> Either Error FInt
opIor FInt
l FInt
r =
case (FInt
l, FInt
r) of
(FInt4{}, FInt4{}) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FInt -> FInt -> FInt
opIor' FInt
l FInt
r
(FInt8{}, FInt8{}) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FInt -> FInt -> FInt
opIor' FInt
l FInt
r
(FInt2{}, FInt2{}) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FInt -> FInt -> FInt
opIor' FInt
l FInt
r
(FInt1{}, FInt1{}) -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ FInt -> FInt -> FInt
opIor' FInt
l FInt
r
(FInt, FInt)
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> Error
EGeneric String
"bad args to ior"