language-fortran-0.5.1: Fortran lexer and parser, language support, and extensions.

Safe HaskellNone
LanguageHaskell98

Language.Fortran

Description

Based on FortranP.hs from Parameterized Fortran by Martin Erwig.

Language definition for Fortran (covers a lot of standards, but still incomplete)

The AST is parameterised by type variable p which allows all nodes of the AST to be annotated. The default annotation is (). This is useful for analysis. The Tagged type class provides the function tag :: d a -> a to extract these annotations.

Furthermore, many nodes of the tree have a SrcSpan which is the start and end locations of the syntax in the source file (including whitespace etc.) This is useful for error reporting and refactoring. The Span type class provides the function srcSpan :: d a -> SrcSpan which which extracts the span (where possible)

Synopsis

Documentation

data SrcLoc #

Constructors

SrcLoc 

Instances

Eq SrcLoc # 

Methods

(==) :: SrcLoc -> SrcLoc -> Bool #

(/=) :: SrcLoc -> SrcLoc -> Bool #

Data SrcLoc # 

Methods

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

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

toConstr :: SrcLoc -> Constr #

dataTypeOf :: SrcLoc -> DataType #

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

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

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

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

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

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

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

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

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

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

Show SrcLoc # 

type ProgName = String #

Fortran program names

data SubName p #

Fortran subroutine names

Constructors

SubName p String 
NullSubName p 

Instances

Functor SubName # 

Methods

fmap :: (a -> b) -> SubName a -> SubName b #

(<$) :: a -> SubName b -> SubName a #

Tagged SubName # 

Methods

tag :: SubName a -> a #

Eq p => Eq (SubName p) # 

Methods

(==) :: SubName p -> SubName p -> Bool #

(/=) :: SubName p -> SubName p -> Bool #

Data p => Data (SubName p) # 

Methods

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

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

toConstr :: SubName p -> Constr #

dataTypeOf :: SubName p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (SubName p) # 

Methods

showsPrec :: Int -> SubName p -> ShowS #

show :: SubName p -> String #

showList :: [SubName p] -> ShowS #

PPVersion v => PrintMaster (SubName p) v # 

Methods

printMaster :: SubName p -> String #

data VarName p #

Constructors

VarName p Variable 

Instances

Functor VarName # 

Methods

fmap :: (a -> b) -> VarName a -> VarName b #

(<$) :: a -> VarName b -> VarName a #

Tagged VarName # 

Methods

tag :: VarName a -> a #

Eq p => Eq (VarName p) # 

Methods

(==) :: VarName p -> VarName p -> Bool #

(/=) :: VarName p -> VarName p -> Bool #

Data p => Data (VarName p) # 

Methods

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

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

toConstr :: VarName p -> Constr #

dataTypeOf :: VarName p -> DataType #

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

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

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

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

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

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

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

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

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

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

Read p => Read (VarName p) # 
Show p => Show (VarName p) # 

Methods

showsPrec :: Int -> VarName p -> ShowS #

show :: VarName p -> String #

showList :: [VarName p] -> ShowS #

PPVersion v => PrintMaster (VarName p) v # 

Methods

printMaster :: VarName p -> String #

data ArgName p #

Constructors

ArgName p String 
ASeq p (ArgName p) (ArgName p) 
NullArg p 

Instances

Functor ArgName # 

Methods

fmap :: (a -> b) -> ArgName a -> ArgName b #

(<$) :: a -> ArgName b -> ArgName a #

Tagged ArgName # 

Methods

tag :: ArgName a -> a #

Eq p => Eq (ArgName p) # 

Methods

(==) :: ArgName p -> ArgName p -> Bool #

(/=) :: ArgName p -> ArgName p -> Bool #

Data p => Data (ArgName p) # 

Methods

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

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

toConstr :: ArgName p -> Constr #

dataTypeOf :: ArgName p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (ArgName p) # 

Methods

showsPrec :: Int -> ArgName p -> ShowS #

