{-# 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   = (Maybe Token, Maybe Token, Maybe Token) -> SrcSpan
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 -> SrcSpan -> SrcSpan -> SrcSpan
forall a b. SpannedPair a b => a -> b -> SrcSpan
getTransSpan SrcSpan
span1 ((SrcSpan, String) -> SrcSpan
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
dotStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i2Str String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exprStr
   in A0 -> SrcSpan -> Value A0 -> Expression A0
forall a. a -> SrcSpan -> Value a -> Expression a
ExpValue () SrcSpan
span2 (Value A0 -> Expression A0) -> Value A0 -> Expression A0
forall a b. (a -> b) -> a -> b
$ RealLit -> Maybe (KindParam A0) -> Value A0
forall a. RealLit -> Maybe (KindParam a) -> Value a
ValReal (String -> RealLit
parseRealLit String
litStr) Maybe (KindParam A0)
forall a. Maybe a
Nothing

parseError :: Token -> LexAction a
parseError :: forall a. Token -> LexAction a
parseError Token
_ = do
    ParseState AlexInput
parseState <- Parse AlexInput Token (ParseState AlexInput)
forall s (m :: * -> *). MonadState s m => m s
get
#ifdef DEBUG
    tokens <- reverse <$> aiPreviousTokensInLine <$> getAlex
#endif
    String -> LexAction a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> LexAction a) -> String -> LexAction a
forall a b. (a -> b) -> a -> b
$ ParseState AlexInput -> String
forall a. ParseState a -> String
psFilename ParseState AlexInput
parseState String -> String -> String
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 = (Block a -> ProgramUnit a) -> [Block a] -> [ProgramUnit a]
forall a b. (a -> b) -> [a] -> [b]
map Block a -> ProgramUnit a
forall {a}. Block a -> ProgramUnit a
convCmt
  where convCmt :: Block a -> ProgramUnit a
convCmt (BlComment a
a SrcSpan
s Comment a
c) = a -> SrcSpan -> Comment a -> ProgramUnit a
forall a. a -> SrcSpan -> Comment a -> ProgramUnit a
PUComment a
a SrcSpan
s Comment a
c
        convCmt Block a
_ = String -> ProgramUnit a
forall a. HasCallStack => String -> a
error String
"convCmt applied to something that is not a comment"