{-# LANGUAGE TemplateHaskell, StandaloneKindSignatures, UndecidableInstances #-}

module Language.Fortran.Repr.Type.Scalar.Real where

import Language.Fortran.Repr.Type.Scalar.Common

import GHC.Generics ( Generic )
import Data.Data ( Data )

import Data.Singletons.TH
-- required for deriving instances (seems like bug)
import Prelude.Singletons
import Data.Ord.Singletons

$(singletons [d|
    data FTReal
      = FTReal4
      | FTReal8
        deriving stock (Eq, Ord, Show)
    |])
deriving stock instance Generic FTReal
deriving stock instance Data    FTReal
deriving stock instance Enum    FTReal

-- | Get the output type from combining two real values of arbitrary kinds (for
--   example, adding a @REAL(4)@ and a @REAL(8)@).
type FTRealCombine :: FTReal -> FTReal -> FTReal
type family FTRealCombine k1 k2 where
    FTRealCombine 'FTReal8 _        = 'FTReal8
    FTRealCombine _        'FTReal8 = 'FTReal8
    FTRealCombine 'FTReal4 'FTReal4 = 'FTReal4

instance FKinded FTReal where
    type FKindOf 'FTReal4 = 4
    type FKindOf 'FTReal8 = 8
    type FKindDefault = 'FTReal4
    parseFKind :: Natural -> Maybe FTReal
parseFKind = \case Natural
4 -> forall a. a -> Maybe a
Just FTReal
FTReal4
                       Natural
8 -> forall a. a -> Maybe a
Just FTReal
FTReal8
                       Natural
_ -> forall a. Maybe a
Nothing
    -- spurious warning on GHC 9.0
    printFKind :: FTReal -> Natural
printFKind (FromSing Sing a
x) = case Sing a
x of
      Sing a
SFTReal a
SFTReal4 -> forall k (a :: k) (n :: Natural).
(n ~ FKindOf a, KnownNat n) =>
Sing a -> Natural
reifyKinded Sing a
x
      Sing a
SFTReal a
SFTReal8 -> forall k (a :: k) (n :: Natural).
(n ~ FKindOf a, KnownNat n) =>
Sing a -> Natural
reifyKinded Sing a
x