show :: ArgName p -> String #

showList :: [ArgName p] -> ShowS #

(PrintSlave (VarName p) v, PrintSlave (ArgName p) v, PPVersion v) => PrintMaster (ArgName p) v # 

Methods

printMaster :: ArgName p -> String #

data Arg p #

The src span denotes the end of the arg list before ')'

Constructors

Arg p (ArgName p) SrcSpan 

Instances

Functor Arg # 

Methods

fmap :: (a -> b) -> Arg a -> Arg b #

(<$) :: a -> Arg b -> Arg a #

Tagged Arg # 

Methods

tag :: Arg a -> a #

Eq p => Eq (Arg p) # 

Methods

(==) :: Arg p -> Arg p -> Bool #

(/=) :: Arg p -> Arg p -> Bool #

Data p => Data (Arg p) # 

Methods

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

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

toConstr :: Arg p -> Constr #

dataTypeOf :: Arg p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (Arg p) # 

Methods

showsPrec :: Int -> Arg p -> ShowS #

show :: Arg p -> String #

showList :: [Arg p] -> ShowS #

(PrintSlave (ArgName p) v, PPVersion v) => PrintMaster (Arg p) v # 

Methods

printMaster :: Arg p -> String #

data ArgList p #

Constructors

ArgList p (Expr p) 

Instances

Functor ArgList # 

Methods

fmap :: (a -> b) -> ArgList a -> ArgList b #

(<$) :: a -> ArgList b -> ArgList a #

Tagged ArgList # 

Methods

tag :: ArgList a -> a #

Eq p => Eq (ArgList p) # 

Methods

(==) :: ArgList p -> ArgList p -> Bool #

(/=) :: ArgList p -> ArgList p -> Bool #

Data p => Data (ArgList p) # 

Methods

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

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

toConstr :: ArgList p -> Constr #

dataTypeOf :: ArgList p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (ArgList p) # 

Methods

showsPrec :: Int -> ArgList p -> ShowS #

show :: ArgList p -> String #

showList :: [ArgList p] -> ShowS #

(PrintSlave (Expr p) v, PPVersion v) => PrintMaster (ArgList p) v # 

Methods

printMaster :: ArgList p -> String #

type Program p = [ProgUnit p] #

data ProgUnit p #

Constructors

Main p SrcSpan (SubName p) (Arg p) (Block p) [ProgUnit p] 
Sub p SrcSpan (Maybe (BaseType p)) (SubName p) (Arg p) (Block p) 
Function p SrcSpan (Maybe (BaseType p)) (SubName p) (Arg p) (Maybe (VarName p)) (Block p) 
Module p SrcSpan (SubName p) (Uses p) (Implicit p) (Decl p) [ProgUnit p] 
BlockData p SrcSpan (SubName p) (Uses p) (Implicit p) (Decl p) 
Prog p SrcSpan (ProgUnit p) 
NullProg p SrcSpan 
IncludeProg p SrcSpan (Decl p) (Maybe (Fortran p)) 

Instances

Functor ProgUnit # 

Methods

fmap :: (a -> b) -> ProgUnit a -> ProgUnit b #

(<$) :: a -> ProgUnit b -> ProgUnit a #

Tagged ProgUnit # 

Methods

tag :: ProgUnit a -> a #

Eq p => Eq (ProgUnit p) # 

Methods

(==) :: ProgUnit p -> ProgUnit p -> Bool #

(/=) :: ProgUnit p -> ProgUnit p -> Bool #

Data p => Data (ProgUnit p) # 

Methods

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

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

toConstr :: ProgUnit p -> Constr #

dataTypeOf :: ProgUnit p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (ProgUnit p) # 

Methods

showsPrec :: Int -> ProgUnit p -> ShowS #

show :: ProgUnit p -> String #

showList :: [ProgUnit p] -> ShowS #

Span (ProgUnit a) # 

Methods

