{-# LANGUAGE CPP #-}
module Language.Fortran.Parser.Fixed.Utils where

import Language.Fortran.Parser.Fixed.Lexer
import Language.Fortran.AST
import Language.Fortran.AST.Literal.Real
import Language.Fortran.Util.Position
import Language.Fortran.Parser.Monad
import Control.Monad.State

-- | UNSAFE. Must be called with expected token types (see usage sites). Will
--   cause a runtime exception if it doesn't form a valid REAL literal.
makeRealLit
    :: Maybe Token -> Maybe Token -> Maybe Token -> Maybe (SrcSpan, String)
    -> Expression A0
makeRealLit :: Maybe Token
-> Maybe Token
-> Maybe Token
-> Maybe (SrcSpan, String)
-> Expression A0
makeRealLit Maybe Token
i1 Maybe Token
dot Maybe Token
i2 Maybe (SrcSpan, String)
expr =
  let span1 :: SrcSpan
span1   = forall a. Spanned a => a -> SrcSpan
getSpan (Maybe Token
i1, Maybe Token
dot, Maybe Token
i2)
      span2 :: SrcSpan
span2   = case Maybe (SrcSpan, String)
expr of
                  Just (SrcSpan, String)
e -> forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan SrcSpan
span1 (forall a b. (a, b) -> a
fst (SrcSpan, String)
e)
                  Maybe (SrcSpan, String)
Nothing -> SrcSpan
span1
      i1Str :: String
i1Str   = case Maybe Token
i1 of { Just (TInt SrcSpan
_ String
s) -> String
s ; Maybe Token
_ -> String
"" }
      dotStr :: String
dotStr  = case Maybe Token
dot of { Just (TDot SrcSpan
_) -> String
"." ; Maybe Token
_ -> String
"" }
      i2Str :: String
i2Str   = case Maybe Token
i2 of { Just (TInt SrcSpan
_ String
s) -> String
s ; Maybe Token
_ -> String
"" }
      exprStr :: String
exprStr  = case Maybe (SrcSpan, String)
expr of { Just (SrcSpan
_, String
s) -> String
s ; Maybe (SrcSpan, String)
_ -> String
"" }
      litStr :: String
litStr  = String
i1Str forall a. [a] -> [a] -> [a]
++ String
dotStr forall a. [a] -> [a] -> [a]
++ String
i2Str forall a. [a] -> [a] -> [a]
++ String
exprStr
   in forall a. a -> SrcSpan -> Value a -> Expression a
ExpValue () SrcSpan
span2 forall a b. (a -> b) -> a -> b
$ forall a. RealLit -> Maybe (KindParam a) -> Value a
ValReal (String -> RealLit
parseRealLit String
litStr) forall a. Maybe a
Nothing

parseError :: Token -> LexAction a
parseError :: forall a. Token -> LexAction a
parseError Token
_ = do
    ParseState AlexInput
parseState <- forall s (m :: * -> *). MonadState s m => m s
get
#ifdef DEBUG
    tokens <- reverse <$> aiPreviousTokensInLine <$> getAlex
#endif
    forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. ParseState a -> String
psFilename ParseState AlexInput
parseState forall a. [a] -> [a] -> [a]
++ String
": parsing failed. "
#ifdef DEBUG
      ++ '\n' : show tokens
#endif

convCmts :: [Block a] -> [ProgramUnit a]
convCmts :: forall a. [Block a] -> [ProgramUnit a]
convCmts = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Block a -> ProgramUnit a
convCmt
  where convCmt :: Block a -> ProgramUnit a
convCmt (BlComment a
a SrcSpan
s Comment a
c) = forall a. a -> SrcSpan -> Comment a -> ProgramUnit a
PUComment a
a SrcSpan
s Comment a
c
        convCmt Block a
_ = forall a. HasCallStack => String -> a
error String
"convCmt applied to something that is not a comment"