{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE CPP #-}
module Language.Fortran.Parser.Monad where
#if !MIN_VERSION_base(4,13,0)
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fail (MonadFail)
#endif
import Language.Fortran.Version
import Language.Fortran.Util.Position
import Control.Exception
import GHC.IO.Exception ( IOException(..), IOErrorType(..) )
import Control.Monad.State hiding (state)
import Control.Monad.Except
import Data.Typeable
data ParanthesesCount = ParanthesesCount
{ ParanthesesCount -> Integer
pcActual :: Integer
, ParanthesesCount -> Bool
pcHasReached0 :: Bool }
deriving (Int -> ParanthesesCount -> ShowS
[ParanthesesCount] -> ShowS
ParanthesesCount -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParanthesesCount] -> ShowS
$cshowList :: [ParanthesesCount] -> ShowS
show :: ParanthesesCount -> String
$cshow :: ParanthesesCount -> String
showsPrec :: Int -> ParanthesesCount -> ShowS
$cshowsPrec :: Int -> ParanthesesCount -> ShowS
Show, ParanthesesCount -> ParanthesesCount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParanthesesCount -> ParanthesesCount -> Bool
$c/= :: ParanthesesCount -> ParanthesesCount -> Bool
== :: ParanthesesCount -> ParanthesesCount -> Bool
$c== :: ParanthesesCount -> ParanthesesCount -> Bool
Eq)
data Context =
ConStart
| ConData
| ConImplicit
| ConNamelist
| ConCommon
deriving (Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show, Context -> Context -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: Context -> Context -> Bool
Eq)
data ParseState a = ParseState
{ forall a. ParseState a -> a
psAlexInput :: a
, forall a. ParseState a -> ParanthesesCount
psParanthesesCount :: ParanthesesCount
, forall a. ParseState a -> FortranVersion
psVersion :: FortranVersion
, forall a. ParseState a -> String
psFilename :: String
, forall a. ParseState a -> [Context]
psContext :: [ Context ]
}
deriving (Int -> ParseState a -> ShowS
forall a. Show a => Int -> ParseState a -> ShowS
forall a. Show a => [ParseState a] -> ShowS
forall a. Show a => ParseState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParseState a] -> ShowS
$cshowList :: forall a. Show a => [ParseState a] -> ShowS
show :: ParseState a -> String
$cshow :: forall a. Show a => ParseState a -> String
showsPrec :: Int -> ParseState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ParseState a -> ShowS
Show)
data ParseError a b = ParseError
{ forall {k} (a :: k) b. ParseError a b -> Position
errPos :: Position
, forall {k} (a :: k) b. ParseError a b -> Maybe b
errLastToken :: Maybe b
, forall {k} (a :: k) b. ParseError a b -> String
errFilename :: String
, forall {k} (a :: k) b. ParseError a b -> String
errMsg :: String }
instance Show b => Show (ParseError a b) where
show :: ParseError a b -> String
show ParseError a b
err = forall a. Show a => a -> String
show (forall {k} (a :: k) b. ParseError a b -> Position
errPos ParseError a b
err) forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall {k} (a :: k) b. ParseError a b -> String
errMsg ParseError a b
err forall a. [a] -> [a] -> [a]
++ String
lastTokenMsg
where lastTokenMsg :: String
lastTokenMsg = forall a. Show a => Maybe a -> String
tokenMsg (forall {k} (a :: k) b. ParseError a b -> Maybe b
errLastToken ParseError a b
err)
tokenMsg :: Show a => Maybe a -> String
tokenMsg :: forall a. Show a => Maybe a -> String
tokenMsg (Just a
a) = String
"Last parsed token: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
a forall a. [a] -> [a] -> [a]
++ String
"."
tokenMsg Maybe a
Nothing = String
"No token had been lexed."
data ParseResult b c a = ParseOk a (ParseState b) | ParseFailed (ParseError b c)
deriving stock (forall a b. a -> ParseResult b c b -> ParseResult b c a
forall a b. (a -> b) -> ParseResult b c a -> ParseResult b c b
forall b c a b. a -> ParseResult b c b -> ParseResult b c a
forall b c a b. (a -> b) -> ParseResult b c a -> ParseResult b c b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ParseResult b c b -> ParseResult b c a
$c<$ :: forall b c a b. a -> ParseResult b c b -> ParseResult b c a
fmap :: forall a b. (a -> b) -> ParseResult b c a -> ParseResult b c b
$cfmap :: forall b c a b. (a -> b) -> ParseResult b c a -> ParseResult b c b
Functor)
instance (Typeable a, Typeable b, Show a, Show b) => Exception (ParseError a b)
class LastToken a b | a -> b where
getLastToken :: (Show b) => a -> Maybe b
class Tok a where
eofToken :: a -> Bool
newtype Parse b c a = Parse { forall b c a. Parse b c a -> ParseState b -> ParseResult b c a
unParse :: ParseState b -> ParseResult b c a }
instance (Loc b, LastToken b c, Show c) => Monad (Parse b c) where
return :: forall a. a -> Parse b c a
return a
a = forall b c a. (ParseState b -> ParseResult b c a) -> Parse b c a
Parse forall a b. (a -> b) -> a -> b
$ \ParseState b
s -> forall b c a. a -> ParseState b -> ParseResult b c a
ParseOk a
a ParseState b
s
(Parse ParseState b -> ParseResult b c a
m) >>= :: forall a b. Parse b c a -> (a -> Parse b c b) -> Parse b c b
>>= a -> Parse b c b
f = forall b c a. (ParseState b -> ParseResult b c a) -> Parse b c a
Parse forall a b. (a -> b) -> a -> b
$ \ParseState b
s ->
case ParseState b -> ParseResult b c a
m ParseState b
s of
ParseOk a
a ParseState b
s' -> forall b c a. Parse b c a -> ParseState b -> ParseResult b c a
unParse (a -> Parse b c b
f a
a) ParseState b
s'
ParseFailed ParseError b c
e -> forall b c a. ParseError b c -> ParseResult b c a
ParseFailed ParseError b c
e
#if !MIN_VERSION_base(4,13,0)
fail = Fail.fail
#endif
instance (Loc b, LastToken b c, Show c) => MonadFail (Parse b c) where
fail :: forall a. String -> Parse b c a
fail String
msg = forall b c a. (ParseState b -> ParseResult b c a) -> Parse b c a
Parse forall a b. (a -> b) -> a -> b
$ \ParseState b
s -> forall b c a. ParseError b c -> ParseResult b c a
ParseFailed ParseError
{ errPos :: Position
errPos = (forall a. Loc a => a -> Position
getPos forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParseState a -> a
psAlexInput) ParseState b
s
, errLastToken :: Maybe c
errLastToken = (forall a b. (LastToken a b, Show b) => a -> Maybe b
getLastToken forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParseState a -> a
psAlexInput) ParseState b
s
, errFilename :: String
errFilename = forall a. ParseState a -> String
psFilename ParseState b
s
, errMsg :: String
errMsg = String
msg }
instance (Loc b, LastToken b c, Show c) => Functor (Parse b c) where
fmap :: forall a b. (a -> b) -> Parse b c a -> Parse b c b
fmap = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
instance (Loc b, LastToken b c, Show c) => Applicative (Parse b c) where
pure :: forall a. a -> Parse b c a
pure = forall (m :: * -> *) a. Monad m => a -> m a
return
<*> :: forall a b. Parse b c (a -> b) -> Parse b c a -> Parse b c b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
instance (Loc b, LastToken b c, Show c) => MonadState (ParseState b) (Parse b c) where
get :: Parse b c (ParseState b)
get = forall b c a. (ParseState b -> ParseResult b c a) -> Parse b c a
Parse forall a b. (a -> b) -> a -> b
$ \ParseState b
s -> forall b c a. a -> ParseState b -> ParseResult b c a
ParseOk ParseState b
s ParseState b
s
put :: ParseState b -> Parse b c ()
put ParseState b
s = forall b c a. (ParseState b -> ParseResult b c a) -> Parse b c a
Parse forall a b. (a -> b) -> a -> b
$ \ParseState b
_ -> forall b c a. a -> ParseState b -> ParseResult b c a
ParseOk () ParseState b
s
instance (Loc b, LastToken b c, Show c) => MonadError (ParseError b c) (Parse b c) where
throwError :: forall a. ParseError b c -> Parse b c a
throwError ParseError b c
e = forall b c a. (ParseState b -> ParseResult b c a) -> Parse b c a
Parse forall a b. (a -> b) -> a -> b
$ \ParseState b
_ -> forall b c a. ParseError b c -> ParseResult b c a
ParseFailed ParseError b c
e
(Parse ParseState b -> ParseResult b c a
m) catchError :: forall a.
Parse b c a -> (ParseError b c -> Parse b c a) -> Parse b c a
`catchError` ParseError b c -> Parse b c a
f = forall b c a. (ParseState b -> ParseResult b c a) -> Parse b c a
Parse forall a b. (a -> b) -> a -> b
$ \ParseState b
s ->
case ParseState b -> ParseResult b c a
m ParseState b
s of
ParseFailed ParseError b c
e -> forall b c a. Parse b c a -> ParseState b -> ParseResult b c a
unParse (ParseError b c -> Parse b c a
f ParseError b c
e) ParseState b
s
ParseResult b c a
m' -> ParseResult b c a
m'
runParse
:: (Loc b, LastToken b c, Show c)
=> Parse b c a -> ParseState b -> ParseResult b c a
runParse :: forall b c a.
(Loc b, LastToken b c, Show c) =>
Parse b c a -> ParseState b -> ParseResult b c a
runParse = forall b c a. Parse b c a -> ParseState b -> ParseResult b c a
unParse
runParseUnsafe
:: (Loc b, LastToken b c, Show c)
=> Parse b c a -> ParseState b -> (a, ParseState b)
runParseUnsafe :: forall b c a.
(Loc b, LastToken b c, Show c) =>
Parse b c a -> ParseState b -> (a, ParseState b)
runParseUnsafe Parse b c a
lexer ParseState b
initState =
case forall b c a. Parse b c a -> ParseState b -> ParseResult b c a
unParse Parse b c a
lexer ParseState b
initState of
ParseOk a
a ParseState b
s -> (a
a, ParseState b
s)
ParseFailed ParseError b c
e -> forall a. String -> a
throwIOError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show ParseError b c
e
throwIOError :: String -> a
throwIOError :: forall a. String -> a
throwIOError String
s = forall a e. Exception e => e -> a
throw
IOError { ioe_handle :: Maybe Handle
ioe_handle = forall a. Maybe a
Nothing
, ioe_type :: IOErrorType
ioe_type = IOErrorType
UserError
, ioe_location :: String
ioe_location = String
"fortran-src"
, ioe_description :: String
ioe_description = String
s
, ioe_errno :: Maybe CInt
ioe_errno = forall a. Maybe a
Nothing
, ioe_filename :: Maybe String
ioe_filename = forall a. Maybe a
Nothing }
evalParse
:: (Loc b, LastToken b c, Show c)
=> Parse b c a -> ParseState b -> a
evalParse :: forall b c a.
(Loc b, LastToken b c, Show c) =>
Parse b c a -> ParseState b -> a
evalParse Parse b c a
m ParseState b
s = forall a b. (a, b) -> a
fst (forall b c a.
(Loc b, LastToken b c, Show c) =>
Parse b c a -> ParseState b -> (a, ParseState b)
runParseUnsafe Parse b c a
m ParseState b
s)
execParse
:: (Loc b, LastToken b c, Show c)
=> Parse b c a -> ParseState b -> ParseState b
execParse :: forall b c a.
(Loc b, LastToken b c, Show c) =>
Parse b c a -> ParseState b -> ParseState b
execParse Parse b c a
m ParseState b
s = forall a b. (a, b) -> b
snd (forall b c a.
(Loc b, LastToken b c, Show c) =>
Parse b c a -> ParseState b -> (a, ParseState b)
runParseUnsafe Parse b c a
m ParseState b
s)
getVersion :: (Loc a, LastToken a b, Show b) => Parse a b FortranVersion
getVersion :: forall a b.
(Loc a, LastToken a b, Show b) =>
Parse a b FortranVersion
getVersion = do
ParseState a
s <- forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ParseState a -> FortranVersion
psVersion ParseState a
s)
putAlex :: (Loc a, LastToken a b, Show b) => a -> Parse a b ()
putAlex :: forall a b. (Loc a, LastToken a b, Show b) => a -> Parse a b ()
putAlex a
ai = do
ParseState a
s <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParseState a
s { psAlexInput :: a
psAlexInput = a
ai })
getAlex :: (Loc a, LastToken a b, Show b) => Parse a b a
getAlex :: forall a b. (Loc a, LastToken a b, Show b) => Parse a b a
getAlex = do
ParseState a
s <- forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ParseState a -> a
psAlexInput ParseState a
s)
topContext :: (Loc a, LastToken a b, Show b) => Parse a b Context
topContext :: forall a b. (Loc a, LastToken a b, Show b) => Parse a b Context
topContext = forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParseState a -> [Context]
psContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
popContext :: (Loc a, LastToken a b, Show b) => Parse a b ()
popContext :: forall a b. (Loc a, LastToken a b, Show b) => Parse a b ()
popContext = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ParseState a
ps -> ParseState a
ps { psContext :: [Context]
psContext = forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. ParseState a -> [Context]
psContext ParseState a
ps }
pushContext :: (Loc a, LastToken a b, Show b) => Context -> Parse a b ()
pushContext :: forall a b.
(Loc a, LastToken a b, Show b) =>
Context -> Parse a b ()
pushContext Context
context = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ParseState a
ps -> ParseState a
ps { psContext :: [Context]
psContext = Context
context forall a. a -> [a] -> [a]
: forall a. ParseState a -> [Context]
psContext ParseState a
ps }
getPosition :: (Loc a, LastToken a b, Show b) => Parse a b Position
getPosition :: forall a b. (Loc a, LastToken a b, Show b) => Parse a b Position
getPosition = do
ParseState a
parseState <- forall s (m :: * -> *). MonadState s m => m s
get
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Loc a => a -> Position
getPos forall a b. (a -> b) -> a -> b
$ forall a. ParseState a -> a
psAlexInput ParseState a
parseState
getSrcSpan :: (Loc a, LastToken a b, Show b) => Position -> Parse a b SrcSpan
getSrcSpan :: forall a b.
(Loc a, LastToken a b, Show b) =>
Position -> Parse a b SrcSpan
getSrcSpan Position
loc1 = do
Position
loc2 <- forall a b. (Loc a, LastToken a b, Show b) => Parse a b Position
getPosition
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Position -> Position -> SrcSpan
SrcSpan Position
loc1 Position
loc2
getParanthesesCount :: (Loc a, LastToken a b, Show b) => Parse a b ParanthesesCount
getParanthesesCount :: forall a b.
(Loc a, LastToken a b, Show b) =>
Parse a b ParanthesesCount
getParanthesesCount = forall a. ParseState a -> ParanthesesCount
psParanthesesCount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *). MonadState s m => m s
get
resetPar :: (Loc a, LastToken a b, Show b) => Parse a b ()
resetPar :: forall a b. (Loc a, LastToken a b, Show b) => Parse a b ()
resetPar = do
ParseState a
ps <- forall s (m :: * -> *). MonadState s m => m s
get
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ ParseState a
ps { psParanthesesCount :: ParanthesesCount
psParanthesesCount = Integer -> Bool -> ParanthesesCount
ParanthesesCount Integer
0 Bool
False }
incPar :: (Loc a, LastToken a b, Show b) => Parse a b ()
incPar :: forall a b. (Loc a, LastToken a b, Show b) => Parse a b ()
incPar = do
ParseState a
ps <- forall s (m :: * -> *). MonadState s m => m s
get
let pc :: ParanthesesCount
pc = forall a. ParseState a -> ParanthesesCount
psParanthesesCount ParseState a
ps
let count :: Integer
count = ParanthesesCount -> Integer
pcActual ParanthesesCount
pc
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ ParseState a
ps { psParanthesesCount :: ParanthesesCount
psParanthesesCount = ParanthesesCount
pc { pcActual :: Integer
pcActual = Integer
count forall a. Num a => a -> a -> a
+ Integer
1 } }
decPar :: (Loc a, LastToken a b, Show b) => Parse a b ()
decPar :: forall a b. (Loc a, LastToken a b, Show b) => Parse a b ()
decPar = do
ParseState a
ps <- forall s (m :: * -> *). MonadState s m => m s
get
let pc :: ParanthesesCount
pc = forall a. ParseState a -> ParanthesesCount
psParanthesesCount ParseState a
ps
let newCount :: Integer
newCount = ParanthesesCount -> Integer
pcActual ParanthesesCount
pc forall a. Num a => a -> a -> a
- Integer
1
let reached0 :: Bool
reached0 = ParanthesesCount -> Bool
pcHasReached0 ParanthesesCount
pc Bool -> Bool -> Bool
|| Integer
newCount forall a. Eq a => a -> a -> Bool
== Integer
0
forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ ParseState a
ps { psParanthesesCount :: ParanthesesCount
psParanthesesCount = Integer -> Bool -> ParanthesesCount
ParanthesesCount Integer
newCount Bool
reached0 }