{- |
Supporting code for handling Fortran REAL literals.

Fortran REAL literals have some idiosyncrasies that prevent them from lining up
with Haskell's reals immediately. So, we parse into an intermediate data type
that can be easily exported with full precision later. Things we do:

  * Strip explicit positive signs so that signed values either begin with the
    minus sign @-@ or no sign. ('Read' doesn't allow explicit positive signs.)
  * Make exponent explicit by adding the default exponent @E0@ if not present.
  * Make implicit zeroes explicit. @.123 -> 0.123@, @123. -> 123.0@. (Again,
    Haskell literals do not support this.)

For example, the Fortran REAL literal @1D0@ will be parsed into @1.0D0@.
-}

{-# LANGUAGE RecordWildCards #-}

module Language.Fortran.AST.Literal.Real where

import qualified Data.Char as Char
import           GHC.Generics
import           Data.Data
import           Control.DeepSeq                ( NFData )
import           Text.PrettyPrint.GenericPretty ( Out )

-- | A Fortran real literal. (Does not include the optional kind parameter.)
--
-- A real literal is formed of a signed rational significand, and an 'Exponent'.
--
-- See F90 ISO spec pg.27 / R412-416.
--
-- Note that we support signed real literals, even though the F90 spec indicates
-- non-signed real literals are the "default" (signed are only used in a "spare"
-- rule). Our parsers should parse explicit signs as unary operators. There's no
-- harm in supporting signed literals though, especially since the exponent *is*
-- signed.
data RealLit = RealLit
  { RealLit -> String
realLitSignificand :: String
  -- ^ A string representing a signed decimal.
  -- ^ Approximate regex: @-? ( [0-9]+ \. [0-9]* | \. [0-9]+ )@
  , RealLit -> Exponent
realLitExponent    :: Exponent
  } deriving stock (RealLit -> RealLit -> Bool
(RealLit -> RealLit -> Bool)
-> (RealLit -> RealLit -> Bool) -> Eq RealLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RealLit -> RealLit -> Bool
== :: RealLit -> RealLit -> Bool
$c/= :: RealLit -> RealLit -> Bool
/= :: RealLit -> RealLit -> Bool
Eq, Eq RealLit
Eq RealLit =>
(RealLit -> RealLit -> Ordering)
-> (RealLit -> RealLit -> Bool)
-> (RealLit -> RealLit -> Bool)
-> (RealLit -> RealLit -> Bool)
-> (RealLit -> RealLit -> Bool)
-> (RealLit -> RealLit -> RealLit)
-> (RealLit -> RealLit -> RealLit)
-> Ord RealLit
RealLit -> RealLit -> Bool
RealLit -> RealLit -> Ordering
RealLit -> RealLit -> RealLit
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RealLit -> RealLit -> Ordering
compare :: RealLit -> RealLit -> Ordering
$c< :: RealLit -> RealLit -> Bool
< :: RealLit -> RealLit -> Bool
$c<= :: RealLit -> RealLit -> Bool
<= :: RealLit -> RealLit -> Bool
$c> :: RealLit -> RealLit -> Bool
> :: RealLit -> RealLit -> Bool
$c>= :: RealLit -> RealLit -> Bool
>= :: RealLit -> RealLit -> Bool
$cmax :: RealLit -> RealLit -> RealLit
max :: RealLit -> RealLit -> RealLit
$cmin :: RealLit -> RealLit -> RealLit
min :: RealLit -> RealLit -> RealLit
Ord, Int -> RealLit -> ShowS
[RealLit] -> ShowS
RealLit -> String
(Int -> RealLit -> ShowS)
-> (RealLit -> String) -> ([RealLit] -> ShowS) -> Show RealLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RealLit -> ShowS
showsPrec :: Int -> RealLit -> ShowS
$cshow :: RealLit -> String
show :: RealLit -> String
$cshowList :: [RealLit] -> ShowS
showList :: [RealLit] -> ShowS
Show, Typeable RealLit
Typeable RealLit =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> RealLit -> c RealLit)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RealLit)
-> (RealLit -> Constr)
-> (RealLit -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RealLit))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RealLit))
-> ((forall b. Data b => b -> b) -> RealLit -> RealLit)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RealLit -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RealLit -> r)
-> (forall u. (forall d. Data d => d -> u) -> RealLit -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RealLit -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RealLit -> m RealLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RealLit -> m RealLit)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RealLit -> m RealLit)
-> Data RealLit
RealLit -> Constr
RealLit -> DataType
(forall b. Data b => b -> b) -> RealLit -> RealLit
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) -> RealLit -> u
forall u. (forall d. Data d => d -> u) -> RealLit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RealLit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RealLit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RealLit -> m RealLit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RealLit -> m RealLit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RealLit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RealLit -> c RealLit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RealLit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RealLit)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RealLit -> c RealLit
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RealLit -> c RealLit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RealLit
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RealLit
$ctoConstr :: RealLit -> Constr
toConstr :: RealLit -> Constr
$cdataTypeOf :: RealLit -> DataType
dataTypeOf :: RealLit -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RealLit)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RealLit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RealLit)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RealLit)
$cgmapT :: (forall b. Data b => b -> b) -> RealLit -> RealLit
gmapT :: (forall b. Data b => b -> b) -> RealLit -> RealLit
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RealLit -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RealLit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RealLit -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RealLit -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RealLit -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> RealLit -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RealLit -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RealLit -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RealLit -> m RealLit
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RealLit -> m RealLit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RealLit -> m RealLit
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RealLit -> m RealLit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RealLit -> m RealLit
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RealLit -> m RealLit
Data, Typeable, (forall x. RealLit -> Rep RealLit x)
-> (forall x. Rep RealLit x -> RealLit) -> Generic RealLit
forall x. Rep RealLit x -> RealLit
forall x. RealLit -> Rep RealLit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RealLit -> Rep RealLit x
from :: forall x. RealLit -> Rep RealLit x
$cto :: forall x. Rep RealLit x -> RealLit
to :: forall x. Rep RealLit x -> RealLit
Generic)
    deriving anyclass (RealLit -> ()
(RealLit -> ()) -> NFData RealLit
forall a. (a -> ()) -> NFData a
$crnf :: RealLit -> ()
rnf :: RealLit -> ()
NFData, Int -> RealLit -> Doc
[RealLit] -> Doc
RealLit -> Doc
(Int -> RealLit -> Doc)
-> (RealLit -> Doc) -> ([RealLit] -> Doc) -> Out RealLit
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> RealLit -> Doc
docPrec :: Int -> RealLit -> Doc
$cdoc :: RealLit -> Doc
doc :: RealLit -> Doc
$cdocList :: [RealLit] -> Doc
docList :: [RealLit] -> Doc
Out)

