To: J3 J3/23-155 From: T. Clune & subgroup generics Subject: Formal syntax for generics Date: 2023-June-05 Reference: 22-120r5, 22-151r3, 22-154r5, 23-007 1. Introduction =============== This paper contains the syntax for generic programming features. Section 2 contains a succinct, non-pedagogical example that exercises most of the proposed syntax. Section 3 provides the formal syntax and is further broken into the following subsections: 3.1 Deferred entities 3.1.1 Syntax for deferred arguments 3.1.2 Deferred interface body 3.1.3 Active specification of deferred arguments 3.1.4 Deferred argument association 3.2 Syntax for the REQUIREMENT construct 3.3 Syntax for the REQUIRES statement 3.4 Syntax for the TEMPLATE construct 3.4.1 Template specification part 3.4.2 Template subprogram part 3.4.3 Additional constraint 3.5 Syntax for the INSTANTIATE statement Section 4 summarized miscellaneous related changes needed in other sections of the standard. 2. Example ========== MODULE A REQUIREMENT R(T,F) TYPE, DEFERRED :: T FUNCTION F(x, i) RESULT(y) TYPE(T) :: y TYPE(T), INTENT(IN) :: x INTEGER, INTENT(IN) :: i END FUNCTION F END REQUIREMENT R TEMPLATE B(T,F,C) REQUIRES R(T,F) ! provides interface for deferred F TYPE, DEFERRED :: T ! redundant decl of deferred type T INTEGER, CONSTANT :: C(..) ! deferred rank constant CONTAINS SUBROUTINE SUB1(x) TYPE(T), INTENT(INOUT) :: x x = F(x, SUM(C)) END SUBROUTINE SUB1 SUBROUTINE SUB2(x) TYPE(T), INTENT(INOUT) :: x x = F(x, MAXVAL(C)) END SUBROUTINE SUB2 END TEMPLATE B END MODULE A MODULE B USE MODULE A INSTANTIATE B(REAL, OPERATOR(*), [3,4]), ONLY: & & tot_sub1 => sub1 INSTANTIATE B(REAL, OPERATOR(+), [3,4]), ONLY: & ! different instance & max_sub1 => sub2 CONTAINS SUBROUTINE DO_SOMETHING(x) REAL, INTENT(INOUT) :: x x = 2. CALL tot_sub(x) PRINT*,'TOT: ', x ! expect 2. * (3+4) = 14. x = 3. CALL max_sub(x) PRINT*,'MAX: ', x ! expect 3. + max(3,4) = 7. END SUBROUTINE DO_SOMETHING END MODULE B 3. Formal Syntax ================ 3.1 Deferred entities -------------------- A deferred argument is an entity that takes some of its characteristics from its ultimate instantiation argument. A deferred argument can be a constant, type, or procedure and can appear in a REQUIREMENT or TEMPLATE construct (3.2, 3.4). Association with instantiation arguments occurs in the REQUIRES and INSTANTIATE statements. A deferred constant is a deferred argument that can appear in constant expressions within a REQUIREMENT or TEMPLATE construct. A deferred type is a deferred argument that can appear as a within a REQUIREMENT or TEMPLATE construct. A deferred procedure is a deferred argument that can appear in procedure references within a REQUIREMENT or TEMPLATE construct. A deferred procedure's interface shall be established by that REQUIREMENT or TEMPLATE construct, possibly in terms of deferred types and constants. An explicit specification of a is either or . A shall have one or more ultimate specifications. An ultimate specification for a is either an explicit specification or the ultimate specification of a requirement referenced in a REQUIRES statement. Note: The approach here is that each deferred argument is always eventually explicitly declared at some level of nesting of requirements. Any given deferred argument must have at least one ultimate specification and may have multiple. All must have a well-defined active specification which will be defined in section 3.1.3. 3.1.1 Syntax for deferred arguments ----------------------------------- A deferred argument declaration construct is used to declare REQUIREMENT or TEMPLATE arguments. <> Constraint: A shall have at most one explicit specification in a given scoping unit. Constraint: A declaration shall not have an nor shall it appear in a PUBLIC statement. Note: Deferred arguments are local identifiers and are not externally accessible.` <> <> <> <> <> Constraint: Each shall appear in at most one . Constraint: If any ultimate specification of a is a then all of the ultimate specifications of that shall be . Constraint: If any ultimate specification of a is a then all of the ultimate specifications of that shall be . Constraint: If any ultimate specification of a is a then all of the ultimate specifications of that shall be . Note: Technically the previous 3 constraints are implied by the first constraint in section 3.1.3. 3.1.1.1 Syntax for deferred constants <> , :: <> [,]... CONSTANT [,]... <> <> Constraint: An entity declared in shall be INTEGER, LOGICAL, or assumed-length CHARACTER. Note: For now, we explicitly disallow fixed-length character deferred arguments. Partly this is to not prejudice further work on deferred arguments with length type parameters. <> [ ( ) ] Constraint: If appears in , it shall be , , , or . Constraint: If , or appears in , then shall not be specified. Constraint: If appears in , then shall not appear as a lower bound. <> Constraint: Each shall appear in of the innermost scoping unit. A is a deferred constant. Some examples of declaring deferred constants are as follows. ! explicit shape integer, constant :: x1 integer, constant :: x2(3) integer, parameter :: v1(2) = [5,15] ! not a deferred constant integer, constant :: x3(v1) ! implied shape integer, constant :: x7(*) integer, constant :: x9(*,*) integer, constant, rank(2) :: x13 ! assumed-or-deferred-rank-spec integer, constant :: x14(..) 3.1.1.2 Syntax for deferred procedures <> PROCEDURE[()] :: <> Constraint: Each that appears in a shall appear in of the innermost scoping unit. Constraint: Each shall appear in a or as a or within an or a . A is a deferred procedure. A that appears as the or in an or a is a deferred procedure. 3.1.1.3 Syntax for deferred types <> TYPE, DEFERRED :: <> Constraint: A entity shall not appear as in an EXTENDS attribute. Note: Possibly a similar constraint is needed for CLASS(T), but current reading of the standard requires CLASS(), and a is not a . Constraint: Each shall appear in of the innermost scoping unit. A is a deferred type. 3.1.2 Deferred interface body ----------------------------- A is a deferred interface body and declares a as a deferred procedure as well as defining the interface of that deferred procedure. <> [ ] <> [ ] Constraint: Each and in a shall be a in the innermost scope. <> [ ] ... [ ] ... <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> [ [ , ] ... :: ] <> ALLOCATABLE <> ASYNCHRONOUS <> CODIMENSION <> CONTIGUOUS <> DIMENSION ( ) <> INTENT ( ) <> OPTIONAL <> PARAMETER <> POINTER <> <> TARGET <> VALUE <> VOLATILE A is a scoping unit that has use and host association. 3.1.3 Active specification of deferred arguments ------------------------------------------------ The active specification of a in each scope is the intersection of the ultimate specifications of that . An active specification is either well-defined or is inconsistent. Constraint: The active specification of a shall be well-defined. A shall only be referenced within a template or a requirement in a way that is consistent with its active specification. If a has a single ultimate specification, its active specification is that specification. If all ultimate specifications of a are then the active specification is a deferred constant, otherwise it is inconsistent. If all ultimate specifications of a are then the active specification is a deferred type, otherwise it is inconsistent. If all ultimate specifications of a are then the active specification is a deferred procedure, otherwise it is inconsistent. 3.1.3.1 Active specification of deferred constants If 2 ultimate specifications of a have types T1 and T2 respectively, then their active specification is of type T1 if T1 and T2 are the same type. Otherwise it is inconsistent. If the active specification of 2 ultimate specifications is of type character, then both shall have assumed-length and the active specification is an assumed-length character. Otherwise it is inconsistent. If 2 ultimate specifications of a have kinds K1 and K2 respectively, then their active specification is of kind K1 if K1 and K2 are the same kind. Otherwise it is inconsistent. If 2 ultimate specifications of a have ranks R1 and R2 then: - if R1 and R2 are defined ranks, then their active specification is of rank R1 if R1 and R2 are the same, otherwise the active specification is inconsistent. - if one of R1 and R2 is deferred rank and the other has defined rank R, then the active specification is R. - if both R1 and R2 are deferred rank, then the active specification has deferred rank. If 2 ultimate specifications of a have shapes S1 and S2, then: - if S1 and S2 both have explicit shapes then their active specification has shape S1 if S1 and S2 are the same. Otherwise it is inconsistent. - if one of S1 and S2 is of assumed-shape and the other has explicit shape S, then the active specification has shape S. - if S1 and S2 are both assumed-shape, then their active specification has assumed-shape. 3.1.3.2 Active specification of deferred procedures If 2 ultimate specifications of are subroutines, then the active specification is a subroutine. If 2 ultimate specifications of a are functions then the active specification is a function. Otherwise, they are inconsistent. If at least one of two ultimate specifications of a is simple, then the active specification is simple. If at least one of two ultimate specifications of a is pure and the other is not simple, then the active specification is pure. If at least one of two ultimate specifications of a is elemental, then the active specification is elemental. If two ultimate specifications of a have the same characteristics of their dummy arguments then the active specification has the same characteristics of its dummy arguments. Otherwise it is inconsistent. If two ultimate specifications of a that is a function have the same characteristics for their results then the active specification has the same characteristics of its result. Otherwise it is inconsistent. The active specification of a does not define the names of its dummy arguments. 3.1.4 Deferred argument association ----------------------------------- Instantiation arguments are specified by either an INSTANTIATE or a REQUIRES statement. <> [ = ] Constraint: Each shall be the name of a in the referenced requirement or template. In the absence of an argument keyword, an instantiation argument corresponds to the deferred argument occupying the corresponding position in ; that is, the first instantiation argument corresponds to the first deferred argument in the reduced list, the second instantiation argument corresponds to the second deferred argument in the reduced list, etc. <> <> <> <> 3.1.4.1 Deferred constant association Constraint: shall be type INTEGER, LOGICAL or CHARACTER. Constraint: An that is a shall correspond to a that has an active specification that is a in the referenced template or requirement. Constraint: The type and kind of an that is a shall have the same type and kind as the active specification of the corresponding in the referenced template or requirement. Constraint: If the shape of the active specification of the corresponding in the referenced template or requirement is not assumed, then shall have the same shape. Constraint: If the rank of the active specification of the corresponding in the referenced template or requirement is not assumed, then shall have the same rank. 3.1.4.2 Deferred procedure association Constraint: An that is a or shall correspond to a that has an active specification that is a in the referenced template or requirement. Constraint: An that is a shall have the same characteristics as the active specification of the corresponding in the referenced template or requirement, except that a pure instantiation argument may be associated with a deferred argument that is not pure, a simple instantiation argument may be associated with a deferred argument that is not simple, and an elemental instantiation argument may be associated with a deferred procedure that is not elemental. Constraint: An that is a shall have one specific procedure that has the same characteristics as the active specification of the corresponding in the referenced template or requirement, except that a pure instantiation argument may be associated with a deferred argument that is not pure, a simple instantiation argument may be associated with a deferred argument that is not simple, and an elemental instantiation argument may be associated with a deferred procedure that is not elemental. The is associated with the specific procedure that is consistent with the characteristics. Note: The previous two constraints constitute what is referred to as "weak constraints" in other languages. 3.1.4.3 Deferred type association Constraint: An that is a shall correspond to a that has an active specification that is a in the referenced template or requirement. Constraint: If an is a , it shall be allowed for a variable of that type to appear in a variable definition context. Constraint: A shall only appear as an instantiation argument if a variable of that type is permitted in an allocate statement. Constraint: If an is a , it shall not specify a type that has a coarray potential subobject component. 3.2 Syntax for the REQUIREMENT construct ---------------------------------------- A REQUIREMENT is a named collection of deferred argument declarations intended to facilitate reuse of common patterns within templates and other requirements. <> REQUIREMENT ( [] ) [ ] ... ... END [REQUIREMENT []] <> <> Constraint: Each shall appear in a . Note: A is a scoping unit that allows use and host association. Note: Each is local to the REQUIREMENT construct. 3.3 Syntax for the REQUIRES statement ------------------------------------- A REQUIRES statement provides declarations of deferred arguments by associating them with the deferred arguments of a REQUIREMENT. <> REQUIRES [::] ( [] ) Constraint: shall be the name of a previously defined . 3.4 Syntax for the TEMPLATE construct ------------------------------------- A template is a set of declarations, specifications and definitions that are enabled by instantiation. A TEMPLATE construct defines a template. A template is a scoping unit to which use and host association and template argument association can be applied. A template can be defined in the specification section of a program unit other than a block data program unit.