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
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, 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, Typeable FScalarValue
FScalarValue -> DataType
FScalarValue -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FScalarValue -> m FScalarValue
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FScalarValue -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FScalarValue -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FScalarValue -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FScalarValue -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FScalarValue -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FScalarValue -> r
gmapT :: (forall b. Data b => b -> b) -> FScalarValue -> FScalarValue
$cgmapT :: (forall b. Data b => b -> b) -> FScalarValue -> FScalarValue
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FScalarValue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c FScalarValue)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FScalarValue)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FScalarValue)
dataTypeOf :: FScalarValue -> DataType
$cdataTypeOf :: FScalarValue -> DataType
toConstr :: FScalarValue -> Constr
$ctoConstr :: FScalarValue -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FScalarValue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FScalarValue
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FScalarValue -> c FScalarValue
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FScalarValue -> c FScalarValue
Data, 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)
    deriving anyclass (Get FScalarValue
[FScalarValue] -> Put
FScalarValue -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [FScalarValue] -> Put
$cputList :: [FScalarValue] -> Put
get :: Get FScalarValue
$cget :: Get FScalarValue
put :: FScalarValue -> Put
$cput :: FScalarValue -> Put
Binary, Int -> FScalarValue -> Doc
[FScalarValue] -> Doc
FScalarValue -> Doc
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
docList :: [FScalarValue] -> Doc
$cdocList :: [FScalarValue] -> Doc
doc :: FScalarValue -> Doc
$cdoc :: FScalarValue -> Doc
docPrec :: Int -> FScalarValue -> Doc
$cdocPrec :: Int -> FScalarValue -> Doc
Out)

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