-- | An exponent is an exponent letter (E, D) and a signed integer.
data Exponent = Exponent
  { Exponent -> ExponentLetter
exponentLetter :: ExponentLetter
  , Exponent -> String
exponentNum    :: String
  } deriving stock (Exponent -> Exponent -> Bool
(Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Bool) -> Eq Exponent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Exponent -> Exponent -> Bool
== :: Exponent -> Exponent -> Bool
$c/= :: Exponent -> Exponent -> Bool
/= :: Exponent -> Exponent -> Bool
Eq, Eq Exponent
Eq Exponent =>
(Exponent -> Exponent -> Ordering)
-> (Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Exponent)
-> (Exponent -> Exponent -> Exponent)
-> Ord Exponent
Exponent -> Exponent -> Bool
Exponent -> Exponent -> Ordering
Exponent -> Exponent -> Exponent
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Exponent -> Exponent -> Ordering
compare :: Exponent -> Exponent -> Ordering
$c< :: Exponent -> Exponent -> Bool
< :: Exponent -> Exponent -> Bool
$c<= :: Exponent -> Exponent -> Bool
<= :: Exponent -> Exponent -> Bool
$c> :: Exponent -> Exponent -> Bool
> :: Exponent -> Exponent -> Bool
$c>= :: Exponent -> Exponent -> Bool
>= :: Exponent -> Exponent -> Bool
$cmax :: Exponent -> Exponent -> Exponent
max :: Exponent -> Exponent -> Exponent
$cmin :: Exponent -> Exponent -> Exponent
min :: Exponent -> Exponent -> Exponent
Ord, Int -> Exponent -> ShowS
[Exponent] -> ShowS
Exponent -> String
(Int -> Exponent -> ShowS)
-> (Exponent -> String) -> ([Exponent] -> ShowS) -> Show Exponent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Exponent -> ShowS
showsPrec :: Int -> Exponent -> ShowS
$cshow :: Exponent -> String
show :: Exponent -> String
$cshowList :: [Exponent] -> ShowS
showList :: [Exponent] -> ShowS
Show, Typeable Exponent
Typeable Exponent =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Exponent -> c Exponent)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Exponent)
-> (Exponent -> Constr)
-> (Exponent -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Exponent))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exponent))
-> ((forall b. Data b => b -> b) -> Exponent -> Exponent)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Exponent -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Exponent -> r)
-> (forall u. (forall d. Data d => d -> u) -> Exponent -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Exponent -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Exponent -> m Exponent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Exponent -> m Exponent)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Exponent -> m Exponent)
-> Data Exponent
Exponent -> Constr
Exponent -> DataType
(forall b. Data b => b -> b) -> Exponent -> Exponent
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) -> Exponent -> u
forall u. (forall d. Data d => d -> u) -> Exponent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Exponent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Exponent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Exponent -> m Exponent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exponent -> m Exponent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Exponent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Exponent -> c Exponent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Exponent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exponent)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Exponent -> c Exponent
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Exponent -> c Exponent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Exponent
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Exponent
$ctoConstr :: Exponent -> Constr
toConstr :: Exponent -> Constr
$cdataTypeOf :: Exponent -> DataType
dataTypeOf :: Exponent -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Exponent)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Exponent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exponent)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Exponent)
$cgmapT :: (forall b. Data b => b -> b) -> Exponent -> Exponent
gmapT :: (forall b. Data b => b -> b) -> Exponent -> Exponent
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Exponent -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Exponent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Exponent -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Exponent -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Exponent -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Exponent -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Exponent -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Exponent -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Exponent -> m Exponent
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Exponent -> m Exponent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exponent -> m Exponent
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exponent -> m Exponent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exponent -> m Exponent
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Exponent -> m Exponent
Data, Typeable, (forall x. Exponent -> Rep Exponent x)
-> (forall x. Rep Exponent x -> Exponent) -> Generic Exponent
forall x. Rep Exponent x -> Exponent
forall x. Exponent -> Rep Exponent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Exponent -> Rep Exponent x
from :: forall x. Exponent -> Rep Exponent x
$cto :: forall x. Rep Exponent x -> Exponent
to :: forall x. Rep Exponent x -> Exponent
Generic)
    deriving anyclass (Exponent -> ()
(Exponent -> ()) -> NFData Exponent
forall a. (a -> ()) -> NFData a
$crnf :: Exponent -> ()
rnf :: Exponent -> ()
NFData, Int -> Exponent -> Doc
[Exponent] -> Doc
Exponent -> Doc
(Int -> Exponent -> Doc)
-> (Exponent -> Doc) -> ([Exponent] -> Doc) -> Out Exponent
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> Exponent -> Doc
docPrec :: Int -> Exponent -> Doc
$cdoc :: Exponent -> Doc
doc :: Exponent -> Doc
$cdocList :: [Exponent] -> Doc
docList :: [Exponent] -> Doc
Out)

