module Language.Fortran.Vars.Eval.FortranSrc.Translate where
import qualified Language.Fortran.Vars.Rep as FV
import qualified Language.Fortran.AST.Literal.Boz as AST
import Language.Fortran.Repr
import Language.Fortran.Repr.Type.Array
import GHC.Float ( float2Double )
import qualified Data.Text as Text
import qualified Data.List.NonEmpty as NonEmpty
translateFType :: FType -> FV.SemType
translateFType :: FType -> SemType
translateFType = \case
MkFScalarType FScalarType
fsty -> FScalarType -> SemType
translateFScalarType FScalarType
fsty
MkFArrayType FArrayType
fat -> FArrayType -> SemType
translateFArrayType FArrayType
fat
translateFScalarType :: FScalarType -> FV.SemType
translateFScalarType :: FScalarType -> SemType
translateFScalarType = \case
FSTInt FTInt
ftint -> forall {a} {c}. FKind a => (Int -> c) -> a -> c
kinded Int -> SemType
FV.TInteger FTInt
ftint
FSTReal FTReal
ftreal -> forall {a} {c}. FKind a => (Int -> c) -> a -> c
kinded Int -> SemType
FV.TReal FTReal
ftreal
FSTComplex FTReal
ftreal -> forall {a} {c}. FKind a => (Int -> c) -> a -> c
kinded Int -> SemType
FV.TComplex (FTReal -> FTComplexWrapper
FTComplexWrapper FTReal
ftreal)
FSTLogical FTInt
ftint -> forall {a} {c}. FKind a => (Int -> c) -> a -> c
kinded Int -> SemType
FV.TInteger FTInt
ftint
FSTString Natural
n -> CharacterLen -> Int -> SemType
FV.TCharacter (Int -> CharacterLen
FV.CharLenInt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n)) Int
1
FSTCustom String
ty -> String -> SemType
FV.TCustom String
ty
where kinded :: (Int -> c) -> a -> c
kinded Int -> c
f = Int -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. FKindLit -> Int
translateFKind forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FKind a => a -> FKindLit
printFKind
translateFArrayType :: FArrayType -> FV.SemType
translateFArrayType :: FArrayType -> SemType
translateFArrayType (FArrayType FScalarType
fsty Shape
shape) =
SemType -> Dimensions -> SemType
FV.TArray (FScalarType -> SemType
translateFScalarType FScalarType
fsty) (Shape -> Dimensions
translateShape Shape
shape)
translateFKind :: FKindLit -> FV.Kind
translateFKind :: FKindLit -> Int
translateFKind = forall a b. (Integral a, Num b) => a -> b
fromIntegral
translateShape :: Shape -> FV.Dimensions
translateShape :: Shape -> Dimensions
translateShape =
forall (t :: * -> *) a. t (Dim a) -> Dims t a
FV.DimsExplicitShape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> NonEmpty a
NonEmpty.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\Natural
ub -> forall a. a -> a -> Dim a
FV.Dim (forall a. a -> Maybe a
Just Int
1) (forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
ub)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shape -> [Natural]
getShape
translateFValue :: FValue -> Either String FV.ExpVal
translateFValue :: FValue -> Either String ExpVal
translateFValue = \case
MkFScalarValue FScalarValue
fsv -> FScalarValue -> Either String ExpVal
translateFScalarValue FScalarValue
fsv
translateFScalarValue :: FScalarValue -> Either String FV.ExpVal
translateFScalarValue :: FScalarValue -> Either String ExpVal
translateFScalarValue = \case
FSVInt FInt
fint -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int -> ExpVal
FV.Int forall a b. (a -> b) -> a -> b
$ forall r. (forall a. FKindedC FInt a => a -> r) -> FInt -> r
fIntUOp forall a b. (Integral a, Num b) => a -> b
fromIntegral FInt
fint
FSVReal FReal
freal -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Double -> ExpVal
FV.Real forall a b. (a -> b) -> a -> b
$ forall r. (Float -> r) -> (Double -> r) -> FReal -> r
fRealUOp' Float -> Double
float2Double forall a. a -> a
id FReal
freal
FSVComplex FComplex
_fcomplex -> forall a b. a -> Either a b
Left String
"ExpVal doesn't support complex values"
FSVLogical FInt
fint -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Bool -> ExpVal
FV.Logical forall a b. (a -> b) -> a -> b
$ FInt -> Bool
fLogicalToBool FInt
fint
FSVString Text
t -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String -> ExpVal
FV.Str forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
t
translateExpVal :: FV.ExpVal -> FScalarValue
translateExpVal :: ExpVal -> FScalarValue
translateExpVal = \case
FV.Int Int
i -> FInt -> FScalarValue
FSVInt forall a b. (a -> b) -> a -> b
$ Int32 -> FInt
FInt4 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
FV.Real Double
r -> FReal -> FScalarValue
FSVReal forall a b. (a -> b) -> a -> b
$ Double -> FReal
FReal8 Double
r
FV.Str String
s -> Text -> FScalarValue
FSVString forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
s
FV.Logical Bool
b -> FInt -> FScalarValue
FSVLogical forall a b. (a -> b) -> a -> b
$ Int32 -> FInt
FInt4 forall a b. (a -> b) -> a -> b
$ forall a. Num a => Bool -> a
fLogicalNumericFromBool Bool
b
FV.Boz Boz
boz -> FInt -> FScalarValue
FSVInt forall a b. (a -> b) -> a -> b
$ Int16 -> FInt
FInt2 forall a b. (a -> b) -> a -> b
$ forall a. (Num a, Eq a, FiniteBits a) => Boz -> a
AST.bozAsTwosComp Boz
boz