{- | Translate fortran-vars Fortran types and values to fortran-src
     (Language.Fortran.Repr).

TODO

  * BYTE is apparently LOGICAL(1). Or INTEGER(1) (same thing?). Could make a
    special check for that.
-}

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
  --FSTLogical ftint  -> kinded FV.TLogical 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

-- | Note that Fortran defaults to 1-indexed arrays.
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

  -- TODO getting some precisions errors, fortran-src over-precise? unsure where
  -- coming from, but need to compare using an epsilon
  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

  -- TODO fortran-vars always converts BOZs at INTEGER(2)
  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