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

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

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

-- | Prettify a 'RealLit' in a Haskell-compatible way.
prettyHsRealLit :: RealLit -> String
prettyHsRealLit :: RealLit -> String
prettyHsRealLit RealLit
r = RealLit -> String
realLitSignificand RealLit
r forall a. Semigroup a => a -> a -> a
<> String
"e" 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 = forall a. Read a => String -> a
read 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) = 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 forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
'.') String
str of
                                 ([], String
d)  -> Char
'0'forall a. a -> [a] -> [a]
:String
d   --    .456
                                 (String
i, String
".") -> String
iforall a. Semigroup a => a -> a -> a
<>String
".0" -- 123.
                                 (String
i, String
"")  -> String
iforall 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
exponentNum :: String
exponentLetter :: ExponentLetter
exponentNum :: String
exponentLetter :: ExponentLetter
..}
    stripPositiveSign :: ShowS
stripPositiveSign = \case
      []  -> []
      Char
c:String
s -> case Char
c of
               Char
'+' ->   String
s
               Char
_   -> Char
cforall a. a -> [a] -> [a]
:String
s
    isSignificand :: Char -> Bool
isSignificand Char
ch | Char -> Bool
Char.isDigit Char
ch                 = Bool
True
                     | Char
ch 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
_   -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Language.Fortran.AST.Literal.Real.parseRealLit: invalid exponent letter: " forall a. Semigroup a => a -> a -> a
<> [Char
ch]