module Language.Fortran.Repr.Value.Scalar.Machine
  (
  -- * Note on type coercion implementation
  -- $type-coercion-implementation

    FScalarValue(..)
  , fScalarValueType
  ) where

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.String
import Language.Fortran.Repr.Type.Scalar
import GHC.Generics ( Generic )

{- $type-coercion-implementation

When you run a binary operation on two Fortran values, type coercion may take
place depending on the types of the values. This complicates evaluation code,
because now we have to export two sets of functions for operating on values: one
for returning a kinded value (e.g. addition returns the same type), and one for
non-kinded values (e.g. equality returns a boolean).

On the lowest level, e.g. for operating over @INTEGER(x)@ and @INTEGER(y)@, we
resolve this by doing the coercion in an internal function which is polymorphic
over the result type, and using that in both sets of functions. To operate
kinded, we use the relevant type. To operate unkinded, we use
@'Data.Functor.Const' r@, which ignores the kind and just stores a value of type
'r'.
-}

-- | A Fortran scalar value.
data FScalarValue
  = FSVInt     SomeFInt
  | FSVReal    SomeFReal
  | FSVComplex SomeFComplex
  | FSVLogical SomeFInt
  | FSVString  SomeFString
    deriving stock (forall x. Rep FScalarValue x -> FScalarValue
forall x. FScalarValue -> Rep FScalarValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FScalarValue x -> FScalarValue
$cfrom :: forall x. FScalarValue -> Rep FScalarValue x
Generic, Int -> FScalarValue -> ShowS
[FScalarValue] -> ShowS
FScalarValue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FScalarValue] -> ShowS
$cshowList :: [FScalarValue] -> ShowS
show :: FScalarValue -> String
$cshow :: FScalarValue -> String
showsPrec :: Int -> FScalarValue -> ShowS
$cshowsPrec :: Int -> FScalarValue -> ShowS
Show, FScalarValue -> FScalarValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FScalarValue -> FScalarValue -> Bool
$c/= :: FScalarValue -> FScalarValue -> Bool
== :: FScalarValue -> FScalarValue -> Bool
$c== :: FScalarValue -> FScalarValue -> Bool
Eq)

-- | Recover a Fortran scalar value's type.
fScalarValueType :: FScalarValue -> FScalarType
fScalarValueType :: FScalarValue -> FScalarType
fScalarValueType = \case
  FSVInt     SomeFInt
a -> FTInt -> FScalarType
FSTInt     forall a b. (a -> b) -> a -> b
$ forall k (ft :: k -> *). SomeFKinded k ft -> Demote k
someFKindedKind SomeFInt
a
  FSVReal    SomeFReal
a -> FTReal -> FScalarType
FSTReal    forall a b. (a -> b) -> a -> b
$ forall k (ft :: k -> *). SomeFKinded k ft -> Demote k
someFKindedKind SomeFReal
a
  FSVComplex SomeFComplex
a -> FTReal -> FScalarType
FSTComplex forall a b. (a -> b) -> a -> b
$ forall k (ft :: k -> *). SomeFKinded k ft -> Demote k
someFKindedKind SomeFComplex
a
  FSVLogical SomeFInt
a -> FTInt -> FScalarType
FSTLogical forall a b. (a -> b) -> a -> b
$ forall k (ft :: k -> *). SomeFKinded k ft -> Demote k
someFKindedKind SomeFInt
a
  FSVString  SomeFString
a -> Natural -> FScalarType
FSTString  forall a b. (a -> b) -> a -> b
$ SomeFString -> Natural
someFStringLen  SomeFString
a