diff --git a/CMakeLists.txt b/CMakeLists.txt
index 2b7a823f7ec3..72e66259b1e3 100644
--- a/CMakeLists.txt
+++ b/CMakeLists.txt
@@ -84,6 +84,13 @@ add_definitions(${LLVM_DEFINITIONS})
set(LLVM_EXTERNAL_LIT ${LLVM_TOOLS_BINARY_DIR}/llvm-lit CACHE STRING "Command used to spawn lit")
if(LINK_WITH_FIR)
+ include(TableGen)
+ include(AddMLIR)
+ find_program(MLIR_TABLEGEN_EXE "mlir-tblgen" ${LLVM_TOOLS_BINARY_DIR}
+ NO_DEFAULT_PATH)
+ # tco/bbc tools output directory
+ set(LLVM_RUNTIME_OUTPUT_INTDIR ${CMAKE_BINARY_DIR}/bin)
+ set(LLVM_LIBRARY_OUTPUT_INTDIR ${CMAKE_BINARY_DIR}/lib)
message(STATUS "Linking driver with FIR and LLVM")
llvm_map_components_to_libnames(LLVM_COMMON_LIBS support)
message(STATUS "LLVM libraries: ${LLVM_COMMON_LIBS}")
diff --git a/documentation/FIRLangRef.md b/documentation/FIRLangRef.md
new file mode 100644
index 000000000000..759fd772b629
--- /dev/null
+++ b/documentation/FIRLangRef.md
@@ -0,0 +1,1048 @@
+# FIR Language Reference
+
+This document describes the FIR dialect, an extension of the MLIR extensible
+IR. FIR (Fortran IR) is a higher-level compiler intermediate representation for
+Fortran compilation units used by the Flang compiler.
+
+Some familiarity with [MLIR](https://github.com/tensorflow/mlir/blob/master/g3doc/LangRef.md) and [LLVM IR](https://llvm.org/docs/LangRef.html) is encouraged. The [LLVM tutorial](https://llvm.org/docs/tutorial/MyFirstLanguageFrontend/index.html) may help as well.
+
+# Type System
+
+This section defines the _FIR type system_, which is related to but certainly
+not the same as Fortran's concept and definition of a type. FIR is a strongly
+typed language. FIR types subsume Fortran types and attributes that, when taken
+together, describe the operational properties applicable to a Fortran entity.
+
+Standard dialect MLIR types are available in FIR. FIR adds its own types as
+well, and this section documents the FIR dialect type system.
+
+In the most general case, the reified FIR type of a Fortran entity may not be
+known at compile-time. Specifically, the size, rank, shape, index ranges,
+strides, aggregate layout, data member sizes, and parameters of that type
+instance may all be deferred until runtime.
+
+In FIR, it is necessary to be able to abstract away much of the Fortran syntax
+and runtime specialization of an entity's properties, while maintaining the
+advantages of a strong type system. For one optimization, it may suffice to
+know that a Fortran entity has a rank. For another, it may be desirable (or
+required) for the operand entities to have a more precise reified FIR type for
+efficiency and performance.
+
+For example, for a Fortran variable with a declared type of `TYPE(*)`, it is
+possible to express this variable in FIR as the most general sort of entity
+with an unlimited polymorphic type. However, the compiler will be able to
+produce better performing (and smaller) code if it can prove and rewrite this
+value as having a FIR type of `i32`, which might be kept in a machine register,
+for example.
+
+The point here is that the FIR type system needs to allow transformations on a
+Fortran entity that express both an unlimited polymorphic type and, say like in
+the last example, a reified type as a 32-bit signed integer depending on the
+context.
+
+#### Notation
+
+* _abc-list_ is a possibly empty comma separated list of _abc_.
+* _abc-xlist_ is a non-empty 'x'-character separated list of _abc._
+* _abc-type_ is a type.
+
+## Fortran Intrinsic Types
+
+!fir.int<kind>
+!fir.real<kind>
+!fir.complex<kind>
+!fir.logical<kind>
+!fir.character<kind>
+ where kind := integer-constant
+
+
+Some of these types may be directly rewritten to standard dialect types. The
+intrinsic types are meant to correspond one-to-one with the front-end's
+intrinsic types. What a particular kind-value means in terms of bit-width is
+not relevant to these FIR types. However, the semantics of kind-values are
+absolutely relevant when these types are converted to a lower-level
+dialect. For example, assuming the f18 front-end definition then `!fir.int<2>`
+can be trivially rewritten to `i16`.
+
+## Fortran Derived Types
+
+!fir.type<derived-type-name [ (len-param-list) ] [ {field-id-list} ] >
+ where len-param := len-param-name : integer-type
+ field-id := field-name : type
+
+
+This is the type of a Fortran derived type. Each derived type is given a unique
+name. The data parts of the derived type are elaborated in the field list. The
+degenerate form is allowed to be able to construct recursive references. As
+these elaborated record types can become rather verbose, the intention will be
+to exploit MLIR's type alias feature to create shorter nicknames.
+
+## Modeled Types
+
+These types are not Fortran types. These modeled types capture the semantic
+properties of attributes on Fortran data entities by converting those
+attributes into the constraints of FIR's static type system.
+
+### Function Type
+
+(argument-type-list) -> result-type
+
+
+This is the type of a Fortran procedure (function or subroutine) and is the
+same as the standard dialect. The void type is simply `()`.
+
+### Sequence Type
+
+!fir.array<extent-xlist : element-type>
+ where extent := integer-constant | ? | *
+
+
+This is used to declare that the value is an array. It may additionally
+capture the shape of the array. It maps to a Fortran column-major layout. An
+array with explicit shape can be represented with an xlist of rank length of
+integers. An unknown extent in one of the dimensions can be specified with the
+`?` character. The `*` character is used (by itself) when the shape of the
+array is not known.
+
+Examples:
+
+```mlir
+ !fir.array<10x10:i32> ; array of rank 2 and shape [10, 10]
+ !fir.array<5x?:f32> ; array of rank 2 and shape [5, unknown]
+ !fir.array<*:f64> ; array of unknown rank and shape
+```
+
+Unlike Fortran, FIR arrays have a starting index of 0 (always). This must be
+accounted for when lowering Fortran arrays. See `fir.coordinate_of` and
+`fir.embox` on how access maps can be used. (A starting index of 0 makes FIR
+array offset computation consistent with tuples, record types, etc.)
+
+### Pointer-like Types
+
+!fir.ref<ref-to-type>
+
+
+This is the type of a memory reference. This is needed in a number of
+situations. For one example, dummy arguments (variables) in Fortran can refer
+to the actual argument passed from the calling procedure. Assignments to the
+dummy variable will change the value of the actual variable. This semantics can
+be reified by passing a memory reference to the actual variable to the called
+procedure. _ref-to-type_ cannot be `!fir.ref`.
+
+!fir.ptr<ptr-to-type>
+
+
+This is also a memory reference type, but it is limited to Fortran's POINTER
+attribute. A variable with a POINTER attribute has a runtime defined reference
+value. This introduces aliasing (which may be important to the optimizer), and
+having a separate type allows for some refinement in alias
+analysis. _ptr-to-type_ cannot be `!fir.ptr`, `!fir.heap`, or `!fir.ref`.
+
+A value of type `!fir.ptr` can introduce aliasing (unlike `!fir.ref`).
+
+!fir.heap<heap-to-type>
+
+
+This is the third memory reference type, and this one is limited to Fortran's
+ALLOCATABLE attribute. The allocation of ALLOCATABLE variables will return a
+reference of `!fir.heap` type. _heap-to-type_ cannot be `!fir.ptr`,
+`!fir.heap`, or `!fir.ref`.
+
+By having different pointer-like types, the language constraint prohibiting
+first-class pointers-to-pointers can be trivially enforced. For example, C852
+prohibits having both a POINTER and ALLOCATABLE attribute on entity. This can
+be enforced in the type system by disallowing the construction of
+`!fir.ptr>` and `!fir.heap>` types.
+
+### Descriptor Types
+
+!fir.box<of-type>
+
+
+The type of the most general object in Fortran. A boxed value can be a scalar
+or an array. A boxed value has a memory reference (to the value's data), a
+reified type value, optional type parameters, and optional array dimension
+information (if it's an array box). A value of box type can return dynamic
+values such as the rank of the object, the size of an element, or the size of
+the object.
+
+!fir.boxchar<kind>
+
+
+A Fortran CHARACTER type can be a pair of values, the buffer of characters
+along with a runtime LEN value. This is the abstract type of the pair that
+describes a CHARACTER value.
+
+!fir.boxproc<function-type>
+
+
+A Fortran procedure POINTER may be to an internal procedure. An internal
+procedure may require a runtime host instance value. This is the abstract type
+of a procedure pointer, including a procedure pointer with a host instance
+value.
+
+### Other Types
+
+!fir.dims<rank>
+
+
+This is the type of a vector of array dimension triples. A boxed array object
+takes a vector of dimension triples to properly instantiate the box value.
+
+!fir.field
+
+
+This is the type of a part reference via a field name. A field value can be
+constructed to provide an abstract value to refer to members of a value of type
+`!fir.type`. In the most general case, the layout of a parametric derived type
+may not be known until runtime and the offset of a particular field must be
+computed.
+
+!fir.tdesc<of-type>
+
+
+A Fortran type has a meta-type known as a type descriptor. This is the type of
+these meta-types. A boxed value carries a `!fir.tdesc` value to identify the
+type of that instance.
+
+
+# Modules, Functions, and Basic Blocks
+
+For organizing a Fortran compilation unit, FIR uses the MLIR infrastructure for
+modules, functions, regions, and basic blocks. These concepts are explained in
+the MLIR Language Reference.
+
+
+# Operations
+
+This section defines the _FIR operations_. MLIR operations are a generalized
+abstraction meant to allow a dialect, like FIR, to add its own constructs with
+their own semantics. FIR operations are meant to capture the operations and
+structures from the Fortran language for presentation to optimization passes.
+
+Some FIR operations capture execution semantics and are intended to be placed
+in Blocks. Other operations are Module level abstractions and intended to be
+referenced by name.
+
+## Executable Operations
+
+### SSA Memory Related Ops
+
+#### `fir.alloca`
+
+Syntax: fir.alloca T [ , size-list ] : !fir.ref<T>
+
+Allocate uninitialized space on the stack for a variable of type _T_. If
+allocating an array of _T_, then a size-list of ssa-values sufficient rank must
+be provided to compute the array's shape.
+
+Example:
+
+```mlir
+ %11 = fir.alloca i32 : !fir.ref
+ %12 = fir.alloca !fir.array<8:i64> : !fir.ref>
+ %13 = fir.alloca f32, %5 : !fir.ref
+```
+
+Note that in the case of `%13`, a contiguous block of memory is allocated and
+its size is some runtime multiple of a 32-bit REAL value. Furthermore, the
+operation is undefined if the ssa-value `%5` is nonpositive.
+
+
+#### `fir.load`
+
+Syntax: fir.load memory-reference : reference-type
+
+Loads a value from a memory reference. A memory reference has type
+`!fir.ref`, `!fir.heap`, or `!fir.ptr`.
+
+Example:
+
+```mlir
+ %14 = fir.alloca i32 : !fir.ref
+ %15 = fir.load %14 : !fir.ref
+```
+
+#### `fir.store`
+
+Syntax: fir.store ssa-value to memory-reference : reference-type
+
+Store a value to a memory reference.
+
+Example:
+
+```mlir
+ %16 = fir.call @foo() : f64
+ %17 = fir.call @bar() : !fir.ptr
+ fir.store %16 to %17 : !fir.ptr
+```
+
+The above store changes the value to which the pointer is pointing and not
+the pointer itself.
+
+
+#### `fir.undefined`
+
+Syntax: fir.undefined T
+
+An undefined value. This is a constant that can be used to represent an
+undefined _ssa-value_ of any type except
+!fir.ref<U>.
+
+Example:
+
+```mlir
+ %18 = fir.undefined !fir.array<10:!fir.type>
+```
+
+### Heap Memory Ops
+
+#### `fir.allocmem`
+
+Syntax: fir.allocmem T [ , size-list ] : !fir.heap<T>
+
+Allocate contiguous memory on the heap. It is expected that a properly
+constructed FIR program properly pairs `fir.allocmem` and `fir.freemem`
+operations.
+
+
+Example:
+
+```mlir
+ %20 = fir.allocmem !fir.type : !fir.heap>
+```
+
+#### `fir.freemem`
+
+
+Syntax: fir.freemem heap-value : !fir.heap<T>
+
+Deallocate a previously allocated block of memory returned from
+`fir.allocmem`.
+
+Example:
+
+```mlir
+ %21 = fir.allocmem !fir.type : !fir.heap>
+ ...
+ fir.freemem %21 : !fir.heap>
+```
+
+
+### Terminators
+
+#### `fir.select`
+
+
+Syntax:
+fir.select selector : selector-type [ value-target-list ]
+ where value-target := select-const , block block-arg-list
+ select-const := integer-const | unit
+ block-arg-list := [ ( value-type-list ) ]
+
+
+A terminator for a simple switch like control flow.
+
+Example:
+
+ fir.select %arg:i32 [ 1,^bb1(%0:i32), 2,^bb2(%2,%arg,%arg2:i32,i32,i32), -3,^bb3(%arg2,%2:i32,i32), 4,^bb4(%1:i32), unit,^bb5 ]
+
+
+#### `fir.select_case`
+
+Syntax:
+fir.select_case selector : selector-type [ case-target-list ]
+ where case-target-list := case-attr , case-attr-values , block block-arg-list
+ case-attr := unit | #fir.point | #fir.interval | #fir.lower | #fir.upper
+ case-attr-values := [ ssa-value [ , ssa-value ] ]
+
+
+A terminator for the SELECT CASE construct.
+
+Example:
+
+ fir.select_case %arg : i32 [#fir.point, %0, ^bb1(%0:i32), #fir.lower, %1, ^bb2(%2,%arg,%arg2,%1:i32,i32,i32,i32), #fir.interval, %2, %3, ^bb3(%2,%arg2:i32,i32), #fir.upper, %arg, ^bb4(%1:i32), unit, ^bb5]
+
+#### `fir.select_rank`
+
+Syntax: fir.select_rank selector : selector-type [ value-target-list ]
+
+A terminator for the SELECT RANK construct.
+
+Example:
+
+ fir.select_rank %arg:i32 [ 1,^bb1(%0:i32), 2,^bb2(%2,%arg,%arg2:i32,i32,i32), 3,^bb3(%arg2,%2:i32,i32), -1,^bb4(%1:i32), unit,^bb5 ]
+
+
+#### `fir.select_type`
+
+Syntax:
+fir.select_type selector [ type-target-list ]
+ where type-target-list := type-attr , block block-arg-list
+ case-attr := unit | #fir.instance<type> | #fir.subsumed<type>
+
+
+A terminator for the SELECT TYPE construct.
+
+Example:
+
+ fir.select_type %arg : !fir.box<()> [ #fir.instance>,^bb1(%0:i32), #fir.instance>,^bb2(%2:i32), #fir.subsumed>,^bb3(%2:i32), #fir.instance>,^bb4(%1:i32), unit,^bb5 ]
+
+#### `fir.unreachable`
+
+Syntax: `fir.unreachable`
+
+A terminator that should never be reached by the executing program. This
+terminator is translated to LLVM's `unreachable` instruction.
+
+
+### Ops for Boxed Values
+
+
+#### Packing Boxed Values
+
+
+#### `fir.embox`
+
+
+Syntax:
+fir.embox mem-ref [ , access-map ] : ( arg-type-list ) -> !fir.box<T>
+ where access-map := dims | affine-map
+
+
+Creation of a boxed value. A boxed value is a memory reference value that
+is wrapped with a Fortran descriptor. References to scalars, arrays,
+pointers, allocatables, etc. can be boxed.
+
+Example:
+
+```mlir
+ %34 = fir.dims(%c1, %c10, %c1) : (i32, i32, i32) -> !fir.dims<1>
+ %35 = fir.call @foo() : () -> !fir.ref>
+ %36 = fir.embox %35, %34 : (!fir.ref>, !fir.dims<1>) -> !fir.box>
+```
+
+#### `fir.emboxchar`
+
+Syntax: fir.emboxchar buffer-ref , len-value : ( arg-type-list ) -> !fir.boxchar<kind>
+
+Creation of a boxed CHARACTER pair. A variable of type CHARACTER has a
+dependent LEN type parameter that is the size of the buffer holding the
+CHARACTER value.
+
+Example:
+
+```mlir
+ %c20 = constant 20 : i32
+ %37 = fir.call @foo() : !fir.ref>
+ %38 = fir.emboxchar %37, %c20 : !fir.boxchar<1>
+```
+
+#### `fir.emboxproc`
+
+
+Syntax: fir.emboxproc callee [ , context ] : ( arg-type-list ) -> !fir.boxproc<(T) -> U>
+
+Creation of a boxed procedure reference.
+
+Example:
+
+```mlir
+ %39 = fir.emboxproc @proc_xyz
+```
+
+#### Unpacking Boxed Values
+
+
+#### `fir.unbox`
+
+
+Syntax: fir.unbox box-value : ( arg-type ) -> (!fir.ref<Tx>, iv, iw, !fir.tdesc<Tx>, iy, !fir.dims<z>)
+
+Unbox a boxed value into a result of multiple values from the box's
+component data. The values are, minimally, a reference to the data of the
+entity, the byte-size of one element, the rank, the type descriptor, a set
+of flags (packed in an integer, and an array of dimension information (of
+size rank).
+
+Example:
+
+```mlir
+ %40 = fir.call @foo() : !fir.box>
+ %41 = fir.unbox %40 : (!fir.box>) -> (!fir.ref>, i32, i32, !fir.tdesc>, i32, !fir.dims<4>)
+```
+
+Note: the exact type and content of the returned multiple value is still to
+be determined and may change.
+
+#### `fir.unboxchar`
+
+Syntax: fir.unboxchar boxchar-value : ( boxchar-type ) -> ( reference , len )
+
+Unbox a boxed CHARACTER pair.
+
+Example:
+
+```mlir
+ %45 = fir.call @foo() : !fir.boxchar<1>
+ %46 = fir.unboxchar %45 : (!fir.boxchar<1>) -> (!fir.ref>, i32)
+```
+
+#### `fir.unboxproc`
+
+
+Syntax: fir.unboxproc boxproc-value : ( boxproc-type ) -> ( callee , context )
+
+Unbox a boxed procedure reference.
+
+
+Example:
+
+```mlir
+ %47 = fir.call @foo() : () -> !fir.boxproc<() -> i32>
+ %48 = fir.unboxproc %47 : (!fir.ref<() -> i32>, !fir.ref<(f32, i32)>)
+```
+
+#### Queries on Boxed Values
+
+#### `fir.box_addr`
+
+
+Syntax: fir.box_addr boxable : ( box-type ) -> !fir.ref<T>
+
+
+Return the referenced entity from the boxed value. The boxable value must
+have a type of !fir.box<T>,
+!fir.boxchar<C>, or
+!fir.boxproc<FT>.
+
+
+Example:
+
+```mlir
+ %51 = fir.box_addr %boxvec : (!fir.box>) -> !fir.ref>
+```
+
+#### `fir.box_dims`
+
+
+Syntax: fir.box_dims box-value , dim : ( box-type ) -> (in, in, in)
+
+
+Return the dimension vector for the boxed value, _box-value_, at dimension,
+_dim_. The returned value is the triple of lower bound, extent, and stride,
+respectively. If _dim_ is larger than the rank of the boxed value, this
+operation has undefined behavior.
+
+
+Example:
+
+```mlir
+ %c1 = constant 1 : i32
+ %52 = fir.box_dims %40, %c1 : (!fir.box>, i32) -> (i32, i32, i32)
+```
+
+#### `fir.box_elesize`
+
+
+Syntax: fir.box_elesize box-value : ( box-type ) -> in
+
+
+Return the size of an element for the boxed value. The returned value may
+not be constant and only known at runtime.
+
+
+Example:
+
+```mlir
+ %53 = fir.box_elesize %40 : (!fir.box>, i32) -> i32
+```
+
+#### `fir.box_isalloc`
+
+
+Syntax: fir.box_isalloc box-value : ( box-type ) -> i1
+
+
+Return true if the boxed value is an ALLOCATABLE. This will return true if
+the originating _box-value_ was from a `fir.embox` with a _mem-ref_ value
+that had the type !fir.ref<!fir.heap<T>>.
+
+
+Example:
+
+```mlir
+ %54 = fir.box_isalloc %40 : (!fir.box>, i32) -> i1
+```
+
+#### `fir.box_isarray`
+
+Syntax: fir.box_isarray box-value : ( box-type ) -> i1
+
+
+Return true if the boxed value has a rank greater than 0. This will return
+true if the originating _box-value_ was from a `fir.embox` with a _mem-ref_
+value that had the type !fir.refT>> and a
+dims argument.
+
+
+Example:
+
+```mlir
+ %55 = fir.box_isarray %40 : (!fir.box>, i32) -> i1
+```
+
+#### `fir.box_isptr`
+
+
+Syntax: fir.box_isptr box-value : ( box-type ) -> i1
+
+Return true if the boxed value is a POINTER. This will return true if the
+originating _box-value_ was from a `fir.embox` with a _mem-ref_ value that
+had the type !fir.ref<!fir.ptr<T>>.
+
+Example:
+
+```mlir
+ %56 = fir.box_isptr %40 : (!fir.box>, i32) -> i1
+```
+
+#### `fir.box_rank`
+
+Syntax: fir.box_rank box-value : ( box-type ) -> in
+
+Return the rank of the boxed value. The rank of a scalar is 0.
+
+Example:
+
+```mlir
+ %57 = fir.box_rank %40 : (!fir.box>, i32) -> i32
+```
+
+#### `fir.box_tdesc`
+
+Syntax: fir.box_tdesc box-value : ( box-type ) -> !fir.tdesc< ele-type >
+
+Return the type descriptor of the boxed value.
+
+Example:
+
+```mlir
+ %58 = fir.box_tdesc %40 : (!fir.box>) -> !fir.tdesc>
+```
+
+#### `fir.boxchar_len`
+
+Syntax: fir.boxchar_len boxchar-value : (!fir.boxchar<1>) -> in
+
+Return the LEN type parameter of a boxchar value.
+
+Example:
+
+```mlir
+ %59 = fir.boxchar_len %45 : (!fir.boxchar<1>) -> i32
+```
+
+#### `fir.boxproc_host`
+
+
+Syntax: fir.boxproc_host boxproc-value : ( boxproc-type ) -> host-context
+
+
+Return the host context of a boxproc value, if any.
+
+
+Example:
+
+```mlir
+ %60 = fir.boxproc_host %47 : (!fir.boxproc<() -> none>) -> (() -> none, !fir.ref<(f32, i64)>)
+```
+
+The content and type of _host-context_ is to be determined.
+
+
+### Ops for Derived Types and Arrays
+
+#### `fir.coordinate_of`
+
+Syntax: fir.coordinate_of box-or-ref-value , index-field-list : ( reference-like-type ) -> !fir.ref<T>
+
+Compute the internal coordinate address starting from a boxed value or unboxed
+memory reference. Returns a memory reference. When computing the coordinate of
+an array element, the rank of the array must be known and the number of
+indexing expressions must equal the rank of the array.
+
+This operation will apply the access map from a boxed value implicitly.
+
+Unlike LLVM's GEP instruction, one cannot stride over the outermost reference;
+therefore, the leading 0 index must be omitted.
+
+Example:
+
+```mlir
+ %57 = fir.call @foo() : () -> !fir.heap>
+ %58 = fir.coordinate_of %57, %56 : (!fir.heap>, index) -> !fir.ref
+```
+
+#### `fir.extract_value`
+
+Syntax: fir.extract_value entity , index-field-list : ( entity-type , index-type ) -> subobject-type
+
+Extract a value from an entity with a type composed of tuples, arrays, and/or
+derived types. Returns the value from _entity_ with the type of the
+specified component. Cannot be used on values of `!fir.box` type.
+
+Note that the entity ssa-value must be of compile-time known size
+in order to use this operation.
+
+Example:
+
+```mlir
+ %59 = fir.field_index("field") : !fir.field
+ %60 = fir.call @foo3() : () -> !fir.type
+ %61 = fir.extract_value %60, %59 : (!fir.type, !fir.field) -> i32
+```
+
+#### `fir.insert_value`
+
+Syntax: fir.insert_value entity , value , index-field-list : ( entity-type , value-type , index-field-type-list ) -> entity-type
+
+Insert a value into an entity with a type composed of tuples, arrays, and/or
+derived types. Returns a new value of the same type as _entity_. It cannot be
+used on values of `!fir.box` type.
+
+Note that the entity ssa-value must be of compile-time known size
+in order to use this operation.
+
+Example:
+
+```mlir
+ %64 = fir.field_index("field") : !fir.field
+ %65 = fir.call @foo2() : () -> i32
+ %66 = fir.call @foo3() : () -> !fir.type
+ %67 = fir.insert_value(%66, %65, %64) : (!fir.type, i32, !fir.field) -> !fir.type
+```
+
+The above is one possible translation of the following Fortran code sequence.
+
+```Fortran
+ temp1 = foo2()
+ temp2 = foo3()
+ temp2%field = temp1
+```
+
+
+#### `fir.field_index`
+
+Syntax: fir.field_index ("field-name") : !fir.field
+
+Compute the field offset of a particular named field in a derived
+type. Note: it is possible in Fortran to write code that can only determine
+the exact offset of a particular field in a parameterized derived type at
+runtime.
+
+Example:
+
+```mlir
+ %62 = fir.field_index ("member_1") : !fir.field
+```
+
+#### `fir.len_param_index`
+
+Syntax: fir.len_param_index ("len-param-name") : !fir.field
+
+Compute the LEN type parameter offset of a particular named parameter in a
+derived type.
+
+Example:
+
+```mlir
+ %62 = fir.len_param_index("param_1") : !fir.field
+```
+
+#### `fir.gendims`
+
+Syntax: fir.gendims triple-list : ( type-list ) -> !fir.dims<R>
+
+
+Generate dimension information. This is needed to embox array entities. A
+triple corresponds to the definition of Fortran's array slice operator.
+Specifically, the components are `(first, last, stride)`.
+
+(These values will be lowered appropriately for the target runtime, which may
+encode the triple as a `CFI_dim_t`, for example.)
+
+Example:
+
+```mlir
+ %c1 = constant 1 : i32
+ %c10 = constant 10 : i32
+ %63 = fir.gendims %c1,%c10,%c1 : (i32,i32,i32) -> !fir.dims<1>
+```
+
+### Generalized Control Flow Ops
+
+
+#### `fir.loop`
+
+Syntax:
+fir.loop ssa-id = lower-bound to upper-bound [ step step-value ] [ unordered ] {
+ op-list
+}
+
+
+Generalized high-level looping construct. This operation is similar to
+MLIR's affine.for but does not have the restriction that the loop be
+affine.
+
+Example:
+
+```mlir
+ %72 = fir.load %A : !fir.ref}>>
+ fir.loop %i = 1 to 10 unordered {
+ %73 = fir.extract_element %72, %field, %i : (!fir.ref}>>, !fir.field, i32) -> f32
+ %74 = fir.call @compute(%73) : (f32) -> i32
+ %75 = fir.coordinate_of %B, %74 : (!fir.ref>, i32) -> !fir.ref
+ fir.store %73 to %75 : !fir.ref
+ }
+```
+
+The above fir.loop is a possible translation for the following Fortran DO
+CONCURRENT loop.
+
+
+```Fortran
+ DO CONCURRENT (i = 1:10) LOCAL(x)
+ x = A%fld(i)
+ B(compute(x)) = x
+ END DO
+```
+
+
+#### `fir.where`
+
+Syntax:
+fir.where condition {
+ op-list
+} [ otherwise {
+ op-list
+} ]
+
+
+To conditionally execute operations (typically) within the body of a
+`fir.loop` operation. This operation is similar to `affine.if`, but it is
+generalized and not restricted to affine loop nests.
+
+Example:
+
+```mlir
+ %78 = fir.call %75(%74) : !fir.ref
+ fir.where %56 {
+ fir.store %76 to %78 : !fir.ref
+ } otherwise {
+ fir.store %77 to %78 : !fir.ref
+ }
+```
+
+#### `fir.call`
+
+Syntax: fir.call callee ( arg-list ) : func-type
+
+Call the specified function or function reference.
+
+Example:
+
+```mlir
+ %89 = fir.call %funcref(%arg0) : (!fir.ref) -> f32
+ %90 = fir.call @function(%arg1, %arg2) : (!fir.ref, !fir.ref) -> f32
+```
+
+#### `fir.dispatch`
+
+Syntax: fir.dispatch method-id ( arg-list ) : func-type
+
+Perform a dynamic dispatch on the method name via the dispatch table
+associated with the first argument. The attribute 'pass_arg_pos' can be
+used to select a dispatch argument other than the first one.
+
+Example:
+
+```mlir
+ %91 = fir.dispatch "methodA"(%89, %90) : (!fir.box>, !fir.ref) -> i32
+```
+
+### Complex Ops
+
+The standard dialect does not have primitive operations for complex types.
+We've added these primitives in the FIR dialect.
+
+#### `fir.addc`
+
+Syntax: fir.addc ssa-value, ssa-value : !fir.complex<k>
+
+Perform addition of two complex values. The result and arguments must be
+the same type.
+
+#### `fir.subc`
+
+Syntax: fir.subc ssa-value, ssa-value : !fir.complex<k>
+
+Perform subtraction on complex values. The result and arguments must be the
+same type.
+
+#### `fir.mulc`
+
+Syntax: fir.mulc ssa-value, ssa-value : !fir.complex<k>
+
+Perform multiplication on complex values. The result and arguments must be
+the same type.
+
+#### `fir.divc`
+
+Syntax: fir.divc ssa-value, ssa-value : !fir.complex<k>
+
+Perform division on complex values. The result and arguments must be the
+same type.
+
+### Other Ops
+
+#### `fir.address_of`
+
+Syntax: fir.address_of (@symbol) : T
+
+Converts a symbol to an SSA-value.
+
+Example:
+
+```mlir
+ %func = fir.address_of(@func) : !fir.ref<(!fir.ref) -> ()>
+```
+
+#### `fir.convert`
+
+Syntax: fir.convert ssa-value : ( T ) -> U
+
+
+Generalized type conversion. Convert the _ssa-value_ from type _T_ to type
+_U_. Conversions between some types may not be defined. When _T_ and _U_
+are the same type, this instruction is a NOP.
+
+
+Example:
+
+```mlir
+ %92 = fir.call @foo() : () -> i64
+ %93 = fir.convert %92 : (i64) -> i32
+```
+
+The above conversion truncates a 64-bit integer value to 32-bits.
+
+
+#### `fir.gentypedesc`
+
+Syntax: fir.gentypedesc T : !fir.tdesc<T>
+
+Generate a type descriptor for the type _T_. This may be useful for
+generating type discriminating code. A type descriptor is an opaque
+singleton constant value in FIR. (It is assumed to be COMDAT.)
+
+
+Example:
+
+```mlir
+ !T = type !fir.type
+ %97 = fir.gentypedesc !T : !fir.tdesc
+```
+
+#### `fir.no_reassoc`
+
+Syntax: fir.no_reassoc ssa-value : T
+
+Primitive operation meant to intrusively prevent operator reassociation.
+The operation is otherwise a nop and the value returned is the same as the
+argument.
+
+
+Example:
+
+```mlir
+ %98 = mulf %96,%97 : f32
+ %99 = fir.no_reassoc %98 : f32
+ %100 = addf %99,%95 : f32
+```
+
+The presence of this operation prevents any local optimizations. In the
+above example, this would prevent replacing the multiply and add with an
+FMA operation.
+
+## Module Abstractions
+
+#### `fir.global`
+
+Syntax:
+fir.global @global-name [ constant ] : type {
+ initializer-list
+}
+
+
+A global variable or constant with initial values.
+
+Example:
+
+```mlir
+ fir.global @_QV_Mquark_Vvarble : !VarType {
+ constant 1 : i32
+ constant @some_func : (i32) -> !fir.logical<1>
+ }
+```
+
+The example creates a global variable (writable) named
+`@_QV_Mquark_Vvarble` with some initial values. The initializer should
+conform to the variable's type.
+
+#### `fir.global_entry`
+
+Syntax: fir.global_entry field-id , constant
+
+A global entry is a mapping in a global variable that binds a field-id to a
+constant value. This allows one to specify the values composed in a
+product type and simultaneously defer layout decisions.
+
+Example:
+
+ To do.
+
+#### `fir.dispatch_table`
+
+
+Syntax:
+fir.dispatch_table @table-name {
+ dt-entry-list
+}
+
+
+A dispatch lookup table used implicitly by a fir.dispatch operation.
+
+Example:
+
+ See below.
+
+
+#### `fir.dt_entry`
+
+Syntax: fir.dt_entry "method-id" , callee
+
+
+A dispatch table entry is a mapping in a dispatch table that binds a
+method-id to a callee-reference.
+
+
+Example:
+
+```mlir
+ fir.dispatch_table @_QDTMquuzTfoo {
+ fir.dt_entry "method1", @_QFNMquuzTfooPmethod1AfooR
+ fir.dt_entry "method2", @_QFNMquuzTfooPmethod2AfooII
+ }
+```
+
diff --git a/include/fir/.clang-format b/include/fir/.clang-format
deleted file mode 100644
index a74fda4b6734..000000000000
--- a/include/fir/.clang-format
+++ /dev/null
@@ -1,2 +0,0 @@
-BasedOnStyle: LLVM
-AlwaysBreakTemplateDeclarations: Yes
diff --git a/include/flang/CMakeLists.txt b/include/flang/CMakeLists.txt
index 7fae707bdc46..ec30a1b17a1d 100644
--- a/include/flang/CMakeLists.txt
+++ b/include/flang/CMakeLists.txt
@@ -1,8 +1,3 @@
-#===-- include/flang/CMakeLists.txt ----------------------------------------===#
-#
-# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
-# See https://llvm.org/LICENSE.txt for license information.
-# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-#
-#===------------------------------------------------------------------------===#
-
+if(LINK_WITH_FIR)
+ add_subdirectory(optimizer)
+endif()
diff --git a/include/flang/optimizer/CMakeLists.txt b/include/flang/optimizer/CMakeLists.txt
new file mode 100644
index 000000000000..0ca0f41c5af4
--- /dev/null
+++ b/include/flang/optimizer/CMakeLists.txt
@@ -0,0 +1 @@
+add_subdirectory(Dialect)
diff --git a/include/flang/optimizer/Dialect/CMakeLists.txt b/include/flang/optimizer/Dialect/CMakeLists.txt
new file mode 100644
index 000000000000..9528b1abffb0
--- /dev/null
+++ b/include/flang/optimizer/Dialect/CMakeLists.txt
@@ -0,0 +1,4 @@
+set(LLVM_TARGET_DEFINITIONS FIROps.td)
+mlir_tablegen(FIROps.h.inc -gen-op-decls)
+mlir_tablegen(FIROps.cpp.inc -gen-op-defs)
+add_public_tablegen_target(FIROpsIncGen)
diff --git a/include/flang/optimizer/Dialect/FIRAttr.h b/include/flang/optimizer/Dialect/FIRAttr.h
new file mode 100644
index 000000000000..3ce9a54a629d
--- /dev/null
+++ b/include/flang/optimizer/Dialect/FIRAttr.h
@@ -0,0 +1,166 @@
+//===-- optimizer/Dialect/FIRAttr.h -- FIR attributes -----------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef OPTIMIZER_DIALECT_FIRATTR_H
+#define OPTIMIZER_DIALECT_FIRATTR_H
+
+#include "mlir/IR/Attributes.h"
+
+namespace mlir {
+class DialectAsmParser;
+class DialectAsmPrinter;
+} // namespace mlir
+
+namespace fir {
+
+class FIROpsDialect;
+
+namespace detail {
+struct RealAttributeStorage;
+struct TypeAttributeStorage;
+} // namespace detail
+
+enum AttributeKind {
+ FIR_ATTR = mlir::Attribute::FIRST_FIR_ATTR,
+ FIR_EXACTTYPE, // instance_of, precise type relation
+ FIR_SUBCLASS, // subsumed_by, is-a (subclass) relation
+ FIR_POINT,
+ FIR_CLOSEDCLOSED_INTERVAL,
+ FIR_OPENCLOSED_INTERVAL,
+ FIR_CLOSEDOPEN_INTERVAL,
+ FIR_REAL_ATTR,
+};
+
+class ExactTypeAttr
+ : public mlir::Attribute::AttrBase {
+public:
+ using Base::Base;
+ using ValueType = mlir::Type;
+
+ static constexpr llvm::StringRef getAttrName() { return "instance"; }
+ static ExactTypeAttr get(mlir::Type value);
+
+ mlir::Type getType() const;
+
+ static constexpr bool kindof(unsigned kind) { return kind == getId(); }
+ static constexpr unsigned getId() { return AttributeKind::FIR_EXACTTYPE; }
+};
+
+class SubclassAttr
+ : public mlir::Attribute::AttrBase {
+public:
+ using Base::Base;
+ using ValueType = mlir::Type;
+
+ static constexpr llvm::StringRef getAttrName() { return "subsumed"; }
+ static SubclassAttr get(mlir::Type value);
+
+ mlir::Type getType() const;
+
+ static constexpr bool kindof(unsigned kind) { return kind == getId(); }
+ static constexpr unsigned getId() { return AttributeKind::FIR_SUBCLASS; }
+};
+
+// Attributes for building SELECT CASE multiway branches
+
+/// A closed interval (including the bound values) is an interval with both an
+/// upper and lower bound as given as ssa-values.
+/// A case selector of `CASE (n:m)` corresponds to any value from `n` to `m` and
+/// is encoded as `#fir.interval, %n, %m`.
+class ClosedIntervalAttr
+ : public mlir::Attribute::AttrBase {
+public:
+ using Base::Base;
+
+ static constexpr llvm::StringRef getAttrName() { return "interval"; }
+ static ClosedIntervalAttr get(mlir::MLIRContext *ctxt);
+ static constexpr bool kindof(unsigned kind) { return kind == getId(); }
+ static constexpr unsigned getId() {
+ return AttributeKind::FIR_CLOSEDCLOSED_INTERVAL;
+ }
+};
+
+/// An upper bound is an open interval (including the bound value) as given as
+/// an ssa-value.
+/// A case selector of `CASE (:m)` corresponds to any value up to and including
+/// `m` and is encoded as `#fir.upper, %m`.
+class UpperBoundAttr : public mlir::Attribute::AttrBase {
+public:
+ using Base::Base;
+
+ static constexpr llvm::StringRef getAttrName() { return "upper"; }
+ static UpperBoundAttr get(mlir::MLIRContext *ctxt);
+ static constexpr bool kindof(unsigned kind) { return kind == getId(); }
+ static constexpr unsigned getId() {
+ return AttributeKind::FIR_OPENCLOSED_INTERVAL;
+ }
+};
+
+/// A lower bound is an open interval (including the bound value) as given as
+/// an ssa-value.
+/// A case selector of `CASE (n:)` corresponds to any value down to and
+/// including `n` and is encoded as `#fir.lower, %n`.
+class LowerBoundAttr : public mlir::Attribute::AttrBase {
+public:
+ using Base::Base;
+
+ static constexpr llvm::StringRef getAttrName() { return "lower"; }
+ static LowerBoundAttr get(mlir::MLIRContext *ctxt);
+ static constexpr bool kindof(unsigned kind) { return kind == getId(); }
+ static constexpr unsigned getId() {
+ return AttributeKind::FIR_CLOSEDOPEN_INTERVAL;
+ }
+};
+
+/// A pointer interval is an closed interval as given as an ssa-value. The
+/// interval contains exactly one value.
+/// A case selector of `CASE (p)` corresponds to exactly the value `p` and is
+/// encoded as `#fir.point, %p`.
+class PointIntervalAttr : public mlir::Attribute::AttrBase {
+public:
+ using Base::Base;
+
+ static constexpr llvm::StringRef getAttrName() { return "point"; }
+ static PointIntervalAttr get(mlir::MLIRContext *ctxt);
+ static constexpr bool kindof(unsigned kind) { return kind == getId(); }
+ static constexpr unsigned getId() { return AttributeKind::FIR_POINT; }
+};
+
+/// A real attribute is used to workaround MLIR's default parsing of a real
+/// constant.
+/// `#fir.real<10, 3.14>` is used to introduce a real constant of value `3.14`
+/// with a kind of `10`.
+class RealAttr
+ : public mlir::Attribute::AttrBase {
+public:
+ using Base::Base;
+ using ValueType = std::pair;
+
+ static constexpr llvm::StringRef getAttrName() { return "real"; }
+ static RealAttr get(mlir::MLIRContext *ctxt, const ValueType &key);
+
+ int getFKind() const;
+ llvm::APFloat getValue() const;
+
+ static constexpr bool kindof(unsigned kind) { return kind == getId(); }
+ static constexpr unsigned getId() { return AttributeKind::FIR_REAL_ATTR; }
+};
+
+mlir::Attribute parseFirAttribute(FIROpsDialect *dialect,
+ mlir::DialectAsmParser &parser,
+ mlir::Type type);
+
+void printFirAttribute(FIROpsDialect *dialect, mlir::Attribute attr,
+ mlir::DialectAsmPrinter &p);
+
+} // namespace fir
+
+#endif // OPTIMIZER_DIALECT_FIRATTR_H
diff --git a/include/flang/optimizer/Dialect/FIRDialect.h b/include/flang/optimizer/Dialect/FIRDialect.h
new file mode 100644
index 000000000000..0c80bbe80e70
--- /dev/null
+++ b/include/flang/optimizer/Dialect/FIRDialect.h
@@ -0,0 +1,86 @@
+//===-- optimizer/Dialect/FIRDialect.h -- FIR dialect -----------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef OPTIMIZER_DIALECT_FIRDIALECT_H
+#define OPTIMIZER_DIALECT_FIRDIALECT_H
+
+#include "mlir/IR/Dialect.h"
+#include "mlir/InitAllPasses.h"
+
+namespace llvm {
+class raw_ostream;
+class StringRef;
+} // namespace llvm
+
+namespace mlir {
+class Attribute;
+class DialectAsmParser;
+class DialectAsmPrinter;
+class Location;
+class MLIRContext;
+class Type;
+} // namespace mlir
+
+namespace fir {
+
+/// FIR dialect
+class FIROpsDialect final : public mlir::Dialect {
+public:
+ explicit FIROpsDialect(mlir::MLIRContext *ctx);
+ virtual ~FIROpsDialect();
+
+ static llvm::StringRef getDialectNamespace() { return "fir"; }
+
+ mlir::Type parseType(mlir::DialectAsmParser &parser) const override;
+ void printType(mlir::Type ty, mlir::DialectAsmPrinter &p) const override;
+
+ mlir::Attribute parseAttribute(mlir::DialectAsmParser &parser,
+ mlir::Type type) const override;
+ void printAttribute(mlir::Attribute attr,
+ mlir::DialectAsmPrinter &p) const override;
+};
+
+/// Register the dialect with MLIR
+inline void registerFIR() {
+ // we want to register exactly once
+ [[maybe_unused]] static bool init_once = [] {
+ mlir::registerDialect();
+ return true;
+ }();
+}
+
+/// Register the standard passes we use. This comes from registerAllPasses(),
+/// but is a smaller set since we aren't using many of the passes found there.
+inline void registerGeneralPasses() {
+ mlir::createCanonicalizerPass();
+ mlir::createCSEPass();
+ mlir::createVectorizePass({});
+ mlir::createLoopUnrollPass();
+ mlir::createLoopUnrollAndJamPass();
+ mlir::createSimplifyAffineStructuresPass();
+ mlir::createLoopFusionPass();
+ mlir::createLoopInvariantCodeMotionPass();
+ mlir::createAffineLoopInvariantCodeMotionPass();
+ mlir::createPipelineDataTransferPass();
+ mlir::createLowerAffinePass();
+ mlir::createLoopTilingPass(0);
+ mlir::createLoopCoalescingPass();
+ mlir::createAffineDataCopyGenerationPass(0, 0);
+ mlir::createMemRefDataFlowOptPass();
+ mlir::createStripDebugInfoPass();
+ mlir::createPrintOpStatsPass();
+ mlir::createInlinerPass();
+ mlir::createSymbolDCEPass();
+ mlir::createLocationSnapshotPass({});
+}
+
+inline void registerFIRPasses() { registerGeneralPasses(); }
+
+} // namespace fir
+
+#endif // OPTIMIZER_DIALECT_FIRDIALECT_H
diff --git a/include/flang/optimizer/Dialect/FIROps.h b/include/flang/optimizer/Dialect/FIROps.h
new file mode 100644
index 000000000000..1ae5a3532cf1
--- /dev/null
+++ b/include/flang/optimizer/Dialect/FIROps.h
@@ -0,0 +1,74 @@
+//===-- optimizer/Dialect/FIROps.h - FIR operations -------------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef OPTIMIZER_DIALECT_FIROPS_H
+#define OPTIMIZER_DIALECT_FIROPS_H
+
+#include "mlir/IR/Builders.h"
+#include "mlir/IR/OpDefinition.h"
+#include "mlir/IR/OpImplementation.h"
+#include "mlir/IR/SymbolTable.h"
+#include "llvm/ADT/ArrayRef.h"
+#include "llvm/ADT/StringRef.h"
+
+using namespace mlir;
+
+namespace fir {
+
+class FirEndOp;
+
+enum class CmpFPredicate {
+ FirstValidValue,
+ // Always false
+ AlwaysFalse = FirstValidValue,
+ // Ordered comparisons
+ OEQ,
+ OGT,
+ OGE,
+ OLT,
+ OLE,
+ ONE,
+ // Both ordered
+ ORD,
+ // Unordered comparisons
+ UEQ,
+ UGT,
+ UGE,
+ ULT,
+ ULE,
+ UNE,
+ // Any unordered
+ UNO,
+ // Always true
+ AlwaysTrue,
+ // Number of predicates.
+ NumPredicates
+};
+
+ParseResult isValidCaseAttr(Attribute attr);
+unsigned getCaseArgumentOffset(ArrayRef cases, unsigned dest);
+ParseResult parseSelector(OpAsmParser *parser, OperationState *result,
+ OpAsmParser::OperandType &selector, mlir::Type &type);
+
+void buildCmpFOp(Builder *builder, OperationState &result,
+ CmpFPredicate predicate, Value lhs, Value rhs);
+void buildCmpCOp(Builder *builder, OperationState &result,
+ CmpFPredicate predicate, Value lhs, Value rhs);
+ParseResult parseCmpfOp(OpAsmParser &parser, OperationState &result);
+ParseResult parseCmpcOp(OpAsmParser &parser, OperationState &result);
+
+#define GET_OP_CLASSES
+#include "flang/optimizer/Dialect/FIROps.h.inc"
+
+LoopOp getForInductionVarOwner(Value val);
+
+bool isReferenceLike(mlir::Type type);
+
+} // namespace fir
+
+#endif // OPTIMIZER_DIALECT_FIROPS_H
diff --git a/include/flang/optimizer/Dialect/FIROps.td b/include/flang/optimizer/Dialect/FIROps.td
new file mode 100644
index 000000000000..5d3f1adc38ad
--- /dev/null
+++ b/include/flang/optimizer/Dialect/FIROps.td
@@ -0,0 +1,2576 @@
+//===-- FIROps.td - FIR operation definitions --------------*- tablegen -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+///
+/// \file
+/// Definition of the FIR dialect operations
+///
+//===----------------------------------------------------------------------===//
+
+#ifndef FIR_DIALECT_FIR_OPS
+#define FIR_DIALECT_FIR_OPS
+
+#ifndef OP_BASE
+include "mlir/IR/OpBase.td"
+#endif
+
+def fir_Dialect : Dialect {
+ let name = "fir";
+}
+
+// Types and predicates
+
+def fir_Type : Type,
+ "FIR dialect type">;
+
+// Fortran intrinsic types
+def fir_CharacterType : Type()">,
+ "FIR character type">;
+def fir_ComplexType : Type()">,
+ "FIR complex type">;
+def fir_IntegerType : Type()">,
+ "FIR integer type">;
+def fir_LogicalType : Type()">,
+ "FIR logical type">;
+def fir_RealType : Type()">,
+ "FIR real type">;
+
+// Generalized FIR and standard dialect types representing intrinsic types
+def AnyIntegerLike : TypeConstraint, "any integer">;
+def AnyLogicalLike : TypeConstraint, "any logical">;
+def AnyRealLike : TypeConstraint, "any real">;
+def AnyIntegerType : Type;
+
+// Fortran derived (user defined) type
+def fir_RecordType : Type()">,
+ "FIR derived type">;
+
+// Fortran array attribute
+def fir_SequenceType : Type()">,
+ "array type">;
+
+// Composable types
+def AnyCompositeLike : TypeConstraint, "any composite">;
+
+// Reference to an entity type
+def fir_ReferenceType : Type()">,
+ "reference type">;
+
+// Reference to an ALLOCATABLE attribute type
+def fir_HeapType : Type()">,
+ "allocatable type">;
+
+// Reference to a POINTER attribute type
+def fir_PointerType : Type()">,
+ "pointer type">;
+
+// Reference types
+def AnyReferenceLike : TypeConstraint, "any reference">;
+
+// A descriptor tuple (captures a reference to an entity and other information)
+def fir_BoxType : Type()">, "box type">;
+
+// CHARACTER type descriptor. A pair of a data reference and a LEN value.
+def fir_BoxCharType : Type()">,
+ "box character type">;
+
+// PROCEDURE POINTER descriptor. A pair that can capture a host closure.
+def fir_BoxProcType : Type()">,
+ "box procedure type">;
+
+def AnyBoxLike : TypeConstraint, "any box">;
+
+def AnyRefOrBox : TypeConstraint,
+ "any reference or box">;
+
+// A vector of Fortran triple notation describing a multidimensional array
+def fir_DimsType : Type()">, "dim type">;
+def AnyEmboxLike : TypeConstraint,
+ "any legal embox argument type">;
+def AnyEmboxArg : Type;
+
+// A type descriptor's type
+def fir_TypeDescType : Type()">,
+ "type desc type">;
+
+// A field (in a RecordType) argument's type
+def fir_FieldType : Type()">, "field type">;
+
+// A LEN parameter (in a RecordType) argument's type
+def fir_LenType : Type()">,
+ "LEN parameter type">;
+
+def AnyComponentLike : TypeConstraint,
+ "any coordinate index">;
+def AnyComponentType : Type;
+
+def AnyCoordinateLike : TypeConstraint, "any coordinate index">;
+def AnyCoordinateType : Type;
+
+// Base class for FIR operations.
+// All operations automatically get a prefix of "fir.".
+class fir_Op traits>
+ : Op;
+
+// Base class for FIR operations that take a single argument
+class fir_SimpleOp traits>
+ : fir_Op {
+
+ let assemblyFormat = [{
+ operands attr-dict `:` functional-type(operands, results)
+ }];
+}
+
+// Base builder for allocate operations
+def fir_AllocateOpBuilder : OpBuilder<
+ "Builder *builder, OperationState &result, Type inType,"
+ "ArrayRef lenParams = {}, ArrayRef sizes = {},"
+ "ArrayRef attributes = {}",
+ [{
+ result.addTypes(getRefTy(inType));
+ result.addAttribute("in_type", mlir::TypeAttr::get(inType));
+ result.addOperands(sizes);
+ for (auto namedAttr : attributes)
+ result.addAttribute(namedAttr.first, namedAttr.second);
+ }]>;
+
+def fir_NamedAllocateOpBuilder : OpBuilder<
+ "Builder *builder, OperationState &result, Type inType, StringRef name,"
+ "ArrayRef lenParams = {}, ArrayRef sizes = {},"
+ "ArrayRef attributes = {}",
+ [{
+ result.addTypes(getRefTy(inType));
+ result.addAttribute("in_type", mlir::TypeAttr::get(inType));
+ result.addAttribute("name", builder->getStringAttr(name));
+ result.addOperands(sizes);
+ for (auto namedAttr : attributes)
+ result.addAttribute(namedAttr.first, namedAttr.second);
+ }]>;
+
+def fir_OneResultOpBuilder : OpBuilder<
+ "Builder *, OperationState &result, Type resultType,"
+ "ArrayRef operands, ArrayRef attributes = {}",
+ [{
+ if (resultType)
+ result.addTypes(resultType);
+ result.addOperands(operands);
+ for (auto namedAttr : attributes)
+ result.addAttribute(namedAttr.first, namedAttr.second);
+ }]>;
+
+// Base class of FIR operations that return 1 result
+class fir_OneResultOp traits = []> :
+ fir_Op, Results<(outs fir_Type:$res)> {
+ let builders = [fir_OneResultOpBuilder];
+}
+
+// Base class of FIR operations that have 1 argument and return 1 result
+class fir_SimpleOneResultOp traits = []> :
+ fir_SimpleOp {
+ let builders = [fir_OneResultOpBuilder];
+}
+
+class fir_TwoBuilders {
+ list builders = [b1, b2];
+}
+
+class fir_AllocatableBaseOp traits = []> :
+ fir_Op, Results<(outs fir_Type:$res)> {
+ let arguments = (ins
+ OptionalAttr:$name,
+ OptionalAttr:$target
+ );
+}
+
+class fir_AllocatableOp traits =[]> :
+ fir_AllocatableBaseOp,
+ fir_TwoBuilders,
+ Arguments<(ins TypeAttr:$in_type, Variadic:$args)> {
+
+ let parser = [{
+ mlir::Type intype;
+ if (parser.parseType(intype))
+ return mlir::failure();
+ auto &builder = parser.getBuilder();
+ result.addAttribute(inType(), mlir::TypeAttr::get(intype));
+ llvm::SmallVector operands;
+ llvm::SmallVector typeVec;
+ bool hasOperands = false;
+ if (!parser.parseOptionalLParen()) {
+ // parse the LEN params of the derived type. ( : )
+ if (parser.parseOperandList(operands,
+ mlir::OpAsmParser::Delimiter::None) ||
+ parser.parseColonTypeList(typeVec) ||
+ parser.parseRParen())
+ return mlir::failure();
+ auto lens = builder.getI32IntegerAttr(operands.size());
+ result.addAttribute(lenpName(), lens);
+ hasOperands = true;
+ }
+ if (!parser.parseOptionalComma()) {
+ // parse size to scale by, vector of n dimensions of type index
+ auto opSize = operands.size();
+ if (parser.parseOperandList(operands, mlir::OpAsmParser::Delimiter::None))
+ return mlir::failure();
+ for (auto i = opSize, end = operands.size(); i != end; ++i)
+ typeVec.push_back(builder.getIndexType());
+ hasOperands = true;
+ }
+ if (hasOperands &&
+ parser.resolveOperands(operands, typeVec, parser.getNameLoc(),
+ result.operands))
+ return mlir::failure();
+ mlir::Type restype = wrapResultType(intype);
+ if (!restype) {
+ parser.emitError(parser.getNameLoc(), "invalid allocate type: ")
+ << intype;
+ return mlir::failure();
+ }
+ if (parser.parseOptionalAttrDict(result.attributes) ||
+ parser.addTypeToList(restype, result.types))
+ return mlir::failure();
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' ' << getAttr(inType());
+ if (hasLenParams()) {
+ // print the LEN parameters to a derived type in parens
+ p << '(';
+ p.printOperands(getLenParams());
+ p << " : ";
+ mlir::interleaveComma(getLenParams(), p.getStream(),
+ [&](const auto &opnd) {
+ p.printType(opnd.getType());
+ });
+ p << ')';
+ }
+ // print the shape of the allocation (if any); all must be index type
+ for (auto sh : getShapeOperands()) {
+ p << ", ";
+ p.printOperand(sh);
+ }
+ p.printOptionalAttrDict(getAttrs(), {inType(), lenpName()});
+ }];
+
+ string extraAllocClassDeclaration = [{
+ static constexpr llvm::StringRef inType() { return "in_type"; }
+ static constexpr llvm::StringRef lenpName() { return "len_param_count"; }
+ mlir::Type getAllocatedType();
+ bool hasLenParams() { return bool{getAttr(lenpName())}; }
+ unsigned numLenParams() {
+ if (auto val = getAttrOfType(lenpName()))
+ return val.getInt();
+ return 0;
+ }
+ operand_range getLenParams() {
+ return {operand_begin(), operand_begin() + numLenParams()};
+ }
+ operand_range getShapeOperands() {
+ return {operand_begin() + numLenParams(), operand_end()};
+ }
+ static mlir::Type getRefTy(mlir::Type ty);
+
+ /// Get the input type of the allocation
+ mlir::Type getInType() {
+ return getAttrOfType(inType()).getValue();
+ }
+ }];
+
+ // Verify checks common to all allocation operations
+ string allocVerify = [{
+ llvm::SmallVector visited;
+ if (verifyInType(getInType(), visited))
+ return emitOpError("invalid type for allocation");
+ if (verifyRecordLenParams(getInType(), numLenParams()))
+ return emitOpError("LEN params do not correspond to type");
+ }];
+}
+
+// Memory SSA operations
+
+def fir_AllocaOp : fir_AllocatableOp<"alloca"> {
+ let summary = "allocate storage for a temporary on the stack given a type";
+ let description = [{
+ This primitive operation is used to allocate an object on the stack. A
+ reference to the object of type `!fir.ref` is returned. The returned
+ object has an undefined/uninitialized state. The allocation can be given
+ an optional name. The allocation may have a dynamic repetition count
+ for allocating a sequence of locations for the specified type.
+
+ %11 = fir.alloca i32
+ %12 = fir.alloca !fir.array<8 x i64>
+ %13 = fir.alloca f32, %5
+
+ %14 = ... : i16
+ %15 = ... : i32
+ %16 = fir.alloca !fir.type (%14, %15 : i16, i32)
+
+ Note that in the case of `%13`, a contiguous block of memory is allocated
+ and its size is a runtime multiple of a 32-bit REAL value.
+
+ In the case of `%16`, the arguments `%14` and `%15` are LEN parameters
+ (`len1`, `len2`) to the type `PT`.
+
+ Finally, the operation is undefined if the ssa-value `%5` is negative.
+ }];
+
+ let results = (outs fir_ReferenceType);
+
+ let verifier = allocVerify#[{
+ mlir::Type outType = getType();
+ if (!outType.isa())
+ return emitOpError("must be a !fir.ref type");
+ return mlir::success();
+ }];
+
+ let extraClassDeclaration = extraAllocClassDeclaration#[{
+ static mlir::Type wrapResultType(mlir::Type intype);
+ }];
+}
+
+def fir_LoadOp : fir_OneResultOp<"load", []>,
+ Arguments<(ins AnyReferenceLike:$memref)> {
+ let summary = "load a value from a memory reference";
+ let description = [{
+ Load a value from a memory reference into an ssa-value (virtual register).
+ Produces an immutable ssa-value of the referent type. A memory reference
+ has type `!fir.ref`, `!fir.heap`, or `!fir.ptr`.
+
+ %14 = fir.alloca i32 : !fir.ref
+ %15 = fir.load %14 : !fir.ref
+
+ The ssa-value has an undefined value if the memory reference is undefined
+ or null.
+ }];
+
+ let builders = [OpBuilder<
+ "Builder *builder, OperationState &result, Value refVal",
+ [{
+ if (!refVal) {
+ mlir::emitError(result.location, "LoadOp has null argument");
+ return;
+ }
+ fir::ReferenceType refTy = refVal.getType().cast();
+ result.addOperands(refVal);
+ result.addTypes(refTy.getEleTy());
+ }]
+ >];
+
+ let parser = [{
+ mlir::Type type;
+ mlir::OpAsmParser::OperandType oper;
+ if (parser.parseOperand(oper) ||
+ parser.parseOptionalAttrDict(result.attributes) ||
+ parser.parseColonType(type) ||
+ parser.resolveOperand(oper, type, result.operands))
+ return mlir::failure();
+ mlir::Type eleTy;
+ if (getElementOf(eleTy, type) ||
+ parser.addTypeToList(eleTy, result.types))
+ return mlir::failure();
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' ';
+ p.printOperand(memref());
+ p.printOptionalAttrDict(getAttrs(), {});
+ p << " : " << memref().getType();
+ }];
+
+ let extraClassDeclaration = [{
+ static mlir::ParseResult getElementOf(mlir::Type &ele, mlir::Type ref);
+ }];
+}
+
+def fir_StoreOp : fir_Op<"store", []>,
+ Arguments<(ins AnyType:$value, AnyReferenceLike:$memref)> {
+ let summary = "store an SSA-value to a memory location";
+
+ let description = [{
+ Store an ssa-value (virtual register) to a memory reference. The stored
+ value must be of the same type as the referent type of the memory
+ reference.
+
+ %16 = fir.call @foo() : f64
+ %17 = fir.call @bar() : !fir.ptr
+ fir.store %16 to %17 : !fir.ptr
+
+ The above store changes the value to which the pointer is pointing and not
+ the pointer itself. The operation is undefined if the memory reference is
+ undefined or null.
+ }];
+
+ let verifier = [{
+ if (value().getType() != fir::dyn_cast_ptrEleTy(memref().getType()))
+ return emitOpError("store value type must match memory reference type");
+ return mlir::success();
+ }];
+
+ let parser = [{
+ mlir::Type type;
+ mlir::OpAsmParser::OperandType oper;
+ mlir::OpAsmParser::OperandType store;
+ if (parser.parseOperand(oper) ||
+ parser.parseKeyword("to") ||
+ parser.parseOperand(store) ||
+ parser.parseOptionalAttrDict(result.attributes) ||
+ parser.parseColonType(type) ||
+ parser.resolveOperand(oper, elementType(type),
+ result.operands) ||
+ parser.resolveOperand(store, type, result.operands))
+ return mlir::failure();
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' ';
+ p.printOperand(value());
+ p << " to ";
+ p.printOperand(memref());
+ p.printOptionalAttrDict(getAttrs(), {});
+ p << " : " << memref().getType();
+ }];
+
+ let extraClassDeclaration = [{
+ static mlir::Type elementType(mlir::Type refType);
+ }];
+}
+
+def fir_UndefOp : fir_OneResultOp<"undefined", [NoSideEffect]> {
+ let summary = "explicit undefined value of some type";
+ let description = [{
+ Constructs an ssa-value of the specified type with an undefined value.
+ This operation is typically created internally by the mem2reg conversion
+ pass. An undefined value can be of any type except `!fir.ref`.
+
+ %18 = fir.undefined !fir.array<10 x !fir.type>
+ }];
+
+ let verifier = [{
+ if (auto ref = getType().dyn_cast())
+ return emitOpError("undefined values of type !fir.ref not allowed");
+ return mlir::success();
+ }];
+
+ let parser = [{
+ mlir::Type intype;
+ if (parser.parseType(intype) ||
+ parser.addTypeToList(intype, result.types))
+ return mlir::failure();
+ return mlir::success();
+ }];
+
+ let printer = [{ p << getOperationName() << ' ' << getType(); }];
+}
+
+def fir_AllocMemOp : fir_AllocatableOp<"allocmem"> {
+ let summary = "allocate storage on the heap for an object of a given type";
+
+ let description = [{
+ Creates a heap memory reference suitable for storing a value of the
+ given type, T. The heap refernce returned has type `!fir.heap`.
+ The memory object is in an undefined state. `allocmem` operations must
+ be paired with `freemem` operations to avoid memory leaks.
+
+ %0 = fir.allocmem !fir.array<10 x f32>
+ fir.freemem %0 : !fir.heap>
+ }];
+
+ let results = (outs fir_HeapType);
+
+ let verifier = allocVerify#[{
+ mlir::Type outType = getType();
+ if (!outType.dyn_cast())
+ return emitOpError("must be a !fir.heap type");
+ return mlir::success();
+ }];
+
+ let extraClassDeclaration = extraAllocClassDeclaration#[{
+ static mlir::Type wrapResultType(mlir::Type intype);
+ }];
+}
+
+def fir_FreeMemOp : fir_Op<"freemem", []> {
+ let summary = "free a heap object";
+
+ let description = [{
+ Deallocates a heap memory reference that was allocated by an `allocmem`.
+ The memory object that is deallocated is placed in an undefined state
+ after `fir.freemem`. Optimizations may treat the loading of an object
+ in the undefined state as undefined behavior. This includes aliasing
+ references, such as the result of an `fir.embox`.
+
+ %21 = fir.allocmem !fir.type
+ ...
+ fir.freemem %21 : !fir.heap>
+ }];
+
+ let arguments = (ins fir_HeapType:$heapref);
+
+ let assemblyFormat = "$heapref attr-dict `:` type($heapref)";
+}
+
+// Terminator operations
+
+class fir_SwitchTerminatorOp traits = []> :
+ fir_Op,
+ Arguments<(ins Variadic:$args)>,
+ Results<(outs)> {
+ let builders = [OpBuilder<
+ "Builder *, OperationState &result, Value selector,"
+ "ArrayRef properOperands, ArrayRef destinations,"
+ "ArrayRef> operands = {},"
+ "ArrayRef attributes = {}",
+ [{
+ result.addOperands(selector);
+ result.addOperands(properOperands);
+ for (auto kvp : llvm::zip(destinations, operands)) {
+ result.addSuccessor(std::get<0>(kvp), std::get<1>(kvp));
+ }
+ for (auto namedAttr : attributes) {
+ result.addAttribute(namedAttr.first, namedAttr.second);
+ }
+ }]
+ >];
+
+ string extraSwitchClassDeclaration = [{
+ using Conditions = mlir::Value;
+ static constexpr auto AttrName = "cases";
+
+ // The number of destination conditions that may be tested
+ unsigned getNumConditions() { return getNumDest(); }
+
+ // The selector is the value being tested to determine the destination
+ mlir::Value getSelector() { return getOperand(0); }
+
+ // The number of blocks that may be branched to
+ unsigned getNumDest() { return getOperation()->getNumSuccessors(); }
+ }];
+}
+
+class fir_IntegralSwitchTerminatorOp traits = []> : fir_SwitchTerminatorOp {
+ let parser = [{
+ mlir::OpAsmParser::OperandType selector;
+ mlir::Type type;
+ if (parseSelector(parser, result, selector, type))
+ return mlir::failure();
+
+ llvm::SmallVector ivalues;
+ llvm::SmallVector dests;
+ llvm::SmallVector, 4> destArgs;
+ while (true) {
+ mlir::Attribute ivalue; // Integer or Unit
+ mlir::Block *dest;
+ llvm::SmallVector destArg;
+ llvm::SmallVector temp;
+ if (parser.parseAttribute(ivalue, "i", temp) ||
+ parser.parseComma() ||
+ parser.parseSuccessorAndUseList(dest, destArg))
+ return mlir::failure();
+ ivalues.push_back(ivalue);
+ dests.push_back(dest);
+ destArgs.push_back(destArg);
+ if (!parser.parseOptionalRSquare())
+ break;
+ if (parser.parseComma())
+ return mlir::failure();
+ }
+ result.addAttribute(AttrName, parser.getBuilder().getArrayAttr(ivalues));
+ for (unsigned i = 0, count = dests.size(); i != count; ++i)
+ result.addSuccessor(dests[i], destArgs[i]);
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' ';
+ p.printOperand(getSelector());
+ p << " : " << getSelector().getType() << " [";
+ auto cases = getAttrOfType(AttrName).getValue();
+ for (unsigned i = 0, count = getNumConditions(); i != count; ++i) {
+ if (i)
+ p << ", ";
+ auto &attr = cases[i];
+ if (auto intAttr = attr.dyn_cast_or_null())
+ p << intAttr.getValue();
+ else
+ p.printAttribute(attr);
+ p << ", ";
+ p.printSuccessorAndUseList(getOperation(), i);
+ }
+ p << ']';
+ p.printOptionalAttrDict(getAttrs(), {AttrName});
+ }];
+
+ let verifier = [{
+ if (!(getSelector().getType().isa() ||
+ getSelector().getType().isa() ||
+ getSelector().getType().isa()))
+ return emitOpError("must be an integer");
+ auto cases = getAttrOfType(AttrName).getValue();
+ for (unsigned i = 0, count = getNumConditions(); i != count; ++i) {
+ auto &attr = cases[i];
+ if (attr.dyn_cast_or_null()) {
+ // ok
+ } else if (attr.dyn_cast_or_null()) {
+ // ok
+ } else {
+ return emitOpError("invalid case alternative");
+ }
+ }
+ return mlir::success();
+ }];
+
+ let successors = (successor VariadicSuccessor:$targets);
+
+ let extraClassDeclaration = extraSwitchClassDeclaration;
+}
+
+def fir_SelectOp : fir_IntegralSwitchTerminatorOp<"select"> {
+ let summary = "a multiway branch";
+
+ let description = [{
+ A multiway branch terminator with similar semantics to C's `switch`
+ statement. A selector value is matched against a list of constants
+ of the same type for a match. When a match is found, control is
+ transferred to the corresponding basic block. A `select` must have
+ at least one basic block with a corresponding `unit` match, and
+ that block will be selected when all other conditions fail to match.
+
+ fir.select %arg:i32 [1, ^bb1(%0 : i32),
+ 2, ^bb2(%2,%arg,%arg2 : i32,i32,i32),
+ -3, ^bb3(%arg2,%2 : i32,i32),
+ 4, ^bb4(%1 : i32),
+ unit, ^bb5]
+ }];
+}
+
+def fir_SelectRankOp : fir_IntegralSwitchTerminatorOp<"select_rank"> {
+ let summary = "Fortran's SELECT RANK statement";
+
+ let description = [{
+ Similar to `select`, `select_rank` provides a way to express Fortran's
+ SELECT RANK construct. In this case, the rank of the selector value
+ is matched against constants of integer type. The structure is the
+ same as `select`, but `select_rank` determines the rank of the selector
+ variable at runtime to determine the best match.
+
+ fir.select_rank %arg:i32 [1, ^bb1(%0 : i32),
+ 2, ^bb2(%2,%arg,%arg2 : i32,i32,i32),
+ 3, ^bb3(%arg2,%2 : i32,i32),
+ -1, ^bb4(%1 : i32),
+ unit, ^bb5]
+ }];
+}
+
+def fir_SelectCaseOp : fir_SwitchTerminatorOp<"select_case"> {
+ let summary = "Fortran's SELECT CASE statement";
+
+ let description = [{
+ Similar to `select`, `select_case` provides a way to express Fortran's
+ SELECT CASE construct. In this case, the selector value is matched
+ against variables (not just constants) and ranges. The structure is
+ the same as `select`, but `select_case` allows for the expression of
+ more complex match conditions.
+
+ fir.select_case %arg : i32 [
+ #fir.point, %0, ^bb1(%0 : i32),
+ #fir.lower, %1, ^bb2(%2,%arg,%arg2,%1 : i32,i32,i32,i32),
+ #fir.interval, %2, %3, ^bb3(%2,%arg2 : i32,i32),
+ #fir.upper, %arg, ^bb4(%1 : i32),
+ unit, ^bb5]
+ }];
+
+ let parser = [{
+ mlir::OpAsmParser::OperandType selector;
+ mlir::Type type;
+ if (parseSelector(parser, result, selector, type))
+ return mlir::failure();
+
+ llvm::SmallVector attrs;
+ llvm::SmallVector opers;
+ llvm::SmallVector dests;
+ llvm::SmallVector, 4> destArgs;
+ while (true) {
+ mlir::Attribute attr;
+ mlir::Block *dest;
+ llvm::SmallVector destArg;
+ llvm::SmallVector temp;
+ if (parser.parseAttribute(attr, "a", temp) ||
+ isValidCaseAttr(attr) ||
+ parser.parseComma())
+ return mlir::failure();
+ attrs.push_back(attr);
+ if (attr.dyn_cast_or_null()) {
+ // do nothing
+ } else if (attr.dyn_cast_or_null()) {
+ mlir::OpAsmParser::OperandType oper1;
+ mlir::OpAsmParser::OperandType oper2;
+ if (parser.parseOperand(oper1) ||
+ parser.parseComma() ||
+ parser.parseOperand(oper2) ||
+ parser.parseComma())
+ return mlir::failure();
+ opers.push_back(oper1);
+ opers.push_back(oper2);
+ } else {
+ mlir::OpAsmParser::OperandType oper;
+ if (parser.parseOperand(oper) ||
+ parser.parseComma())
+ return mlir::failure();
+ opers.push_back(oper);
+ }
+ if (parser.parseSuccessorAndUseList(dest, destArg))
+ return mlir::failure();
+ dests.push_back(dest);
+ destArgs.push_back(destArg);
+ if (!parser.parseOptionalRSquare())
+ break;
+ if (parser.parseComma())
+ return mlir::failure();
+ }
+ result.addAttribute(AttrName, parser.getBuilder().getArrayAttr(attrs));
+ if (parser.resolveOperands(opers, type, result.operands))
+ return mlir::failure();
+ for (unsigned i = 0, count = dests.size(); i != count; ++i)
+ result.addSuccessor(dests[i], destArgs[i]);
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' ';
+ p.printOperand(getSelector());
+ p << " : " << getSelector().getType() << " [";
+ auto cases = getAttrOfType(AttrName).getValue();
+ for (unsigned i = 0, count = getNumConditions(); i != count; ++i) {
+ if (i)
+ p << ", ";
+ p << cases[i] << ", ";
+ if (!cases[i].dyn_cast_or_null()) {
+ p.printOperand(getCaseArg(i, 0));
+ p << ", ";
+ if (cases[i].dyn_cast_or_null()) {
+ p.printOperand(getCaseArg(i, 1));
+ p << ", ";
+ }
+ }
+ p.printSuccessorAndUseList(getOperation(), i);
+ }
+ p << ']';
+ p.printOptionalAttrDict(getAttrs(), {AttrName});
+ }];
+
+ let verifier = [{
+ if (!(getSelector().getType().isa() ||
+ getSelector().getType().isa() ||
+ getSelector().getType().isa() ||
+ getSelector().getType().isa() ||
+ getSelector().getType().isa()))
+ return emitOpError("must be an integer, character, or logical");
+ auto cases = getAttrOfType(AttrName).getValue();
+ for (unsigned i = 0, count = getNumConditions(); i != count; ++i) {
+ auto &attr = cases[i];
+ if (attr.isa() ||
+ attr.isa() ||
+ attr.isa() ||
+ attr.isa() ||
+ attr.isa()) {
+ // ok
+ } else {
+ return emitOpError("incorrect select case attribute type");
+ }
+ }
+ return mlir::success();
+ }];
+
+ let successors = (successor VariadicSuccessor:$targets);
+
+ let extraClassDeclaration = extraSwitchClassDeclaration#[{
+ mlir::Value getCaseArg(unsigned dest, unsigned ele) {
+ assert(ele < 2);
+ assert(dest < getNumConditions());
+ auto cases = getAttrOfType(AttrName).getValue();
+ assert(cases.size() == getNumConditions());
+ unsigned o = getCaseArgumentOffset(cases, dest);
+ return getOperand(o + 1 + ele);
+ }
+ }];
+}
+
+def fir_SelectTypeOp : fir_SwitchTerminatorOp<"select_type"> {
+ let summary = "Fortran's SELECT TYPE statement";
+
+ let description = [{
+ Similar to `select`, `select_type` provides a way to express Fortran's
+ SELECT TYPE construct. In this case, the type of the selector value
+ is matched against a list of type descriptors. The structure is the
+ same as `select`, but `select_type` determines the type of the selector
+ variable at runtime to determine the best match.
+
+ fir.select_type %arg : !fir.box<()> [
+ #fir.instance>, ^bb1(%0 : i32),
+ #fir.instance>, ^bb2(%2 : i32),
+ #fir.subsumed>, ^bb3(%2 : i32),
+ #fir.instance>, ^bb4(%1,%3 : i32,f32),
+ unit, ^bb5]
+ }];
+
+ let parser = [{
+ mlir::OpAsmParser::OperandType selector;
+ mlir::Type type;
+ if (parseSelector(parser, result, selector, type))
+ return mlir::failure();
+
+ llvm::SmallVector attrs;
+ llvm::SmallVector dests;
+ llvm::SmallVector, 4> destArgs;
+ while (true) {
+ mlir::Attribute attr;
+ mlir::Block *dest;
+ llvm::SmallVector destArg;
+ llvm::SmallVector temp;
+ if (parser.parseAttribute(attr, "a", temp) ||
+ parser.parseComma() ||
+ parser.parseSuccessorAndUseList(dest, destArg))
+ return mlir::failure();
+ attrs.push_back(attr);
+ dests.push_back(dest);
+ destArgs.push_back(destArg);
+ if (!parser.parseOptionalRSquare())
+ break;
+ if (parser.parseComma())
+ return mlir::failure();
+ }
+ result.addAttribute(AttrName, parser.getBuilder().getArrayAttr(attrs));
+ for (unsigned i = 0, count = dests.size(); i != count; ++i)
+ result.addSuccessor(dests[i], destArgs[i]);
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' ';
+ p.printOperand(getSelector());
+ p << " : " << getSelector().getType() << " [";
+ auto cases = getAttrOfType(AttrName).getValue();
+ for (unsigned i = 0, count = getNumConditions(); i != count; ++i) {
+ if (i)
+ p << ", ";
+ p << cases[i] << ", ";
+ p.printSuccessorAndUseList(getOperation(), i);
+ }
+ p << ']';
+ p.printOptionalAttrDict(getAttrs(), {AttrName});
+ }];
+
+ let verifier = [{
+ if (!(getSelector().getType().isa()))
+ return emitOpError("must be a boxed type");
+ auto cases = getAttrOfType(AttrName).getValue();
+ for (unsigned i = 0, count = getNumConditions(); i != count; ++i) {
+ auto &attr = cases[i];
+ if (attr.dyn_cast_or_null() ||
+ attr.dyn_cast_or_null() ||
+ attr.dyn_cast_or_null()) {
+ // ok
+ } else {
+ return emitOpError("invalid type-case alternative");
+ }
+ }
+ return mlir::success();
+ }];
+
+ let successors = (successor VariadicSuccessor:$targets);
+
+ let extraClassDeclaration = extraSwitchClassDeclaration;
+}
+
+def fir_UnreachableOp : fir_Op<"unreachable", [Terminator]> {
+ let summary = "the unreachable instruction";
+
+ let description = [{
+ Terminates a basic block with the assertion that the end of the block
+ will never be reached at runtime. This instruction can be used
+ immediately after a call to the Fortran runtime to terminate the
+ program, for example. This instruction corresponds to the LLVM IR
+ instruction `unreachable`.
+
+ fir.unreachable
+ }];
+
+ let parser = "return mlir::success();";
+
+ let printer = "p << getOperationName();";
+}
+
+def fir_FirEndOp : fir_Op<"end", [Terminator]> {
+ let summary = "the end instruction";
+
+ let description = [{
+ The end terminator is a special terminator used inside various FIR
+ operations that have regions. End is thus the custom invisible terminator
+ for these operations. It is implicit and need not appear in the textual
+ representation.
+ }];
+}
+
+def fir_HasValueOp : fir_Op<"has_value", [Terminator, HasParent<"GlobalOp">]> {
+ let summary = "terminator for GlobalOp";
+ let description = [{
+ The terminator for a GlobalOp with a body.
+
+ global @variable : tuple {
+ %0 = constant 45 : i32
+ %1 = constant 100.0 : f32
+ %2 = fir.undefined tuple
+ %3 = constant 0 : index
+ %4 = fir.insert_value %2, %0, %3 : (tuple, i32, index) -> tuple
+ %5 = constant 1 : index
+ %6 = fir.insert_value %4, %1, %5 : (tuple, f32, index) -> tuple
+ fir.has_value %6 : tuple
+ }
+ }];
+
+ let arguments = (ins AnyType:$resval);
+
+ let assemblyFormat = "$resval attr-dict `:` type($resval)";
+}
+
+// Operations on !fir.box type objects
+
+def fir_EmboxOp : fir_Op<"embox", [NoSideEffect]> {
+ let summary = "boxes a given reference and (optional) dimension information";
+
+ let description = [{
+ Create a boxed reference value. In Fortran, the implementation can require
+ extra information about an entity, such as its type, rank, etc. This
+ auxilliary information is packaged and abstracted as a value with box type
+ by the calling routine. (In Fortran, these are called descriptors.)
+
+ %c1 = constant 1 : index
+ %c10 = constant 10 : index
+ %4 = fir.dims(%c1, %c10, %c1) : (index, index, index) -> !fir.dims<1>
+ %5 = ... : !fir.ref>
+ %6 = fir.embox %5, %4 : (!fir.ref>, !fir.dims<1>)
+ -> !fir.box>
+ }];
+
+ let arguments = (ins AnyReferenceLike:$memref, Variadic:$args);
+
+ let results = (outs fir_BoxType);
+
+ let parser = [{
+ mlir::FunctionType type;
+ llvm::SmallVector operands;
+ mlir::OpAsmParser::OperandType memref;
+ if (parser.parseOperand(memref))
+ return mlir::failure();
+ operands.push_back(memref);
+ auto &builder = parser.getBuilder();
+ if (!parser.parseOptionalLParen()) {
+ if (parser.parseOperandList(operands,
+ mlir::OpAsmParser::Delimiter::None) ||
+ parser.parseRParen())
+ return mlir::failure();
+ auto lens = builder.getI32IntegerAttr(operands.size());
+ result.addAttribute(lenpName(), lens);
+ }
+ if (!parser.parseOptionalComma()) {
+ mlir::OpAsmParser::OperandType dims;
+ if (parser.parseOperand(dims))
+ return mlir::failure();
+ operands.push_back(dims);
+ } else if (!parser.parseOptionalLSquare()) {
+ mlir::AffineMapAttr map;
+ if (parser.parseAttribute(map, layoutName(), result.attributes) ||
+ parser.parseRSquare())
+ return mlir::failure();
+ }
+ if (parser.parseOptionalAttrDict(result.attributes) ||
+ parser.parseColonType(type) ||
+ parser.resolveOperands(operands, type.getInputs(),
+ parser.getNameLoc(), result.operands) ||
+ parser.addTypesToList(type.getResults(), result.types))
+ return mlir::failure();
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' ';
+ p.printOperand(memref());
+ if (hasLenParams()) {
+ p << '(';
+ p.printOperands(getLenParams());
+ p << ')';
+ }
+ if (getNumOperands() == 2) {
+ p << ", ";
+ p.printOperands(dims());
+ } else if (auto map = getAttr(layoutName())) {
+ p << " [" << map << ']';
+ }
+ p.printOptionalAttrDict(getAttrs(), {layoutName(), lenpName()});
+ p << " : ";
+ p.printFunctionalType(getOperation());
+ }];
+
+ let verifier = [{
+ if (hasLenParams()) {
+ auto lenParams = numLenParams();
+ auto eleTy = fir::dyn_cast_ptrEleTy(memref().getType());
+ if (!eleTy)
+ return emitOpError("must embox a memory reference type");
+ if (auto rt = eleTy.dyn_cast()) {
+ if (lenParams != rt.getNumLenParams())
+ return emitOpError("number of LEN params does not correspond"
+ " to the !fir.type type");
+ } else {
+ return emitOpError("LEN parameters require !fir.type type");
+ }
+ for (auto lp : getLenParams())
+ if (lp.getType().isa())
+ return emitOpError("LEN parameters must be integral type");
+ }
+ if (dims().size() == 0) {
+ // Ok. If there is no dims and no layout map, then emboxing a scalar.
+ // TODO: Should the type be enforced? It already must agree.
+ } else if (dims().size() == 1) {
+ auto d = *dims().begin();
+ if (!d.getType().isa())
+ return emitOpError("dimension argument must have !fir.dims type");
+ } else {
+ return emitOpError("embox can only have one !fir.dim argument");
+ }
+ return mlir::success();
+ }];
+
+ let extraClassDeclaration = [{
+ static constexpr llvm::StringRef layoutName() { return "layout_map"; }
+ static constexpr llvm::StringRef lenpName() { return "len_param_count"; }
+ bool hasLenParams() { return bool{getAttr(lenpName())}; }
+ unsigned numLenParams() {
+ if (auto x = getAttrOfType(lenpName()))
+ return x.getInt();
+ return 0;
+ }
+ operand_range getLenParams() {
+ return {operand_begin(), operand_begin() + numLenParams()};
+ }
+ operand_range dims() {
+ return {operand_begin() + numLenParams() + 1, operand_end()};
+ }
+ }];
+}
+
+def fir_EmboxCharOp : fir_Op<"emboxchar", [NoSideEffect]> {
+ let arguments = (ins AnyReferenceLike:$memref, AnyIntegerLike:$len);
+ let results = (outs fir_BoxCharType);
+
+ let summary = "boxes a given CHARACTER reference and its LEN parameter";
+
+ let description = [{
+ Create a boxed CHARACTER value. The CHARACTER type has the LEN type
+ parameter, the value of which may only be known at runtime. Therefore,
+ a variable of type CHARACTER has both its data reference as well as a
+ LEN type parameter.
+
+ CHARACTER(LEN=10) :: var
+
+ %4 = ... : !fir.ref>>
+ %5 = constant 10 : i32
+ %6 = fir.emboxchar %4, %5 : (!fir.ref>>,
+ i32) -> !fir.boxchar<1>
+ }];
+
+ let assemblyFormat = [{
+ $memref `,` $len attr-dict `:` functional-type(operands, results)
+ }];
+
+ let verifier = [{
+ auto eleTy = elementTypeOf(memref().getType());
+ if (!eleTy.dyn_cast())
+ return mlir::failure();
+ return mlir::success();
+ }];
+}
+
+def fir_EmboxProcOp : fir_Op<"emboxproc", [NoSideEffect]> {
+
+ let summary = "boxes a given procedure and optional host context";
+
+ let description = [{
+ Creates an abstract encapsulation of a PROCEDURE POINTER along with an
+ optional pointer to a host instance context. If the pointer is not to an
+ internal procedure or the internal procedure does not need a host context
+ then the form takes only the procedure's symbol.
+
+ %0 = fir.emboxproc @f : ((i32) -> i32) -> !fir.boxproc<(i32) -> i32>
+
+ An internal procedure requiring a host instance for correct execution uses
+ the second form. The closure of the host procedure's state is passed as a
+ reference to a tuple. It is the responsibility of the host to manage the
+ context's values accordingly, up to and including inhibiting register
+ promotion of local values.
+
+ %5 = fir.emboxproc @g, %4 : ((i32) -> i32, !fir.ref>) ->
+ !fir.boxproc<(i32) -> i32>
+ }];
+
+ let arguments = (ins SymbolRefAttr:$funcname, AnyReferenceLike:$host);
+
+ let results = (outs fir_BoxProcType);
+
+ let parser = [{
+ mlir::SymbolRefAttr procRef;
+ if (parser.parseAttribute(procRef, "funcname", result.attributes))
+ return mlir::failure();
+ bool hasTuple = false;
+ mlir::OpAsmParser::OperandType tupleRef;
+ if (!parser.parseOptionalComma()) {
+ if (parser.parseOperand(tupleRef))
+ return mlir::failure();
+ hasTuple = true;
+ }
+ mlir::FunctionType type;
+ if (parser.parseColon() ||
+ parser.parseLParen() ||
+ parser.parseType(type))
+ return mlir::failure();
+ result.addAttribute("functype", mlir::TypeAttr::get(type));
+ if (hasTuple) {
+ mlir::Type tupleType;
+ if (parser.parseComma() ||
+ parser.parseType(tupleType) ||
+ parser.resolveOperand(tupleRef, tupleType, result.operands))
+ return mlir::failure();
+ }
+ mlir::Type boxType;
+ if (parser.parseRParen() ||
+ parser.parseArrow() ||
+ parser.parseType(boxType) ||
+ parser.addTypesToList(boxType, result.types))
+ return mlir::failure();
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' ' << getAttr("funcname");
+ auto h = host();
+ if (h) {
+ p << ", ";
+ p.printOperand(h);
+ }
+ p << " : (" << getAttr("functype");
+ if (h)
+ p << ", " << h.getType();
+ p << ") -> " << getType();
+ }];
+
+ let verifier = [{
+ // host bindings (optional) must be a reference to a tuple
+ if (auto h = host()) {
+ if (auto r = h.getType().dyn_cast()) {
+ if (!r.getEleTy().dyn_cast())
+ return mlir::failure();
+ } else {
+ return mlir::failure();
+ }
+ }
+ return mlir::success();
+ }];
+}
+
+def fir_UnboxOp : fir_SimpleOp<"unbox", [NoSideEffect]> {
+ let summary = "unbox the boxed value into a tuple value";
+
+ let description = [{
+ Unboxes a value of `box` type into a tuple of information abstracted in
+ that boxed value.
+ }];
+
+ let arguments = (ins fir_BoxType:$box);
+
+ let results = (outs
+ fir_ReferenceType, // pointer to data
+ AnyIntegerLike, // size of a data element
+ AnyIntegerLike, // rank of data
+ fir_TypeDescType, // abstract type descriptor
+ AnyIntegerLike, // attribute flags (bitfields)
+ fir_DimsType // dimension information (if any)
+ );
+}
+
+def fir_UnboxCharOp : fir_SimpleOp<"unboxchar", [NoSideEffect]>,
+ Arguments<(ins fir_BoxCharType:$boxchar)>,
+ Results<(outs fir_ReferenceType, AnyIntegerLike)> {
+ let summary = "unbox a boxchar value into a pair value";
+
+ let description = [{
+ Unboxes a value of `boxchar` type into a pair consisting of a memory
+ reference to the CHARACTER data and the LEN type parameter.
+ }];
+}
+
+def fir_UnboxProcOp : fir_SimpleOp<"unboxproc", [NoSideEffect]>,
+ Arguments<(ins fir_BoxProcType:$boxproc)>,
+ Results<(outs FunctionType, fir_ReferenceType:$refTuple)> {
+ let summary = "unbox a boxproc value into a pair value";
+
+ let description = [{
+ Unboxes a value of `boxproc` type into a pair consisting of a procedure
+ pointer and a pointer to a host context.
+ }];
+
+ let verifier = [{
+ if (auto eleTy = fir::dyn_cast_ptrEleTy(refTuple().getType()))
+ if (eleTy.isa())
+ return mlir::success();
+ return emitOpError("second output argument has bad type");
+ }];
+}
+
+def fir_BoxAddrOp : fir_SimpleOneResultOp<"box_addr", [NoSideEffect]> {
+
+ let summary = "return a memory reference to the boxed value";
+
+ let description = [{
+ This operator is overloaded to work with values of type `box`,
+ `boxchar`, and `boxproc`. The result for each of these
+ cases, respectively, is the address of the data, the address of the
+ CHARACTER data, and the address of the procedure.
+ }];
+
+ let arguments = (ins fir_BoxType:$val);
+
+ let results = (outs AnyReferenceLike);
+}
+
+def fir_BoxCharLenOp : fir_SimpleOp<"boxchar_len", [NoSideEffect]> {
+ let summary = "return the LEN type parameter from a boxchar value";
+
+ let description = [{
+ Extracts the LEN type parameter from a `boxchar` value.
+ }];
+
+ let arguments = (ins fir_BoxCharType:$val);
+
+ let results = (outs AnyIntegerLike);
+}
+
+def fir_BoxDimsOp : fir_Op<"box_dims", [NoSideEffect]> {
+ let summary = "return the dynamic dimension information for the boxed value";
+
+ let description = [{
+ Returns the triple of lower bound, extent, and stride for `dim` dimension
+ of `val`, which must have a `box` type. The dimensions are enumerated from
+ left to right from 0 to rank-1. This operation has undefined behavior if
+ `dim` is out of bounds.
+ }];
+
+ let arguments = (ins fir_BoxType:$val, AnyIntegerLike:$dim);
+
+ let results = (outs AnyIntegerLike, AnyIntegerLike, AnyIntegerLike);
+
+ let assemblyFormat = [{
+ $val `,` $dim attr-dict `:` functional-type(operands, results)
+ }];
+
+ let extraClassDeclaration = [{
+ mlir::Type getTupleType();
+ }];
+}
+
+def fir_BoxEleSizeOp : fir_SimpleOneResultOp<"box_elesize", [NoSideEffect]> {
+ let summary = "return the size of an element of the boxed value";
+
+ let description = [{
+ Returns the size of an element in an entity of `box` type. This size may
+ not be known until runtime.
+ }];
+
+ let arguments = (ins fir_BoxType:$val);
+
+ let results = (outs AnyIntegerLike);
+}
+
+def fir_BoxIsAllocOp : fir_SimpleOp<"box_isalloc", [NoSideEffect]>,
+ Arguments<(ins fir_BoxType:$val)>,
+ Results<(outs BoolLike)> {
+ let summary = "is the boxed value an ALLOCATABLE?";
+
+ let description = [{
+ Determine if the boxed value was from an ALLOCATABLE entity.
+
+ %ref = ... : !fir.heap
+ %box = fir.embox %ref : !fir.box
+ %isheap = fir.box_isalloc %box : i1
+ }];
+}
+
+def fir_BoxIsArrayOp : fir_SimpleOp<"box_isarray", [NoSideEffect]>,
+ Arguments<(ins fir_BoxType:$val)>,
+ Results<(outs BoolLike)> {
+ let summary = "is the boxed value an array?";
+
+ let description = [{
+ Determine if the boxed value has a positive (> 0) rank.
+
+ %ref = ... : !fir.ref
+ %dims = fir.gendims(1, 100, 1) : !fir.dims<1>
+ %box = fir.embox %ref, %dims : !fir.box
+ %isarr = fir.box_isarray %box : i1
+ }];
+}
+
+def fir_BoxIsPtrOp : fir_SimpleOp<"box_isptr", [NoSideEffect]>,
+ Arguments<(ins fir_BoxType:$val)>,
+ Results<(outs BoolLike)> {
+ let summary = "is the boxed value a POINTER?";
+
+ let description = [{
+ Determine if the boxed value was from a POINTER entity.
+
+ %ptr = ... : !fir.ptr
+ %box = fir.embox %ptr : !fir.box
+ %isptr = fir.box_isptr %box : i1
+ }];
+}
+
+def fir_BoxProcHostOp : fir_SimpleOp<"boxproc_host", [NoSideEffect]>,
+ Arguments<(ins fir_BoxProcType:$val)>,
+ Results<(outs fir_ReferenceType)> {
+ let summary = "returns the host instance pointer (or null)";
+
+ let description = [{
+ Extract the host context pointer from a `boxproc` value.
+ }];
+}
+
+def fir_BoxRankOp : fir_SimpleOneResultOp<"box_rank", [NoSideEffect]> {
+ let summary = "return the number of dimensions for the boxed value";
+
+ let description = [{
+ Return the rank of a value of `box` type. If the value is scalar, the
+ rank is 0.
+ }];
+
+ let arguments = (ins fir_BoxType:$val);
+
+ let results = (outs AnyIntegerType);
+}
+
+def fir_BoxTypeDescOp : fir_SimpleOneResultOp<"box_tdesc", [NoSideEffect]> {
+ let summary = "return the type descriptor for the boxed value";
+
+ let description = [{
+ Return the opaque type descriptor of a value of `box` type.
+ }];
+
+ let arguments = (ins fir_BoxType:$val);
+
+ let results = (outs fir_TypeDescType);
+}
+
+// Record and array type operations
+
+def fir_CoordinateOp : fir_Op<"coordinate_of", [NoSideEffect]>,
+ Arguments<(ins AnyRefOrBox:$ref, Variadic:$coor)>,
+ Results<(outs fir_ReferenceType)> {
+ let summary = "Finds the coordinate (location) of a value in memory";
+
+ let description = [{
+ Determine a memory reference given a memory reference of composite type
+ and a list of index values. (This returns the address of a value.)
+ }];
+
+ let assemblyFormat = [{
+ operands attr-dict `:` functional-type(operands, results)
+ }];
+
+ let verifier = [{
+ // Recovering a LEN type parameter only makes sense from a boxed value
+ for (auto co : coor())
+ if (auto *s = co.getDefiningOp())
+ if (dyn_cast_or_null(s)) {
+ if (getNumOperands() != 2)
+ return emitOpError("len_param_index must be last argument");
+ if (!ref().getType().dyn_cast())
+ return emitOpError("len_param_index must be used on box type");
+ }
+ return mlir::success();
+ }];
+}
+
+def fir_ExtractValueOp : fir_OneResultOp<"extract_value", [NoSideEffect]>,
+ Arguments<(ins AnyCompositeLike:$adt, Variadic:$coor)> {
+ let summary = "Extract a value from an aggregate SSA-value";
+
+ let description = [{
+ Extract a subobject value given a value of composite type and a list of
+ index values.
+ }];
+
+ let assemblyFormat = [{
+ $adt `,` $coor attr-dict `:` functional-type(operands, results)
+ }];
+}
+
+def fir_FieldIndexOp : fir_OneResultOp<"field_index", [NoSideEffect]>,
+ Arguments<(ins StrAttr:$field_id, TypeAttr:$on_type,
+ Variadic:$lenparams)> {
+ let summary = "create a field index value from a field identifier";
+
+ let description = [{
+ Generate a field (offset) value from an identifier. Field values may be
+ lowered into exact offsets when the layout of a Fortran derived type is
+ known at compile-time. The type of a field value is `!fir.field` and
+ these values can be used with the `fir.coordinate_of`, `fir.extract_value`,
+ or `fir.insert_value` instructions to compute (abstract) addresses of
+ subobjects.
+ }];
+
+ let builders = [OpBuilder<
+ "Builder *builder, OperationState &result, StringRef fieldName,"
+ "Type recTy, ArrayRef operands = {}",
+ [{
+ result.addAttribute(fieldAttrName(), builder->getStringAttr(fieldName));
+ result.addAttribute(typeAttrName(), TypeAttr::get(recTy));
+ result.addOperands(operands);
+ }]
+ >];
+
+ let parser = [{
+ llvm::StringRef fieldName;
+ auto &builder = parser.getBuilder();
+ mlir::Type recty;
+ if (parser.parseOptionalKeyword(&fieldName) ||
+ parser.parseComma() ||
+ parser.parseType(recty))
+ return mlir::failure();
+ result.addAttribute(fieldAttrName(), builder.getStringAttr(fieldName));
+ if (!recty.dyn_cast())
+ return mlir::failure();
+ result.addAttribute(typeAttrName(), mlir::TypeAttr::get(recty));
+ if (!parser.parseOptionalLParen()) {
+ llvm::SmallVector operands;
+ llvm::SmallVector types;
+ auto loc = parser.getNameLoc();
+ if (parser.parseOperandList(operands,
+ mlir::OpAsmParser::Delimiter::None) ||
+ parser.parseRParen() ||
+ parser.parseColonTypeList(types) ||
+ parser.resolveOperands(operands, types, loc, result.operands))
+ return mlir::failure();
+ }
+ mlir::Type fieldType = fir::FieldType::get(builder.getContext());
+ if (parser.addTypeToList(fieldType, result.types))
+ return mlir::failure();
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' '
+ << getAttrOfType(fieldAttrName()).getValue() << ", "
+ << getAttr(typeAttrName());
+ if (getNumOperands()) {
+ p << '(';
+ p.printOperands(lenparams());
+ auto sep = ") : ";
+ for (auto op : lenparams()) {
+ p << sep;
+ if (op)
+ p.printType(op.getType());
+ else
+ p << "()";
+ sep = ", ";
+ }
+ }
+ }];
+
+ let extraClassDeclaration = [{
+ static constexpr llvm::StringRef fieldAttrName() { return "field_id"; }
+ static constexpr llvm::StringRef typeAttrName() { return "on_type"; }
+ }];
+}
+
+def fir_GenDimsOp : fir_OneResultOp<"gendims", [NoSideEffect]> {
+
+ let summary = "generate a value of type `!fir.dims`";
+
+ let description = [{
+ The arguments are an ordered list of integral type values that is a
+ multiple of 3 in length. Each such triple is defined as: the lower
+ index, the extent, and the stride for that dimension. The dimension
+ information is given in the same row-to-column order as Fortran. This
+ abstract dimension value must describe a reified object, so all dimension
+ information must be specified. The extent must be non-negative and the
+ stride must not be zero.
+ }];
+
+ let arguments = (ins Variadic:$triples);
+
+ let results = (outs fir_DimsType);
+
+ let assemblyFormat = [{
+ operands attr-dict `:` functional-type(operands, results)
+ }];
+
+ let verifier = [{
+ auto size = triples().size();
+ if (size < 1 && size <= 16 * 3)
+ return emitOpError("incorrect number of args");
+ if (size % 3 != 0)
+ return emitOpError("requires a multiple of 3 args");
+ return mlir::success();
+ }];
+}
+
+def fir_InsertValueOp : fir_OneResultOp<"insert_value", [NoSideEffect]> {
+ let summary = "insert a new sub-value into a copy of an existing aggregate";
+
+ let description = [{
+ Insert a value into a composite value.
+ }];
+
+ let arguments = (ins AnyCompositeLike:$adt, AnyType:$val,
+ Variadic:$coor);
+ let results = (outs AnyCompositeLike);
+
+ let assemblyFormat = [{
+ operands attr-dict `:` functional-type(operands, results)
+ }];
+}
+
+def fir_LenParamIndexOp : fir_OneResultOp<"len_param_index", [NoSideEffect]>,
+ Arguments<(ins StrAttr:$field_id, TypeAttr:$on_type)> {
+ let summary =
+ "create a field index value from a LEN type parameter identifier";
+
+ let description = [{
+ Generate a LEN parameter (offset) value from an LEN parameter identifier.
+ The type of a LEN parameter value is `!fir.len` and these values can be
+ used with the `fir.coordinate_of` instructions to compute (abstract)
+ addresses of LEN parameters.
+ }];
+
+ let builders = [OpBuilder<
+ "Builder *builder, OperationState &result, StringRef fieldName, Type recTy",
+ [{
+ result.addAttribute(fieldAttrName(), builder->getStringAttr(fieldName));
+ result.addAttribute(typeAttrName(), TypeAttr::get(recTy));
+ }]
+ >];
+
+ let parser = [{
+ llvm::StringRef fieldName;
+ auto &builder = parser.getBuilder();
+ mlir::Type recty;
+ if (parser.parseOptionalKeyword(&fieldName) ||
+ parser.parseComma() ||
+ parser.parseType(recty))
+ return mlir::failure();
+ result.addAttribute(fieldAttrName(), builder.getStringAttr(fieldName));
+ if (!recty.dyn_cast())
+ return mlir::failure();
+ result.addAttribute(typeAttrName(), mlir::TypeAttr::get(recty));
+ mlir::Type lenType = fir::LenType::get(builder.getContext());
+ if (parser.addTypeToList(lenType, result.types))
+ return mlir::failure();
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' '
+ << getAttrOfType(fieldAttrName()).getValue() << ", "
+ << getAttr(typeAttrName());
+ }];
+
+ let extraClassDeclaration = [{
+ static constexpr llvm::StringRef fieldAttrName() { return "field_id"; }
+ static constexpr llvm::StringRef typeAttrName() { return "on_type"; }
+ mlir::Type getOnType() {
+ return getAttrOfType(typeAttrName()).getValue();
+ }
+ }];
+}
+
+// Fortran loops
+
+def ImplicitFirTerminator : SingleBlockImplicitTerminator<"FirEndOp">;
+
+def fir_LoopOp : fir_Op<"loop", [ImplicitFirTerminator]> {
+ let summary = "generalized loop operation";
+ let description = [{
+ A generalized Fortran loop construct.
+ }];
+
+ let arguments = (ins
+ Index:$lowerBound,
+ Index:$upperBound,
+ Variadic:$optStep,
+ OptionalAttr:$constantStep,
+ OptionalAttr:$unordered
+ );
+
+ let results = (outs Variadic:$lastVal);
+
+ let regions = (region SizedRegion<1>:$region);
+
+ let skipDefaultBuilders = 1;
+ let builders = [
+ OpBuilder<"mlir::Builder *builder, OperationState &result,"
+ "int64_t lowerBound, int64_t upperBound, int64_t step = 1">,
+ OpBuilder<"mlir::Builder *builder, OperationState &result,"
+ "mlir::Value lowerBound, mlir::Value upperBound,"
+ "ArrayRef step = {}">
+ ];
+
+ let parser = "return parseLoopOp(parser, result);";
+
+ let printer = [{
+ p << getOperationName() << ' ' << getInductionVar() << " = "
+ << lowerBound() << " to " << upperBound();
+ auto s = optStep();
+ if (s.begin() != s.end()) {
+ p << " step ";
+ p.printOperand(*s.begin());
+ }
+ if (unordered())
+ p << " unordered";
+ p.printRegion(region(), /*printEntryBlockArgs=*/false,
+ /*printBlockTerminators=*/false);
+ p.printOptionalAttrDict(getAttrs(), {unorderedKeyword(), stepKeyword()});
+ }];
+
+ let verifier = [{
+ auto step = optStep();
+ if (step.begin() != step.end()) {
+ // FIXME: size of step must be 1
+ auto *s = (*step.begin()).getDefiningOp();
+ if (auto cst = dyn_cast_or_null(s))
+ if (cst.getValue() == 0)
+ return emitOpError("constant step operand must be nonzero");
+ }
+
+ // Check that the body defines as single block argument for the induction
+ // variable.
+ auto *body = getBody();
+ if (body->getNumArguments() != 1 ||
+ !body->getArgument(0).getType().isIndex())
+ return emitOpError("expected body to have a single index argument for "
+ "the induction variable");
+ if (lastVal().size() > 1)
+ return emitOpError("can only return one final value of iterator");
+ return mlir::success();
+ }];
+
+ let extraClassDeclaration = [{
+ static constexpr const char *unorderedKeyword() { return "unordered"; }
+ static constexpr const char *stepKeyword() { return "step"; }
+
+ /// Is this an unordered loop?
+ bool isUnordered() { return getAttr(unorderedKeyword()).isa(); }
+
+ /// Does loop set (and return) the final value of the control variable?
+ bool hasLastValue() { return lastVal().size(); }
+
+ /// Get the body of the loop
+ mlir::Block *getBody() { return ®ion().front(); }
+
+ /// Get the block argument corresponding to the loop control value (PHI)
+ mlir::Value getInductionVar() { return getBody()->getArgument(0); }
+
+ /// Get a builder to insert operations into the LoopOp
+ mlir::OpBuilder getBodyBuilder() {
+ return mlir::OpBuilder(getBody(), std::prev(getBody()->end()));
+ }
+
+ void setLowerBound(mlir::Value bound) {
+ getOperation()->setOperand(0, bound);
+ }
+
+ void setUpperBound(mlir::Value bound) {
+ getOperation()->setOperand(1, bound);
+ }
+
+ void setStep(mlir::Value step) {
+ getOperation()->setOperand(2, step);
+ }
+ }];
+}
+
+def fir_WhereOp : fir_Op<"where", [ImplicitFirTerminator]> {
+ let summary = "generalized conditional operation";
+ let description = [{
+ This is a generalized conditional construct.
+ }];
+ let arguments = (ins I1:$condition);
+ let regions = (region SizedRegion<1>:$whereRegion, AnyRegion:$otherRegion);
+
+ let skipDefaultBuilders = 1;
+ let builders = [
+ OpBuilder<"Builder *builder, OperationState &result, "
+ "Value cond, bool withOtherRegion">
+ ];
+ let parser = [{ return parseWhereOp(parser, result); }];
+
+ let printer = [{
+ p << getOperationName() << ' ' << condition();
+ p.printRegion(whereRegion(), /*printEntryBlockArgs=*/false,
+ /*printBlockTerminators=*/false);
+
+ // Print the 'else' regions if it exists and has a block.
+ auto &otherReg = otherRegion();
+ if (!otherReg.empty()) {
+ p << " otherwise";
+ p.printRegion(otherReg, /*printEntryBlockArgs=*/false,
+ /*printBlockTerminators=*/false);
+ }
+ p.printOptionalAttrDict(getAttrs());
+ }];
+
+ let verifier = [{
+ for (auto ®ion : getOperation()->getRegions()) {
+ if (region.empty())
+ continue;
+ for (auto &b : region)
+ if (b.getNumArguments() != 0)
+ return emitOpError("requires that child entry blocks have no args");
+ }
+ return mlir::success();
+ }];
+
+ let extraClassDeclaration = [{
+ mlir::OpBuilder getWhereBodyBuilder() {
+ assert(!whereRegion().empty() && "Unexpected empty 'where' region.");
+ mlir::Block &body = whereRegion().front();
+ return mlir::OpBuilder(&body, std::prev(body.end()));
+ }
+ mlir::OpBuilder getOtherBodyBuilder() {
+ assert(!otherRegion().empty() && "Unexpected empty 'other' region.");
+ mlir::Block &body = otherRegion().front();
+ return mlir::OpBuilder(&body, std::prev(body.end()));
+ }
+ }];
+}
+
+// Procedure call operations
+
+def fir_CallOp : fir_Op<"call", []>,
+ Arguments<(ins OptionalAttr:$callee,
+ Variadic:$args)>,
+ Results<(outs Variadic)> {
+ let summary = "call a procedure";
+
+ let description = [{
+ Provides a custom parser and pretty printer to allow a more readable syntax
+ in the FIR dialect, e.g. `fir.call @sub(%12)` or `fir.call %20(%22,%23)`.
+ }];
+
+ let parser = "return parseCallOp(parser, result);";
+ let printer = "printCallOp(p, *this);";
+}
+
+def fir_DispatchOp : fir_Op<"dispatch", []>,
+ Arguments<(ins StrAttr:$method, fir_BoxType:$object,
+ Variadic:$args)>,
+ Results<(outs Variadic)> {
+ let summary = "call a type-bound procedure";
+
+ let description = [{
+ Dynamic dispatch to the specified method.
+ }];
+
+ let parser = [{
+ mlir::FunctionType calleeType;
+ llvm::SmallVector operands;
+ auto calleeLoc = parser.getNameLoc();
+ llvm::StringRef calleeName;
+ if (parser.parseOptionalKeyword(&calleeName)) {
+ mlir::StringAttr calleeAttr;
+ if (parser.parseAttribute(calleeAttr, "method", result.attributes))
+ return mlir::failure();
+ } else {
+ result.addAttribute("method",
+ parser.getBuilder().getStringAttr(calleeName));
+ }
+ if (parser.parseOperandList(operands,
+ mlir::OpAsmParser::Delimiter::Paren) ||
+ parser.parseOptionalAttrDict(result.attributes) ||
+ parser.parseColonType(calleeType) ||
+ parser.addTypesToList(calleeType.getResults(), result.types) ||
+ parser.resolveOperands(
+ operands, calleeType.getInputs(), calleeLoc, result.operands))
+ return mlir::failure();
+ result.addAttribute("fn_type", mlir::TypeAttr::get(calleeType));
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' ' << getAttr("method") << '(';
+ p.printOperand(object());
+ if (arg_operand_begin() != arg_operand_end()) {
+ p << ", ";
+ p.printOperands(args());
+ }
+ p << ')';
+ p.printOptionalAttrDict(getAttrs(), {"fn_type", "method"});
+ auto resTy{getResultTypes()};
+ llvm::SmallVector argTy(getOperandTypes());
+ p << " : " << mlir::FunctionType::get(argTy, resTy, getContext());
+ }];
+
+ let extraClassDeclaration = [{
+ mlir::FunctionType getFunctionType();
+ operand_range getArgOperands() {
+ return {arg_operand_begin(), arg_operand_end()};
+ }
+ operand_iterator arg_operand_begin() { return operand_begin() + 1; }
+ operand_iterator arg_operand_end() { return operand_end(); }
+ llvm::StringRef passArgAttrName() { return "pass_arg_pos"; }
+ unsigned passArgPos();
+ }];
+}
+
+// Constant operations that support Fortran
+
+def fir_StringLitOp : fir_Op<"string_lit", [NoSideEffect]>,
+ Results<(outs fir_SequenceType)> {
+ let summary = "create a string literal constant";
+
+ let description = [{
+ An FIR constant that represents a sequence of characters that correspond
+ to Fortran's CHARACTER type, including a LEN. We support CHARACTER values
+ of different KINDs (different constant sizes).
+
+ Example:
+
+ %1 = fir.string_lit "Hello, World!"(13) : !fir.char<1> // ASCII
+ %2 = fir.string_lit [158, 2345](2) : !fir.char<2> // Wide chars
+ }];
+
+ let parser = [{
+ auto &builder = parser.getBuilder();
+ mlir::Attribute val;
+ llvm::SmallVector attrs;
+ if (parser.parseAttribute(val, "fake", attrs))
+ return mlir::failure();
+ if (auto v = val.dyn_cast())
+ result.attributes.push_back(builder.getNamedAttr(value(), v));
+ else if (auto v = val.dyn_cast())
+ result.attributes.push_back(builder.getNamedAttr(xlist(), v));
+ else
+ return mlir::failure();
+ mlir::IntegerAttr sz;
+ mlir::Type type;
+ if (parser.parseLParen() ||
+ parser.parseAttribute(sz, size(), result.attributes) ||
+ parser.parseRParen() ||
+ parser.parseColonType(type))
+ return mlir::failure();
+ type = fir::SequenceType::get({sz.getInt()}, type);
+ if (!type ||
+ parser.addTypesToList(type, result.types))
+ return mlir::failure();
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' ' << getValue() << '(';
+ p << getSize().cast().getValue() << ") : ";
+ p.printType(getType().cast().getEleTy());
+ }];
+
+ let verifier = [{
+ if (getSize().cast().getValue().isNegative())
+ return emitOpError("size must be non-negative");
+ auto eleTy = getType().cast().getEleTy();
+ if (!eleTy.isa())
+ return emitOpError("must have !fir.char type");
+ if (auto xl = getAttr(xlist())) {
+ auto xList = xl.cast();
+ for (auto a : xList)
+ if (!a.isa())
+ return emitOpError("values in list must be integers");
+ }
+ return mlir::success();
+ }];
+
+ let extraClassDeclaration = [{
+ static constexpr const char *size() { return "size"; }
+ static constexpr const char *value() { return "value"; }
+ static constexpr const char *xlist() { return "xlist"; }
+
+ // Get the LEN attribute of this character constant
+ mlir::Attribute getSize() { return getAttr(size()); }
+ // Get the string value of this character constant
+ mlir::Attribute getValue() {
+ if (auto attr = getAttr(value()))
+ return attr;
+ return getAttr(xlist());
+ }
+
+ /// Is this a wide character literal (1 character > 8 bits)
+ bool isWideValue();
+ }];
+}
+
+// Complex operations
+
+class fir_ArithmeticOp traits = []> :
+ fir_Op,
+ Results<(outs AnyType)> {
+ let parser = [{
+ return impl::parseOneResultSameOperandTypeOp(parser, result);
+ }];
+
+ let printer = [{ return fir::printBinaryOp(this->getOperation(), p); }];
+}
+
+class fir_UnaryArithmeticOp traits = []> :
+ fir_Op,
+ Results<(outs AnyType)> {
+ let parser = [{
+ return impl::parseOneResultSameOperandTypeOp(parser, result);
+ }];
+
+ let printer = [{ return fir::printUnaryOp(this->getOperation(), p); }];
+}
+
+def fir_ConstfOp : fir_Op<"constf", [NoSideEffect]>,
+ Results<(outs fir_RealType)> {
+ let summary = "create a floating point constant";
+
+ let description = [{
+ FIXME
+ }];
+
+ let parser = [{
+ fir::RealAttr flt;
+ mlir::Type type;
+ if (parser.parseLParen() ||
+ parser.parseAttribute(flt, constAttrName(), result.attributes) ||
+ parser.parseRParen() || parser.parseColonType(type) ||
+ parser.addTypesToList(type, result.types))
+ return mlir::failure();
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << ' ' << getAttr(constAttrName()) << " : ";
+ p.printType(getType());
+ }];
+
+ let verifier = [{
+ if (!getType().isa())
+ return emitOpError("must be a !fir.real type");
+ return mlir::success();
+ }];
+
+ let extraClassDeclaration = [{
+ static constexpr llvm::StringRef constAttrName() { return "constant"; }
+
+ mlir::Attribute getValue() { return getAttr(constAttrName()); }
+ }];
+}
+
+class RealUnaryArithmeticOp traits = []> :
+ fir_UnaryArithmeticOp,
+ Arguments<(ins AnyRealLike:$operand)>;
+
+def fir_NegfOp : RealUnaryArithmeticOp<"negf">;
+
+class RealArithmeticOp traits = []> :
+ fir_ArithmeticOp,
+ Arguments<(ins AnyRealLike:$lhs, AnyRealLike:$rhs)>;
+
+def fir_AddfOp : RealArithmeticOp<"addf", [Commutative]>;
+def fir_SubfOp : RealArithmeticOp<"subf">;
+def fir_MulfOp : RealArithmeticOp<"mulf", [Commutative]>;
+def fir_DivfOp : RealArithmeticOp<"divf">;
+def fir_ModfOp : RealArithmeticOp<"modf">;
+// Pow is a builtin call and not a primitive
+
+def fir_CmpfOp : fir_Op<"cmpf",
+ [NoSideEffect, SameTypeOperands, SameOperandsAndResultShape]> {
+ let summary = "floating-point comparison operator";
+
+ let description = [{
+ Extends the standard floating-point comparison to handle the extended
+ floating-point types found in FIR.
+ }];
+
+ let arguments = (ins AnyRealLike:$lhs, AnyRealLike:$rhs);
+
+ let results = (outs AnyLogicalLike);
+
+ let builders = [OpBuilder<
+ "Builder *builder, OperationState &result, CmpFPredicate predicate,"
+ "Value lhs, Value rhs", [{
+ fir::buildCmpFOp(builder, result, predicate, lhs, rhs);
+ }]>];
+
+ let parser = [{ return fir::parseCmpfOp(parser, result); }];
+
+ let printer = [{ fir::printCmpfOp(p, *this); }];
+
+ let extraClassDeclaration = [{
+ static constexpr llvm::StringRef getPredicateAttrName() {
+ return "predicate";
+ }
+ static CmpFPredicate getPredicateByName(llvm::StringRef name);
+
+ CmpFPredicate getPredicate() {
+ return (CmpFPredicate)getAttrOfType(
+ getPredicateAttrName()).getInt();
+ }
+ }];
+}
+
+def fir_ConstcOp : fir_Op<"constc", [NoSideEffect]>,
+ Results<(outs fir_ComplexType)> {
+ let summary = "create a complex constant";
+
+ let description = [{
+ FIXME
+ }];
+
+ let parser = [{
+ fir::RealAttr realp;
+ fir::RealAttr imagp;
+ mlir::Type type;
+ if (parser.parseLParen() ||
+ parser.parseAttribute(realp, realAttrName(), result.attributes) ||
+ parser.parseComma() ||
+ parser.parseAttribute(imagp, imagAttrName(), result.attributes) ||
+ parser.parseRParen() ||
+ parser.parseColonType(type) ||
+ parser.addTypesToList(type, result.types))
+ return mlir::failure();
+ return mlir::success();
+ }];
+
+ let printer = [{
+ p << getOperationName() << " (0x";
+ auto f1 = getAttr(realAttrName()).cast();
+ auto i1 = f1.getValue().bitcastToAPInt();
+ p.getStream().write_hex(i1.getZExtValue());
+ p << ", 0x";
+ auto f2 = getAttr(imagAttrName()).cast