srcSpan :: ProgUnit a -> (SrcLoc, SrcLoc) #

(PPVersion v, PrintSlave (ProgUnit p) v) => PrintMaster [ProgUnit p] v # 

Methods

printMaster :: [ProgUnit p] -> String #

(PrintSlave (Arg p) v, PrintSlave (BaseType p) v, PrintSlave (Block p) v, PrintSlave (Decl p) v, PrintSlave (Fortran p) v, PrintSlave (Implicit p) v, PrintSlave (SubName p) v, PrintSlave (VarName p) v, PrintSlave (ProgUnit p) v, PPVersion v) => PrintMaster (ProgUnit p) v # 

Methods

printMaster :: ProgUnit p -> String #

data Implicit p #

Implicit none or no implicit

Constructors

ImplicitNone p 
ImplicitNull p 

Instances

Functor Implicit # 

Methods

fmap :: (a -> b) -> Implicit a -> Implicit b #

(<$) :: a -> Implicit b -> Implicit a #

Tagged Implicit # 

Methods

tag :: Implicit a -> a #

Eq p => Eq (Implicit p) # 

Methods

(==) :: Implicit p -> Implicit p -> Bool #

(/=) :: Implicit p -> Implicit p -> Bool #

Data p => Data (Implicit p) # 

Methods

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

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

toConstr :: Implicit p -> Constr #

dataTypeOf :: Implicit p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (Implicit p) # 

Methods

showsPrec :: Int -> Implicit p -> ShowS #

show :: Implicit p -> String #

showList :: [Implicit p] -> ShowS #

PPVersion v => PrintMaster (Implicit p) v # 

Methods

printMaster :: Implicit p -> String #

type Renames = [(Variable, Variable)] #

renames for "use"s

data UseBlock p #

Constructors

UseBlock (Uses p) SrcLoc 

Instances

Functor UseBlock # 

Methods

fmap :: (a -> b) -> UseBlock a -> UseBlock b #

(<$) :: a -> UseBlock b -> UseBlock a #

Eq p => Eq (UseBlock p) # 

Methods

(==) :: UseBlock p -> UseBlock p -> Bool #

(/=) :: UseBlock p -> UseBlock p -> Bool #

Data p => Data (UseBlock p) # 

Methods

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

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

toConstr :: UseBlock p -> Constr #

dataTypeOf :: UseBlock p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (UseBlock p) # 

Methods

showsPrec :: Int -> UseBlock p -> ShowS #

show :: UseBlock p -> String #

showList :: [UseBlock p] -> ShowS #

(PPVersion v, PrintMaster (Uses p) v) => PrintMaster (UseBlock p) v # 

Methods

printMaster :: UseBlock p -> String #

data Use #

Instances

Eq Use # 

Methods

(==) :: Use -> Use -> Bool #

(/=) :: Use -> Use -> Bool #

Data Use # 

Methods

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

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

toConstr :: Use -> Constr #

dataTypeOf :: Use -> DataType #

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

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

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

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

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

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

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

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

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

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

Show Use # 

Methods

showsPrec :: Int -> Use -> ShowS #

show :: Use -> String #

showList :: [Use] -> ShowS #

data Uses p #

