{-# LANGUAGE CPP #-}
module Language.Fortran.Parser.ParserUtils where
import Language.Fortran.AST
import Language.Fortran.AST.Literal.Real
import Language.Fortran.AST.Literal.Complex
import Language.Fortran.Util.Position
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
exprToComplexLitPart :: MonadFail m => Expression a -> m (ComplexPart a)
exprToComplexLitPart :: forall (m :: * -> *) a.
MonadFail m =>
Expression a -> m (ComplexPart a)
exprToComplexLitPart Expression a
e =
case Expression a
e' of
ExpValue a
a SrcSpan
ss Value a
val ->
case Value a
val of
ValReal RealLit
r Maybe (KindParam a)
mkp ->
let r' :: RealLit
r' = RealLit
r { realLitSignificand :: String
realLitSignificand = String
sign forall a. Semigroup a => a -> a -> a
<> RealLit -> String
realLitSignificand RealLit
r }
in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
a -> SrcSpan -> RealLit -> Maybe (KindParam a) -> ComplexPart a
ComplexPartReal a
a SrcSpan
ss RealLit
r' Maybe (KindParam a)
mkp
ValInteger String
i Maybe (KindParam a)
mkp -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
a -> SrcSpan -> String -> Maybe (KindParam a) -> ComplexPart a
ComplexPartInt a
a SrcSpan
ss (String
signforall a. Semigroup a => a -> a -> a
<>String
i) Maybe (KindParam a)
mkp
ValVariable String
var -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> SrcSpan -> String -> ComplexPart a
ComplexPartNamed a
a SrcSpan
ss String
var
Value a
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid COMPLEX literal @ " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show SrcSpan
ss
Expression a
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Invalid COMPLEX literal @ " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall a. Spanned a => a -> SrcSpan
getSpan Expression a
e')
where
(String
sign, Expression a
e') = case Expression a
e of ExpUnary a
_ SrcSpan
_ UnaryOp
Minus Expression a
e'' -> (String
"-", Expression a
e'')
ExpUnary a
_ SrcSpan
_ UnaryOp
Plus Expression a
e'' -> (String
"", Expression a
e'')
Expression a
_ -> (String
"", Expression a
e)
complexLit
:: MonadFail m => SrcSpan -> Expression A0 -> Expression A0
-> m (Expression A0)
complexLit :: forall (m :: * -> *).
MonadFail m =>
SrcSpan -> Expression A0 -> Expression A0 -> m (Expression A0)
complexLit SrcSpan
ss Expression A0
e1 Expression A0
e2 = do
ComplexPart A0
compReal <- forall (m :: * -> *) a.
MonadFail m =>
Expression a -> m (ComplexPart a)
exprToComplexLitPart Expression A0
e1
ComplexPart A0
compImag <- forall (m :: * -> *) a.
MonadFail m =>
Expression a -> m (ComplexPart a)
exprToComplexLitPart Expression A0
e2
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> SrcSpan -> Value a -> Expression a
ExpValue () SrcSpan
ss forall a b. (a -> b) -> a -> b
$ forall a. ComplexLit a -> Value a
ValComplex forall a b. (a -> b) -> a -> b
$ forall a.
a -> SrcSpan -> ComplexPart a -> ComplexPart a -> ComplexLit a
ComplexLit () SrcSpan
ss ComplexPart A0
compReal ComplexPart A0
compImag