fortran-src-0.2.1.1: Parser and anlyses for Fortran standards 66, 77, 90 and 95.

Safe HaskellSafe
LanguageHaskell2010

Language.Fortran.ParserMonad

Documentation

data FortranVersion Source #

Instances

Eq FortranVersion Source # 
Data FortranVersion Source # 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> FortranVersion -> c FortranVersion #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c FortranVersion #

toConstr :: FortranVersion -> Constr #

dataTypeOf :: FortranVersion -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c FortranVersion) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FortranVersion) #

gmapT :: (forall b. Data b => b -> b) -> FortranVersion -> FortranVersion #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> FortranVersion -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> FortranVersion -> r #

gmapQ :: (forall d. Data d => d -> u) -> FortranVersion -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> FortranVersion -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> FortranVersion -> m FortranVersion #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> FortranVersion -> m FortranVersion #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> FortranVersion -> m FortranVersion #

Ord FortranVersion Source # 
Show FortranVersion Source # 
Generic FortranVersion Source # 

Associated Types

type Rep FortranVersion :: * -> * #

type Rep FortranVersion Source # 
type Rep FortranVersion = D1 * (MetaData "FortranVersion" "Language.Fortran.ParserMonad" "fortran-src-0.2.1.1-4CSp5fVEmo08Ygy2mwA6e4" False) ((:+:) * ((:+:) * ((:+:) * (C1 * (MetaCons "Fortran66" PrefixI False) (U1 *)) (C1 * (MetaCons "Fortran77" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "Fortran77Extended" PrefixI False) (U1 *)) (C1 * (MetaCons "Fortran77Legacy" PrefixI False) (U1 *)))) ((:+:) * ((:+:) * (C1 * (MetaCons "Fortran90" PrefixI False) (U1 *)) (C1 * (MetaCons "Fortran95" PrefixI False) (U1 *))) ((:+:) * (C1 * (MetaCons "Fortran2003" PrefixI False) (U1 *)) (C1 * (MetaCons "Fortran2008" PrefixI False) (U1 *)))))

data ParseState a Source #

Instances

Show a => Show (ParseState a) Source # 
(Loc b, LastToken b c, Show c) => MonadState (ParseState b) (Parse b c) Source # 

Methods

get :: Parse b c (ParseState b) #

put :: ParseState b -> Parse b c () #

state :: (ParseState b -> (a, ParseState b)) -> Parse b c a #

data ParseError a b Source #

Instances

Show b => Show (ParseError a b) Source # 

Methods

showsPrec :: Int -> ParseError a b -> ShowS #

show :: ParseError a b -> String #

showList :: [ParseError a b] -> ShowS #

(Typeable * a, Typeable * b, Show a, Show b) => Exception (ParseError a b) Source # 
(Loc b, LastToken b c, Show c) => MonadError (ParseError b c) (Parse b c) Source # 

Methods

throwError :: ParseError b c -> Parse b c a #

catchError :: Parse b c a -> (ParseError b c -> Parse b c a) -> Parse b c a #

tokenMsg :: Show a => Maybe a -> [Char] Source #

data ParseResult b c a Source #

Constructors

ParseOk a (ParseState b) 
ParseFailed (ParseError b c) 

Instances

Functor (ParseResult b c) Source # 

Methods

fmap :: (a -> b) -> ParseResult b c a -> ParseResult b c b #

(<$) :: a -> ParseResult b c b -> ParseResult b c a #

fromRight :: Show a => Either a b -> b Source #

class LastToken a b | a -> b where Source #

Minimal complete definition

getLastToken

Methods

getLastToken :: Show b => a -> Maybe b Source #

newtype Parse b c a Source #

Constructors

Parse 

Fields

Instances

(Loc b, LastToken b c, Show c) => MonadState (ParseState b) (Parse b c) Source # 

Methods

get :: Parse b c (ParseState b) #

put :: ParseState b -> Parse b c () #

state :: (ParseState b -> (a, ParseState b)) -> Parse b c a #

(Loc b, LastToken b c, Show c) => Monad (Parse b c) Source # 

Methods

(>>=) :: Parse b c a -> (a -> Parse b c b) -> Parse b c b #

(>>) :: Parse b c a -> Parse b c b -> Parse b c b #

return :: a -> Parse b c a #

fail :: String -> Parse b c a #

(Loc b, LastToken b c, Show c) => Functor (Parse b c) Source # 

Methods

fmap :: (a -> b) -> Parse b c a -> Parse b c b #

(<$) :: a -> Parse b c b -> Parse b c a #

(Loc b, LastToken b c, Show c) => Applicative (Parse b c) Source # 

Methods

pure :: a -> Parse b c a #

(<*>) :: Parse b c (a -> b) -> Parse b c a -> Parse b c b #

liftA2 :: (a -> b -> c) -> Parse b c a -> Parse b c b -> Parse b c c #

(*>) :: Parse b c a -> Parse b c b -> Parse b c b #

(<*) :: Parse b c a -> Parse b c b -> Parse b c a #

(Loc b, LastToken b c, Show c) => MonadError (ParseError b c) (Parse b c) Source # 

Methods

throwError :: ParseError b c -> Parse b c a #

catchError :: Parse b c a -> (ParseError b c -> Parse b c a) -> Parse b c a #

putAlex :: (Loc a, LastToken a b, Show b) => a -> Parse a b () Source #

getAlex :: (Loc a, LastToken a b, Show b) => Parse a b a Source #

popContext :: (Loc a, LastToken a b, Show b) => Parse a b () Source #

pushContext :: (Loc a, LastToken a b, Show b) => Context -> Parse a b () Source #

resetPar :: (Loc a, LastToken a b, Show b) => Parse a b () Source #

incPar :: (Loc a, LastToken a b, Show b) => Parse a b () Source #

decPar :: (Loc a, LastToken a b, Show b) => Parse a b () Source #

runParse :: (Loc b, LastToken b c, Show c) => Parse b c a -> ParseState b -> ParseResult b c a Source #

runParseUnsafe :: (Loc b, LastToken b c, Show c) => Parse b c a -> ParseState b -> (a, ParseState b) Source #

evalParse :: (Loc b, LastToken b c, Show c) => Parse b c a -> ParseState b -> a Source #

execParse :: (Loc b, LastToken b c, Show c) => Parse b c a -> ParseState b -> ParseState b Source #

class Tok a where Source #

Minimal complete definition

eofToken

Methods

eofToken :: a -> Bool Source #

Instances

collectTokens :: forall a b. (Loc b, Tok a, LastToken b a, Show a) => Parse b a a -> ParseState b -> [a] Source #

collectTokensSafe :: forall a b. (Loc b, Tok a, LastToken b a, Show a) => Parse b a a -> ParseState b -> Maybe [a] Source #