{-# LANGUAGE CPP #-}

{-| Utils for various parsers (beyond token level).

We can sometimes work around there being free-form and fixed-form versions of
the @LexAction@ monad by requesting the underlying instances instances. We place
such utilities that match that form here.

-}
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)
-- Control.Monad.Fail import is redundant since GHC 8.8.1
import Control.Monad.Fail ( MonadFail )
#endif

{- $complex-lit-parsing

Parsing complex literal parts unambiguously is a pain, so instead, we parse any
expression, then case on it to determine if it's valid for a complex literal
part -- and if so, push it into a 'ComplexPart' constructor. This may cause
unexpected behaviour if more bracketing/tuple rules are added!
-}

-- | Try to validate an expression as a COMPLEX literal part.
--
-- $complex-lit-parsing
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)

-- | Helper for forming COMPLEX literals.
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