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.Type.Scalar

import Data.Text ( Text )
import qualified Data.Text as Text

import GHC.Generics ( Generic )
import Data.Data ( Data )
import Data.Binary ( Binary )
import Text.PrettyPrint.GenericPretty ( Out )
import Text.PrettyPrint.GenericPretty.Orphans()

{- $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     FInt
  | FSVReal    FReal
  | FSVComplex FComplex
  | FSVLogical FInt
  | FSVString  Text
    deriving stock (Int -> FScalarValue -> ShowS
[FScalarValue] -> ShowS
FScalarValue -> String
(Int -> FScalarValue -> ShowS)
-> (FScalarValue -> String)
-> ([FScalarValue] -> ShowS)
-> Show FScalarValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FScalarValue -> ShowS
showsPrec :: Int -> FScalarValue -> ShowS
$cshow :: FScalarValue -> String
show :: FScalarValue -> String
$cshowList :: [FScalarValue] -> ShowS
showList :: [FScalarValue] -> ShowS
Show, (forall x. FScalarValue -> Rep FScalarValue x)
-> (forall x. Rep FScalarValue x -> FScalarValue)
-> Generic FScalarValue
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
$cfrom :: forall x. FScalarValue -> Rep FScalarValue x
from :: forall x. FScalarValue -> Rep FScalarValue x
$cto :: forall x. Rep FScalarValue x -> FScalarValue
to :: forall x. Rep FScalarValue x -> FScalarValue
Generic, Typeable FScalarValue
Typeable FScalarValue =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> FScalarValue -> c FScalarValue)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FScalarValue)
-> (FScalarValue -> Constr)
-> (FScalarValue -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FScalarValue))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c FScalarValue))
-> ((forall b. Data b => b -> b) -> FScalarValue -> FScalarValue)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FScalarValue -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FScalarValue -> r)
-> (forall u. (forall d. Data d => d -> u) -> FScalarValue -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FScalarValue -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue)
-> Data FScalarValue
FScalarValue -> Constr
FScalarValue -> DataType
(forall b. Data b => b -> b) -> FScalarValue -> FScalarValue
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> FScalarValue -> u
forall u. (forall d. Data d => d -> u) -> FScalarValue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FScalarValue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FScalarValue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FScalarValue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FScalarValue -> c FScalarValue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FScalarValue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FScalarValue)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FScalarValue -> c FScalarValue
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FScalarValue -> c FScalarValue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FScalarValue
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FScalarValue
$ctoConstr :: FScalarValue -> Constr
toConstr :: FScalarValue -> Constr
$cdataTypeOf :: FScalarValue -> DataType
dataTypeOf :: FScalarValue -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FScalarValue)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FScalarValue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FScalarValue)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FScalarValue)
$cgmapT :: (forall b. Data b => b -> b) -> FScalarValue -> FScalarValue
gmapT :: (forall b. Data b => b -> b) -> FScalarValue -> FScalarValue
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FScalarValue -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FScalarValue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FScalarValue -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FScalarValue -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FScalarValue -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FScalarValue -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FScalarValue -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FScalarValue -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue
Data, FScalarValue -> FScalarValue -> Bool
(FScalarValue -> FScalarValue -> Bool)
-> (FScalarValue -> FScalarValue -> Bool) -> Eq FScalarValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FScalarValue -> FScalarValue -> Bool
== :: FScalarValue -> FScalarValue -> Bool
$c/= :: FScalarValue -> FScalarValue -> Bool
/= :: FScalarValue -> FScalarValue -> Bool
Eq)
    deriving anyclass (Get FScalarValue
[FScalarValue] -> Put
FScalarValue -> Put
(FScalarValue -> Put)
-> Get FScalarValue
-> ([FScalarValue] -> Put)
-> Binary FScalarValue
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: FScalarValue -> Put
put :: FScalarValue -> Put
$cget :: Get FScalarValue
get :: Get FScalarValue
$cputList :: [FScalarValue] -> Put
putList :: [FScalarValue] -> Put
Binary, Int -> FScalarValue -> Doc
[FScalarValue] -> Doc
FScalarValue -> Doc
(Int -> FScalarValue -> Doc)
-> (FScalarValue -> Doc)
-> ([FScalarValue] -> Doc)
-> Out FScalarValue
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> FScalarValue -> Doc
docPrec :: Int -> FScalarValue -> Doc
$cdoc :: FScalarValue -> Doc
doc :: FScalarValue -> Doc
$cdocList :: [FScalarValue] -> Doc
docList :: [FScalarValue] -> Doc
Out)

-- | Recover a Fortran scalar value's type.
fScalarValueType :: FScalarValue -> FScalarType
fScalarValueType :: FScalarValue -> FScalarType
fScalarValueType = \case
  FSVInt     FInt
a -> FTInt -> FScalarType
FSTInt     (FTInt -> FScalarType) -> FTInt -> FScalarType
forall a b. (a -> b) -> a -> b
$ FInt -> FKindedT FInt
forall a. FKinded a => a -> FKindedT a
fKind FInt
a
  FSVReal    FReal
a -> FTReal -> FScalarType
FSTReal    (FTReal -> FScalarType) -> FTReal -> FScalarType
forall a b. (a -> b) -> a -> b
$ FReal -> FKindedT FReal
forall a. FKinded a => a -> FKindedT a
fKind FReal
a
  FSVComplex FComplex
a -> FTReal -> FScalarType
FSTComplex (FTReal -> FScalarType) -> FTReal -> FScalarType
forall a b. (a -> b) -> a -> b
$ FComplex -> FKindedT FComplex
forall a. FKinded a => a -> FKindedT a
fKind FComplex
a
  FSVLogical FInt
a -> FTInt -> FScalarType
FSTLogical (FTInt -> FScalarType) -> FTInt -> FScalarType
forall a b. (a -> b) -> a -> b
$ FInt -> FKindedT FInt
forall a. FKinded a => a -> FKindedT a
fKind FInt
a
  FSVString  Text
a -> Natural -> FScalarType
FSTString  (Natural -> FScalarType) -> Natural -> FScalarType
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> Int -> Natural
forall a b. (a -> b) -> a -> b
$ Text -> Int
Text.length Text
a