fortran-src-0.15.1: Parsers and analyses for Fortran standards 66, 77, 90, 95 and 2003 (partial).
Safe HaskellSafe-Inferred
LanguageHaskell2010

Language.Fortran.Analysis

Description

Common data structures and functions supporting analysis of the AST.

Synopsis

Documentation

initAnalysis :: Functor b => b a -> b (Analysis a) Source #

Create analysis annotations for the program, saving the original annotations.

stripAnalysis :: Functor b => b (Analysis a) -> b a Source #

Remove analysis annotations from the program, restoring the original annotations.

data Analysis a Source #

Constructors

Analysis 

Fields

Instances

Instances details
Functor Analysis Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

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

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

Out (Analysis a) Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

docPrec :: Int -> Analysis a -> Doc #

doc :: Analysis a -> Doc #

docList :: [Analysis a] -> Doc #

Data a => Data (Analysis a) Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

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

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

toConstr :: Analysis a -> Constr #

dataTypeOf :: Analysis a -> DataType #

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

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

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

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

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

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

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

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

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

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

Generic (Analysis a) Source # 
Instance details

Defined in Language.Fortran.Analysis

Associated Types

type Rep (Analysis a) :: Type -> Type #

Methods

from :: Analysis a -> Rep (Analysis a) x #

to :: Rep (Analysis a) x -> Analysis a #

Show a => Show (Analysis a) Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

showsPrec :: Int -> Analysis a -> ShowS #

show :: Analysis a -> String #

showList :: [Analysis a] -> ShowS #

Eq a => Eq (Analysis a) Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

(==) :: Analysis a -> Analysis a -> Bool #

(/=) :: Analysis a -> Analysis a -> Bool #

type Rep (Analysis a) Source # 
Instance details

Defined in Language.Fortran.Analysis

varName :: Expression (Analysis a) -> Name Source #

Obtain either uniqueName or sourceName from an ExpValue variable, or an ExpDataRef.

Precedence is as follows:

  • if uniqueName is present, it is returned
  • else if sourceName is present, it is returned
  • else the variable name itself is returned

Crashes on Expressions which don't define a variable.

srcName :: Expression (Analysis a) -> Name Source #

Obtain the source name from an ExpValue variable.

lvVarName :: LValue (Analysis a) -> Name Source #

Obtain either uniqueName or source name from an LvSimpleVar variable.

lvSrcName :: LValue (Analysis a) -> Name Source #

Obtain the source name from an LvSimpleVar variable.

isNamedExpression :: Expression a -> Bool Source #

True iff the expression can be used with varName or srcName

genVar :: Analysis a -> SrcSpan -> Name -> Expression (Analysis a) Source #

Generate an ExpValue variable with its source name == to its uniqueName.

puName :: ProgramUnit (Analysis a) -> ProgramUnitName Source #

Obtain either ProgramUnit uniqueName or whatever is in the AST.

puSrcName :: ProgramUnit (Analysis a) -> ProgramUnitName Source #

Obtain either ProgramUnit sourceName or whatever is in the AST.

blockRhsExprs :: Data a => Block a -> [Expression a] Source #

Set of expressions used -- not defined -- by an AST-block.

rhsExprs :: (Data a, Data (b a)) => b a -> [Expression a] Source #

Return list of expressions that are not "left-hand-side" of assignment statements.

data NameType Source #

Instances

Instances details
Out NameType Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

docPrec :: Int -> NameType -> Doc #

doc :: NameType -> Doc #

docList :: [NameType] -> Doc #

Data NameType Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

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

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

toConstr :: NameType -> Constr #

dataTypeOf :: NameType -> DataType #

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

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

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

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

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

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

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

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

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

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

Generic NameType Source # 
Instance details

Defined in Language.Fortran.Analysis

Associated Types

type Rep NameType :: Type -> Type #

Methods

from :: NameType -> Rep NameType x #

to :: Rep NameType x -> NameType #

Show NameType Source # 
Instance details

Defined in Language.Fortran.Analysis

