camfort-0.804: CamFort - Cambridge Fortran infrastructure

Safe HaskellNone
LanguageHaskell2010

Camfort.Analysis.Syntax

Contents

Description

This module provides a number of helper functions for working with Fortran syntax that are useful between different analyses and transformations.

Synopsis

Comparison and ordering

data AnnotationFree t Source #

AnnotationFree is a data type that wraps other types and denotes terms which should be compared for equality modulo their annotations and source location information

Constructors

AnnotationFree 

Fields

Instances

Eq (AnnotationFree Char) Source # 
Eq (AnnotationFree Int) Source # 
Eq (AnnotationFree a) => Eq (AnnotationFree [a]) Source # 
(Eq (AnnotationFree a), Eq (AnnotationFree b)) => Eq (AnnotationFree (a, b)) Source # 

Methods

(==) :: AnnotationFree (a, b) -> AnnotationFree (a, b) -> Bool #

(/=) :: AnnotationFree (a, b) -> AnnotationFree (a, b) -> Bool #

Eq (AnnotationFree (SubName p)) Source # 
Eq (AnnotationFree (Type a)) Source # 
Eq (AnnotationFree (BaseType p)) Source # 
Eq (AnnotationFree (Attr p)) Source # 
Eq (AnnotationFree (MeasureUnitSpec p)) Source # 
Eq (AnnotationFree (Fraction p)) Source # 
Eq (AnnotationFree (IntentAttr p)) Source # 
Eq (AnnotationFree (Expr a)) Source # 
Eq (AnnotationFree (AccessP ())) Source # 
Show t => Show (AnnotationFree t) Source # 

af :: t -> AnnotationFree t Source #

short-hand constructor for AnnotationFree

unaf :: AnnotationFree t -> t Source #

short-hand deconstructor for AnnotationFree

eraseSrcLocs :: (Typeable (t a), Data (t a)) => t a -> t a Source #

A helpful function, used by the 'Eq AnnotationFree' instance that resets and source location information

setCompactSrcLocs :: (Typeable (t a), Data (t a)) => t a -> t a Source #

Sets the SrcLoc information to have the filename "compact" which triggers a special compact form of pretty printing in the Show SrcLoc instances

lower :: [Char] -> [Char] Source #

Accessor functions for extracting various pieces of information out of syntax trees

getSubName :: ProgUnit p -> Maybe String Source #

Extracts the subprocedure name from a program unit

accesses :: Data from => from -> [AccessP ()] Source #

Extracts all accessors (variables and array indexing) from a piece of syntax

varExprToVariable :: Expr a -> Maybe Variable Source #

Extracts a string of the (root) variable name from a variable expression (if it is indeed a variable expression

varExprToAccess :: Expr a -> Maybe Access Source #

Extracts an accessor form a variable from a variable expression

varExprToAccesses :: Expr a -> [Access] Source #

Extracts all accessors from a variable expression e.g., varExprToAccess on the syntax tree coming from a(i, j) returns a list of [VarA "a", VarA "i", VarA "j"]

class Successors t where Source #

Minimal complete definition

successorsRoot, successors

Methods

successorsRoot :: t a -> [t a] Source #

Computes the root successor from the current

successors :: (Eq a, Typeable a) => Zipper (ProgUnit a) -> [t a] Source #

Computes the successors nodes of a CFG (described by a zipper) for certain node types

rhsExpr :: Fortran Annotation -> [Expr Annotation] Source #

extract all 'right-hand side' expressions e.g. rhsExpr (parse "x = e") = parse "e"

lhsExpr :: Fortran Annotation -> [Expr Annotation] Source #

extract all 'left-hand side' expressions e.g. rhsExpr (parse "x = e") = parse "x"

Various simple analyses

numberStmts :: ProgUnit Annotation -> ProgUnit Annotation Source #

Numbers all the statements in a program unit (successively) which is useful for analysis output

variables :: Data from => from -> [[Char]] Source #

All variables from a Fortran syntax tree

isConstant :: Expr p -> Bool Source #

A predicate on whether an expression is actually a constant constructor

freeVariables :: (Data (t a), Data a) => t a -> [String] Source #

Free-variables in a piece of Fortran syntax

binders :: forall a t. (Data (t a), Typeable (t a), Data a, Typeable a) => t a -> [String] Source #

All variables from binders

affineMatch :: (Read t1, Num t1) => Expr t -> Maybe (Variable, t1) Source #

Tests whether an expression is an affine transformation (without scaling) on some variable, if so returns the variable and the translation factor

An embedded domain-specific language for describing syntax tree queries

data QueryCmd t where Source #

QueryCmd provides commands of which pieces of syntax to find

from :: forall t synTyp. (Data t, Data synTyp) => QueryCmd synTyp -> t -> [synTyp] Source #

from takes a command as its first parameter, a piece of syntax as its second, and returns all pieces of syntax matching the query request.

For example: from Decls x returns a list of all declarations in x, of type [Decl Annotation] If x is itself a declaration then this is returned as well (so be careful with recursive functions over things defined in turns of from. See topFrom for a solution to this.

topFrom :: forall t synTyp. (Data t, Data synTyp) => QueryCmd synTyp -> t -> [synTyp] Source #

topFrom takes a command as first parameter, a piece of syntax as its second, and returns all pieces of syntax matching the query request that are *children* of the current piece of syntax. This means that it will not return itself.

Orphan instances

Monoid Int Source #

Set a default monoid instances for Int

Methods

mempty :: Int #

mappend :: Int -> Int -> Int #

mconcat :: [Int] -> Int #

Eq p => Ord (Expr p) Source #

Partial-ordering for expressions (constructors only so far), ignores annotations

Methods

compare :: Expr p -> Expr p -> Ordering #

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

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

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

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

max :: Expr p -> Expr p -> Expr p #

min :: Expr p -> Expr p -> Expr p #

Ord (AccessP ()) Source #

Ordering on accessor syntax

Methods

compare :: AccessP () -> AccessP () -> Ordering #

(<) :: AccessP () -> AccessP () -> Bool #

(<=) :: AccessP () -> AccessP () -> Bool #

(>) :: AccessP () -> AccessP () -> Bool #

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

max :: AccessP () -> AccessP () -> AccessP () #

min :: AccessP () -> AccessP () -> AccessP () #