-- Note: Some Fortran language references include extensions here. HP's F90
-- reference provides a Q exponent letter which sets kind to 16.
data ExponentLetter
  = ExpLetterE -- ^ KIND=4 (float)
  | ExpLetterD -- ^ KIND=8 (double)
  | ExpLetterQ -- ^ KIND=16 ("quad", rare? extension)
    deriving stock (ExponentLetter -> ExponentLetter -> Bool
(ExponentLetter -> ExponentLetter -> Bool)
-> (ExponentLetter -> ExponentLetter -> Bool) -> Eq ExponentLetter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExponentLetter -> ExponentLetter -> Bool
== :: ExponentLetter -> ExponentLetter -> Bool
$c/= :: ExponentLetter -> ExponentLetter -> Bool
/= :: ExponentLetter -> ExponentLetter -> Bool
Eq, Eq ExponentLetter
Eq ExponentLetter =>
(ExponentLetter -> ExponentLetter -> Ordering)
-> (ExponentLetter -> ExponentLetter -> Bool)
-> (ExponentLetter -> ExponentLetter -> Bool)
-> (ExponentLetter -> ExponentLetter -> Bool)
-> (ExponentLetter -> ExponentLetter -> Bool)
-> (ExponentLetter -> ExponentLetter -> ExponentLetter)
-> (ExponentLetter -> ExponentLetter -> ExponentLetter)
-> Ord ExponentLetter
ExponentLetter -> ExponentLetter -> Bool
ExponentLetter -> ExponentLetter -> Ordering
ExponentLetter -> ExponentLetter -> ExponentLetter
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ExponentLetter -> ExponentLetter -> Ordering
compare :: ExponentLetter -> ExponentLetter -> Ordering
$c< :: ExponentLetter -> ExponentLetter -> Bool
< :: ExponentLetter -> ExponentLetter -> Bool
$c<= :: ExponentLetter -> ExponentLetter -> Bool
<= :: ExponentLetter -> ExponentLetter -> Bool
$c> :: ExponentLetter -> ExponentLetter -> Bool
> :: ExponentLetter -> ExponentLetter -> Bool
$c>= :: ExponentLetter -> ExponentLetter -> Bool
>= :: ExponentLetter -> ExponentLetter -> Bool
$cmax :: ExponentLetter -> ExponentLetter -> ExponentLetter
max :: ExponentLetter -> ExponentLetter -> ExponentLetter
$cmin :: ExponentLetter -> ExponentLetter -> ExponentLetter
min :: ExponentLetter -> ExponentLetter -> ExponentLetter
Ord, Int -> ExponentLetter -> ShowS
[ExponentLetter] -> ShowS
ExponentLetter -> String
(Int -> ExponentLetter -> ShowS)
-> (ExponentLetter -> String)
-> ([ExponentLetter] -> ShowS)
-> Show ExponentLetter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExponentLetter -> ShowS
showsPrec :: Int -> ExponentLetter -> ShowS
$cshow :: ExponentLetter -> String
show :: ExponentLetter -> String
$cshowList :: [ExponentLetter] -> ShowS
showList :: [ExponentLetter] -> ShowS
Show, Typeable ExponentLetter
Typeable ExponentLetter =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ExponentLetter -> c ExponentLetter)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ExponentLetter)
-> (ExponentLetter -> Constr)
-> (ExponentLetter -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ExponentLetter))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ExponentLetter))
-> ((forall b. Data b => b -> b)
    -> ExponentLetter -> ExponentLetter)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ExponentLetter -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ExponentLetter -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ExponentLetter -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ExponentLetter -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ExponentLetter -> m ExponentLetter)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ExponentLetter -> m ExponentLetter)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ExponentLetter -> m ExponentLetter)
