{- |
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.)
-}

{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveAnyClass #-}
{-# LANGUAGE RecordWildCards, LambdaCase #-}

module Language.Fortran.AST.RealLit 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
(RealLit -> RealLit -> Bool)
-> (RealLit -> RealLit -> Bool) -> Eq RealLit
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
(Int -> RealLit -> ShowS)
-> (RealLit -> String) -> ([RealLit] -> ShowS) -> Show RealLit
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
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 -> 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. 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
$cto :: forall x. Rep RealLit x -> RealLit
$cfrom :: forall x. RealLit -> Rep RealLit x
Generic, RealLit -> ()
(RealLit -> ()) -> NFData RealLit
forall a. (a -> ()) -> NFData a
rnf :: RealLit -> ()
$crnf :: 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
docList :: [RealLit] -> Doc
$cdocList :: [RealLit] -> Doc
doc :: RealLit -> Doc
$cdoc :: RealLit -> Doc
docPrec :: Int -> RealLit -> Doc
$cdocPrec :: Int -> RealLit -> Doc
Out, 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
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
(Exponent -> Exponent -> Bool)
-> (Exponent -> Exponent -> Bool) -> Eq Exponent
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
(Int -> Exponent -> ShowS)
-> (Exponent -> String) -> ([Exponent] -> ShowS) -> Show Exponent
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
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 -> 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. 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
$cto :: forall x. Rep Exponent x -> Exponent
$cfrom :: forall x. Exponent -> Rep Exponent x
Generic, Exponent -> ()
(Exponent -> ()) -> NFData Exponent
forall a. (a -> ()) -> NFData a
rnf :: Exponent -> ()
$crnf :: 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
docList :: [Exponent] -> Doc
$cdocList :: [Exponent] -> Doc
doc :: Exponent -> Doc
$cdoc :: Exponent -> Doc
docPrec :: Int -> Exponent -> Doc
$cdocPrec :: Int -> Exponent -> Doc
Out, 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
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
(ExponentLetter -> ExponentLetter -> Bool)
-> (ExponentLetter -> ExponentLetter -> Bool) -> Eq ExponentLetter
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
(Int -> ExponentLetter -> ShowS)
-> (ExponentLetter -> String)
-> ([ExponentLetter] -> ShowS)
-> Show ExponentLetter
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
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 -> 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. 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
$cto :: forall x. Rep ExponentLetter x -> ExponentLetter
$cfrom :: forall x. ExponentLetter -> Rep ExponentLetter x
Generic, ExponentLetter -> ()
(ExponentLetter -> ()) -> NFData ExponentLetter
forall a. (a -> ()) -> NFData a
rnf :: ExponentLetter -> ()
$crnf :: 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
docList :: [ExponentLetter] -> Doc
$cdocList :: [ExponentLetter] -> Doc
doc :: ExponentLetter -> Doc
$cdoc :: ExponentLetter -> Doc
docPrec :: Int -> ExponentLetter -> Doc
$cdocPrec :: Int -> ExponentLetter -> Doc
Out, 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
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 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 -> RealLit
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 -> String -> Exponent
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 :: ExponentLetter -> String -> Exponent
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
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 (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.RealLit.parseRealLit: invalid exponent letter: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
ch]