Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Data types for representing Fortran code (for various versions of Fortran).
The same representation is used for all supported Fortran standards. Constructs only available in certain versions are gated by the parsers (and the pretty printer). In general, the definitions here are highly permissible, partly to allow for all the oddities of older standards & extensions.
Useful Fortran standard references:
- Fortran 2018 standard: WD 1539-1 J3/18-007r1
- Fortran 2008 standard: WD 1539-1 J3/10-007r1
- Fortran 90 standard: ANSI X3.198-1992 (also ISO/IEC 1539:1991)
- Fortran 90 Handbook (J. Adams)
- Fortran 77 standard: ANSI X3.9-1978
Synopsis
- data ProgramFile a = ProgramFile {}
- data ProgramUnit a
- = PUMain a SrcSpan (Maybe Name) [Block a] (Maybe [ProgramUnit a])
- | PUModule a SrcSpan Name [Block a] (Maybe [ProgramUnit a])
- | PUSubroutine a SrcSpan (PrefixSuffix a) Name (Maybe (AList Expression a)) [Block a] (Maybe [ProgramUnit a])
- | PUFunction a SrcSpan (Maybe (TypeSpec a)) (PrefixSuffix a) Name (Maybe (AList Expression a)) (Maybe (Expression a)) [Block a] (Maybe [ProgramUnit a])
- | PUBlockData a SrcSpan (Maybe Name) [Block a]
- | PUComment a SrcSpan (Comment a)
- data Block a
- = BlStatement a SrcSpan (Maybe (Expression a)) (Statement a)
- | BlForall a SrcSpan (Maybe (Expression a)) (Maybe String) (ForallHeader a) [Block a] (Maybe (Expression a))
- | BlIf a SrcSpan (Maybe (Expression a)) (Maybe String) (NonEmpty (Expression a, [Block a])) (Maybe [Block a]) (Maybe (Expression a))
- | BlCase a SrcSpan (Maybe (Expression a)) (Maybe String) (Expression a) [(AList Index a, [Block a])] (Maybe [Block a]) (Maybe (Expression a))
- | BlDo a SrcSpan (Maybe (Expression a)) (Maybe String) (Maybe (Expression a)) (Maybe (DoSpecification a)) [Block a] (Maybe (Expression a))
- | BlDoWhile a SrcSpan (Maybe (Expression a)) (Maybe String) (Maybe (Expression a)) (Expression a) [Block a] (Maybe (Expression a))
- | BlAssociate a SrcSpan (Maybe (Expression a)) (Maybe String) (AList (ATuple Expression Expression) a) [Block a] (Maybe (Expression a))
- | BlInterface a SrcSpan (Maybe (Expression a)) Bool [ProgramUnit a] [Block a]
- | BlComment a SrcSpan (Comment a)
- data Statement a
- = StDeclaration a SrcSpan (TypeSpec a) (Maybe (AList Attribute a)) (AList Declarator a)
- | StStructure a SrcSpan (Maybe String) (AList StructureItem a)
- | StIntent a SrcSpan Intent (AList Expression a)
- | StOptional a SrcSpan (AList Expression a)
- | StPublic a SrcSpan (Maybe (AList Expression a))
- | StPrivate a SrcSpan (Maybe (AList Expression a))
- | StProtected a SrcSpan (Maybe (AList Expression a))
- | StSave a SrcSpan (Maybe (AList Expression a))
- | StDimension a SrcSpan (AList Declarator a)
- | StAllocatable a SrcSpan (AList Declarator a)
- | StAsynchronous a SrcSpan (AList Declarator a)
- | StPointer a SrcSpan (AList Declarator a)
- | StTarget a SrcSpan (AList Declarator a)
- | StValue a SrcSpan (AList Declarator a)
- | StVolatile a SrcSpan (AList Declarator a)
- | StData a SrcSpan (AList DataGroup a)
- | StAutomatic a SrcSpan (AList Declarator a)
- | StStatic a SrcSpan (AList Declarator a)
- | StNamelist a SrcSpan (AList Namelist a)
- | StParameter a SrcSpan (AList Declarator a)
- | StExternal a SrcSpan (AList Expression a)
- | StIntrinsic a SrcSpan (AList Expression a)
- | StCommon a SrcSpan (AList CommonGroup a)
- | StEquivalence a SrcSpan (AList (AList Expression) a)
- | StFormat a SrcSpan (AList FormatItem a)
- | StImplicit a SrcSpan (Maybe (AList ImpList a))
- | StEntry a SrcSpan (Expression a) (Maybe (AList Expression a)) (Maybe (Expression a))
- | StInclude a SrcSpan (Expression a) (Maybe [Block a])
- | StDo a SrcSpan (Maybe String) (Maybe (Expression a)) (Maybe (DoSpecification a))
- | StDoWhile a SrcSpan (Maybe String) (Maybe (Expression a)) (Expression a)
- | StEnddo a SrcSpan (Maybe String)
- | StCycle a SrcSpan (Maybe (Expression a))
- | StExit a SrcSpan (Maybe (Expression a))
- | StIfLogical a SrcSpan (Expression a) (Statement a)
- | StIfArithmetic a SrcSpan (Expression a) (Expression a) (Expression a) (Expression a)
- | StSelectCase a SrcSpan (Maybe String) (Expression a)
- | StCase a SrcSpan (Maybe String) (Maybe (AList Index a))
- | StEndcase a SrcSpan (Maybe String)
- | StFunction a SrcSpan (Expression a) (AList Expression a) (Expression a)
- | StExpressionAssign a SrcSpan (Expression a) (Expression a)
- | StPointerAssign a SrcSpan (Expression a) (Expression a)
- | StLabelAssign a SrcSpan (Expression a) (Expression a)
- | StGotoUnconditional a SrcSpan (Expression a)
- | StGotoAssigned a SrcSpan (Expression a) (Maybe (AList Expression a))
- | StGotoComputed a SrcSpan (AList Expression a) (Expression a)
- | StCall a SrcSpan (Expression a) (AList Argument a)
- | StReturn a SrcSpan (Maybe (Expression a))
- | StContinue a SrcSpan
- | StStop a SrcSpan (Maybe (Expression a))
- | StPause a SrcSpan (Maybe (Expression a))
- | StRead a SrcSpan (AList ControlPair a) (Maybe (AList Expression a))
- | StRead2 a SrcSpan (Expression a) (Maybe (AList Expression a))
- | StWrite a SrcSpan (AList ControlPair a) (Maybe (AList Expression a))
- | StPrint a SrcSpan (Expression a) (Maybe (AList Expression a))
- | StTypePrint a SrcSpan (Expression a) (Maybe (AList Expression a))
- | StOpen a SrcSpan (AList ControlPair a)
- | StClose a SrcSpan (AList ControlPair a)
- | StFlush a SrcSpan (AList FlushSpec a)
- | StInquire a SrcSpan (AList ControlPair a)
- | StRewind a SrcSpan (AList ControlPair a)
- | StRewind2 a SrcSpan (Expression a)
- | StBackspace a SrcSpan (AList ControlPair a)
- | StBackspace2 a SrcSpan (Expression a)
- | StEndfile a SrcSpan (AList ControlPair a)
- | StEndfile2 a SrcSpan (Expression a)
- | StAllocate a SrcSpan (Maybe (TypeSpec a)) (AList Expression a) (Maybe (AList AllocOpt a))
- | StNullify a SrcSpan (AList Expression a)
- | StDeallocate a SrcSpan (AList Expression a) (Maybe (AList AllocOpt a))
- | StWhere a SrcSpan (Expression a) (Statement a)
- | StWhereConstruct a SrcSpan (Maybe String) (Expression a)
- | StElsewhere a SrcSpan (Maybe String) (Maybe (Expression a))
- | StEndWhere a SrcSpan (Maybe String)
- | StUse a SrcSpan (Expression a) (Maybe ModuleNature) Only (Maybe (AList Use a))
- | StModuleProcedure a SrcSpan (AList Expression a)
- | StProcedure a SrcSpan (Maybe (ProcInterface a)) (Maybe (AList Attribute a)) (AList ProcDecl a)
- | StType a SrcSpan (Maybe (AList Attribute a)) String
- | StEndType a SrcSpan (Maybe String)
- | StSequence a SrcSpan
- | StForall a SrcSpan (Maybe String) (ForallHeader a)
- | StEndForall a SrcSpan (Maybe String)
- | StForallStatement a SrcSpan (ForallHeader a) (Statement a)
- | StImport a SrcSpan (AList Expression a)
- | StEnum a SrcSpan
- | StEnumerator a SrcSpan (AList Declarator a)
- | StEndEnum a SrcSpan
- | StFormatBogus a SrcSpan String
- data Expression a
- = ExpValue a SrcSpan (Value a)
- | ExpBinary a SrcSpan BinaryOp (Expression a) (Expression a)
- | ExpUnary a SrcSpan UnaryOp (Expression a)
- | ExpSubscript a SrcSpan (Expression a) (AList Index a)
- | ExpDataRef a SrcSpan (Expression a) (Expression a)
- | ExpFunctionCall a SrcSpan (Expression a) (AList Argument a)
- | ExpImpliedDo a SrcSpan (AList Expression a) (DoSpecification a)
- | ExpInitialisation a SrcSpan (AList Expression a)
- | ExpReturnSpec a SrcSpan (Expression a)
- data Index a
- = IxSingle a SrcSpan (Maybe String) (Expression a)
- | IxRange a SrcSpan (Maybe (Expression a)) (Maybe (Expression a)) (Maybe (Expression a))
- data Value a
- = ValInteger String (Maybe (KindParam a))
- | ValReal RealLit (Maybe (KindParam a))
- | ValComplex (ComplexLit a)
- | ValString String
- | ValBoz Boz
- | ValHollerith String
- | ValVariable Name
- | ValIntrinsic Name
- | ValLogical Bool (Maybe (KindParam a))
- | ValOperator String
- | ValAssignment
- | ValType String
- | ValStar
- | ValColon
- data KindParam a
- = KindParamInt a SrcSpan String
- | KindParamVar a SrcSpan Name
- data ComplexPart a
- = ComplexPartReal a SrcSpan RealLit (Maybe (KindParam a))
- | ComplexPartInt a SrcSpan String (Maybe (KindParam a))
- | ComplexPartNamed a SrcSpan Name
- data UnaryOp
- data BinaryOp
- = Addition
- | Subtraction
- | Multiplication
- | Division
- | Exponentiation
- | Concatenation
- | GT
- | GTE
- | LT
- | LTE
- | EQ
- | NE
- | Or
- | XOr
- | And
- | Equivalent
- | NotEquivalent
- | BinCustom String
- type Name = String
- data BaseType
- data TypeSpec a = TypeSpec {
- typeSpecAnno :: a
- typeSpecSpan :: SrcSpan
- typeSpecBaseType :: BaseType
- typeSpecSelector :: Maybe (Selector a)
- data Selector a = Selector {
- selectorAnno :: a
- selectorSpan :: SrcSpan
- selectorLength :: Maybe (Expression a)
- selectorKind :: Maybe (Expression a)
- data Declarator a = Declarator {
- declaratorAnno :: a
- declaratorSpan :: SrcSpan
- declaratorVariable :: Expression a
- declaratorType :: DeclaratorType a
- declaratorLength :: Maybe (Expression a)
- declaratorInitial :: Maybe (Expression a)
- data DeclaratorType a
- data DimensionDeclarator a = DimensionDeclarator {
- dimDeclAnno :: a
- dimDeclSpan :: SrcSpan
- dimDeclLower :: Maybe (Expression a)
- dimDeclUpper :: Maybe (Expression a)
- module Language.Fortran.AST.AList
- data Attribute a
- = AttrAllocatable a SrcSpan
- | AttrAsynchronous a SrcSpan
- | AttrDimension a SrcSpan (AList DimensionDeclarator a)
- | AttrExternal a SrcSpan
- | AttrIntent a SrcSpan Intent
- | AttrIntrinsic a SrcSpan
- | AttrOptional a SrcSpan
- | AttrParameter a SrcSpan
- | AttrPointer a SrcSpan
- | AttrPrivate a SrcSpan
- | AttrProtected a SrcSpan
- | AttrPublic a SrcSpan
- | AttrSave a SrcSpan
- | AttrSuffix a SrcSpan (Suffix a)
- | AttrTarget a SrcSpan
- | AttrValue a SrcSpan
- | AttrVolatile a SrcSpan
- data Prefix a
- = PfxRecursive a SrcSpan
- | PfxElemental a SrcSpan
- | PfxPure a SrcSpan
- data Suffix a = SfxBind a SrcSpan (Maybe (Expression a))
- data ProcDecl a = ProcDecl {
- procDeclAnno :: a
- procDeclSpan :: SrcSpan
- procDeclEntityName :: Expression a
- procDeclInitName :: Maybe (Expression a)
- data ProcInterface a
- = ProcInterfaceName a SrcSpan (Expression a)
- | ProcInterfaceType a SrcSpan (TypeSpec a)
- newtype Comment a = Comment String
- data ForallHeader a = ForallHeader {}
- data ForallHeaderPart a = ForallHeaderPart {}
- data Only
- data MetaInfo = MetaInfo {}
- type Prefixes a = Maybe (AList Prefix a)
- type Suffixes a = Maybe (AList Suffix a)
- type PrefixSuffix a = (Prefixes a, Suffixes a)
- data ModuleNature
- data Use a
- = UseRename a SrcSpan (Expression a) (Expression a)
- | UseID a SrcSpan (Expression a)
- data Argument a = Argument {}
- data ArgumentExpression a
- = ArgExpr (Expression a)
- | ArgExprVar a SrcSpan Name
- argExprNormalize :: ArgumentExpression a -> Expression a
- argExtractExpr :: Argument a -> Expression a
- data Intent
- data ControlPair a = ControlPair {}
- data AllocOpt a
- = AOStat a SrcSpan (Expression a)
- | AOErrMsg a SrcSpan (Expression a)
- | AOSource a SrcSpan (Expression a)
- data ImpList a = ImpList {
- impListAnno :: a
- impListSpan :: SrcSpan
- impListType :: TypeSpec a
- impListElements :: AList ImpElement a
- data ImpElement a = ImpElement {}
- data CommonGroup a = CommonGroup {
- commonGroupAnno :: a
- commonGroupSpan :: SrcSpan
- commonGroupName :: Maybe (Expression a)
- commonGroupVars :: AList Declarator a
- data Namelist a = Namelist {
- namelistAnno :: a
- namelistSpan :: SrcSpan
- namelistName :: Expression a
- namelistVars :: AList Expression a
- data DataGroup a = DataGroup {}
- data StructureItem a
- = StructFields a SrcSpan (TypeSpec a) (Maybe (AList Attribute a)) (AList Declarator a)
- | StructUnion a SrcSpan (AList UnionMap a)
- | StructStructure a SrcSpan (Maybe String) String (AList StructureItem a)
- data UnionMap a = UnionMap {
- unionMapAnno :: a
- unionMapSpan :: SrcSpan
- unionMapFields :: AList StructureItem a
- data FormatItem a
- = FIFormatList a SrcSpan (Maybe String) (AList FormatItem a)
- | FIHollerith a SrcSpan (Value a)
- | FIDelimiter a SrcSpan
- | FIFieldDescriptorDEFG a SrcSpan (Maybe Integer) Char Integer Integer
- | FIFieldDescriptorAIL a SrcSpan (Maybe Integer) Char Integer
- | FIBlankDescriptor a SrcSpan Integer
- | FIScaleFactor a SrcSpan Integer
- data FlushSpec a
- = FSUnit a SrcSpan (Expression a)
- | FSIOStat a SrcSpan (Expression a)
- | FSIOMsg a SrcSpan (Expression a)
- | FSErr a SrcSpan (Expression a)
- data DoSpecification a = DoSpecification {
- doSpecAnno :: a
- doSpecSpan :: SrcSpan
- doSpecInitial :: Statement a
- doSpecLimit :: Expression a
- doSpecIncrement :: Maybe (Expression a)
- data ProgramUnitName
- type A0 = ()
- class Annotated f where
- getAnnotation :: f a -> a
- setAnnotation :: a -> f a -> f a
- modifyAnnotation :: (a -> a) -> f a -> f a
- class Labeled f where
- getLabel :: f a -> Maybe (Expression a)
- getLastLabel :: f a -> Maybe (Expression a)
- setLabel :: f a -> Expression a -> f a
- class Named a where
- getName :: a -> ProgramUnitName
- setName :: ProgramUnitName -> a -> a
- validPrefixSuffix :: PrefixSuffix a -> Bool
- emptyPrefixes :: Prefixes a
- emptySuffixes :: Suffixes a
- emptyPrefixSuffix :: PrefixSuffix a
- nonExecutableStatement :: FortranVersion -> Statement a -> Bool
- nonExecutableStatementBlock :: FortranVersion -> Block a -> Bool
- executableStatement :: FortranVersion -> Statement a -> Bool
- executableStatementBlock :: FortranVersion -> Block a -> Bool
- setInitialisation :: Declarator a -> Expression a -> Declarator a
- pfSetFilename :: String -> ProgramFile a -> ProgramFile a
- pfGetFilename :: ProgramFile a -> String
- programUnitBody :: ProgramUnit a -> [Block a]
- updateProgramUnitBody :: ProgramUnit a -> [Block a] -> ProgramUnit a
- programUnitSubprograms :: ProgramUnit a -> Maybe [ProgramUnit a]
- data NonEmpty a = a :| [a]
AST nodes and types
Statements and expressions
data ProgramFile a Source #
Instances
data ProgramUnit a Source #
A Fortran program unit. _(F2008 2.2)_
A Fortran program is made up of many program units.
Related points from the Fortran 2008 specification:
- There must be exactly one main program, and any number of other program units.
- Note 2.3: There may be at most 1 unnamed block data program unit.
PUMain | Main program |
PUModule | Module |
| |
PUSubroutine | Subroutine subprogram (procedure) |
| |
PUFunction | Function subprogram (procedure) |
| |
PUBlockData | Block data (named or unnamed). |
PUComment a SrcSpan (Comment a) | Program unit-level comment |
Instances
BlStatement | Statement |
| |
BlForall | FORALL array assignment syntax |
| |
BlIf | IF block construct |
| |
BlCase | SELECT CASE construct |
| |
BlDo | |
| |
BlDoWhile | |
| |
BlAssociate | The first |
| |
BlInterface | |
| |
BlComment a SrcSpan (Comment a) | Block-level comment |
Instances
StDeclaration | Declare variable(s) at a given type. |
StStructure | A structure (pre-F90 extension) declaration. |
| |
StIntent a SrcSpan Intent (AList Expression a) | |
StOptional a SrcSpan (AList Expression a) | |
StPublic a SrcSpan (Maybe (AList Expression a)) | |
StPrivate a SrcSpan (Maybe (AList Expression a)) | |
StProtected a SrcSpan (Maybe (AList Expression a)) | |
StSave | SAVE statement: variable retains its value between invocations |
| |
StDimension a SrcSpan (AList Declarator a) | DIMENSION attribute as statement. |
StAllocatable a SrcSpan (AList Declarator a) | ALLOCATABLE attribute statement. |
StAsynchronous a SrcSpan (AList Declarator a) | ASYNCHRONOUS attribute statement. |
StPointer a SrcSpan (AList Declarator a) | POINTER attribute statement. |
StTarget a SrcSpan (AList Declarator a) | TARGET attribute statement. |
StValue a SrcSpan (AList Declarator a) | VALUE attribute statement. |
StVolatile a SrcSpan (AList Declarator a) | VOLATILE attribute statement. |
StData a SrcSpan (AList DataGroup a) | |
StAutomatic a SrcSpan (AList Declarator a) | |
StStatic a SrcSpan (AList Declarator a) | |
StNamelist a SrcSpan (AList Namelist a) | |
StParameter a SrcSpan (AList Declarator a) | PARAMETER attribute as statement. |
StExternal a SrcSpan (AList Expression a) | |
StIntrinsic a SrcSpan (AList Expression a) | |
StCommon a SrcSpan (AList CommonGroup a) | A COMMON statement, defining a list of common blocks. |
StEquivalence a SrcSpan (AList (AList Expression) a) | |
StFormat a SrcSpan (AList FormatItem a) | |
StImplicit a SrcSpan (Maybe (AList ImpList a)) | |
StEntry | |
| |
StInclude | |
| |
StDo a SrcSpan (Maybe String) (Maybe (Expression a)) (Maybe (DoSpecification a)) | |
StDoWhile a SrcSpan (Maybe String) (Maybe (Expression a)) (Expression a) | |
StEnddo a SrcSpan (Maybe String) | |
StCycle a SrcSpan (Maybe (Expression a)) | guaranteed |
StExit a SrcSpan (Maybe (Expression a)) | |
StIfLogical | |
| |
StIfArithmetic a SrcSpan (Expression a) (Expression a) (Expression a) (Expression a) | |
StSelectCase | CASE construct opener. |
| |
StCase | inner CASE clause |
StEndcase | END SELECT statement |
StFunction a SrcSpan (Expression a) (AList Expression a) (Expression a) | |
StExpressionAssign a SrcSpan (Expression a) (Expression a) | |
StPointerAssign a SrcSpan (Expression a) (Expression a) | |
StLabelAssign a SrcSpan (Expression a) (Expression a) | |
StGotoUnconditional a SrcSpan (Expression a) | |
StGotoAssigned a SrcSpan (Expression a) (Maybe (AList Expression a)) | |
StGotoComputed a SrcSpan (AList Expression a) (Expression a) | |
StCall a SrcSpan (Expression a) (AList Argument a) | |
StReturn a SrcSpan (Maybe (Expression a)) | |
StContinue a SrcSpan | |
StStop a SrcSpan (Maybe (Expression a)) | |
StPause a SrcSpan (Maybe (Expression a)) | |
StRead a SrcSpan (AList ControlPair a) (Maybe (AList Expression a)) | |
StRead2 a SrcSpan (Expression a) (Maybe (AList Expression a)) | |
StWrite a SrcSpan (AList ControlPair a) (Maybe (AList Expression a)) | |
StPrint a SrcSpan (Expression a) (Maybe (AList Expression a)) | |
StTypePrint | Special TYPE "print" statement (~F77 syntactic sugar for PRINT/WRITE) Not to be confused with the TYPE construct in later standards for defining derived data types. |
| |
StOpen a SrcSpan (AList ControlPair a) | |
StClose a SrcSpan (AList ControlPair a) | |
StFlush a SrcSpan (AList FlushSpec a) | |
StInquire a SrcSpan (AList ControlPair a) | |
StRewind a SrcSpan (AList ControlPair a) | |
StRewind2 a SrcSpan (Expression a) | |
StBackspace a SrcSpan (AList ControlPair a) | |
StBackspace2 a SrcSpan (Expression a) | |
StEndfile a SrcSpan (AList ControlPair a) | |
StEndfile2 a SrcSpan (Expression a) | |
StAllocate | ALLOCATE: associate pointers with targets |
StNullify | NULLIFY: disassociate pointers from targets |
| |
StDeallocate | DEALLOCATE: disassociate pointers from targets |
StWhere | |
| |
StWhereConstruct | begin WHERE block |
| |
StElsewhere | WHERE clause. compare to IF, IF ELSE |
| |
StEndWhere | end WHERE block |
StUse | Import definitions (procedures, types) from a module. (F2018 14.2.2) If a module nature isn't provided and there are both intrinsic and nonintrinsic modules with that name, the nonintrinsic module is selected. |
| |
StModuleProcedure a SrcSpan (AList Expression a) | procedure names, guaranteed |
StProcedure a SrcSpan (Maybe (ProcInterface a)) (Maybe (AList Attribute a)) (AList ProcDecl a) | |
StType | TYPE ... = begin a DDT (derived data type) definition block |
StEndType | END TYPE [ type-name ] = end a DDT definition block |
StSequence a SrcSpan | |
StForall | FORALL ... = begin a FORALL block |
| |
StEndForall | END FORALL [ construct-name ] |
StForallStatement | FORALL statement - essentially an inline FORALL block |
| |
StImport a SrcSpan (AList Expression a) | guaranteed |
StEnum a SrcSpan | |
StEnumerator a SrcSpan (AList Declarator a) | |
StEndEnum a SrcSpan | |
StFormatBogus a SrcSpan String |
Instances
data Expression a Source #
ExpValue a SrcSpan (Value a) | Use a value as an expression. |
ExpBinary a SrcSpan BinaryOp (Expression a) (Expression a) | A binary operator applied to two expressions. |
ExpUnary a SrcSpan UnaryOp (Expression a) | A unary operator applied to one expression. |
ExpSubscript a SrcSpan (Expression a) (AList Index a) | Array indexing |
ExpDataRef a SrcSpan (Expression a) (Expression a) |
|
ExpFunctionCall a SrcSpan (Expression a) (AList Argument a) | A function expression applied to a list of arguments. |
ExpImpliedDo a SrcSpan (AList Expression a) (DoSpecification a) | Implied do (i.e. one-liner do loops) |
ExpInitialisation a SrcSpan (AList Expression a) | Array initialisation |
ExpReturnSpec a SrcSpan (Expression a) | Function return value specification |
Instances
IxSingle a SrcSpan (Maybe String) (Expression a) | |
IxRange | |
|
Instances
Values and literals.
Note that KindParam
kind parameters may only be available on certain
Fortran parsers. The fixed form parsers (F77, F66) may not parse them.
ValInteger String (Maybe (KindParam a)) | The string representation of an integer literal |
ValReal RealLit (Maybe (KindParam a)) | The string representation of a real literal |
ValComplex (ComplexLit a) | The real and imaginary parts of a complex literal |
ValString String | A string literal |
ValBoz Boz | A BOZ literal constant |
ValHollerith String | A Hollerith literal |
ValVariable Name | The name of a variable |
ValIntrinsic Name | The name of a built-in function |
ValLogical Bool (Maybe (KindParam a)) | A boolean value |
ValOperator String | User-defined operators in interfaces |
ValAssignment | Overloaded assignment in interfaces |
ValType String | |
ValStar | |
ValColon |
Instances
KindParamInt a SrcSpan String | [0-9]+ |
KindParamVar a SrcSpan Name |
|
Instances
data ComplexPart a Source #
A part (either real or imaginary) of a complex literal.
Since Fortran 2003, complex literal parts support named constants, which must be resolved in context at compile time (R422, R423).
Some compilers also allow constant expressions for the parts, and must evaluate at compile time. That's not allowed in any standard. Apparently, gfortran and ifort don't allow it, while nvfortran does. See: https://fortran-lang.discourse.group/t/complex-constants-and-variables/2909/3
We specifically avoid supporting that by defining complex parts without being
mutually recursive with Expression
.
ComplexPartReal a SrcSpan RealLit (Maybe (KindParam a)) | signed real lit |
ComplexPartInt a SrcSpan String (Maybe (KindParam a)) | signed int lit |
ComplexPartNamed a SrcSpan Name | named constant |
Instances
Instances
Out UnaryOp Source # | |
Data UnaryOp Source # | |
Defined in Language.Fortran.AST gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> UnaryOp -> c UnaryOp # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c UnaryOp # toConstr :: UnaryOp -> Constr # dataTypeOf :: UnaryOp -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c UnaryOp) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UnaryOp) # gmapT :: (forall b. Data b => b -> b) -> UnaryOp -> UnaryOp # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> UnaryOp -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> UnaryOp -> r # gmapQ :: (forall d. Data d => d -> u) -> UnaryOp -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> UnaryOp -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> UnaryOp -> m UnaryOp # | |
Generic UnaryOp Source # | |
Show UnaryOp Source # | |
Binary UnaryOp Source # | |
NFData UnaryOp Source # | |
Defined in Language.Fortran.AST | |
Pretty UnaryOp Source # | |
Defined in Language.Fortran.PrettyPrint | |
Eq UnaryOp Source # | |
Ord UnaryOp Source # | |
type Rep UnaryOp Source # | |
Defined in Language.Fortran.AST type Rep UnaryOp = D1 ('MetaData "UnaryOp" "Language.Fortran.AST" "fortran-src-0.15.1-inplace" 'False) ((C1 ('MetaCons "Plus" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Minus" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Not" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "UnCustom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)))) |
Addition | |
Subtraction | |
Multiplication | |
Division | |
Exponentiation | |
Concatenation | |
GT | |
GTE | |
LT | |
LTE | |
EQ | |
NE | |
Or | |
XOr | |
And | |
Equivalent | |
NotEquivalent | |
BinCustom String |
Instances
Out BinaryOp Source # | |
Data BinaryOp Source # | |
Defined in Language.Fortran.AST gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> BinaryOp -> c BinaryOp # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c BinaryOp # toConstr :: BinaryOp -> Constr # dataTypeOf :: BinaryOp -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c BinaryOp) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BinaryOp) # gmapT :: (forall b. Data b => b -> b) -> BinaryOp -> BinaryOp # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BinaryOp -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BinaryOp -> r # gmapQ :: (forall d. Data d => d -> u) -> BinaryOp -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> BinaryOp -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> BinaryOp -> m BinaryOp # | |
Generic BinaryOp Source # | |
Show BinaryOp Source # | |
Binary BinaryOp Source # | |
NFData BinaryOp Source # | |
Defined in Language.Fortran.AST | |
Pretty BinaryOp Source # | |
Defined in Language.Fortran.PrettyPrint | |
Eq BinaryOp Source # | |
Ord BinaryOp Source # | |
Defined in Language.Fortran.AST | |
type Rep BinaryOp Source # | |
Defined in Language.Fortran.AST type Rep BinaryOp = D1 ('MetaData "BinaryOp" "Language.Fortran.AST" "fortran-src-0.15.1-inplace" 'False) ((((C1 ('MetaCons "Addition" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Subtraction" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Multiplication" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Division" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "Exponentiation" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Concatenation" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "GT" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "GTE" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "LT" 'PrefixI 'False) (U1 :: Type -> Type))))) :+: (((C1 ('MetaCons "LTE" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "EQ" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "NE" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Or" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "XOr" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "And" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "Equivalent" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "NotEquivalent" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "BinCustom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String))))))) |
Types and declarations
Type name referenced in syntax.
In many Fortran specs and compilers, certain types are actually "synonyms" for other types with specified kinds. The primary example is DOUBLE PRECISION being equivalent to REAL(8). Type kinds were introduced in Fortran 90, and it should be safe to replace all instances of DOUBLE PRECISION with REAL(8) in Fortran 90 code. However, type kinds weren't present in (standard) Fortran 77, so this equivalence was detached from the user.
In any case, it's unclear how strong the equivalence is and whether it can
be retroactively applied to previous standards. We choose to parse types
directly, and handle those transformations during type analysis, where we
assign most scalars a kind (see SemType
).
TypeInteger | |
TypeReal | |
TypeDoublePrecision | |
TypeComplex | |
TypeDoubleComplex | |
TypeLogical | |
TypeCharacter | |
TypeCustom String | |
ClassStar | |
ClassCustom String | |
TypeByte |
Instances
Out BaseType Source # | |
Data BaseType Source # | |
Defined in Language.Fortran.AST gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> BaseType -> c BaseType # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c BaseType # toConstr :: BaseType -> Constr # dataTypeOf :: BaseType -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c BaseType) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c BaseType) # gmapT :: (forall b. Data b => b -> b) -> BaseType -> BaseType # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> BaseType -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> BaseType -> r # gmapQ :: (forall d. Data d => d -> u) -> BaseType -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> BaseType -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> BaseType -> m BaseType # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> BaseType -> m BaseType # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> BaseType -> m BaseType # | |
Generic BaseType Source # | |
Show BaseType Source # | |
Binary BaseType Source # | |
NFData BaseType Source # | |
Defined in Language.Fortran.AST | |
Pretty BaseType Source # | |
Defined in Language.Fortran.PrettyPrint | |
Eq BaseType Source # | |
Ord BaseType Source # | |
Defined in Language.Fortran.AST | |
type Rep BaseType Source # | |
Defined in Language.Fortran.AST type Rep BaseType = D1 ('MetaData "BaseType" "Language.Fortran.AST" "fortran-src-0.15.1-inplace" 'False) (((C1 ('MetaCons "TypeInteger" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TypeReal" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "TypeDoublePrecision" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "TypeComplex" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TypeDoubleComplex" 'PrefixI 'False) (U1 :: Type -> Type)))) :+: ((C1 ('MetaCons "TypeLogical" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "TypeCharacter" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "TypeCustom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)))) :+: (C1 ('MetaCons "ClassStar" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "ClassCustom" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String)) :+: C1 ('MetaCons "TypeByte" 'PrefixI 'False) (U1 :: Type -> Type))))) |
The type specification of a declaration statement, containing the syntactic type name and kind selector.
See HP's F90 spec pg.24.
TypeSpec | |
|
Instances
The "kind selector" of a declaration statement. Tightly bound to
TypeSpec
.
HP's F90 spec (pg.24) actually differentiates between "kind selectors" and
"char selectors", where char selectors can specify a length (alongside kind),
and the default meaning of an unlabelled kind parameter (the 8 in INTEGER(8))
is length instead of kind. We handle this correctly in the parsers, but place
both into this Selector
type.
The upshot is, length is invalid for non-CHARACTER types, and the parser guarantees that it will be Nothing. For CHARACTER types, both maybe or may not be present.
Often used with the assumption that when a Selector
term is present, it
contains some information (i.e. one of length or kind is
), so that
the awkward "empty" possibility may be avoided.Just
_
Selector | |
|
Instances
Functor Selector Source # | |
Annotated Selector Source # | |
Defined in Language.Fortran.AST getAnnotation :: Selector a -> a Source # setAnnotation :: a -> Selector a -> Selector a Source # modifyAnnotation :: (a -> a) -> Selector a -> Selector a Source # | |
Out a => Out (Selector a) Source # | |
Data a => Data (Selector a) Source # | |
Defined in Language.Fortran.AST gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Selector a -> c (Selector a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Selector a) # toConstr :: Selector a -> Constr # dataTypeOf :: Selector a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Selector a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Selector a)) # gmapT :: (forall b. Data b => b -> b) -> Selector a -> Selector a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Selector a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Selector a -> r # gmapQ :: (forall d. Data d => d -> u) -> Selector a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Selector a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Selector a -> m (Selector a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Selector a -> m (Selector a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Selector a -> m (Selector a) # | |
Generic (Selector a) Source # | |
Show a => Show (Selector a) Source # | |
NFData a => NFData (Selector a) Source # | |
Defined in Language.Fortran.AST | |
Pretty (Selector a) Source # | Note that this instance is tightly bound with |
Defined in Language.Fortran.PrettyPrint | |
Spanned (Selector a) Source # | |
Eq a => Eq (Selector a) Source # | |
FirstParameter (Selector a) a Source # | |
Defined in Language.Fortran.AST getFirstParameter :: Selector a -> a Source # setFirstParameter :: a -> Selector a -> Selector a Source # | |
SecondParameter (Selector a) SrcSpan Source # | |
Defined in Language.Fortran.AST | |
type Rep (Selector a) Source # | |
Defined in Language.Fortran.AST type Rep (Selector a) = D1 ('MetaData "Selector" "Language.Fortran.AST" "fortran-src-0.15.1-inplace" 'False) (C1 ('MetaCons "Selector" 'PrefixI 'True) ((S1 ('MetaSel ('Just "selectorAnno") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: S1 ('MetaSel ('Just "selectorSpan") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SrcSpan)) :*: (S1 ('MetaSel ('Just "selectorLength") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (Expression a))) :*: S1 ('MetaSel ('Just "selectorKind") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (Expression a)))))) |
data Declarator a Source #
Declarators. R505 entity-decl from F90 ISO spec.
Declaration statements can have multiple variables on the right of the double
colon, separated by commas. A Declarator
identifies a single one of these.
In F90, they look like this:
VAR_NAME ( OPT_ARRAY_DIMS ) * CHAR_LENGTH_EXPR = INIT_EXPR
F77 doesn't standardize so nicely -- in particular, I'm not confident in initializing expression syntax. So no example.
Only CHARACTERs may specify a length. However, a nonstandard syntax feature uses non-CHARACTER lengths as a kind parameter. We parse regardless of type and warn during analysis.
Declarator | |
|
Instances
data DeclaratorType a Source #
Instances
data DimensionDeclarator a Source #
Dimension declarator stored in dimension
attributes and Declarator
s.
DimensionDeclarator | |
|
Instances
Annotated node list (re-export)
module Language.Fortran.AST.AList
Other
Instances
Instances
SfxBind a SrcSpan (Maybe (Expression a)) |
Instances
Functor Suffix Source # | |
Out a => Out (Suffix a) Source # | |
Data a => Data (Suffix a) Source # | |
Defined in Language.Fortran.AST gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Suffix a -> c (Suffix a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Suffix a) # toConstr :: Suffix a -> Constr # dataTypeOf :: Suffix a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Suffix a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Suffix a)) # gmapT :: (forall b. Data b => b -> b) -> Suffix a -> Suffix a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Suffix a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Suffix a -> r # gmapQ :: (forall d. Data d => d -> u) -> Suffix a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Suffix a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Suffix a -> m (Suffix a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Suffix a -> m (Suffix a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Suffix a -> m (Suffix a) # | |
Generic (Suffix a) Source # | |
Show a => Show (Suffix a) Source # | |
NFData a => NFData (Suffix a) Source # | |
Defined in Language.Fortran.AST | |
Pretty (Suffix a) Source # | |
Defined in Language.Fortran.PrettyPrint | |
Spanned (Suffix a) Source # | |
Eq a => Eq (Suffix a) Source # | |
FirstParameter (Suffix a) a Source # | |
Defined in Language.Fortran.AST getFirstParameter :: Suffix a -> a Source # setFirstParameter :: a -> Suffix a -> Suffix a Source # | |
SecondParameter (Suffix a) SrcSpan Source # | |
Defined in Language.Fortran.AST | |
type Rep (Suffix a) Source # | |
Defined in Language.Fortran.AST type Rep (Suffix a) = D1 ('MetaData "Suffix" "Language.Fortran.AST" "fortran-src-0.15.1-inplace" 'False) (C1 ('MetaCons "SfxBind" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 SrcSpan) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe (Expression a)))))) |
ProcDecl | |
|
Instances
data ProcInterface a Source #
ProcInterfaceName a SrcSpan (Expression a) | |
ProcInterfaceType a SrcSpan (TypeSpec a) |
Instances
Instances
Functor (Comment :: TYPE LiftedRep -> TYPE LiftedRep) Source # | |
Out a => Out (Comment a) Source # | |
(Typeable a, Typeable k) => Data (Comment a) Source # | |
Defined in Language.Fortran.AST gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Comment a -> c (Comment a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Comment a) # toConstr :: Comment a -> Constr # dataTypeOf :: Comment a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (Comment a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Comment a)) # gmapT :: (forall b. Data b => b -> b) -> Comment a -> Comment a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Comment a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Comment a -> r # gmapQ :: (forall d. Data d => d -> u) -> Comment a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Comment a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Comment a -> m (Comment a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Comment a -> m (Comment a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Comment a -> m (Comment a) # | |
Generic (Comment a) Source # | |
Show (Comment a) Source # | |
NFData a => NFData (Comment a) Source # | |
Defined in Language.Fortran.AST | |
Eq (Comment a) Source # | |
type Rep (Comment a) Source # | |
Defined in Language.Fortran.AST |
data ForallHeader a Source #
Part of a FORALL statement. Introduced in Fortran 95.
ForallHeader | |
|
Instances
data ForallHeaderPart a Source #
Instances
Instances
Out Only Source # | |
Data Only Source # | |
Defined in Language.Fortran.AST gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Only -> c Only # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Only # dataTypeOf :: Only -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Only) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Only) # gmapT :: (forall b. Data b => b -> b) -> Only -> Only # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Only -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Only -> r # gmapQ :: (forall d. Data d => d -> u) -> Only -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Only -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Only -> m Only # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Only -> m Only # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Only -> m Only # | |
Generic Only Source # | |
Show Only Source # | |
NFData Only Source # | |
Defined in Language.Fortran.AST | |
Pretty Only Source # | |
Defined in Language.Fortran.PrettyPrint | |
Eq Only Source # | |
type Rep Only Source # | |
Instances
Out MetaInfo Source # | |
Data MetaInfo Source # | |
Defined in Language.Fortran.AST gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> MetaInfo -> c MetaInfo # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c MetaInfo # toConstr :: MetaInfo -> Constr # dataTypeOf :: MetaInfo -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c MetaInfo) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MetaInfo) # gmapT :: (forall b. Data b => b -> b) -> MetaInfo -> MetaInfo # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> MetaInfo -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> MetaInfo -> r # gmapQ :: (forall d. Data d => d -> u) -> MetaInfo -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> MetaInfo -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> MetaInfo -> m MetaInfo # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> MetaInfo -> m MetaInfo # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> MetaInfo -> m MetaInfo # | |
Generic MetaInfo Source # | |
Show MetaInfo Source # | |
NFData MetaInfo Source # | |
Defined in Language.Fortran.AST | |
Eq MetaInfo Source # | |
type Rep MetaInfo Source # | |
Defined in Language.Fortran.AST type Rep MetaInfo = D1 ('MetaData "MetaInfo" "Language.Fortran.AST" "fortran-src-0.15.1-inplace" 'False) (C1 ('MetaCons "MetaInfo" 'PrefixI 'True) (S1 ('MetaSel ('Just "miVersion") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 FortranVersion) :*: S1 ('MetaSel ('Just "miFilename") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 String))) |
type PrefixSuffix a = (Prefixes a, Suffixes a) Source #
data ModuleNature Source #
Instances
Part of USE statement. (F2018 14.2.2)
Expressions may be names or operators.
UseRename | |
| |
UseID a SrcSpan (Expression a) | name |
Instances
Argument | |
|
Instances
data ArgumentExpression a Source #
Extra data type to disambiguate between plain variable arguments and expression arguments (due to apparent behaviour of some Fortran compilers to treat these differently).
Note the Annotated
and Spanned
instances pass to the inner Expression
for ArgExpr
.
ArgExpr (Expression a) | |
ArgExprVar a SrcSpan Name |
Instances
argExprNormalize :: ArgumentExpression a -> Expression a Source #
argExtractExpr :: Argument a -> Expression a Source #
Instances
Out Intent Source # | |
Data Intent Source # | |
Defined in Language.Fortran.AST gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Intent -> c Intent # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Intent # toConstr :: Intent -> Constr # dataTypeOf :: Intent -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c Intent) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Intent) # gmapT :: (forall b. Data b => b -> b) -> Intent -> Intent # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Intent -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Intent -> r # gmapQ :: (forall d. Data d => d -> u) -> Intent -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> Intent -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> Intent -> m Intent # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Intent -> m Intent # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Intent -> m Intent # | |
Generic Intent Source # | |
Show Intent Source # | |
NFData Intent Source # | |
Defined in Language.Fortran.AST | |
Pretty Intent Source # | |
Defined in Language.Fortran.PrettyPrint | |
Eq Intent Source # | |
type Rep Intent Source # | |
Defined in Language.Fortran.AST |
data ControlPair a Source #
ControlPair | |
|
Instances
Part of ALLOCATE statement.
There are restrictions on how ALLOCATE options can be combined. See F2018 9.7.1, or: https://www.intel.com/content/www/us/en/develop/documentation/fortran-compiler-oneapi-dev-guide-and-reference/top/language-reference/a-to-z-reference/a-to-b/allocate-statement.html
AOStat | (output) status of allocation |
| |
AOErrMsg | (output) error condition if present |
| |
AOSource a SrcSpan (Expression a) |
Instances
List of names for an IMPLICIT statement.
ImpList | |
|
Instances
data ImpElement a Source #
ImpElement | |
|
Instances
data CommonGroup a Source #
A single COMMON block definition.
The Declarator
s here shall not contain initializing expressions.
CommonGroup | |
|
Instances
Namelist | |
|
Instances
The part of a DATA statement describing a single set of initializations.
The initializer list must be compatible with the name list. Generally, that means either the lengths must be equal, or the name list is the singleton list referring to an array, and the initializer list is compatible with that array's shape.
DataGroup | |
|
Instances
data StructureItem a Source #
Field types in pre-Fortran 90 non-standard structurerecordunion extension.
Structures were obsoleted by derived types in later standards.
The outer structure is stored in StStructure
.
StructFields | Regular field |
StructUnion | Union field |
StructStructure | Substructure (nestedinline recordstructure) |
Instances
UnionMap | |
|
Instances
data FormatItem a Source #
Instances
Part of the newer (Fortran 2003?) FLUSH statement.
See: https://www.ibm.com/docs/en/xl-fortran-aix/15.1.0?topic=attributes-flush-fortran-2003
FSUnit a SrcSpan (Expression a) | scalar integer expression |
FSIOStat a SrcSpan (Expression a) | scalar integer variable |
FSIOMsg a SrcSpan (Expression a) | scalar character variable |
FSErr a SrcSpan (Expression a) | statement label |
Instances
data DoSpecification a Source #
DoSpecification | |
|
Instances
data ProgramUnitName Source #
Instances
Node annotations & related typeclasses
class Annotated f where Source #
Nothing
getAnnotation :: f a -> a Source #
default getAnnotation :: FirstParameter (f a) a => f a -> a Source #
setAnnotation :: a -> f a -> f a Source #
default setAnnotation :: FirstParameter (f a) a => a -> f a -> f a Source #
modifyAnnotation :: (a -> a) -> f a -> f a Source #
Instances
class Labeled f where Source #
getLabel :: f a -> Maybe (Expression a) Source #
getLastLabel :: f a -> Maybe (Expression a) Source #
setLabel :: f a -> Expression a -> f a Source #
Instances
Labeled Block Source # | |
Defined in Language.Fortran.AST getLabel :: Block a -> Maybe (Expression a) Source # getLastLabel :: Block a -> Maybe (Expression a) Source # |
getName :: a -> ProgramUnitName Source #
setName :: ProgramUnitName -> a -> a Source #
Instances
Named (ProgramUnit a) Source # | |
Defined in Language.Fortran.AST getName :: ProgramUnit a -> ProgramUnitName Source # setName :: ProgramUnitName -> ProgramUnit a -> ProgramUnit a Source # |
Helpers
validPrefixSuffix :: PrefixSuffix a -> Bool Source #
emptyPrefixes :: Prefixes a Source #
emptySuffixes :: Suffixes a Source #
nonExecutableStatement :: FortranVersion -> Statement a -> Bool Source #
nonExecutableStatementBlock :: FortranVersion -> Block a -> Bool Source #
executableStatement :: FortranVersion -> Statement a -> Bool Source #
executableStatementBlock :: FortranVersion -> Block a -> Bool Source #
setInitialisation :: Declarator a -> Expression a -> Declarator a Source #
Set a Declarator'
s initializing expression only if it has none already.
Assorted getters & setters
pfSetFilename :: String -> ProgramFile a -> ProgramFile a Source #
pfGetFilename :: ProgramFile a -> String Source #
programUnitBody :: ProgramUnit a -> [Block a] Source #
updateProgramUnitBody :: ProgramUnit a -> [Block a] -> ProgramUnit a Source #
programUnitSubprograms :: ProgramUnit a -> Maybe [ProgramUnit a] Source #
Re-exports
Non-empty (and non-strict) list type.
Since: base-4.9.0.0
a :| [a] infixr 5 |
Instances
MonadFix NonEmpty | Since: base-4.9.0.0 |
Defined in Control.Monad.Fix | |
Foldable NonEmpty | Since: base-4.9.0.0 |
Defined in Data.Foldable fold :: Monoid m => NonEmpty m -> m # foldMap :: Monoid m => (a -> m) -> NonEmpty a -> m # foldMap' :: Monoid m => (a -> m) -> NonEmpty a -> m # foldr :: (a -> b -> b) -> b -> NonEmpty a -> b # foldr' :: (a -> b -> b) -> b -> NonEmpty a -> b # foldl :: (b -> a -> b) -> b -> NonEmpty a -> b # foldl' :: (b -> a -> b) -> b -> NonEmpty a -> b # foldr1 :: (a -> a -> a) -> NonEmpty a -> a # foldl1 :: (a -> a -> a) -> NonEmpty a -> a # elem :: Eq a => a -> NonEmpty a -> Bool # maximum :: Ord a => NonEmpty a -> a # minimum :: Ord a => NonEmpty a -> a # | |
Eq1 NonEmpty | Since: base-4.10.0.0 |
Ord1 NonEmpty | Since: base-4.10.0.0 |
Defined in Data.Functor.Classes | |
Read1 NonEmpty | Since: base-4.10.0.0 |
Defined in Data.Functor.Classes | |
Show1 NonEmpty | Since: base-4.10.0.0 |
Traversable NonEmpty | Since: base-4.9.0.0 |
Applicative NonEmpty | Since: base-4.9.0.0 |
Functor NonEmpty | Since: base-4.9.0.0 |
Monad NonEmpty | Since: base-4.9.0.0 |
NFData1 NonEmpty | Since: deepseq-1.4.3.0 |
Defined in Control.DeepSeq | |
Hashable1 NonEmpty | Since: hashable-1.3.1.0 |
Defined in Data.Hashable.Class | |
Generic1 NonEmpty | |
Lift a => Lift (NonEmpty a :: Type) | Since: template-haskell-2.15.0.0 |
SingI1 ((:|@#@$$) :: a -> TyFun [a] (NonEmpty a) -> Type) | |
Out a => Out (NonEmpty a) Source # | |
Data a => Data (NonEmpty a) | Since: base-4.9.0.0 |
Defined in Data.Data gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> NonEmpty a -> c (NonEmpty a) # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (NonEmpty a) # toConstr :: NonEmpty a -> Constr # dataTypeOf :: NonEmpty a -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c (NonEmpty a)) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (NonEmpty a)) # gmapT :: (forall b. Data b => b -> b) -> NonEmpty a -> NonEmpty a # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> NonEmpty a -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> NonEmpty a -> r # gmapQ :: (forall d. Data d => d -> u) -> NonEmpty a -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> NonEmpty a -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> NonEmpty a -> m (NonEmpty a) # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> NonEmpty a -> m (NonEmpty a) # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> NonEmpty a -> m (NonEmpty a) # | |
Semigroup (NonEmpty a) | Since: base-4.9.0.0 |
IsList (NonEmpty a) | Since: base-4.9.0.0 |
Generic (NonEmpty a) | |
Read a => Read (NonEmpty a) | Since: base-4.11.0.0 |
Show a => Show (NonEmpty a) | Since: base-4.11.0.0 |
Binary a => Binary (NonEmpty a) | Since: binary-0.8.4.0 |
NFData a => NFData (NonEmpty a) | Since: deepseq-1.4.2.0 |
Defined in Control.DeepSeq | |
Spanned a => Spanned (NonEmpty a) Source # | |
Eq a => Eq (NonEmpty a) | Since: base-4.9.0.0 |
Ord a => Ord (NonEmpty a) | Since: base-4.9.0.0 |
Hashable a => Hashable (NonEmpty a) | |
Defined in Data.Hashable.Class | |
PEq (NonEmpty a) | |
(SEq a, SEq [a]) => SEq (NonEmpty a) | |
POrd (NonEmpty a) | |
(SOrd a, SOrd [a]) => SOrd (NonEmpty a) | |
Defined in Data.Ord.Singletons sCompare :: forall (t1 :: NonEmpty a) (t2 :: NonEmpty a). Sing t1 -> Sing t2 -> Sing (Apply (Apply CompareSym0 t1) t2) # (%<) :: forall (t1 :: NonEmpty a) (t2 :: NonEmpty a). Sing t1 -> Sing t2 -> Sing (Apply (Apply (<@#@$) t1) t2) # (%<=) :: forall (t1 :: NonEmpty a) (t2 :: NonEmpty a). Sing t1 -> Sing t2 -> Sing (Apply (Apply (<=@#@$) t1) t2) # (%>) :: forall (t1 :: NonEmpty a) (t2 :: NonEmpty a). Sing t1 -> Sing t2 -> Sing (Apply (Apply (>@#@$) t1) t2) # (%>=) :: forall (t1 :: NonEmpty a) (t2 :: NonEmpty a). Sing t1 -> Sing t2 -> Sing (Apply (Apply (>=@#@$) t1) t2) # sMax :: forall (t1 :: NonEmpty a) (t2 :: NonEmpty a). Sing t1 -> Sing t2 -> Sing (Apply (Apply MaxSym0 t1) t2) # sMin :: forall (t1 :: NonEmpty a) (t2 :: NonEmpty a). Sing t1 -> Sing t2 -> Sing (Apply (Apply MinSym0 t1) t2) # | |
(SDecide a, SDecide [a]) => TestCoercion (SNonEmpty :: NonEmpty a -> Type) | |
Defined in Data.Singletons.Base.Instances | |
(SDecide a, SDecide [a]) => TestEquality (SNonEmpty :: NonEmpty a -> Type) | |
Defined in Data.Singletons.Base.Instances | |
SingI ((:|@#@$) :: TyFun a ([a] ~> NonEmpty a) -> Type) | |
Defined in Data.Singletons.Base.Instances | |
SuppressUnusedWarnings (Compare_6989586621679299464Sym0 :: TyFun (NonEmpty a) (NonEmpty a ~> Ordering) -> Type) | |
Defined in Data.Ord.Singletons suppressUnusedWarnings :: () # | |
SuppressUnusedWarnings (TFHelper_6989586621679141588Sym0 :: TyFun (NonEmpty a) (NonEmpty a ~> Bool) -> Type) | |
Defined in Data.Eq.Singletons suppressUnusedWarnings :: () # | |
SuppressUnusedWarnings ((:|@#@$) :: TyFun a ([a] ~> NonEmpty a) -> Type) | |
Defined in Data.Singletons.Base.Instances suppressUnusedWarnings :: () # | |
SingI d => SingI ((:|@#@$$) d :: TyFun [a] (NonEmpty a) -> Type) | |
Defined in Data.Singletons.Base.Instances | |
SuppressUnusedWarnings (Compare_6989586621679299464Sym1 a6989586621679299469 :: TyFun (NonEmpty a) Ordering -> Type) | |
Defined in Data.Ord.Singletons suppressUnusedWarnings :: () # | |
SuppressUnusedWarnings (TFHelper_6989586621679141588Sym1 a6989586621679141593 :: TyFun (NonEmpty a) Bool -> Type) | |
Defined in Data.Eq.Singletons suppressUnusedWarnings :: () # | |
SuppressUnusedWarnings ((:|@#@$$) a6989586621679028402 :: TyFun [a] (NonEmpty a) -> Type) | |
Defined in Data.Singletons.Base.Instances suppressUnusedWarnings :: () # | |
type Rep1 NonEmpty | Since: base-4.6.0.0 |
Defined in GHC.Generics type Rep1 NonEmpty = D1 ('MetaData "NonEmpty" "GHC.Base" "base" 'False) (C1 ('MetaCons ":|" ('InfixI 'LeftAssociative 9) 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) Par1 :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec1 []))) | |
type Apply ((:|@#@$) :: TyFun a ([a] ~> NonEmpty a) -> Type) (a6989586621679028402 :: a) | |
type Item (NonEmpty a) | |
type Rep (NonEmpty a) | Since: base-4.6.0.0 |
Defined in GHC.Generics type Rep (NonEmpty a) = D1 ('MetaData "NonEmpty" "GHC.Base" "base" 'False) (C1 ('MetaCons ":|" ('InfixI 'LeftAssociative 9) 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 a) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [a]))) | |
type Demote (NonEmpty a) | |
Defined in Data.Singletons.Base.Instances | |
type Sing | |
Defined in Data.Singletons.Base.Instances | |
type (arg1 :: NonEmpty a) /= (arg2 :: NonEmpty a) | |
type (a2 :: NonEmpty a1) == (a3 :: NonEmpty a1) | |
type (arg1 :: NonEmpty a) < (arg2 :: NonEmpty a) | |
type (arg1 :: NonEmpty a) <= (arg2 :: NonEmpty a) | |
type (arg1 :: NonEmpty a) > (arg2 :: NonEmpty a) | |
type (arg1 :: NonEmpty a) >= (arg2 :: NonEmpty a) | |
type Compare (a2 :: NonEmpty a1) (a3 :: NonEmpty a1) | |
type Max (arg1 :: NonEmpty a) (arg2 :: NonEmpty a) | |
type Min (arg1 :: NonEmpty a) (arg2 :: NonEmpty a) | |
type Apply (Compare_6989586621679299464Sym1 a6989586621679299469 :: TyFun (NonEmpty a) Ordering -> Type) (a6989586621679299470 :: NonEmpty a) | |
type Apply (TFHelper_6989586621679141588Sym1 a6989586621679141593 :: TyFun (NonEmpty a) Bool -> Type) (a6989586621679141594 :: NonEmpty a) | |
type Apply ((:|@#@$$) a6989586621679028402 :: TyFun [a] (NonEmpty a) -> Type) (a6989586621679028403 :: [a]) | |
type Apply (Compare_6989586621679299464Sym0 :: TyFun (NonEmpty a) (NonEmpty a ~> Ordering) -> Type) (a6989586621679299469 :: NonEmpty a) | |
type Apply (TFHelper_6989586621679141588Sym0 :: TyFun (NonEmpty a) (NonEmpty a ~> Bool) -> Type) (a6989586621679141593 :: NonEmpty a) | |