-> Data ExponentLetter
ExponentLetter -> Constr
ExponentLetter -> DataType
(forall b. Data b => b -> b) -> ExponentLetter -> ExponentLetter
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) -> ExponentLetter -> u
forall u. (forall d. Data d => d -> u) -> ExponentLetter -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExponentLetter -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExponentLetter -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExponentLetter -> m ExponentLetter
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExponentLetter -> m ExponentLetter
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExponentLetter
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExponentLetter -> c ExponentLetter
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExponentLetter)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExponentLetter)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExponentLetter -> c ExponentLetter
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ExponentLetter -> c ExponentLetter
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExponentLetter
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ExponentLetter
$ctoConstr :: ExponentLetter -> Constr
toConstr :: ExponentLetter -> Constr
$cdataTypeOf :: ExponentLetter -> DataType
dataTypeOf :: ExponentLetter -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExponentLetter)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ExponentLetter)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExponentLetter)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ExponentLetter)
$cgmapT :: (forall b. Data b => b -> b) -> ExponentLetter -> ExponentLetter
gmapT :: (forall b. Data b => b -> b) -> ExponentLetter -> ExponentLetter
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExponentLetter -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ExponentLetter -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExponentLetter -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ExponentLetter -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ExponentLetter -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ExponentLetter -> [u]
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ExponentLetter -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ExponentLetter -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExponentLetter -> m ExponentLetter
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ExponentLetter -> m ExponentLetter
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExponentLetter -> m ExponentLetter
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExponentLetter -> m ExponentLetter
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExponentLetter -> m ExponentLetter
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ExponentLetter -> m ExponentLetter
Data, Typeable, (forall x. ExponentLetter -> Rep ExponentLetter x)
-> (forall x. Rep ExponentLetter x -> ExponentLetter)
-> Generic ExponentLetter
forall x. Rep ExponentLetter x -> ExponentLetter
forall x. ExponentLetter -> Rep ExponentLetter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ExponentLetter -> Rep ExponentLetter x
from :: forall x. ExponentLetter -> Rep ExponentLetter x
$cto :: forall x. Rep ExponentLetter x -> ExponentLetter
to :: forall x. Rep ExponentLetter x -> ExponentLetter
Generic)
    deriving anyclass (ExponentLetter -> ()
(ExponentLetter -> ()) -> NFData ExponentLetter
forall a. (a -> ()) -> NFData a
$crnf :: ExponentLetter -> ()
rnf :: ExponentLetter -> ()
NFData, Int -> ExponentLetter -> Doc
[ExponentLetter] -> Doc
ExponentLetter -> Doc
(Int -> ExponentLetter -> Doc)
-> (ExponentLetter -> Doc)
-> ([ExponentLetter] -> Doc)
-> Out ExponentLetter
forall a. (Int -> a -> Doc) -> (a -> Doc) -> ([a] -> Doc) -> Out a
$cdocPrec :: Int -> ExponentLetter -> Doc
docPrec :: Int -> ExponentLetter -> Doc
$cdoc :: ExponentLetter -> Doc
doc :: ExponentLetter -> Doc
$cdocList :: [ExponentLetter] -> Doc
docList :: [ExponentLetter] -> Doc
Out)