Binary NameType Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

put :: NameType -> Put #

get :: Get NameType #

putList :: [NameType] -> Put #

Eq NameType Source # 
Instance details

Defined in Language.Fortran.Analysis

Ord NameType Source # 
Instance details

Defined in Language.Fortran.Analysis

type Rep NameType Source # 
Instance details

Defined in Language.Fortran.Analysis

type Rep NameType = D1 ('MetaData "NameType" "Language.Fortran.Analysis" "fortran-src-0.15.1-inplace" 'False) (C1 ('MetaCons "NTSubprogram" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "NTVariable" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "NTIntrinsic" 'PrefixI 'False) (U1 :: Type -> Type)))

data IDType Source #

Constructors

IDType 

Instances

Instances details
Out IDType Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

docPrec :: Int -> IDType -> Doc #

doc :: IDType -> Doc #

docList :: [IDType] -> Doc #

Data IDType Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

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

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

toConstr :: IDType -> Constr #

dataTypeOf :: IDType -> DataType #

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

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

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

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

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

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

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

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

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

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

Generic IDType Source # 
Instance details

Defined in Language.Fortran.Analysis

Associated Types

type Rep IDType :: Type -> Type #

Methods

from :: IDType -> Rep IDType x #

to :: Rep IDType x -> IDType #

Show IDType Source # 
Instance details

Defined in Language.Fortran.Analysis

Binary IDType Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

put :: IDType -> Put #

get :: Get IDType #

putList :: [IDType] -> Put #

Eq IDType Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

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

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

Ord IDType Source # 
Instance details

Defined in Language.Fortran.Analysis

type Rep IDType Source # 
Instance details

Defined in Language.Fortran.Analysis

type Rep IDType = D1 ('MetaData "IDType" "Language.Fortran.Analysis" "fortran-src-0.15.1-inplace" 'False) (C1 ('MetaCons "IDType" 'PrefixI 'True) (S1 ('MetaSel ('Just "idVType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe SemType)) :*: S1 ('MetaSel ('Just "idCType") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe ConstructType))))

data ConstructType Source #

Instances

Instances details
Out ConstructType Source # 
Instance details

Defined in Language.Fortran.Analysis

Data ConstructType Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

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

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

toConstr :: ConstructType -> Constr #

dataTypeOf :: ConstructType -> DataType #

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

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

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

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

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

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

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

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

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

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

Generic ConstructType Source # 
Instance details

Defined in Language.Fortran.Analysis

Associated Types

type Rep ConstructType :: Type -> Type #

Show ConstructType Source # 
Instance details

Defined in Language.Fortran.Analysis

Binary ConstructType Source # 
Instance details

Defined in Language.Fortran.Analysis

Eq ConstructType Source # 
Instance details

Defined in Language.Fortran.Analysis

Ord ConstructType Source # 
Instance details

Defined in Language.Fortran.Analysis

type Rep ConstructType Source # 
Instance details

Defined in Language.Fortran.Analysis

type Rep ConstructType = D1 ('MetaData "ConstructType" "Language.Fortran.Analysis" "fortran-src-0.15.1-inplace" 'False) ((C1 ('MetaCons "CTFunction" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "CTSubroutine" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CTExternal" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "CTVariable" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CTArray" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [(Maybe Int, Maybe Int)]))) :+: (C1 ('MetaCons "CTParameter" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CTIntrinsic" 'PrefixI 'False) (U1 :: Type -> Type))))

lhsExprs :: forall a b. (Data a, Data (b a)) => b a -> [Expression a] Source #

Return list of expressions used as the left-hand-side of assignment statements (including for-loops and function-calls by reference).

isLExpr :: Expression a -> Bool Source #

Is this an expression capable of assignment?

allVars :: forall a b. (Data a, Data (b (Analysis a))) => b (Analysis a) -> [Name] Source #

Set of names found in an AST node.

analyseAllLhsVars :: forall a. Data a => ProgramFile (Analysis a) -> ProgramFile (Analysis a) Source #

Initiate (lazy) computation of all LHS variables for each node of the AST so that it may be accessed later.

analyseAllLhsVars1 :: (Annotated f, Data (f (Analysis a)), Data a) => f (Analysis a) -> f (Analysis a) Source #

allLhsVars :: Data a => Block (Analysis a) -> [Name] Source #

Set of names found in the parts of an AST that are the target of an assignment statement. allLhsVars :: (Annotated b, Data a, Data (b (Analysis a))) => b (Analysis a) -> [Name]

blockVarUses :: forall a. Data a => Block (Analysis a) -> [Name] Source #

Set of names used -- not defined -- by an AST-block.

blockVarDefs :: Data a => Block (Analysis a) -> [Name] Source #

Set of names defined by an AST-block.

type BB a = [Block a] Source #

Basic block

data BBGr a Source #

Basic block graph.

Constructors

BBGr 

Fields

Instances

Instances details
Data a => Data (BBGr a) Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

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

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

toConstr :: BBGr a -> Constr #

dataTypeOf :: BBGr a -> DataType #

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

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

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

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

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

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

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

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

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

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

Generic (BBGr a) Source # 
Instance details

Defined in Language.Fortran.Analysis

Associated Types

type Rep (BBGr a) :: Type -> Type #

Methods

from :: BBGr a -> Rep (BBGr a) x #

to :: Rep (BBGr a) x -> BBGr a #

Show a => Show (BBGr a) Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

showsPrec :: Int -> BBGr a -> ShowS #

show :: BBGr a -> String #

showList :: [BBGr a] -> ShowS #

Eq a => Eq (BBGr a) Source # 
Instance details

Defined in Language.Fortran.Analysis

Methods

(==) :: BBGr a -> BBGr a -> Bool #

(/=) :: BBGr a -> BBGr a -> Bool #

type Rep (BBGr a) Source # 
Instance details

Defined in Language.Fortran.Analysis

type Rep (BBGr a) = D1 ('MetaData "BBGr" "Language.Fortran.Analysis" "fortran-src-0.15.1-inplace" 'False) (C1 ('MetaCons "BBGr" 'PrefixI 'True) (S1 ('MetaSel ('Just "bbgrGr") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Gr (BB a) ())) :*: (S1 ('MetaSel ('Just "bbgrEntries") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Node]) :*: S1 ('MetaSel ('Just "bbgrExits") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Node]))))

bbgrMap :: (Gr (BB a) () -> Gr (BB b) ()) -> BBGr a -> BBGr b Source #

Call function on the underlying graph

bbgrMapM :: Monad m => (Gr (BB a1) () -> m (Gr (BB a2) ())) -> BBGr a1 -> m (BBGr a2) Source #

Monadically call function on the underlying graph

bbgrEmpty :: BBGr a Source #

Empty basic block graph

type TransFunc f g a = (f (Analysis a) -> f (Analysis a)) -> g (Analysis a) -> g (Analysis a) Source #

The type of "transformBi"-family functions

type TransFuncM m f g a = (f (Analysis a) -> m (f (Analysis a))) -> g (Analysis a) -> m (g (Analysis a)) Source #

The type of "transformBiM"-family functions

Orphan instances

(Typeable a, Typeable b) => Data (Gr a b) Source # 
Instance details

Methods

gfoldl :: (forall d b0. Data d => c (d -> b0) -> d -> c b0) -> (forall g. g -> c g) -> Gr a b -> c (Gr a b) #

gunfold :: (forall b0 r. Data b0 => c (b0 -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Gr a b) #

toConstr :: Gr a b -> Constr #

dataTypeOf :: Gr a b -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Gr a b)) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Gr a b)) #

gmapT :: (forall b0. Data b0 => b0 -> b0) -> Gr a b -> Gr a b #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Gr a b -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Gr a b -> r #

gmapQ :: (forall d. Data d => d -> u) -> Gr a b -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Gr a b -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Gr a b -> m (Gr a b) #