{-# 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
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"