-- | Prettify a 'RealLit' in a Haskell-compatible way.
prettyHsRealLit :: RealLit -> String
prettyHsRealLit :: RealLit -> String
prettyHsRealLit RealLit
r = RealLit -> String
realLitSignificand RealLit
r String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"e" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Exponent -> String
exponentNum (RealLit -> Exponent
realLitExponent RealLit
r)

readRealLit :: (Fractional a, Read a) => RealLit -> a
readRealLit :: forall a. (Fractional a, Read a) => RealLit -> a
readRealLit = String -> a
forall a. Read a => String -> a
read (String -> a) -> (RealLit -> String) -> RealLit -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealLit -> String
prettyHsRealLit

-- UNSAFE. Expects a valid Fortran REAL literal.
parseRealLit :: String -> RealLit
parseRealLit :: String -> RealLit
parseRealLit String
r =
    let (String
significandStr, String
exponentStr) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSignificand String
r
        realLitExponent :: Exponent
realLitExponent = String -> Exponent
parseExponent String
exponentStr
        realLitSignificand :: String
realLitSignificand = ShowS
normalizeSignificand (ShowS
stripPositiveSign String
significandStr)
     in RealLit{String
Exponent
realLitSignificand :: String
realLitExponent :: Exponent
realLitExponent :: Exponent
realLitSignificand :: String
..}
  where
    -- | Ensure that the given decimal string is in form @x.y@.
    normalizeSignificand :: ShowS
normalizeSignificand String
str = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') String
str of
                                 ([], String
d)  -> Char
'0'Char -> ShowS
forall a. a -> [a] -> [a]
:String
d   --    .456
                                 (String
i, String
".") -> String
iString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
".0" -- 123.
                                 (String
i, String
"")  -> String
iString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
".0" -- 123
                                 (String, String)
_        -> String
str     -- 123.456
    parseExponent :: String -> Exponent
parseExponent String
"" = Exponent { exponentLetter :: ExponentLetter
exponentLetter = ExponentLetter
ExpLetterE, exponentNum :: String
exponentNum = String
"0" }
    parseExponent (Char
l:String
str) =
        let exponentLetter :: ExponentLetter
exponentLetter = Char -> ExponentLetter
parseExponentLetter Char
l
            exponentNum :: String
exponentNum = ShowS
stripPositiveSign String
str
         in Exponent{String
ExponentLetter
exponentLetter :: ExponentLetter
exponentNum :: String
exponentLetter :: ExponentLetter
exponentNum :: String
..}
    stripPositiveSign :: ShowS
stripPositiveSign = \case
      []  -> []
      Char
c:String
s -> case Char
c of
               Char
'+' ->   String
s
               Char
_   -> Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
s
    isSignificand :: Char -> Bool
isSignificand Char
ch | Char -> Bool
Char.isDigit Char
ch                 = Bool
True
                     | Char
ch Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'.', Char
'-', Char
'+']  = Bool
True
                     | Bool
otherwise                  = Bool
False
    parseExponentLetter :: Char -> ExponentLetter
parseExponentLetter Char
ch = case Char -> Char
Char.toLower Char
ch of
                               Char
'e' -> ExponentLetter
ExpLetterE
                               Char
'd' -> ExponentLetter
ExpLetterD
                               Char
'q' -> ExponentLetter
ExpLetterQ
                               Char
_   -> String -> ExponentLetter
forall a. HasCallStack => String -> a
error (String -> ExponentLetter) -> String -> ExponentLetter
forall a b. (a -> b) -> a -> b
$ String
"Language.Fortran.AST.Literal.Real.parseRealLit: invalid exponent letter: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
ch]