(second p let's you annotate the cons part of the cell)

Constructors

Uses p Use (Uses p) p 
UseNil p 

Instances

Functor Uses # 

Methods

fmap :: (a -> b) -> Uses a -> Uses b #

(<$) :: a -> Uses b -> Uses a #

Tagged Uses # 

Methods

tag :: Uses a -> a #

Eq p => Eq (Uses p) # 

Methods

(==) :: Uses p -> Uses p -> Bool #

(/=) :: Uses p -> Uses p -> Bool #

Data p => Data (Uses p) # 

Methods

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

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

toConstr :: Uses p -> Constr #

dataTypeOf :: Uses p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (Uses p) # 

Methods

showsPrec :: Int -> Uses p -> ShowS #

show :: Uses p -> String #

showList :: [Uses p] -> ShowS #

PPVersion v => PrintMaster (Uses p) v # 

Methods

printMaster :: Uses p -> String #

data Block p #

Constructors

Block p (UseBlock p) (Implicit p) SrcSpan (Decl p) (Fortran p) 

Instances

Functor Block # 

Methods

fmap :: (a -> b) -> Block a -> Block b #

(<$) :: a -> Block b -> Block a #

Eq p => Eq (Block p) # 

Methods

(==) :: Block p -> Block p -> Bool #

(/=) :: Block p -> Block p -> Bool #

Data p => Data (Block p) # 

Methods

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

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

toConstr :: Block p -> Constr #

dataTypeOf :: Block p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (Block p) # 

Methods

showsPrec :: Int -> Block p -> ShowS #

show :: Block p -> String #

showList :: [Block p] -> ShowS #

Span (Block a) # 

Methods

srcSpan :: Block a -> (SrcLoc, SrcLoc) #

(PrintSlave (Fortran p) v, PrintSlave (Decl p) v, PrintSlave (Implicit p) v, PPVersion v) => PrintMaster (Block p) v # 

Methods

printMaster :: Block p -> String #

data Decl p #

Instances

Functor Decl # 

Methods

fmap :: (a -> b) -> Decl a -> Decl b #

(<$) :: a -> Decl b -> Decl a #

Tagged Decl # 

Methods

tag :: Decl a -> a #

Eq p => Eq (Decl p) # 

Methods

(==) :: Decl p -> Decl p -> Bool #

(/=) :: Decl p -> Decl p -> Bool #

Data p => Data (Decl p) # 

Methods

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

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

toConstr :: Decl p -> Constr #

dataTypeOf :: Decl p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (Decl p) # 

Methods

showsPrec :: Int -> Decl p -> ShowS #

show :: Decl p -> String #

showList :: [Decl p] -> ShowS #

Span (Decl a) # 

Methods

srcSpan :: Decl a -> (SrcLoc, SrcLoc) #

(Indentor (Decl p), PrintSlave (Arg p) v, PrintSlave (ArgList p) v, PrintSlave (Attr p) v, PrintSlave (BinOp p) v, PrintSlave (Decl p) v, PrintSlave (DataForm p) v, PrintSlave (Expr p) v, PrintSlave (GSpec p) v, PrintSlave (Implicit p) v, PrintSlave (InterfaceSpec p) v, PrintSlave (MeasureUnitSpec p) v, PrintSlave (SubName p) v, PrintSlave (UnaryOp p) v, PrintSlave (VarName p) v, PrintSlave (Type p) v, PPVersion v) => PrintMaster (Decl p) v # 

Methods

printMaster :: Decl p -> String #

data Type p #

Constructors

BaseType p (BaseType p) [Attr p] (Expr p) (Expr p) 
ArrayT p [(Expr p, Expr p)] (BaseType p) [Attr p] (Expr p) (Expr p) 

Instances

Functor Type # 

Methods

fmap :: (a -> b) -> Type a -> Type b #

(<$) :: a -> Type b -> Type a #

Eq p => Eq (Type p) # 

Methods

(==) :: Type p -> Type p -> Bool #

(/=) :: Type p -> Type p -> Bool #

Data p => Data (Type p) # 

Methods

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

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

toConstr :: Type p -> Constr #

dataTypeOf :: Type p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (Type p) # 

Methods

showsPrec :: Int -> Type p -> ShowS #

show :: Type p -> String #

showList :: [Type p] -> ShowS #

(PrintSlave (ArgList p) v, PrintSlave (BinOp p) v, PrintSlave (UnaryOp p) v, PrintSlave (BaseType p) v, PrintSlave (Expr p) v, PrintSlave (MeasureUnitSpec p) v, PrintSlave (VarName p) v, PPVersion v) => PrintMaster (Type p) v # 

Methods

printMaster :: Type p -> String #

data BaseType p #

Instances

Functor BaseType # 

Methods

fmap :: (a -> b) -> BaseType a -> BaseType b #

(<$) :: a -> BaseType b -> BaseType a #

Tagged BaseType # 

Methods

tag :: BaseType a -> a #

Eq p => Eq (BaseType p) # 

Methods

(==) :: BaseType p -> BaseType p -> Bool #

(/=) :: BaseType p -> BaseType p -> Bool #

Data p => Data (BaseType p) # 

Methods

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

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

toConstr :: BaseType p -> Constr #

dataTypeOf :: BaseType p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (BaseType p) # 

Methods

showsPrec :: Int -> BaseType p -> ShowS #

show :: BaseType p -> String #

showList :: [BaseType p] -> ShowS #

(PrintSlave (SubName p) v, PPVersion v) => PrintMaster (BaseType p) v # 

Methods

printMaster :: BaseType p -> String #

data Attr p #

Instances

Functor Attr # 

Methods

fmap :: (a -> b) -> Attr a -> Attr b #

(<$) :: a -> Attr b -> Attr a #

Tagged Attr # 

Methods

tag :: Attr a -> a #

Eq p => Eq (Attr p) # 

Methods

(==) :: Attr p -> Attr p -> Bool #

(/=) :: Attr p -> Attr p -> Bool #

Data p => Data (Attr p) # 

Methods

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

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

toConstr :: Attr p -> Constr #

dataTypeOf :: Attr p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (Attr p) # 

Methods

showsPrec :: Int -> Attr p -> ShowS #

show :: Attr p -> String #

showList :: [Attr p] -> ShowS #

(PrintSlave (ArgList p) v, PrintSlave (BinOp p) v, PrintSlave (Expr p) v, PrintSlave (UnaryOp p) v, PrintSlave (VarName p) v, PrintSlave (MeasureUnitSpec p) v, PPVersion v) => PrintMaster (Attr p) v # 

Methods

printMaster :: Attr p -> String #

data MeasureUnitSpec p #

Instances

Functor MeasureUnitSpec # 

Methods

fmap :: (a -> b) -> MeasureUnitSpec a -> MeasureUnitSpec b #

(<$) :: a -> MeasureUnitSpec b -> MeasureUnitSpec a #

Eq p => Eq (MeasureUnitSpec p) # 
Data p => Data (MeasureUnitSpec p) # 

Methods

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

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

toConstr :: MeasureUnitSpec p -> Constr #

dataTypeOf :: MeasureUnitSpec p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (MeasureUnitSpec p) # 
PPVersion v => PrintMaster (MeasureUnitSpec p) v # 

data Fraction p #

Instances

Functor Fraction # 

Methods

fmap :: (a -> b) -> Fraction a -> Fraction b #

(<$) :: a -> Fraction b -> Fraction a #

Eq p => Eq (Fraction p) # 

Methods

(==) :: Fraction p -> Fraction p -> Bool #

(/=) :: Fraction p -> Fraction p -> Bool #

Data p => Data (Fraction p) # 

Methods

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

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

toConstr :: Fraction p -> Constr #

dataTypeOf :: Fraction p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (Fraction p) # 

Methods

showsPrec :: Int -> Fraction p -> ShowS #

show :: Fraction p -> String #

showList :: [Fraction p] -> ShowS #

PPVersion v => PrintMaster (Fraction p) v # 

Methods

printMaster :: Fraction p -> String #

data GSpec p #

Constructors

GName p (Expr p) 
GOper p (BinOp p) 
GAssg p 

Instances

Functor GSpec # 

Methods

fmap :: (a -> b) -> GSpec a -> GSpec b #

(<$) :: a -> GSpec b -> GSpec a #

Tagged GSpec # 

Methods

tag :: GSpec a -> a #

Eq p => Eq (GSpec p) # 

Methods

(==) :: GSpec p -> GSpec p -> Bool #

(/=) :: GSpec p -> GSpec p -> Bool #

Data p => Data (GSpec p) # 

Methods

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

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

toConstr :: GSpec p -> Constr #

dataTypeOf :: GSpec p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (GSpec p) # 

Methods

showsPrec :: Int -> GSpec p -> ShowS #

show :: GSpec p -> String #

showList :: [GSpec p] -> ShowS #

(PrintSlave (Arg p) v, PrintSlave (BinOp p) v, PrintSlave (Expr p) v, PPVersion v) => PrintMaster (GSpec p) v # 

Methods

printMaster :: GSpec p -> String #

data InterfaceSpec p #

Constructors

FunctionInterface p (SubName p) (Arg p) (Uses p) (Implicit p) (Decl p) 
SubroutineInterface p (SubName p) (Arg p) (Uses p) (Implicit p) (Decl p) 
ModuleProcedure p [SubName p] 

Instances

Functor InterfaceSpec # 

Methods

fmap :: (a -> b) -> InterfaceSpec a -> InterfaceSpec b #

(<$) :: a -> InterfaceSpec b -> InterfaceSpec a #

Eq p => Eq (InterfaceSpec p) # 
Data p => Data (InterfaceSpec p) # 

Methods

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

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

toConstr :: InterfaceSpec p -> Constr #

dataTypeOf :: InterfaceSpec p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (InterfaceSpec p) # 
(PrintSlave (Arg p) v, PrintSlave (Decl p) v, PrintSlave (Implicit p) v, PrintSlave (SubName p) v, PPVersion v) => PrintMaster (InterfaceSpec p) v # 

data DataForm p #

Constructors

Data p [(Expr p, Expr p)] 

Instances

Functor DataForm # 

Methods

fmap :: (a -> b) -> DataForm a -> DataForm b #

(<$) :: a -> DataForm b -> DataForm a #

Tagged DataForm # 

Methods

tag :: DataForm a -> a #

Eq p => Eq (DataForm p) # 

Methods

(==) :: DataForm p -> DataForm p -> Bool #

(/=) :: DataForm p -> DataForm p -> Bool #

Data p => Data (DataForm p) # 

Methods

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

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

toConstr :: DataForm p -> Constr #

dataTypeOf :: DataForm p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (DataForm p) # 

Methods

showsPrec :: Int -> DataForm p -> ShowS #

show :: DataForm p -> String #

showList :: [DataForm p] -> ShowS #

PrintSlave (Expr p) v => PrintMaster (DataForm p) v # 

Methods

printMaster :: DataForm p -> String #

data IntentAttr p #

Constructors

In p 
Out p 
InOut p 

Instances

Functor IntentAttr # 

Methods

fmap :: (a -> b) -> IntentAttr a -> IntentAttr b #

(<$) :: a -> IntentAttr b -> IntentAttr a #

Eq p => Eq (IntentAttr p) # 

Methods

(==) :: IntentAttr p -> IntentAttr p -> Bool #

(/=) :: IntentAttr p -> IntentAttr p -> Bool #

Data p => Data (IntentAttr p) # 

Methods

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

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

toConstr :: IntentAttr p -> Constr #

dataTypeOf :: IntentAttr p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (IntentAttr p) # 

data Fortran p #

Instances

Functor Fortran # 

Methods

fmap :: (a -> b) -> Fortran a -> Fortran b #

(<$) :: a -> Fortran b -> Fortran a #

Tagged Fortran # 

Methods

tag :: Fortran a -> a #

Eq p => Eq (Fortran p) # 

Methods

(==) :: Fortran p -> Fortran p -> Bool #

(/=) :: Fortran p -> Fortran p -> Bool #

Data p => Data (Fortran p) # 

Methods

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

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

toConstr :: Fortran p -> Constr #

dataTypeOf :: Fortran p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (Fortran p) # 

Methods

showsPrec :: Int -> Fortran p -> ShowS #

show :: Fortran p -> String #

showList :: [Fortran p] -> ShowS #

Span (Fortran a) # 

Methods

srcSpan :: Fortran a -> (SrcLoc, SrcLoc) #

(Indentor (Fortran p), PrintSlave (VarName p) v, PrintSlave (Expr p) v, PrintSlave (UnaryOp p) v, PrintSlave (BinOp p) v, PrintSlave (ArgList p) v, PrintIndSlave (Fortran p) v, PrintSlave (DataForm p) v, PrintSlave (Fortran p) v, PrintSlave (Spec p) v, PPVersion v) => PrintIndMaster (Fortran p) v # 

Methods

printIndMaster :: Int -> Fortran p -> String #

(PrintIndMaster (Fortran p) v, PPVersion v) => PrintMaster (Fortran p) v # 

Methods

printMaster :: Fortran p -> String #

data Expr p #

Instances

Functor Expr # 

Methods

fmap :: (a -> b) -> Expr a -> Expr b #

(<$) :: a -> Expr b -> Expr a #

Tagged Expr # 

Methods

tag :: Expr a -> a #

Eq p => Eq (Expr p) # 

Methods

(==) :: Expr p -> Expr p -> Bool #

(/=) :: Expr p -> Expr p -> Bool #

Data p => Data (Expr p) # 

Methods

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

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

toConstr :: Expr p -> Constr #

dataTypeOf :: Expr p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (Expr p) # 

Methods

showsPrec :: Int -> Expr p -> ShowS #

show :: Expr p -> String #

showList :: [Expr p] -> ShowS #

Span (Expr a) # 

Methods

srcSpan :: Expr a -> (SrcLoc, SrcLoc) #

(PrintSlave (ArgList p) v, PrintSlave (BinOp p) v, PrintSlave (Expr p) v, PrintSlave (UnaryOp p) v, PrintSlave (VarName p) v, PPVersion v) => PrintMaster (Expr p) v # 

Methods

printMaster :: Expr p -> String #

data BinOp p #

Constructors

Plus p 
Minus p 
Mul p 
Div p 
Or p 
And p 
Concat p 
Power p 
RelEQ p 
RelNE p 
RelLT p 
RelLE p 
RelGT p 
RelGE p 

Instances

Functor BinOp # 

Methods

fmap :: (a -> b) -> BinOp a -> BinOp b #

(<$) :: a -> BinOp b -> BinOp a #

Eq p => Eq (BinOp p) # 

Methods

(==) :: BinOp p -> BinOp p -> Bool #

(/=) :: BinOp p -> BinOp p -> Bool #

Data p => Data (BinOp p) # 

Methods

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

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

toConstr :: BinOp p -> Constr #

dataTypeOf :: BinOp p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (BinOp p) # 

Methods

showsPrec :: Int -> BinOp p -> ShowS #

show :: BinOp p -> String #

showList :: [BinOp p] -> ShowS #

PPVersion v => PrintMaster (BinOp p) v # 

Methods

printMaster :: BinOp p -> String #

data UnaryOp p #

Constructors

UMinus p 
Not p 

Instances

Functor UnaryOp # 

Methods

fmap :: (a -> b) -> UnaryOp a -> UnaryOp b #

(<$) :: a -> UnaryOp b -> UnaryOp a #

Eq p => Eq (UnaryOp p) # 

Methods

(==) :: UnaryOp p -> UnaryOp p -> Bool #

(/=) :: UnaryOp p -> UnaryOp p -> Bool #

Data p => Data (UnaryOp p) # 

Methods

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

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

toConstr :: UnaryOp p -> Constr #

dataTypeOf :: UnaryOp p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (UnaryOp p) # 

Methods

showsPrec :: Int -> UnaryOp p -> ShowS #

show :: UnaryOp p -> String #

showList :: [UnaryOp p] -> ShowS #

PPVersion v => PrintMaster (UnaryOp p) v # 

Methods

printMaster :: UnaryOp p -> String #

data Spec p #

Constructors

Access p (Expr p) 
Action p (Expr p) 
Advance p (Expr p) 
Blank p (Expr p) 
Delim p (Expr p) 
Direct p (Expr p) 
End p (Expr p) 
Err p (Expr p) 
ExFile p (Expr p) 
Exist p (Expr p) 
Eor p (Expr p) 
File p (Expr p) 
FMT p (Expr p) 
Form p (Expr p) 
Formatted p (Expr p) 
Unformatted p (Expr p) 
IOLength p (Expr p) 
IOStat p (Expr p) 
Name p (Expr p) 
Named p (Expr p) 
NoSpec p (Expr p) 
Number p (Expr p) 
Floating p (Expr p) (Expr p) 
NextRec p (Expr p) 
NML p (Expr p) 
Opened p (Expr p) 
Pad p (Expr p) 
Position p (Expr p) 
Read p (Expr p) 
ReadWrite p (Expr p) 
Rec p (Expr p) 
Recl p (Expr p) 
Sequential p (Expr p) 
Size p (Expr p) 
Status p (Expr p) 
StringLit p String 
Unit p (Expr p) 
WriteSp p (Expr p) 
Delimiter p 

Instances

Functor Spec # 

Methods

fmap :: (a -> b) -> Spec a -> Spec b #

(<$) :: a -> Spec b -> Spec a #

Eq p => Eq (Spec p) # 

Methods

(==) :: Spec p -> Spec p -> Bool #

(/=) :: Spec p -> Spec p -> Bool #

Data p => Data (Spec p) # 

Methods

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

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

toConstr :: Spec p -> Constr #

dataTypeOf :: Spec p -> DataType #

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

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

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

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

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

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

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

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

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

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

Show p => Show (Spec p) # 

Methods

showsPrec :: Int -> Spec p -> ShowS #

show :: Spec p -> String #

showList :: [Spec p] -> ShowS #

(PrintSlave (Expr p) v, PPVersion v) => PrintMaster (Spec p) v # 

Methods

printMaster :: Spec p -> String #

class Span t where #

Minimal complete definition

srcSpan

Methods

srcSpan :: t -> (SrcLoc, SrcLoc) #

Instances

Span (Expr a) # 

Methods

srcSpan :: Expr a -> (SrcLoc, SrcLoc) #

Span (Fortran a) # 

Methods

srcSpan :: Fortran a -> (SrcLoc, SrcLoc) #

Span (Decl a) # 

Methods

srcSpan :: Decl a -> (SrcLoc, SrcLoc) #

Span (Block a) # 

Methods

srcSpan :: Block a -> (SrcLoc, SrcLoc) #

Span (ProgUnit a) # 

Methods

srcSpan :: ProgUnit a -> (SrcLoc, SrcLoc) #

class Tagged d where #

Minimal complete definition

tag

Methods

tag :: d a -> a #

Instances

Tagged Expr # 

Methods

tag :: Expr a -> a #

Tagged Fortran # 

Methods

tag :: Fortran a -> a #

Tagged DataForm # 

Methods

tag :: DataForm a -> a #

Tagged GSpec # 

Methods

tag :: GSpec a -> a #

Tagged Attr # 

Methods

tag :: Attr a -> a #

Tagged BaseType # 

Methods

tag :: BaseType a -> a #

Tagged Decl # 

Methods

tag :: Decl a -> a #

Tagged Uses # 

Methods

tag :: Uses a -> a #

Tagged Implicit # 

Methods

tag :: Implicit a -> a #

Tagged ProgUnit # 

Methods

tag :: ProgUnit a -> a #

Tagged ArgList # 

Methods

tag :: ArgList a -> a #

Tagged Arg # 

Methods

tag :: Arg a -> a #

Tagged ArgName # 

Methods

tag :: ArgName a -> a #

Tagged VarName # 

Methods

tag :: VarName a -> a #

Tagged SubName # 

Methods

tag :: SubName a -> a #