1//===-- FIROps.td - FIR operation definitions --------------*- tablegen -*-===//
2//
3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4// See https://llvm.org/LICENSE.txt for license information.
5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6//
7//===----------------------------------------------------------------------===//
8///
9/// \file
10/// Definition of the FIR dialect operations
11///
12//===----------------------------------------------------------------------===//
13
14#ifndef FIR_DIALECT_FIR_OPS
15#define FIR_DIALECT_FIR_OPS
16
17include "mlir/IR/SymbolInterfaces.td"
18include "mlir/Interfaces/ControlFlowInterfaces.td"
19include "mlir/Interfaces/LoopLikeInterface.td"
20include "mlir/Interfaces/SideEffectInterfaces.td"
21
22def fir_Dialect : Dialect {
23  let name = "fir";
24  let cppNamespace = "::fir";
25}
26
27// Types and predicates
28
29def fir_Type : Type<CPred<"fir::isa_fir_or_std_type($_self)">,
30    "FIR dialect type">;
31
32// Fortran intrinsic types
33def fir_CharacterType : Type<CPred<"$_self.isa<fir::CharacterType>()">,
34    "FIR character type">;
35def fir_ComplexType : Type<CPred<"$_self.isa<fir::CplxType>()">,
36    "FIR complex type">;
37def fir_IntegerType : Type<CPred<"$_self.isa<fir::IntType>()">,
38    "FIR integer type">;
39def fir_LogicalType : Type<CPred<"$_self.isa<fir::LogicalType>()">,
40    "FIR logical type">;
41def fir_RealType : Type<CPred<"$_self.isa<fir::RealType>()">,
42    "FIR real type">;
43
44// Generalized FIR and standard dialect types representing intrinsic types
45def AnyIntegerLike : TypeConstraint<Or<[SignlessIntegerLike.predicate,
46    fir_IntegerType.predicate]>, "any integer">;
47def AnyLogicalLike : TypeConstraint<Or<[BoolLike.predicate,
48    fir_LogicalType.predicate]>, "any logical">;
49def AnyRealLike : TypeConstraint<Or<[FloatLike.predicate,
50    fir_RealType.predicate]>, "any real">;
51def AnyIntegerType : Type<AnyIntegerLike.predicate, "any integer">;
52
53// Fortran derived (user defined) type
54def fir_RecordType : Type<CPred<"$_self.isa<fir::RecordType>()">,
55    "FIR derived type">;
56
57// Fortran array attribute
58def fir_SequenceType : Type<CPred<"$_self.isa<fir::SequenceType>()">,
59    "array type">;
60
61// Composable types
62def AnyCompositeLike : TypeConstraint<Or<[fir_RecordType.predicate,
63    fir_SequenceType.predicate, fir_ComplexType.predicate,
64    IsTupleTypePred]>, "any composite">;
65
66// Reference to an entity type
67def fir_ReferenceType : Type<CPred<"$_self.isa<fir::ReferenceType>()">,
68    "reference type">;
69
70// Reference to an ALLOCATABLE attribute type
71def fir_HeapType : Type<CPred<"$_self.isa<fir::HeapType>()">,
72    "allocatable type">;
73
74// Reference to a POINTER attribute type
75def fir_PointerType : Type<CPred<"$_self.isa<fir::PointerType>()">,
76    "pointer type">;
77
78// Reference types
79def AnyReferenceLike : TypeConstraint<Or<[fir_ReferenceType.predicate,
80    fir_HeapType.predicate, fir_PointerType.predicate]>, "any reference">;
81
82// A descriptor tuple (captures a reference to an entity and other information)
83def fir_BoxType : Type<CPred<"$_self.isa<fir::BoxType>()">, "box type">;
84
85// CHARACTER type descriptor. A pair of a data reference and a LEN value.
86def fir_BoxCharType : Type<CPred<"$_self.isa<fir::BoxCharType>()">,
87    "box character type">;
88
89// PROCEDURE POINTER descriptor. A pair that can capture a host closure.
90def fir_BoxProcType : Type<CPred<"$_self.isa<fir::BoxProcType>()">,
91    "box procedure type">;
92
93def AnyBoxLike : TypeConstraint<Or<[fir_BoxType.predicate,
94    fir_BoxCharType.predicate, fir_BoxProcType.predicate]>, "any box">;
95
96def AnyRefOrBox : TypeConstraint<Or<[fir_ReferenceType.predicate,
97    fir_HeapType.predicate, fir_PointerType.predicate, fir_BoxType.predicate]>,
98    "any reference or box">;
99
100// A vector of Fortran triple notation describing a multidimensional array
101def fir_DimsType : Type<CPred<"$_self.isa<fir::DimsType>()">, "dim type">;
102def AnyEmboxLike : TypeConstraint<Or<[AnySignlessInteger.predicate,
103    Index.predicate, fir_IntegerType.predicate, fir_DimsType.predicate]>,
104    "any legal embox argument type">;
105def AnyEmboxArg : Type<AnyEmboxLike.predicate, "embox argument type">;
106
107// A type descriptor's type
108def fir_TypeDescType : Type<CPred<"$_self.isa<fir::TypeDescType>()">,
109    "type desc type">;
110
111// A field (in a RecordType) argument's type
112def fir_FieldType : Type<CPred<"$_self.isa<fir::FieldType>()">, "field type">;
113
114// A LEN parameter (in a RecordType) argument's type
115def fir_LenType : Type<CPred<"$_self.isa<fir::LenType>()">,
116    "LEN parameter type">;
117
118def AnyComponentLike : TypeConstraint<Or<[AnySignlessInteger.predicate,
119    Index.predicate, fir_IntegerType.predicate, fir_FieldType.predicate]>,
120    "any coordinate index">;
121def AnyComponentType : Type<AnyComponentLike.predicate, "coordinate type">;
122
123def AnyCoordinateLike : TypeConstraint<Or<[AnySignlessInteger.predicate,
124    Index.predicate, fir_IntegerType.predicate, fir_FieldType.predicate,
125    fir_LenType.predicate]>, "any coordinate index">;
126def AnyCoordinateType : Type<AnyCoordinateLike.predicate, "coordinate type">;
127
128// Base class for FIR operations.
129// All operations automatically get a prefix of "fir.".
130class fir_Op<string mnemonic, list<OpTrait> traits>
131  : Op<fir_Dialect, mnemonic, traits>;
132
133// Base class for FIR operations that take a single argument
134class fir_SimpleOp<string mnemonic, list<OpTrait> traits>
135  : fir_Op<mnemonic, traits> {
136
137  let assemblyFormat = [{
138    operands attr-dict `:` functional-type(operands, results)
139  }];
140}
141
142// Base builder for allocate operations
143def fir_AllocateOpBuilder :
144  OpBuilderDAG<(ins "Type":$inType, CArg<"ValueRange", "{}">:$lenParams,
145    CArg<"ValueRange", "{}">:$sizes,
146    CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes),
147  [{
148    $_state.addTypes(getRefTy(inType));
149    $_state.addAttribute("in_type", TypeAttr::get(inType));
150    $_state.addOperands(sizes);
151    $_state.addAttributes(attributes);
152  }]>;
153
154def fir_NamedAllocateOpBuilder :
155  OpBuilderDAG<(ins "Type":$inType, "StringRef":$name,
156    CArg<"ValueRange", "{}">:$lenParams, CArg<"ValueRange", "{}">:$sizes,
157    CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes),
158  [{
159    $_state.addTypes(getRefTy(inType));
160    $_state.addAttribute("in_type", TypeAttr::get(inType));
161    $_state.addAttribute("name", $_builder.getStringAttr(name));
162    $_state.addOperands(sizes);
163    $_state.addAttributes(attributes);
164  }]>;
165
166def fir_OneResultOpBuilder :
167  OpBuilderDAG<(ins "Type":$resultType, "ValueRange":$operands,
168    CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes),
169  [{
170    if (resultType)
171      $_state.addTypes(resultType);
172    $_state.addOperands(operands);
173    $_state.addAttributes(attributes);
174  }]>;
175
176// Base class of FIR operations that return 1 result
177class fir_OneResultOp<string mnemonic, list<OpTrait> traits = []> :
178    fir_Op<mnemonic, traits>, Results<(outs fir_Type:$res)> {
179  let builders = [fir_OneResultOpBuilder];
180}
181
182// Base class of FIR operations that have 1 argument and return 1 result
183class fir_SimpleOneResultOp<string mnemonic, list<OpTrait> traits = []> :
184    fir_SimpleOp<mnemonic, traits> {
185  let builders = [fir_OneResultOpBuilder];
186}
187
188class fir_TwoBuilders<OpBuilderDAG b1, OpBuilderDAG b2> {
189  list<OpBuilderDAG> builders = [b1, b2];
190}
191
192class fir_AllocatableBaseOp<string mnemonic, list<OpTrait> traits = []> :
193    fir_Op<mnemonic, traits>, Results<(outs fir_Type:$res)> {
194  let arguments = (ins
195    OptionalAttr<StrAttr>:$name,
196    OptionalAttr<BoolAttr>:$target
197  );
198}
199
200class fir_AllocatableOp<string mnemonic, list<OpTrait> traits = []> :
201    fir_AllocatableBaseOp<mnemonic,
202	!listconcat(traits, [MemoryEffects<[MemAlloc]>])>,
203    fir_TwoBuilders<fir_AllocateOpBuilder, fir_NamedAllocateOpBuilder>,
204    Arguments<(ins TypeAttr:$in_type, Variadic<AnyIntegerType>:$args)> {
205
206  let parser = [{
207    mlir::Type intype;
208    if (parser.parseType(intype))
209      return mlir::failure();
210    auto &builder = parser.getBuilder();
211    result.addAttribute(inType(), mlir::TypeAttr::get(intype));
212    llvm::SmallVector<mlir::OpAsmParser::OperandType, 8> operands;
213    llvm::SmallVector<mlir::Type, 8> typeVec;
214    bool hasOperands = false;
215    if (!parser.parseOptionalLParen()) {
216      // parse the LEN params of the derived type. (<params> : <types>)
217      if (parser.parseOperandList(operands,
218                                  mlir::OpAsmParser::Delimiter::None) ||
219          parser.parseColonTypeList(typeVec) ||
220          parser.parseRParen())
221        return mlir::failure();
222      auto lens = builder.getI32IntegerAttr(operands.size());
223      result.addAttribute(lenpName(), lens);
224      hasOperands = true;
225    }
226    if (!parser.parseOptionalComma()) {
227      // parse size to scale by, vector of n dimensions of type index
228      auto opSize = operands.size();
229      if (parser.parseOperandList(operands, mlir::OpAsmParser::Delimiter::None))
230        return mlir::failure();
231      for (auto i = opSize, end = operands.size(); i != end; ++i)
232        typeVec.push_back(builder.getIndexType());
233      hasOperands = true;
234    }
235    if (hasOperands &&
236        parser.resolveOperands(operands, typeVec, parser.getNameLoc(),
237                               result.operands))
238      return mlir::failure();
239    mlir::Type restype = wrapResultType(intype);
240    if (!restype) {
241      parser.emitError(parser.getNameLoc(), "invalid allocate type: ")
242          << intype;
243      return mlir::failure();
244    }
245    if (parser.parseOptionalAttrDict(result.attributes) ||
246        parser.addTypeToList(restype, result.types))
247      return mlir::failure();
248    return mlir::success();
249  }];
250
251  let printer = [{
252    p << getOperationName() << ' ' << (*this)->getAttr(inType());
253    if (hasLenParams()) {
254      // print the LEN parameters to a derived type in parens
255      p << '(' << getLenParams() << " : " << getLenParams().getTypes() << ')';
256    }
257    // print the shape of the allocation (if any); all must be index type
258    for (auto sh : getShapeOperands()) {
259      p << ", ";
260      p.printOperand(sh);
261    }
262    p.printOptionalAttrDict(getAttrs(), {inType(), lenpName()});
263  }];
264
265  string extraAllocClassDeclaration = [{
266    static constexpr llvm::StringRef inType() { return "in_type"; }
267    static constexpr llvm::StringRef lenpName() { return "len_param_count"; }
268    mlir::Type getAllocatedType();
269
270    bool hasLenParams() { return bool{(*this)->getAttr(lenpName())}; }
271
272    unsigned numLenParams() {
273      if (auto val = (*this)->getAttrOfType<mlir::IntegerAttr>(lenpName()))
274        return val.getInt();
275      return 0;
276    }
277
278    operand_range getLenParams() {
279      return {operand_begin(), operand_begin() + numLenParams()};
280    }
281
282    unsigned numShapeOperands() {
283      return operand_end() - operand_begin() + numLenParams();
284    }
285
286    operand_range getShapeOperands() {
287      return {operand_begin() + numLenParams(), operand_end()};
288    }
289
290    static mlir::Type getRefTy(mlir::Type ty);
291
292    /// Get the input type of the allocation
293    mlir::Type getInType() {
294      return (*this)->getAttrOfType<mlir::TypeAttr>(inType()).getValue();
295    }
296  }];
297
298  // Verify checks common to all allocation operations
299  string allocVerify = [{
300    llvm::SmallVector<llvm::StringRef, 8> visited;
301    if (verifyInType(getInType(), visited, numShapeOperands()))
302      return emitOpError("invalid type for allocation");
303    if (verifyRecordLenParams(getInType(), numLenParams()))
304      return emitOpError("LEN params do not correspond to type");
305  }];
306}
307
308//===----------------------------------------------------------------------===//
309// Memory SSA operations
310//===----------------------------------------------------------------------===//
311
312def fir_AllocaOp : fir_AllocatableOp<"alloca"> {
313  let summary = "allocate storage for a temporary on the stack given a type";
314  let description = [{
315    This primitive operation is used to allocate an object on the stack.  A
316    reference to the object of type `!fir.ref<T>` is returned.  The returned
317    object has an undefined/uninitialized state.  The allocation can be given
318    an optional name.  The allocation may have a dynamic repetition count
319    for allocating a sequence of locations for the specified type.
320
321    ```mlir
322      %c = ... : i64
323      %x = fir.alloca i32
324      %y = fir.alloca !fir.array<8 x i64>
325      %z = fir.alloca f32, %c
326
327      %i = ... : i16
328      %j = ... : i32
329      %w = fir.alloca !fir.type<PT(len1:i16, len2:i32)> (%i, %j : i16, i32)
330    ```
331
332    Note that in the case of `%z`, a contiguous block of memory is allocated
333    and its size is a runtime multiple of a 32-bit REAL value.
334
335    In the case of `%w`, the arguments `%i` and `%j` are LEN parameters
336    (`len1`, `len2`) to the type `PT`.
337
338    Finally, the operation is undefined if the ssa-value `%c` is negative.
339  }];
340
341  let results = (outs fir_ReferenceType);
342
343  let verifier = allocVerify#[{
344    mlir::Type outType = getType();
345    if (!outType.isa<fir::ReferenceType>())
346      return emitOpError("must be a !fir.ref type");
347    return mlir::success();
348  }];
349
350  let extraClassDeclaration = extraAllocClassDeclaration#[{
351    static mlir::Type wrapResultType(mlir::Type intype);
352  }];
353}
354
355def fir_LoadOp : fir_OneResultOp<"load", [MemoryEffects<[MemRead]>]> {
356  let summary = "load a value from a memory reference";
357  let description = [{
358    Load a value from a memory reference into an ssa-value (virtual register).
359    Produces an immutable ssa-value of the referent type. A memory reference
360    has type `!fir.ref<T>`, `!fir.heap<T>`, or `!fir.ptr<T>`.
361
362    ```mlir
363      %a = fir.alloca i32
364      %l = fir.load %a : !fir.ref<i32>
365    ```
366
367    The ssa-value has an undefined value if the memory reference is undefined
368    or null.
369  }];
370
371  let arguments = (ins AnyReferenceLike:$memref);
372
373  let builders = [
374    OpBuilderDAG<(ins "Value":$refVal),
375    [{
376      if (!refVal) {
377        mlir::emitError($_state.location, "LoadOp has null argument");
378        return;
379      }
380      auto refTy = refVal.getType().cast<fir::ReferenceType>();
381      $_state.addOperands(refVal);
382      $_state.addTypes(refTy.getEleTy());
383    }]>];
384
385  let parser = [{
386    mlir::Type type;
387    mlir::OpAsmParser::OperandType oper;
388    if (parser.parseOperand(oper) ||
389        parser.parseOptionalAttrDict(result.attributes) ||
390        parser.parseColonType(type) ||
391        parser.resolveOperand(oper, type, result.operands))
392       return mlir::failure();
393    mlir::Type eleTy;
394    if (getElementOf(eleTy, type) ||
395        parser.addTypeToList(eleTy, result.types))
396       return mlir::failure();
397    return mlir::success();
398  }];
399
400  let printer = [{
401    p << getOperationName() << ' ';
402    p.printOperand(memref());
403    p.printOptionalAttrDict(getAttrs(), {});
404    p << " : " << memref().getType();
405  }];
406
407  let extraClassDeclaration = [{
408    static mlir::ParseResult getElementOf(mlir::Type &ele, mlir::Type ref);
409  }];
410}
411
412def fir_StoreOp : fir_Op<"store", [MemoryEffects<[MemWrite]>]> {
413  let summary = "store an SSA-value to a memory location";
414
415  let description = [{
416    Store an ssa-value (virtual register) to a memory reference.  The stored
417    value must be of the same type as the referent type of the memory
418    reference.
419
420    ```mlir
421      %v = ... : f64
422      %p = ... : !fir.ptr<f64>
423      fir.store %v to %p : !fir.ptr<f64>
424    ```
425
426    The above store changes the value to which the pointer is pointing and not
427    the pointer itself. The operation is undefined if the memory reference,
428    `%p`, is undefined or null.
429  }];
430
431  let arguments = (ins AnyType:$value, AnyReferenceLike:$memref);
432
433  let parser = [{
434    mlir::Type type;
435    mlir::OpAsmParser::OperandType oper;
436    mlir::OpAsmParser::OperandType store;
437    if (parser.parseOperand(oper) ||
438        parser.parseKeyword("to") ||
439        parser.parseOperand(store) ||
440        parser.parseOptionalAttrDict(result.attributes) ||
441        parser.parseColonType(type) ||
442        parser.resolveOperand(oper, elementType(type),
443          result.operands) ||
444        parser.resolveOperand(store, type, result.operands))
445       return mlir::failure();
446    return mlir::success();
447  }];
448
449  let printer = [{
450    p << getOperationName() << ' ';
451    p.printOperand(value());
452    p << " to ";
453    p.printOperand(memref());
454    p.printOptionalAttrDict(getAttrs(), {});
455    p << " : " << memref().getType();
456  }];
457
458  let verifier = [{
459    if (value().getType() != fir::dyn_cast_ptrEleTy(memref().getType()))
460      return emitOpError("store value type must match memory reference type");
461    return mlir::success();
462  }];
463
464  let extraClassDeclaration = [{
465    static mlir::Type elementType(mlir::Type refType);
466  }];
467}
468
469def fir_UndefOp : fir_OneResultOp<"undefined", [NoSideEffect]> {
470  let summary = "explicit undefined value of some type";
471  let description = [{
472    Constructs an ssa-value of the specified type with an undefined value.
473    This operation is typically created internally by the mem2reg conversion
474    pass. An undefined value can be of any type except `!fir.ref<T>`.
475
476    ```mlir
477      %a = fir.undefined !fir.array<10 x !fir.type<T>>
478    ```
479
480    The example creates an array shaped ssa value. The array is rank 1, extent
481    10, and each element has type `!fir.type<T>`.
482  }];
483
484  let results = (outs AnyType:$intype);
485
486  let assemblyFormat = "type($intype) attr-dict";
487
488  let verifier = [{
489    // allow `undef : ref<T>` since it is a possible from transformations
490    return mlir::success();
491  }];
492}
493
494def fir_AllocMemOp : fir_AllocatableOp<"allocmem"> {
495  let summary = "allocate storage on the heap for an object of a given type";
496
497  let description = [{
498    Creates a heap memory reference suitable for storing a value of the
499    given type, T.  The heap refernce returned has type `!fir.heap<T>`.
500    The memory object is in an undefined state.  `allocmem` operations must
501    be paired with `freemem` operations to avoid memory leaks.
502
503    ```mlir
504      %0 = fir.allocmem !fir.array<10 x f32>
505      fir.freemem %0 : !fir.heap<!fir.array<10 x f32>>
506    ```
507  }];
508
509  let results = (outs fir_HeapType);
510
511  let verifier = allocVerify#[{
512    mlir::Type outType = getType();
513    if (!outType.dyn_cast<fir::HeapType>())
514      return emitOpError("must be a !fir.heap type");
515    return mlir::success();
516  }];
517
518  let extraClassDeclaration = extraAllocClassDeclaration#[{
519    static mlir::Type wrapResultType(mlir::Type intype);
520  }];
521}
522
523def fir_FreeMemOp : fir_Op<"freemem", [MemoryEffects<[MemFree]>]> {
524  let summary = "free a heap object";
525
526  let description = [{
527    Deallocates a heap memory reference that was allocated by an `allocmem`.
528    The memory object that is deallocated is placed in an undefined state
529    after `fir.freemem`.  Optimizations may treat the loading of an object
530    in the undefined state as undefined behavior.  This includes aliasing
531    references, such as the result of an `fir.embox`.
532
533    ```mlir
534      %21 = fir.allocmem !fir.type<ZT(p:i32){field:i32}>
535      ...
536      fir.freemem %21 : !fir.heap<!fir.type<ZT>>
537    ```
538  }];
539
540  let arguments = (ins fir_HeapType:$heapref);
541
542  let assemblyFormat = "$heapref attr-dict `:` type($heapref)";
543}
544
545//===----------------------------------------------------------------------===//
546// Terminator operations
547//===----------------------------------------------------------------------===//
548
549class fir_SwitchTerminatorOp<string mnemonic, list<OpTrait> traits = []> :
550    fir_Op<mnemonic, !listconcat(traits, [AttrSizedOperandSegments,
551    DeclareOpInterfaceMethods<BranchOpInterface>, Terminator])> {
552
553  let arguments = (ins
554    AnyType:$selector,
555    Variadic<AnyType>:$compareArgs,
556    Variadic<AnyType>:$targetArgs
557  );
558
559  let results = (outs);
560
561  let successors = (successor VariadicSuccessor<AnySuccessor>:$targets);
562
563  string extraSwitchClassDeclaration = [{
564    using Conditions = mlir::Value;
565
566    static constexpr llvm::StringRef getCasesAttr() { return "case_tags"; }
567
568    // The number of destination conditions that may be tested
569    unsigned getNumConditions() {
570      return (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).size();
571    }
572
573    // The selector is the value being tested to determine the destination
574    mlir::Value getSelector() { return selector(); }
575    mlir::Value getSelector(llvm::ArrayRef<mlir::Value> operands) {
576      return operands[0];
577    }
578
579    // The number of blocks that may be branched to
580    unsigned getNumDest() { return (*this)->getNumSuccessors(); }
581
582    llvm::Optional<mlir::OperandRange> getCompareOperands(unsigned cond);
583    llvm::Optional<llvm::ArrayRef<mlir::Value>> getCompareOperands(
584        llvm::ArrayRef<mlir::Value> operands, unsigned cond);
585
586    llvm::Optional<llvm::ArrayRef<mlir::Value>> getSuccessorOperands(
587        llvm::ArrayRef<mlir::Value> operands, unsigned cond);
588    using BranchOpInterfaceTrait::getSuccessorOperands;
589
590    // Helper function to deal with Optional operand forms
591    void printSuccessorAtIndex(mlir::OpAsmPrinter &p, unsigned i) {
592      auto *succ = getSuccessor(i);
593      auto ops = getSuccessorOperands(i);
594      if (ops.hasValue())
595        p.printSuccessorAndUseList(succ, ops.getValue());
596      else
597        p.printSuccessor(succ);
598    }
599
600    unsigned targetOffsetSize();
601  }];
602}
603
604class fir_IntegralSwitchTerminatorOp<string mnemonic,
605    list<OpTrait> traits = []> : fir_SwitchTerminatorOp<mnemonic, traits> {
606
607  let skipDefaultBuilders = 1;
608  let builders = [
609    OpBuilderDAG<(ins "Value":$selector, "ArrayRef<int64_t>":$compareOperands,
610      "ArrayRef<Block *>":$destinations,
611      CArg<"ArrayRef<ValueRange>", "{}">:$destOperands,
612      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes),
613    [{
614      $_state.addOperands(selector);
615      llvm::SmallVector<mlir::Attribute, 8> ivalues;
616      for (auto iv : compareOperands)
617        ivalues.push_back($_builder.getI64IntegerAttr(iv));
618      ivalues.push_back($_builder.getUnitAttr());
619      $_state.addAttribute(getCasesAttr(), $_builder.getArrayAttr(ivalues));
620      const auto count = destinations.size();
621      for (auto d : destinations)
622        $_state.addSuccessors(d);
623      const auto opCount = destOperands.size();
624      llvm::SmallVector<int32_t, 8> argOffs;
625      int32_t sumArgs = 0;
626      for (std::remove_const_t<decltype(count)> i = 0; i != count; ++i) {
627        if (i < opCount) {
628          $_state.addOperands(destOperands[i]);
629          const auto argSz = destOperands[i].size();
630          argOffs.push_back(argSz);
631          sumArgs += argSz;
632        } else {
633          argOffs.push_back(0);
634        }
635      }
636      $_state.addAttribute(getOperandSegmentSizeAttr(),
637                          $_builder.getI32VectorAttr({1, 0, sumArgs}));
638      $_state.addAttribute(getTargetOffsetAttr(),
639                          $_builder.getI32VectorAttr(argOffs));
640      $_state.addAttributes(attributes);
641    }]>];
642
643  let parser = [{
644    mlir::OpAsmParser::OperandType selector;
645    mlir::Type type;
646    if (parseSelector(parser, result, selector, type))
647      return mlir::failure();
648
649    llvm::SmallVector<mlir::Attribute, 8> ivalues;
650    llvm::SmallVector<mlir::Block *, 8> dests;
651    llvm::SmallVector<llvm::SmallVector<mlir::Value, 8>, 8> destArgs;
652    while (true) {
653      mlir::Attribute ivalue; // Integer or Unit
654      mlir::Block *dest;
655      llvm::SmallVector<mlir::Value, 8> destArg;
656      mlir::NamedAttrList temp;
657      if (parser.parseAttribute(ivalue, "i", temp) ||
658          parser.parseComma() ||
659          parser.parseSuccessorAndUseList(dest, destArg))
660        return mlir::failure();
661      ivalues.push_back(ivalue);
662      dests.push_back(dest);
663      destArgs.push_back(destArg);
664      if (!parser.parseOptionalRSquare())
665        break;
666      if (parser.parseComma())
667        return mlir::failure();
668    }
669    auto &bld = parser.getBuilder();
670    result.addAttribute(getCasesAttr(), bld.getArrayAttr(ivalues));
671    llvm::SmallVector<int32_t, 8> argOffs;
672    int32_t sumArgs = 0;
673    const auto count = dests.size();
674    for (std::remove_const_t<decltype(count)> i = 0; i != count; ++i) {
675      result.addSuccessors(dests[i]);
676      result.addOperands(destArgs[i]);
677      auto argSize = destArgs[i].size();
678      argOffs.push_back(argSize);
679      sumArgs += argSize;
680    }
681    result.addAttribute(getOperandSegmentSizeAttr(),
682                        bld.getI32VectorAttr({1, 0, sumArgs}));
683    result.addAttribute(getTargetOffsetAttr(), bld.getI32VectorAttr(argOffs));
684    return mlir::success();
685  }];
686
687  let printer = [{
688    p << getOperationName() << ' ';
689    p.printOperand(getSelector());
690    p << " : " << getSelector().getType() << " [";
691    auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
692    auto count = getNumConditions();
693    for (decltype(count) i = 0; i != count; ++i) {
694      if (i)
695        p << ", ";
696      auto &attr = cases[i];
697      if (auto intAttr = attr.dyn_cast_or_null<mlir::IntegerAttr>())
698        p << intAttr.getValue();
699      else
700        p.printAttribute(attr);
701      p << ", ";
702      printSuccessorAtIndex(p, i);
703    }
704    p << ']';
705    p.printOptionalAttrDict(getAttrs(), {getCasesAttr(), getCompareOffsetAttr(),
706        getTargetOffsetAttr(), getOperandSegmentSizeAttr()});
707  }];
708
709  let verifier = [{
710    if (!(getSelector().getType().isa<mlir::IntegerType>() ||
711          getSelector().getType().isa<mlir::IndexType>() ||
712          getSelector().getType().isa<fir::IntType>()))
713      return emitOpError("must be an integer");
714    auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
715    auto count = getNumDest();
716    if (count == 0)
717      return emitOpError("must have at least one successor");
718    if (getNumConditions() != count)
719      return emitOpError("number of cases and targets don't match");
720    if (targetOffsetSize() != count)
721      return emitOpError("incorrect number of successor operand groups");
722    for (decltype(count) i = 0; i != count; ++i) {
723      auto &attr = cases[i];
724      if (!(attr.isa<mlir::IntegerAttr>() || attr.isa<mlir::UnitAttr>()))
725        return emitOpError("invalid case alternative");
726    }
727    return mlir::success();
728  }];
729
730  let extraClassDeclaration = extraSwitchClassDeclaration;
731}
732
733def fir_SelectOp : fir_IntegralSwitchTerminatorOp<"select"> {
734  let summary = "a multiway branch";
735
736  let description = [{
737    A multiway branch terminator with similar semantics to C's `switch`
738    statement.  A selector value is matched against a list of constants
739    of the same type for a match.  When a match is found, control is
740    transferred to the corresponding basic block.  A `select` must have
741    at least one basic block with a corresponding `unit` match, and
742    that block will be selected when all other conditions fail to match.
743
744    ```mlir
745      fir.select %arg:i32 [1, ^bb1(%0 : i32),
746                           2, ^bb2(%2,%arg,%arg2 : i32,i32,i32),
747                          -3, ^bb3(%arg2,%2 : i32,i32),
748                           4, ^bb4(%1 : i32),
749                        unit, ^bb5]
750    ```
751  }];
752}
753
754def fir_SelectRankOp : fir_IntegralSwitchTerminatorOp<"select_rank"> {
755  let summary = "Fortran's SELECT RANK statement";
756
757  let description = [{
758    Similar to `select`, `select_rank` provides a way to express Fortran's
759    SELECT RANK construct.  In this case, the rank of the selector value
760    is matched against constants of integer type.  The structure is the
761    same as `select`, but `select_rank` determines the rank of the selector
762    variable at runtime to determine the best match.
763
764    ```mlir
765      fir.select_rank %arg:i32 [1, ^bb1(%0 : i32),
766                                2, ^bb2(%2,%arg,%arg2 : i32,i32,i32),
767                                3, ^bb3(%arg2,%2 : i32,i32),
768                               -1, ^bb4(%1 : i32),
769                             unit, ^bb5]
770    ```
771  }];
772}
773
774def fir_SelectCaseOp : fir_SwitchTerminatorOp<"select_case"> {
775  let summary = "Fortran's SELECT CASE statement";
776
777  let description = [{
778    Similar to `select`, `select_case` provides a way to express Fortran's
779    SELECT CASE construct.  In this case, the selector value is matched
780    against variables (not just constants) and ranges.  The structure is
781    the same as `select`, but `select_case` allows for the expression of
782    more complex match conditions.
783
784    ```mlir
785      fir.select_case %arg : i32 [
786            #fir.point, %0, ^bb1(%0 : i32),
787            #fir.lower, %1, ^bb2(%2,%arg,%arg2,%1 : i32,i32,i32,i32),
788            #fir.interval, %2, %3, ^bb3(%2,%arg2 : i32,i32),
789            #fir.upper, %arg, ^bb4(%1 : i32),
790            unit, ^bb5]
791    ```
792  }];
793
794  let skipDefaultBuilders = 1;
795  let builders = [
796    OpBuilderDAG<(ins "Value":$selector,
797      "ArrayRef<mlir::Attribute>":$compareAttrs,
798      "ArrayRef<ValueRange>":$cmpOperands, "ArrayRef<Block *>":$destinations,
799      CArg<"ArrayRef<ValueRange>", "{}">:$destOperands,
800      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes)>,
801    OpBuilderDAG<(ins "Value":$selector,
802      "ArrayRef<mlir::Attribute>":$compareAttrs, "ArrayRef<Value>":$cmpOpList,
803      "ArrayRef<Block *>":$destinations,
804      CArg<"ArrayRef<ValueRange>", "{}">:$destOperands,
805      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes)>];
806
807  let parser = "return parseSelectCase(parser, result);";
808
809  let printer = [{
810    p << getOperationName() << ' ';
811    p.printOperand(getSelector());
812    p << " : " << getSelector().getType() << " [";
813    auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
814    auto count = getNumConditions();
815    for (decltype(count) i = 0; i != count; ++i) {
816      if (i)
817        p << ", ";
818      p << cases[i] << ", ";
819      if (!cases[i].isa<mlir::UnitAttr>()) {
820        auto caseArgs = *getCompareOperands(i);
821        p.printOperand(*caseArgs.begin());
822        p << ", ";
823        if (cases[i].isa<fir::ClosedIntervalAttr>()) {
824          p.printOperand(*(++caseArgs.begin()));
825          p << ", ";
826        }
827      }
828      printSuccessorAtIndex(p, i);
829    }
830    p << ']';
831    p.printOptionalAttrDict(getAttrs(), {getCasesAttr(), getCompareOffsetAttr(),
832        getTargetOffsetAttr(), getOperandSegmentSizeAttr()});
833  }];
834
835  let verifier = [{
836    if (!(getSelector().getType().isa<mlir::IntegerType>() ||
837          getSelector().getType().isa<mlir::IndexType>() ||
838          getSelector().getType().isa<fir::IntType>() ||
839          getSelector().getType().isa<fir::LogicalType>() ||
840          getSelector().getType().isa<fir::CharacterType>()))
841      return emitOpError("must be an integer, character, or logical");
842    auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
843    auto count = getNumDest();
844    if (count == 0)
845      return emitOpError("must have at least one successor");
846    if (getNumConditions() != count)
847      return emitOpError("number of conditions and successors don't match");
848    if (compareOffsetSize() != count)
849      return emitOpError("incorrect number of compare operand groups");
850    if (targetOffsetSize() != count)
851      return emitOpError("incorrect number of successor operand groups");
852    for (decltype(count) i = 0; i != count; ++i) {
853      auto &attr = cases[i];
854      if (!(attr.isa<fir::PointIntervalAttr>() ||
855            attr.isa<fir::LowerBoundAttr>() ||
856            attr.isa<fir::UpperBoundAttr>() ||
857            attr.isa<fir::ClosedIntervalAttr>() ||
858            attr.isa<mlir::UnitAttr>()))
859        return emitOpError("incorrect select case attribute type");
860    }
861    return mlir::success();
862  }];
863
864  let extraClassDeclaration = extraSwitchClassDeclaration#[{
865    unsigned compareOffsetSize();
866  }];
867}
868
869def fir_SelectTypeOp : fir_SwitchTerminatorOp<"select_type"> {
870  let summary = "Fortran's SELECT TYPE statement";
871
872  let description = [{
873    Similar to `select`, `select_type` provides a way to express Fortran's
874    SELECT TYPE construct.  In this case, the type of the selector value
875    is matched against a list of type descriptors.  The structure is the
876    same as `select`, but `select_type` determines the type of the selector
877    variable at runtime to determine the best match.
878
879    ```mlir
880      fir.select_type %arg : !fir.box<()> [
881          #fir.instance<!fir.type<type1>>, ^bb1(%0 : i32),
882          #fir.instance<!fir.type<type2>>, ^bb2(%2 : i32),
883          #fir.subsumed<!fir.type<type3>>, ^bb3(%2 : i32),
884          #fir.instance<!fir.type<type4>>, ^bb4(%1,%3 : i32,f32),
885          unit, ^bb5]
886    ```
887  }];
888
889  let skipDefaultBuilders = 1;
890  let builders = [
891    OpBuilderDAG<(ins "Value":$selector,
892      "ArrayRef<mlir::Attribute>":$typeOperands,
893      "ArrayRef<Block *>":$destinations,
894      CArg<"ArrayRef<ValueRange>", "{}">:$destOperands,
895      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes),
896    [{
897      $_state.addOperands(selector);
898      $_state.addAttribute(getCasesAttr(), $_builder.getArrayAttr(typeOperands));
899      const auto count = destinations.size();
900      for (auto d : destinations)
901        $_state.addSuccessors(d);
902      const auto opCount = destOperands.size();
903      llvm::SmallVector<int32_t, 8> argOffs;
904      int32_t sumArgs = 0;
905      for (std::remove_const_t<decltype(count)> i = 0; i != count; ++i) {
906        if (i < opCount) {
907          $_state.addOperands(destOperands[i]);
908          const auto argSz = destOperands[i].size();
909          argOffs.push_back(argSz);
910          sumArgs += argSz;
911        } else {
912          argOffs.push_back(0);
913        }
914      }
915      $_state.addAttribute(getOperandSegmentSizeAttr(),
916                          $_builder.getI32VectorAttr({1, 0, sumArgs}));
917      $_state.addAttribute(getTargetOffsetAttr(),
918                          $_builder.getI32VectorAttr(argOffs));
919      $_state.addAttributes(attributes);
920    }]>];
921
922  let parser = "return parseSelectType(parser, result);";
923
924  let printer = [{
925    p << getOperationName() << ' ';
926    p.printOperand(getSelector());
927    p << " : " << getSelector().getType() << " [";
928    auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
929    auto count = getNumConditions();
930    for (decltype(count) i = 0; i != count; ++i) {
931      if (i)
932        p << ", ";
933      p << cases[i] << ", ";
934      printSuccessorAtIndex(p, i);
935    }
936    p << ']';
937    p.printOptionalAttrDict(getAttrs(), {getCasesAttr(), getCompareOffsetAttr(),
938        getTargetOffsetAttr(), getOperandSegmentSizeAttr()});
939  }];
940
941  let verifier = [{
942    if (!(getSelector().getType().isa<fir::BoxType>()))
943      return emitOpError("must be a boxed type");
944    auto cases = (*this)->getAttrOfType<mlir::ArrayAttr>(getCasesAttr()).getValue();
945    auto count = getNumDest();
946    if (count == 0)
947      return emitOpError("must have at least one successor");
948    if (getNumConditions() != count)
949      return emitOpError("number of conditions and successors don't match");
950    if (targetOffsetSize() != count)
951      return emitOpError("incorrect number of successor operand groups");
952    for (decltype(count) i = 0; i != count; ++i) {
953      auto &attr = cases[i];
954      if (!(attr.isa<fir::ExactTypeAttr>() || attr.isa<fir::SubclassAttr>() ||
955            attr.isa<mlir::UnitAttr>()))
956        return emitOpError("invalid type-case alternative");
957    }
958    return mlir::success();
959  }];
960
961  let extraClassDeclaration = extraSwitchClassDeclaration;
962}
963
964def fir_UnreachableOp : fir_Op<"unreachable", [Terminator]> {
965  let summary = "the unreachable instruction";
966
967  let description = [{
968    Terminates a basic block with the assertion that the end of the block
969    will never be reached at runtime.  This instruction can be used
970    immediately after a call to the Fortran runtime to terminate the
971    program, for example.  This instruction corresponds to the LLVM IR
972    instruction `unreachable`.
973
974    ```mlir
975      fir.unreachable
976    ```
977  }];
978
979  let parser = "return mlir::success();";
980
981  let printer = "p << getOperationName();";
982}
983
984def fir_FirEndOp : fir_Op<"end", [Terminator]> {
985  let summary = "the end instruction";
986
987  let description = [{
988    The end terminator is a special terminator used inside various FIR
989    operations that have regions.  End is thus the custom invisible terminator
990    for these operations.  It is implicit and need not appear in the textual
991    representation.
992  }];
993}
994
995def fir_HasValueOp : fir_Op<"has_value", [Terminator, HasParent<"GlobalOp">]> {
996  let summary = "terminator for GlobalOp";
997  let description = [{
998    The terminator for a GlobalOp with a body.
999
1000    ```mlir
1001      global @variable : tuple<i32, f32> {
1002        %0 = constant 45 : i32
1003        %1 = constant 100.0 : f32
1004        %2 = fir.undefined tuple<i32, f32>
1005        %3 = constant 0 : index
1006        %4 = fir.insert_value %2, %0, %3 : (tuple<i32, f32>, i32, index) -> tuple<i32, f32>
1007        %5 = constant 1 : index
1008        %6 = fir.insert_value %4, %1, %5 : (tuple<i32, f32>, f32, index) -> tuple<i32, f32>
1009        fir.has_value %6 : tuple<i32, f32>
1010      }
1011    ```
1012  }];
1013
1014  let arguments = (ins AnyType:$resval);
1015
1016  let assemblyFormat = "$resval attr-dict `:` type($resval)";
1017}
1018
1019// Operations on !fir.box<T> type objects
1020
1021def fir_EmboxOp : fir_Op<"embox", [NoSideEffect]> {
1022  let summary = "boxes a given reference and (optional) dimension information";
1023
1024  let description = [{
1025    Create a boxed reference value. In Fortran, the implementation can require
1026    extra information about an entity, such as its type, rank, etc.  This
1027    auxilliary information is packaged and abstracted as a value with box type
1028    by the calling routine. (In Fortran, these are called descriptors.)
1029
1030    ```mlir
1031      %c1 = constant 1 : index
1032      %c10 = constant 10 : index
1033      %4 = fir.dims(%c1, %c10, %c1) : (index, index, index) -> !fir.dims<1>
1034      %5 = ... : !fir.ref<!fir.array<10 x i32>>
1035      %6 = fir.embox %5, %4 : (!fir.ref<!fir.array<10 x i32>>, !fir.dims<1>) -> !fir.box<!fir.array<10 x i32>>
1036    ```
1037
1038    The descriptor tuple may contain additional implementation-specific
1039    information through the use of additional attributes.
1040  }];
1041
1042  let arguments = (ins AnyReferenceLike:$memref, Variadic<AnyEmboxArg>:$args);
1043
1044  let results = (outs fir_BoxType);
1045
1046  let parser = "return parseEmboxOp(parser, result);";
1047
1048  let printer = [{
1049    p << getOperationName() << ' ';
1050    p.printOperand(memref());
1051    if (hasLenParams()) {
1052      p << '(';
1053      p.printOperands(getLenParams());
1054      p << ')';
1055    }
1056    if (getNumOperands() == 2) {
1057      p << ", ";
1058      p.printOperands(dims());
1059    } else if (auto map = (*this)->getAttr(layoutName())) {
1060      p << " [" << map << ']';
1061    }
1062    p.printOptionalAttrDict(getAttrs(), {layoutName(), lenpName()});
1063    p << " : ";
1064    p.printFunctionalType(getOperation());
1065  }];
1066
1067  let verifier = [{
1068    if (hasLenParams()) {
1069      auto lenParams = numLenParams();
1070      auto eleTy = fir::dyn_cast_ptrEleTy(memref().getType());
1071      if (!eleTy)
1072        return emitOpError("must embox a memory reference type");
1073      if (auto rt = eleTy.dyn_cast<fir::RecordType>()) {
1074        if (lenParams != rt.getNumLenParams())
1075          return emitOpError("number of LEN params does not correspond"
1076                             " to the !fir.type type");
1077      } else {
1078        return emitOpError("LEN parameters require !fir.type type");
1079      }
1080      for (auto lp : getLenParams())
1081        if (lp.getType().isa<fir::DimsType>())
1082          return emitOpError("LEN parameters must be integral type");
1083    }
1084    if (dims().size() == 0) {
1085      // Ok. If there is no dims and no layout map, then emboxing a scalar.
1086      // TODO: Should the type be enforced? It already must agree.
1087    } else if (dims().size() == 1) {
1088      auto d = *dims().begin();
1089      if (!d.getType().isa<fir::DimsType>())
1090        return emitOpError("dimension argument must have !fir.dims type");
1091    } else {
1092      return emitOpError("embox can only have one !fir.dim argument");
1093    }
1094    return mlir::success();
1095  }];
1096
1097  let extraClassDeclaration = [{
1098    static constexpr llvm::StringRef layoutName() { return "layout_map"; }
1099    static constexpr llvm::StringRef lenpName() { return "len_param_count"; }
1100    bool hasLenParams() { return bool{(*this)->getAttr(lenpName())}; }
1101    unsigned numLenParams() {
1102      if (auto x = (*this)->getAttrOfType<mlir::IntegerAttr>(lenpName()))
1103        return x.getInt();
1104      return 0;
1105    }
1106    operand_range getLenParams() {
1107      return {operand_begin(), operand_begin() + numLenParams()};
1108    }
1109    operand_range dims() {
1110      return {operand_begin() + numLenParams() + 1, operand_end()};
1111    }
1112  }];
1113}
1114
1115def fir_EmboxCharOp : fir_Op<"emboxchar", [NoSideEffect]> {
1116  let summary = "boxes a given CHARACTER reference and its LEN parameter";
1117
1118  let description = [{
1119    Create a boxed CHARACTER value. The CHARACTER type has the LEN type
1120    parameter, the value of which may only be known at runtime.  Therefore,
1121    a variable of type CHARACTER has both its data reference as well as a
1122    LEN type parameter.
1123
1124    ```fortran
1125      CHARACTER(LEN=10) :: var
1126    ```
1127    ```mlir
1128      %4 = ...         : !fir.ref<!fir.array<10 x !fir.char<1>>>
1129      %5 = constant 10 : i32
1130      %6 = fir.emboxchar %4, %5 : (!fir.ref<!fir.array<10 x !fir.char<1>>>, i32) -> !fir.boxchar<1>
1131    ```
1132
1133    In the above `%4` is a memory reference to a buffer of 10 CHARACTER units.
1134    This buffer and its LEN value (10) are wrapped into a pair in `%6`.
1135  }];
1136
1137  let arguments = (ins AnyReferenceLike:$memref, AnyIntegerLike:$len);
1138
1139  let results = (outs fir_BoxCharType);
1140
1141  let assemblyFormat = [{
1142    $memref `,` $len attr-dict `:` functional-type(operands, results)
1143  }];
1144
1145  let verifier = [{
1146    auto eleTy = elementTypeOf(memref().getType());
1147    if (!eleTy.dyn_cast<CharacterType>())
1148      return mlir::failure();
1149    return mlir::success();
1150  }];
1151}
1152
1153def fir_EmboxProcOp : fir_Op<"emboxproc", [NoSideEffect]> {
1154  let summary = "boxes a given procedure and optional host context";
1155
1156  let description = [{
1157    Creates an abstract encapsulation of a PROCEDURE POINTER along with an
1158    optional pointer to a host instance context. If the pointer is not to an
1159    internal procedure or the internal procedure does not need a host context
1160    then the form takes only the procedure's symbol.
1161
1162    ```mlir
1163      %0 = fir.emboxproc @f : ((i32) -> i32) -> !fir.boxproc<(i32) -> i32>
1164    ```
1165
1166    An internal procedure requiring a host instance for correct execution uses
1167    the second form. The closure of the host procedure's state is passed as a
1168    reference to a tuple. It is the responsibility of the host to manage the
1169    context's values accordingly, up to and including inhibiting register
1170    promotion of local values.
1171
1172    ```mlir
1173      %4 = ... : !fir.ref<tuple<i32, i32>>
1174      %5 = fir.emboxproc @g, %4 : ((i32) -> i32, !fir.ref<tuple<i32, i32>>) -> !fir.boxproc<(i32) -> i32>
1175    ```
1176  }];
1177
1178  let arguments = (ins SymbolRefAttr:$funcname, AnyReferenceLike:$host);
1179
1180  let results = (outs fir_BoxProcType);
1181
1182  let parser = [{
1183    mlir::SymbolRefAttr procRef;
1184    if (parser.parseAttribute(procRef, "funcname", result.attributes))
1185      return mlir::failure();
1186    bool hasTuple = false;
1187    mlir::OpAsmParser::OperandType tupleRef;
1188    if (!parser.parseOptionalComma()) {
1189      if (parser.parseOperand(tupleRef))
1190        return mlir::failure();
1191      hasTuple = true;
1192    }
1193    mlir::FunctionType type;
1194    if (parser.parseColon() ||
1195        parser.parseLParen() ||
1196        parser.parseType(type))
1197      return mlir::failure();
1198    result.addAttribute("functype", mlir::TypeAttr::get(type));
1199    if (hasTuple) {
1200      mlir::Type tupleType;
1201      if (parser.parseComma() ||
1202          parser.parseType(tupleType) ||
1203          parser.resolveOperand(tupleRef, tupleType, result.operands))
1204        return mlir::failure();
1205    }
1206    mlir::Type boxType;
1207    if (parser.parseRParen() ||
1208        parser.parseArrow() ||
1209        parser.parseType(boxType) ||
1210        parser.addTypesToList(boxType, result.types))
1211      return mlir::failure();
1212    return mlir::success();
1213  }];
1214
1215  let printer = [{
1216    p << getOperationName() << ' ' << (*this)->getAttr("funcname");
1217    auto h = host();
1218    if (h) {
1219      p << ", ";
1220      p.printOperand(h);
1221    }
1222    p << " : (" << (*this)->getAttr("functype");
1223    if (h)
1224      p << ", " << h.getType();
1225    p << ") -> " << getType();
1226  }];
1227
1228  let verifier = [{
1229    // host bindings (optional) must be a reference to a tuple
1230    if (auto h = host()) {
1231      if (auto r = h.getType().dyn_cast<ReferenceType>()) {
1232        if (!r.getEleTy().dyn_cast<mlir::TupleType>())
1233          return mlir::failure();
1234      } else {
1235        return mlir::failure();
1236      }
1237    }
1238    return mlir::success();
1239  }];
1240}
1241
1242def fir_UnboxOp : fir_SimpleOp<"unbox", [NoSideEffect]> {
1243  let summary = "unbox the boxed value into a tuple value";
1244
1245  let description = [{
1246    Unbox a boxed value into a result of multiple values from the box's
1247    component data.  The values are, minimally, a reference to the data of the
1248    entity, the byte-size of one element, the rank, the type descriptor, a set
1249    of flags (packed in an integer, and an array of dimension information (of
1250    size rank).
1251
1252    ```mlir
1253      %40   = ... : !fir.box<!fir.type<T>>
1254      %41:6 = fir.unbox %40 : (!fir.box<!fir.type<T>>) -> (!fir.ref<!fir.type<T>>, i32, i32, !fir.tdesc<!fir.type<T>>, i32, !fir.dims<4>)
1255    ```
1256  }];
1257
1258  let arguments = (ins fir_BoxType:$box);
1259
1260  let results = (outs
1261    fir_ReferenceType,  // pointer to data
1262    AnyIntegerLike,     // size of a data element
1263    AnyIntegerLike,     // rank of data
1264    fir_TypeDescType,   // abstract type descriptor
1265    AnyIntegerLike,     // attribute flags (bitfields)
1266    fir_DimsType        // dimension information (if any)
1267  );
1268}
1269
1270def fir_UnboxCharOp : fir_SimpleOp<"unboxchar", [NoSideEffect]> {
1271  let summary = "unbox a boxchar value into a pair value";
1272
1273  let description = [{
1274    Unboxes a value of `boxchar` type into a pair consisting of a memory
1275    reference to the CHARACTER data and the LEN type parameter.
1276
1277    ```mlir
1278      %45   = ... : !fir.boxchar<1>
1279      %46:2 = fir.unboxchar %45 : (!fir.boxchar<1>) -> (!fir.ref<!fir.character<1>>, i32)
1280    ```
1281  }];
1282
1283  let arguments = (ins fir_BoxCharType:$boxchar);
1284
1285  let results = (outs fir_ReferenceType, AnyIntegerLike);
1286}
1287
1288def fir_UnboxProcOp : fir_SimpleOp<"unboxproc", [NoSideEffect]> {
1289  let summary = "unbox a boxproc value into a pair value";
1290
1291  let description = [{
1292    Unboxes a value of `boxproc` type into a pair consisting of a procedure
1293    pointer and a pointer to a host context.
1294
1295    ```mlir
1296      %47   = ... : !fir.boxproc<() -> i32>
1297      %48:2 = fir.unboxproc %47 : (!fir.ref<() -> i32>, !fir.ref<tuple<f32, i32>>)
1298    ```
1299  }];
1300
1301  let verifier = [{
1302    if (auto eleTy = fir::dyn_cast_ptrEleTy(refTuple().getType()))
1303      if (eleTy.isa<mlir::TupleType>())
1304        return mlir::success();
1305    return emitOpError("second output argument has bad type");
1306  }];
1307
1308  let arguments = (ins fir_BoxProcType:$boxproc);
1309
1310  let results = (outs FunctionType, fir_ReferenceType:$refTuple);
1311}
1312
1313def fir_BoxAddrOp : fir_SimpleOneResultOp<"box_addr", [NoSideEffect]> {
1314  let summary = "return a memory reference to the boxed value";
1315
1316  let description = [{
1317    This operator is overloaded to work with values of type `box`,
1318    `boxchar`, and `boxproc`.  The result for each of these
1319    cases, respectively, is the address of the data, the address of the
1320    `CHARACTER` data, and the address of the procedure.
1321
1322    ```mlir
1323      %51 = fir.box_addr %box : (!fir.box<f64>) -> !fir.ref<f64>
1324      %52 = fir.box_addr %boxchar : (!fir.boxchar<1>) -> !fir.ref<!fir.char<1>>
1325      %53 = fir.box_addr %boxproc : (!fir.boxproc<!P>) -> !fir.ref<!P>
1326    ```
1327  }];
1328
1329  let arguments = (ins fir_BoxType:$val);
1330
1331  let results = (outs AnyReferenceLike);
1332
1333  let hasFolder = 1;
1334}
1335
1336def fir_BoxCharLenOp : fir_SimpleOp<"boxchar_len", [NoSideEffect]> {
1337  let summary = "return the LEN type parameter from a boxchar value";
1338
1339  let description = [{
1340    Extracts the LEN type parameter from a `boxchar` value.
1341
1342    ```mlir
1343      %45 = ... : !boxchar<1>  // CHARACTER(20)
1344      %59 = fir.boxchar_len %45 : (!fir.boxchar<1>) -> i64  // len=20
1345    ```
1346  }];
1347
1348  let arguments = (ins fir_BoxCharType:$val);
1349
1350  let results = (outs AnyIntegerLike);
1351
1352  let hasFolder = 1;
1353}
1354
1355def fir_BoxDimsOp : fir_Op<"box_dims", [NoSideEffect]> {
1356  let summary = "return the dynamic dimension information for the boxed value";
1357
1358  let description = [{
1359    Returns the triple of lower bound, extent, and stride for `dim` dimension
1360    of `val`, which must have a `box` type.  The dimensions are enumerated from
1361    left to right from 0 to rank-1. This operation has undefined behavior if
1362    `dim` is out of bounds.
1363
1364    ```mlir
1365      %c1   = constant 0 : i32
1366      %52:3 = fir.box_dims %40, %c1 : (!fir.box<!fir.array<*:f64>>, i32) -> (i32, i32, i32)
1367    ```
1368
1369    The above is a request to return the left most row (at index 0) triple from
1370    the box. The triple will be the lower bound, upper bound, and stride.
1371  }];
1372
1373  let arguments = (ins fir_BoxType:$val, AnyIntegerLike:$dim);
1374
1375  let results = (outs AnyIntegerLike, AnyIntegerLike, AnyIntegerLike);
1376
1377  let assemblyFormat = [{
1378    $val `,` $dim attr-dict `:` functional-type(operands, results)
1379  }];
1380
1381  let extraClassDeclaration = [{
1382    mlir::Type getTupleType();
1383  }];
1384}
1385
1386def fir_BoxEleSizeOp : fir_SimpleOneResultOp<"box_elesize", [NoSideEffect]> {
1387  let summary = "return the size of an element of the boxed value";
1388
1389  let description = [{
1390    Returns the size of an element in an entity of `box` type.  This size may
1391    not be known until runtime.
1392
1393    ```mlir
1394      %53 = fir.box_elesize %40 : (!fir.box<f32>, i32) -> i32  // size=4
1395      %54 = fir.box_elesize %40 : (!fir.box<!fir.array<*:f32>>, i32) -> i32
1396    ```
1397
1398    In the above example, `%53` may box an array of REAL values while `%54`
1399    must box an array of REAL values (with dynamic rank and extent).
1400  }];
1401
1402  let arguments = (ins fir_BoxType:$val);
1403
1404  let results = (outs AnyIntegerLike);
1405}
1406
1407def fir_BoxIsAllocOp : fir_SimpleOp<"box_isalloc", [NoSideEffect]> {
1408  let summary = "is the boxed value an ALLOCATABLE?";
1409
1410  let description = [{
1411    Determine if the boxed value was from an ALLOCATABLE entity. This will
1412    return true if the originating box value was from a `fir.embox` op
1413    with a mem-ref value that had the type !fir.heap<T>.
1414
1415    ```mlir
1416      %r = ... : !fir.heap<i64>
1417      %b = fir.embox %r : (!fir.heap<i64>) -> !fir.box<i64>
1418      %a = fir.box_isalloc %b : (!fir.box<i64>) -> i1  // true
1419    ```
1420
1421    The canonical descriptor implementation will carry a flag to record if the
1422    variable is an `ALLOCATABLE`.
1423  }];
1424
1425  let arguments = (ins fir_BoxType:$val);
1426
1427  let results = (outs BoolLike);
1428}
1429
1430def fir_BoxIsArrayOp : fir_SimpleOp<"box_isarray", [NoSideEffect]> {
1431  let summary = "is the boxed value an array?";
1432
1433  let description = [{
1434    Determine if the boxed value has a positive (> 0) rank. This will return
1435    true if the originating box value was from a fir.embox with a memory
1436    reference value that had the type !fir.array<T> and/or a dims argument.
1437
1438    ```mlir
1439      %r = ... : !fir.ref<i64>
1440      %d = fir.gendims(1, 100, 1) : (i32, i32, i32) -> !fir.dims<1>
1441      %b = fir.embox %r, %d : (!fir.ref<i64>, !fir.dims<1>) -> !fir.box<i64>
1442      %a = fir.box_isarray %b : (!fir.box<i64>) -> i1  // true
1443    ```
1444  }];
1445
1446  let arguments = (ins fir_BoxType:$val);
1447
1448  let results = (outs BoolLike);
1449}
1450
1451def fir_BoxIsPtrOp : fir_SimpleOp<"box_isptr", [NoSideEffect]> {
1452  let summary = "is the boxed value a POINTER?";
1453
1454  let description = [{
1455    Determine if the boxed value was from a POINTER entity.
1456
1457    ```mlir
1458      %p = ... : !fir.ptr<i64>
1459      %b = fir.embox %p : (!fir.ptr<i64>) -> !fir.box<i64>
1460      %a = fir.box_isptr %b : (!fir.box<i64>) -> i1  // true
1461    ```
1462  }];
1463
1464  let arguments = (ins fir_BoxType:$val);
1465
1466  let results = (outs BoolLike);
1467}
1468
1469def fir_BoxProcHostOp : fir_SimpleOp<"boxproc_host", [NoSideEffect]> {
1470  let summary = "returns the host instance pointer (or null)";
1471
1472  let description = [{
1473    Extract the host context pointer from a boxproc value.
1474
1475    ```mlir
1476      %8 = ... : !fir.boxproc<(!fir.ref<!fir.type<T>>) -> i32>
1477      %9 = fir.boxproc_host %8 : (!fir.boxproc<(!fir.ref<!fir.type<T>>) -> i32>) -> !fir.ref<tuple<i32, i32>>
1478    ```
1479
1480    In the example, the reference to the closure over the host procedure's
1481    variables is returned. This allows an internal procedure to access the
1482    host's variables. It is up to lowering to determine the contract between
1483    the host and the internal procedure.
1484  }];
1485
1486  let arguments = (ins fir_BoxProcType:$val);
1487
1488  let results = (outs fir_ReferenceType);
1489}
1490
1491def fir_BoxRankOp : fir_SimpleOneResultOp<"box_rank", [NoSideEffect]> {
1492  let summary = "return the number of dimensions for the boxed value";
1493
1494  let description = [{
1495    Return the rank of a value of `box` type.  If the value is scalar, the
1496    rank is 0.
1497
1498    ```mlir
1499      %57 = fir.box_rank %40 : (!fir.box<!fir.array<*:f64>>) -> i32
1500      %58 = fir.box_rank %41 : (!fir.box<f64>) -> i32
1501    ```
1502
1503    The example `%57` shows how one would determine the rank of an array that
1504    has deferred rank at runtime. This rank should be at least 1. In %58, the
1505    descriptor may be either an array or a scalar, so the value is nonnegative.
1506  }];
1507
1508  let arguments = (ins fir_BoxType:$val);
1509
1510  let results = (outs AnyIntegerType);
1511}
1512
1513def fir_BoxTypeDescOp : fir_SimpleOneResultOp<"box_tdesc", [NoSideEffect]> {
1514  let summary = "return the type descriptor for the boxed value";
1515
1516  let description = [{
1517    Return the opaque type descriptor of a value of `box` type. A type
1518    descriptor is an implementation defined value that fully describes a type
1519    to the Fortran runtime.
1520
1521    ```mlir
1522      %7 = fir.box_tdesc %41 : (!fir.box<f64>) -> !fir.tdesc<f64>
1523    ```
1524  }];
1525
1526  let arguments = (ins fir_BoxType:$val);
1527
1528  let results = (outs fir_TypeDescType);
1529}
1530
1531// Record and array type operations
1532
1533def fir_CoordinateOp : fir_Op<"coordinate_of", [NoSideEffect]> {
1534  let summary = "Finds the coordinate (location) of a value in memory";
1535
1536  let description = [{
1537    Compute the internal coordinate address starting from a boxed value or
1538    unboxed memory reference. Returns a memory reference. When computing the
1539    coordinate of an array element, the rank of the array must be known and
1540    the number of indexing expressions must equal the rank of the array.
1541
1542    This operation will apply the access map from a boxed value implicitly.
1543
1544    Unlike LLVM's GEP instruction, one cannot stride over the outermost
1545    reference; therefore, the leading 0 index must be omitted.
1546
1547    ```mlir
1548      %i = ... : index
1549      %h = ... : !fir.heap<!fir.array<100 x f32>>
1550      %p = fir.coordinate_of %h, %i : (!fir.heap<!fir.array<100 x f32>>, index) -> !fir.ref<f32>
1551    ```
1552
1553    In the example, `%p` will be a pointer to the `%i`-th f32 value in the
1554    array `%h`.
1555  }];
1556
1557  let arguments = (ins AnyRefOrBox:$ref, Variadic<AnyCoordinateType>:$coor);
1558
1559  let results = (outs fir_ReferenceType);
1560
1561  let parser = "return parseCoordinateOp(parser, result);";
1562
1563  let printer = [{
1564    p << getOperationName() << ' ' << (*this)->getOperands();
1565    p.printOptionalAttrDict(getAttrs(), /*elidedAttrs=*/{baseType()});
1566    p << " : ";
1567    p.printFunctionalType((*this)->getOperandTypes(),
1568        (*this)->getResultTypes());
1569  }];
1570
1571  let verifier = [{
1572    auto refTy = ref().getType();
1573    if (fir::isa_ref_type(refTy)) {
1574      auto eleTy = fir::dyn_cast_ptrEleTy(refTy);
1575      if (auto arrTy = eleTy.dyn_cast<fir::SequenceType>()) {
1576        if (arrTy.hasUnknownShape())
1577          return emitOpError("cannot find coordinate in unknown shape");
1578        if (arrTy.getConstantRows() < arrTy.getDimension() - 1)
1579          return emitOpError("cannot find coordinate with unknown extents");
1580      }
1581    }
1582    // Recovering a LEN type parameter only makes sense from a boxed value
1583    for (auto co : coor())
1584      if (dyn_cast_or_null<LenParamIndexOp>(co.getDefiningOp())) {
1585        if (getNumOperands() != 2)
1586          return emitOpError("len_param_index must be last argument");
1587        if (!ref().getType().dyn_cast<BoxType>())
1588          return emitOpError("len_param_index must be used on box type");
1589      }
1590    if (auto attr = (*this)->getAttr(CoordinateOp::baseType())) {
1591      if (!attr.isa<mlir::TypeAttr>())
1592        return emitOpError("improperly constructed");
1593    } else {
1594      return emitOpError("must have base type");
1595    }
1596    return mlir::success();
1597  }];
1598
1599  let skipDefaultBuilders = 1;
1600  let builders = [
1601    OpBuilderDAG<(ins "Type":$type, "Value":$ref, "ValueRange":$coor,
1602      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
1603    OpBuilderDAG<(ins "Type":$type, "ValueRange":$operands,
1604      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>];
1605
1606  let extraClassDeclaration = [{
1607    static constexpr llvm::StringRef baseType() { return "base_type"; }
1608    mlir::Type getBaseType();
1609  }];
1610}
1611
1612def fir_ExtractValueOp : fir_OneResultOp<"extract_value", [NoSideEffect]> {
1613  let summary = "Extract a value from an aggregate SSA-value";
1614
1615  let description = [{
1616    Extract a value from an entity with a type composed of tuples, arrays,
1617    and/or derived types. Returns the value from entity with the type of the
1618    specified component. Cannot be used on values of `!fir.box` type.
1619
1620    Note that the entity ssa-value must be of compile-time known size in order
1621    to use this operation.
1622
1623    ```mlir
1624      %f = fir.field_index field, !fir.type<X{field:i32}>
1625      %s = ... : !fir.type<X>
1626      %v = fir.extract_value %s, %f : (!fir.type<X>, !fir.field) -> i32
1627    ```
1628  }];
1629
1630  let arguments = (ins
1631    AnyCompositeLike:$adt,
1632    Variadic<AnyComponentType>:$coor
1633  );
1634
1635  let assemblyFormat = [{
1636    $adt `,` $coor attr-dict `:` functional-type(operands, results)
1637  }];
1638}
1639
1640def fir_FieldIndexOp : fir_OneResultOp<"field_index", [NoSideEffect]> {
1641  let summary = "create a field index value from a field identifier";
1642
1643  let description = [{
1644    Generate a field (offset) value from an identifier.  Field values may be
1645    lowered into exact offsets when the layout of a Fortran derived type is
1646    known at compile-time. The type of a field value is `!fir.field` and
1647    these values can be used with the `fir.coordinate_of`, `fir.extract_value`,
1648    or `fir.insert_value` instructions to compute (abstract) addresses of
1649    subobjects.
1650
1651    ```mlir
1652      %f = fir.field_index field, !fir.type<X{field:i32}>
1653    ```
1654  }];
1655
1656  let arguments = (ins
1657    StrAttr:$field_id,
1658    TypeAttr:$on_type,
1659    Variadic<AnyIntegerType>:$lenparams
1660  );
1661
1662  let parser = [{
1663    llvm::StringRef fieldName;
1664    auto &builder = parser.getBuilder();
1665    mlir::Type recty;
1666    if (parser.parseOptionalKeyword(&fieldName) ||
1667        parser.parseComma() ||
1668        parser.parseType(recty))
1669      return mlir::failure();
1670    result.addAttribute(fieldAttrName(), builder.getStringAttr(fieldName));
1671    if (!recty.dyn_cast<RecordType>())
1672      return mlir::failure();
1673    result.addAttribute(typeAttrName(), mlir::TypeAttr::get(recty));
1674    if (!parser.parseOptionalLParen()) {
1675      llvm::SmallVector<mlir::OpAsmParser::OperandType, 8> operands;
1676      llvm::SmallVector<mlir::Type, 8> types;
1677      auto loc = parser.getNameLoc();
1678      if (parser.parseOperandList(operands,
1679                                  mlir::OpAsmParser::Delimiter::None) ||
1680          parser.parseRParen() ||
1681          parser.parseColonTypeList(types) ||
1682          parser.resolveOperands(operands, types, loc, result.operands))
1683        return mlir::failure();
1684    }
1685    mlir::Type fieldType = fir::FieldType::get(builder.getContext());
1686    if (parser.addTypeToList(fieldType, result.types))
1687      return mlir::failure();
1688    return mlir::success();
1689  }];
1690
1691  let printer = [{
1692    p << getOperationName() << ' '
1693      << (*this)->getAttrOfType<mlir::StringAttr>(fieldAttrName()).getValue()
1694      << ", " << (*this)->getAttr(typeAttrName());
1695    if (getNumOperands()) {
1696      p << '(';
1697      p.printOperands(lenparams());
1698      auto sep = ") : ";
1699      for (auto op : lenparams()) {
1700        p << sep;
1701        if (op)
1702          p.printType(op.getType());
1703        else
1704          p << "()";
1705        sep = ", ";
1706      }
1707    }
1708  }];
1709
1710  let builders = [
1711    OpBuilderDAG<(ins "StringRef":$fieldName, "Type":$recTy,
1712      CArg<"ValueRange", "{}">:$operands),
1713    [{
1714      $_state.addAttribute(fieldAttrName(), $_builder.getStringAttr(fieldName));
1715      $_state.addAttribute(typeAttrName(), TypeAttr::get(recTy));
1716      $_state.addOperands(operands);
1717    }]>];
1718
1719  let extraClassDeclaration = [{
1720    static constexpr llvm::StringRef fieldAttrName() { return "field_id"; }
1721    static constexpr llvm::StringRef typeAttrName() { return "on_type"; }
1722  }];
1723}
1724
1725def fir_GenDimsOp : fir_OneResultOp<"gendims", [NoSideEffect]> {
1726
1727  let summary = "generate a value of type `!fir.dims`";
1728
1729  let description = [{
1730    The arguments are an ordered list of integral type values that is a
1731    multiple of 3 in length.  Each such triple is defined as: the lower
1732    index, the extent, and the stride for that dimension. The dimension
1733    information is given in the same row-to-column order as Fortran. This
1734    abstract dimension value must describe a reified object, so all dimension
1735    information must be specified.  The extent must be nonnegative and the
1736    stride must not be zero.
1737
1738    ```mlir
1739      %d = fir.gendims %lo, %ext, %str : (index, index, index) -> !fir.dims<1>
1740    ```
1741  }];
1742
1743  let arguments = (ins Variadic<AnyIntegerType>:$triples);
1744
1745  let results = (outs fir_DimsType);
1746
1747  let assemblyFormat = [{
1748    operands attr-dict `:` functional-type(operands, results)
1749  }];
1750
1751  let verifier = [{
1752    auto size = triples().size();
1753    if (size < 1 || size > 16 * 3)
1754      return emitOpError("incorrect number of args");
1755    if (size % 3 != 0)
1756      return emitOpError("requires a multiple of 3 args");
1757    return mlir::success();
1758  }];
1759}
1760
1761def fir_InsertValueOp : fir_OneResultOp<"insert_value", [NoSideEffect]> {
1762  let summary = "insert a new sub-value into a copy of an existing aggregate";
1763
1764  let description = [{
1765    Insert a value from an entity with a type composed of tuples, arrays,
1766    and/or derived types. Returns a new ssa value with the same type as the
1767    original entity. Cannot be used on values of `!fir.box` type.
1768
1769    Note that the entity ssa-value must be of compile-time known size in order
1770    to use this operation.
1771
1772    ```mlir
1773      %a = ... : !fir.array<10xtuple<i32, f32>>
1774      %f = ... : f32
1775      %o = ... : i32
1776      %c = constant 1 : i32
1777      %b = fir.insert_value %a, %f, %o, %c : (!fir.array<10x20xtuple<i32, f32>>, f32, i32, i32) -> !fir.array<10x20xtuple<i32, f32>>
1778    ```
1779  }];
1780
1781  let arguments = (ins AnyCompositeLike:$adt, AnyType:$val,
1782                       Variadic<AnyComponentType>:$coor);
1783  let results = (outs AnyCompositeLike);
1784
1785  let assemblyFormat = [{
1786    operands attr-dict `:` functional-type(operands, results)
1787  }];
1788}
1789
1790def fir_LenParamIndexOp : fir_OneResultOp<"len_param_index", [NoSideEffect]> {
1791  let summary =
1792    "create a field index value from a LEN type parameter identifier";
1793
1794  let description = [{
1795    Generate a LEN parameter (offset) value from an LEN parameter identifier.
1796    The type of a LEN parameter value is `!fir.len` and these values can be
1797    used with the `fir.coordinate_of` instructions to compute (abstract)
1798    addresses of LEN parameters.
1799
1800    ```mlir
1801      %e = fir.len_param_index len1, !fir.type<X(len1:i32)>
1802      %p = ... : !fir.box<!fir.type<X>>
1803      %q = fir.coordinate_of %p, %e : (!fir.box<!fir.type<X>>, !fir.len) -> !fir.ref<i32>
1804    ```
1805  }];
1806
1807  let arguments = (ins StrAttr:$field_id, TypeAttr:$on_type);
1808
1809  let parser = [{
1810    llvm::StringRef fieldName;
1811    auto &builder = parser.getBuilder();
1812    mlir::Type recty;
1813    if (parser.parseOptionalKeyword(&fieldName) ||
1814        parser.parseComma() ||
1815        parser.parseType(recty))
1816      return mlir::failure();
1817    result.addAttribute(fieldAttrName(), builder.getStringAttr(fieldName));
1818    if (!recty.dyn_cast<RecordType>())
1819      return mlir::failure();
1820    result.addAttribute(typeAttrName(), mlir::TypeAttr::get(recty));
1821    mlir::Type lenType = fir::LenType::get(builder.getContext());
1822    if (parser.addTypeToList(lenType, result.types))
1823      return mlir::failure();
1824    return mlir::success();
1825  }];
1826
1827  let printer = [{
1828    p << getOperationName() << ' '
1829      << (*this)->getAttrOfType<mlir::StringAttr>(fieldAttrName()).getValue()
1830      << ", " << (*this)->getAttr(typeAttrName());
1831  }];
1832
1833  let builders = [
1834    OpBuilderDAG<(ins "StringRef":$fieldName, "Type":$recTy),
1835    [{
1836      $_state.addAttribute(fieldAttrName(), $_builder.getStringAttr(fieldName));
1837      $_state.addAttribute(typeAttrName(), TypeAttr::get(recTy));
1838    }]>];
1839
1840  let extraClassDeclaration = [{
1841    static constexpr llvm::StringRef fieldAttrName() { return "field_id"; }
1842    static constexpr llvm::StringRef typeAttrName() { return "on_type"; }
1843    mlir::Type getOnType() {
1844      return (*this)->getAttrOfType<TypeAttr>(typeAttrName()).getValue();
1845    }
1846  }];
1847}
1848
1849//===----------------------------------------------------------------------===//
1850// Fortran loops
1851//===----------------------------------------------------------------------===//
1852
1853def fir_ResultOp : fir_Op<"result",
1854    [NoSideEffect, ReturnLike, Terminator,
1855     ParentOneOf<["WhereOp", "LoopOp", "IterWhileOp"]>]> {
1856  let summary = "special terminator for use in fir region operations";
1857
1858  let description = [{
1859    Result takes a list of ssa-values produced in the block and forwards them
1860    as a result to the operation that owns the region of the block. The
1861    operation can retain the values or return them to its parent block
1862    depending upon its semantics.
1863  }];
1864
1865  let arguments = (ins Variadic<AnyType>:$results);
1866  let builders = [
1867    OpBuilderDAG<(ins),
1868    [{/* do nothing */}]>
1869  ];
1870
1871  let assemblyFormat = "($results^ `:` type($results))? attr-dict";
1872
1873  let verifier = [{ return ::verify(*this); }];
1874}
1875
1876def FirRegionTerminator : SingleBlockImplicitTerminator<"ResultOp">;
1877
1878class region_Op<string mnemonic, list<OpTrait> traits = []> :
1879    fir_Op<mnemonic,
1880    !listconcat(traits, [FirRegionTerminator, RecursiveSideEffects])> {
1881  let printer = [{ return ::print(p, *this); }];
1882  let verifier = [{ return ::verify(*this); }];
1883  let parser = [{ return ::parse$cppClass(parser, result); }];
1884}
1885
1886def fir_LoopOp : region_Op<"do_loop",
1887    [DeclareOpInterfaceMethods<LoopLikeOpInterface>]> {
1888  let summary = "generalized loop operation";
1889  let description = [{
1890    Generalized high-level looping construct. This operation is similar to
1891    MLIR's `loop.for`.
1892
1893    ```mlir
1894      %l = constant 0 : index
1895      %u = constant 9 : index
1896      %s = constant 1 : index
1897      fir.do_loop %i = %l to %u step %s unordered {
1898        %x = fir.convert %i : (index) -> i32
1899        %v = fir.call @compute(%x) : (i32) -> f32
1900        %p = fir.coordinate_of %A, %i : (!fir.ref<f32>, index) -> !fir.ref<f32>
1901        fir.store %v to %p : !fir.ref<f32>
1902      }
1903    ```
1904
1905    The above example iterates over the interval `[%l, %u]`. The unordered
1906    keyword indicates that the iterations can be executed in any order.
1907  }];
1908
1909  let arguments = (ins
1910    Index:$lowerBound,
1911    Index:$upperBound,
1912    Index:$step,
1913    Variadic<AnyType>:$initArgs,
1914    OptionalAttr<UnitAttr>:$unordered
1915  );
1916  let results = (outs
1917    Variadic<AnyType>:$results
1918  );
1919  let regions = (region SizedRegion<1>:$region);
1920
1921  let skipDefaultBuilders = 1;
1922  let builders = [
1923    OpBuilderDAG<(ins "mlir::Value":$lowerBound, "mlir::Value":$upperBound,
1924      "mlir::Value":$step, CArg<"bool", "false">:$unordered,
1925      CArg<"ValueRange", "llvm::None">:$iterArgs,
1926      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes)>
1927  ];
1928
1929  let extraClassDeclaration = [{
1930    static constexpr llvm::StringRef unorderedAttrName() { return "unordered"; }
1931
1932    mlir::Value getInductionVar() { return getBody()->getArgument(0); }
1933    mlir::OpBuilder getBodyBuilder() {
1934      return OpBuilder(getBody(), std::prev(getBody()->end()));
1935    }
1936    mlir::Block::BlockArgListType getRegionIterArgs() {
1937      return getBody()->getArguments().drop_front();
1938    }
1939    mlir::Operation::operand_range getIterOperands() {
1940      return getOperands().drop_front(getNumControlOperands());
1941    }
1942
1943    void setLowerBound(Value bound) { (*this)->setOperand(0, bound); }
1944    void setUpperBound(Value bound) { (*this)->setOperand(1, bound); }
1945    void setStep(Value step) { (*this)->setOperand(2, step); }
1946
1947    /// Number of region arguments for loop-carried values
1948    unsigned getNumRegionIterArgs() {
1949      return getBody()->getNumArguments() - 1;
1950    }
1951    /// Number of operands controlling the loop: lb, ub, step
1952    unsigned getNumControlOperands() { return 3; }
1953    /// Does the operation hold operands for loop-carried values
1954    bool hasIterOperands() {
1955      return (*this)->getNumOperands() > getNumControlOperands();
1956    }
1957    /// Get Number of loop-carried values
1958    unsigned getNumIterOperands() {
1959      return (*this)->getNumOperands() - getNumControlOperands();
1960    }
1961
1962    /// Get the body of the loop
1963    mlir::Block *getBody() { return &region().front(); }
1964
1965    void setUnordered() {
1966      (*this)->setAttr(unorderedAttrName(),
1967                              mlir::UnitAttr::get(getContext()));
1968    }
1969  }];
1970}
1971
1972def fir_WhereOp : region_Op<"if", [NoRegionArguments]> {
1973  let summary = "if-then-else conditional operation";
1974  let description = [{
1975    Used to conditionally execute operations. This operation is the FIR
1976    dialect's version of `loop.if`.
1977
1978    ```mlir
1979      %56 = ... : i1
1980      %78 = ... : !fir.ref<!T>
1981      fir.if %56 {
1982        fir.store %76 to %78 : !fir.ref<!T>
1983      } else {
1984        fir.store %77 to %78 : !fir.ref<!T>
1985      }
1986    ```
1987  }];
1988
1989  let arguments = (ins I1:$condition);
1990  let results = (outs Variadic<AnyType>:$results);
1991
1992  let regions = (region
1993    SizedRegion<1>:$whereRegion,
1994    AnyRegion:$otherRegion
1995  );
1996
1997  let skipDefaultBuilders = 1;
1998  let builders = [
1999    OpBuilderDAG<(ins "Value":$cond, "bool":$withOtherRegion)>,
2000    OpBuilderDAG<(ins "TypeRange":$resultTypes, "Value":$cond,
2001      "bool":$withOtherRegion)>
2002  ];
2003
2004  let extraClassDeclaration = [{
2005    mlir::OpBuilder getWhereBodyBuilder() {
2006      assert(!whereRegion().empty() && "Unexpected empty 'where' region.");
2007      mlir::Block &body = whereRegion().front();
2008      return mlir::OpBuilder(&body, std::prev(body.end()));
2009    }
2010    mlir::OpBuilder getOtherBodyBuilder() {
2011      assert(!otherRegion().empty() && "Unexpected empty 'other' region.");
2012      mlir::Block &body = otherRegion().front();
2013      return mlir::OpBuilder(&body, std::prev(body.end()));
2014    }
2015  }];
2016}
2017
2018def fir_IterWhileOp : region_Op<"iterate_while",
2019    [DeclareOpInterfaceMethods<LoopLikeOpInterface>]> {
2020  let summary = "DO loop with early exit condition";
2021  let description = [{
2022    This construct is useful for lowering implied-DO loops. It is very similar
2023    to `fir::LoopOp` with the addition that it requires a single loop-carried
2024    bool value that signals an early exit condition to the operation. A `true`
2025    disposition means the next loop iteration should proceed. A `false`
2026    indicates that the `fir.iterate_while` operation should terminate and
2027    return its iteration arguments.
2028  }];
2029
2030  let arguments = (ins
2031    Index:$lowerBound,
2032    Index:$upperBound,
2033    Index:$step,
2034    I1:$iterateIn,
2035    Variadic<AnyType>:$initArgs
2036  );
2037  let results = (outs
2038    I1:$iterateResult,
2039    Variadic<AnyType>:$results
2040  );
2041  let regions = (region SizedRegion<1>:$region);
2042
2043  let skipDefaultBuilders = 1;
2044  let builders = [
2045    OpBuilderDAG<(ins "mlir::Value":$lowerBound, "mlir::Value":$upperBound,
2046      "mlir::Value":$step, "mlir::Value":$iterate,
2047      CArg<"ValueRange", "llvm::None">:$iterArgs,
2048      CArg<"ArrayRef<NamedAttribute>", "{}">:$attributes)>
2049  ];
2050
2051  let extraClassDeclaration = [{
2052    mlir::Block *getBody() { return &region().front(); }
2053    mlir::Value getIterateVar() { return getBody()->getArgument(1); }
2054    mlir::Value getInductionVar() { return getBody()->getArgument(0); }
2055    mlir::OpBuilder getBodyBuilder() {
2056      return mlir::OpBuilder(getBody(), std::prev(getBody()->end()));
2057    }
2058    mlir::Block::BlockArgListType getRegionIterArgs() {
2059      return getBody()->getArguments().drop_front();
2060    }
2061    mlir::Operation::operand_range getIterOperands() {
2062      return getOperands().drop_front(getNumControlOperands());
2063    }
2064
2065    void setLowerBound(Value bound) { (*this)->setOperand(0, bound); }
2066    void setUpperBound(Value bound) { (*this)->setOperand(1, bound); }
2067    void setStep(mlir::Value step) { (*this)->setOperand(2, step); }
2068
2069    /// Number of region arguments for loop-carried values
2070    unsigned getNumRegionIterArgs() {
2071      return getBody()->getNumArguments() - 1;
2072    }
2073    /// Number of operands controlling the loop
2074    unsigned getNumControlOperands() { return 3; }
2075    /// Does the operation hold operands for loop-carried values
2076    bool hasIterOperands() {
2077      return (*this)->getNumOperands() > getNumControlOperands();
2078    }
2079    /// Get Number of loop-carried values
2080    unsigned getNumIterOperands() {
2081      return (*this)->getNumOperands() - getNumControlOperands();
2082    }
2083  }];
2084}
2085
2086//===----------------------------------------------------------------------===//
2087// Procedure call operations
2088//===----------------------------------------------------------------------===//
2089
2090def fir_CallOp : fir_Op<"call",
2091    [MemoryEffects<[MemAlloc, MemFree, MemRead, MemWrite]>]> {
2092  let summary = "call a procedure";
2093
2094  let description = [{
2095    Call the specified function or function reference.
2096
2097    Provides a custom parser and pretty printer to allow a more readable syntax
2098    in the FIR dialect, e.g. `fir.call @sub(%12)` or `fir.call %20(%22,%23)`.
2099
2100    ```mlir
2101      %a = fir.call %funcref(%arg0) : (!fir.ref<f32>) -> f32
2102      %b = fir.call @function(%arg1, %arg2) : (!fir.ref<f32>, !fir.ref<f32>) -> f32
2103    ```
2104  }];
2105
2106  let arguments = (ins
2107    OptionalAttr<SymbolRefAttr>:$callee,
2108    Variadic<AnyType>:$args
2109  );
2110
2111  let results = (outs Variadic<AnyType>);
2112
2113  let parser = "return parseCallOp(parser, result);";
2114  let printer = "printCallOp(p, *this);";
2115
2116  let extraClassDeclaration = [{
2117    static constexpr StringRef calleeAttrName() { return "callee"; }
2118  }];
2119}
2120
2121def fir_DispatchOp : fir_Op<"dispatch",
2122    [MemoryEffects<[MemAlloc, MemFree, MemRead, MemWrite]>]> {
2123  let summary = "call a type-bound procedure";
2124
2125  let description = [{
2126    Perform a dynamic dispatch on the method name via the dispatch table
2127    associated with the first argument.  The attribute 'pass_arg_pos' can be
2128    used to select a dispatch argument other than the first one.
2129
2130    ```mlir
2131      %r = fir.dispatch methodA(%o) : (!fir.box<none>) -> i32
2132    ```
2133  }];
2134
2135  let arguments = (ins
2136    StrAttr:$method,
2137    fir_BoxType:$object,
2138    Variadic<AnyType>:$args
2139  );
2140
2141  let results = (outs Variadic<AnyType>);
2142
2143  let parser = [{
2144    mlir::FunctionType calleeType;
2145    llvm::SmallVector<mlir::OpAsmParser::OperandType, 4> operands;
2146    auto calleeLoc = parser.getNameLoc();
2147    llvm::StringRef calleeName;
2148    if (failed(parser.parseOptionalKeyword(&calleeName))) {
2149      mlir::StringAttr calleeAttr;
2150      if (parser.parseAttribute(calleeAttr, "method", result.attributes))
2151        return mlir::failure();
2152    } else {
2153      result.addAttribute("method",
2154          parser.getBuilder().getStringAttr(calleeName));
2155    }
2156    if (parser.parseOperandList(operands,
2157                                mlir::OpAsmParser::Delimiter::Paren) ||
2158        parser.parseOptionalAttrDict(result.attributes) ||
2159        parser.parseColonType(calleeType) ||
2160        parser.addTypesToList(calleeType.getResults(), result.types) ||
2161        parser.resolveOperands(
2162            operands, calleeType.getInputs(), calleeLoc, result.operands))
2163      return mlir::failure();
2164    result.addAttribute("fn_type", mlir::TypeAttr::get(calleeType));
2165    return mlir::success();
2166  }];
2167
2168  let printer = [{
2169    p << getOperationName() << ' ' << (*this)->getAttr("method") << '(';
2170    p.printOperand(object());
2171    if (arg_operand_begin() != arg_operand_end()) {
2172      p << ", ";
2173      p.printOperands(args());
2174    }
2175    p << ')';
2176    p.printOptionalAttrDict(getAttrs(), {"fn_type", "method"});
2177    auto resTy{getResultTypes()};
2178    llvm::SmallVector<mlir::Type, 8> argTy(getOperandTypes());
2179    p << " : " << mlir::FunctionType::get(getContext(), argTy, resTy);
2180  }];
2181
2182  let extraClassDeclaration = [{
2183    mlir::FunctionType getFunctionType();
2184    operand_range getArgOperands() {
2185      return {arg_operand_begin(), arg_operand_end()};
2186    }
2187    operand_iterator arg_operand_begin() { return operand_begin() + 1; }
2188    operand_iterator arg_operand_end() { return operand_end(); }
2189    llvm::StringRef passArgAttrName() { return "pass_arg_pos"; }
2190    unsigned passArgPos();
2191  }];
2192}
2193
2194// Constant operations that support Fortran
2195
2196def fir_StringLitOp : fir_Op<"string_lit", [NoSideEffect]> {
2197  let summary = "create a string literal constant";
2198
2199  let description = [{
2200    An FIR constant that represents a sequence of characters that correspond
2201    to Fortran's CHARACTER type, including a LEN.  We support CHARACTER values
2202    of different KINDs (different constant sizes).
2203
2204    ```mlir
2205      %1 = fir.string_lit "Hello, World!"(13) : !fir.char<1> // ASCII
2206      %2 = fir.string_lit [158, 2345](2) : !fir.char<2>      // Wide chars
2207    ```
2208  }];
2209
2210  let results = (outs fir_SequenceType);
2211
2212  let parser = [{
2213    auto &builder = parser.getBuilder();
2214    mlir::Attribute val;
2215    mlir::NamedAttrList attrs;
2216    if (parser.parseAttribute(val, "fake", attrs))
2217      return mlir::failure();
2218    if (auto v = val.dyn_cast<mlir::StringAttr>())
2219      result.attributes.push_back(builder.getNamedAttr(value(), v));
2220    else if (auto v = val.dyn_cast<mlir::ArrayAttr>())
2221      result.attributes.push_back(builder.getNamedAttr(xlist(), v));
2222    else
2223      return parser.emitError(parser.getCurrentLocation(),
2224                              "found an invalid constant");
2225    mlir::IntegerAttr sz;
2226    mlir::Type type;
2227    if (parser.parseLParen() ||
2228        parser.parseAttribute(sz, size(), result.attributes) ||
2229        parser.parseRParen() ||
2230        parser.parseColonType(type))
2231      return mlir::failure();
2232    if (!(type.isa<fir::CharacterType>() || type.isa<mlir::IntegerType>()))
2233      return parser.emitError(parser.getCurrentLocation(),
2234                              "must have character type");
2235    type = fir::SequenceType::get({sz.getInt()}, type);
2236    if (!type || parser.addTypesToList(type, result.types))
2237      return mlir::failure();
2238    return mlir::success();
2239  }];
2240
2241  let printer = [{
2242    p << getOperationName() << ' ' << getValue() << '(';
2243    p << getSize().cast<mlir::IntegerAttr>().getValue() << ") : ";
2244    p.printType(getType().cast<fir::SequenceType>().getEleTy());
2245  }];
2246
2247  let verifier = [{
2248    if (getSize().cast<mlir::IntegerAttr>().getValue().isNegative())
2249      return emitOpError("size must be non-negative");
2250    auto eleTy = getType().cast<fir::SequenceType>().getEleTy();
2251    if (!eleTy.isa<fir::CharacterType>())
2252      return emitOpError("must have !fir.char type");
2253    if (auto xl = (*this)->getAttr(xlist())) {
2254      auto xList = xl.cast<mlir::ArrayAttr>();
2255      for (auto a : xList)
2256        if (!a.isa<mlir::IntegerAttr>())
2257	  return emitOpError("values in list must be integers");
2258    }
2259    return mlir::success();
2260  }];
2261
2262  let extraClassDeclaration = [{
2263    static constexpr const char *size() { return "size"; }
2264    static constexpr const char *value() { return "value"; }
2265    static constexpr const char *xlist() { return "xlist"; }
2266
2267    // Get the LEN attribute of this character constant
2268    mlir::Attribute getSize() { return (*this)->getAttr(size()); }
2269    // Get the string value of this character constant
2270    mlir::Attribute getValue() {
2271      if (auto attr = (*this)->getAttr(value()))
2272        return attr;
2273      return (*this)->getAttr(xlist());
2274    }
2275
2276    /// Is this a wide character literal (1 character > 8 bits)
2277    bool isWideValue();
2278  }];
2279}
2280
2281// Complex operations
2282
2283class fir_ArithmeticOp<string mnemonic, list<OpTrait> traits = []> :
2284    fir_Op<mnemonic,
2285           !listconcat(traits, [NoSideEffect, SameOperandsAndResultType])>,
2286    Results<(outs AnyType)> {
2287  let parser = [{
2288    return impl::parseOneResultSameOperandTypeOp(parser, result);
2289  }];
2290
2291  let printer = [{ return printBinaryOp(this->getOperation(), p); }];
2292}
2293
2294class fir_UnaryArithmeticOp<string mnemonic, list<OpTrait> traits = []> :
2295      fir_Op<mnemonic,
2296             !listconcat(traits, [NoSideEffect, SameOperandsAndResultType])>,
2297      Results<(outs AnyType)> {
2298  let parser = [{
2299    return impl::parseOneResultSameOperandTypeOp(parser, result);
2300  }];
2301
2302  let printer = [{ return printUnaryOp(this->getOperation(), p); }];
2303}
2304
2305def FirRealAttr : Attr<CPred<"$_self.isa<fir::RealAttr>()">, "FIR real attr"> {
2306  let storageType = [{ fir::RealAttr }];
2307  let returnType = [{ llvm::APFloat }];
2308}
2309
2310def fir_ConstfOp : fir_Op<"constf", [NoSideEffect]> {
2311  let summary = "create a floating point constant";
2312
2313  let description = [{
2314    A floating-point constant. This operation is to augment MLIR to be able
2315    to represent APFloat values that are not supported in the standard dialect.
2316  }];
2317
2318  let arguments = (ins FirRealAttr:$constant);
2319
2320  let results = (outs fir_RealType:$res);
2321
2322  let assemblyFormat = "`(` $constant `)` attr-dict `:` type($res)";
2323
2324  let verifier = [{
2325    if (!getType().isa<fir::RealType>())
2326      return emitOpError("must be a !fir.real type");
2327    return mlir::success();
2328  }];
2329}
2330
2331class RealUnaryArithmeticOp<string mnemonic, list<OpTrait> traits = []> :
2332      fir_UnaryArithmeticOp<mnemonic, traits>,
2333      Arguments<(ins AnyRealLike:$operand)>;
2334
2335def fir_NegfOp : RealUnaryArithmeticOp<"negf">;
2336
2337class RealArithmeticOp<string mnemonic, list<OpTrait> traits = []> :
2338      fir_ArithmeticOp<mnemonic, traits>,
2339      Arguments<(ins AnyRealLike:$lhs, AnyRealLike:$rhs)>;
2340
2341def fir_AddfOp : RealArithmeticOp<"addf", [Commutative]> {
2342  let hasFolder = 1;
2343}
2344def fir_SubfOp : RealArithmeticOp<"subf"> {
2345  let hasFolder = 1;
2346}
2347def fir_MulfOp : RealArithmeticOp<"mulf", [Commutative]> {
2348  let hasFolder = 1;
2349}
2350def fir_DivfOp : RealArithmeticOp<"divf">;
2351def fir_ModfOp : RealArithmeticOp<"modf">;
2352// Pow is a builtin call and not a primitive
2353
2354def fir_CmpfOp : fir_Op<"cmpf",
2355    [NoSideEffect, SameTypeOperands, SameOperandsAndResultShape]> {
2356  let summary = "floating-point comparison operator";
2357
2358  let description = [{
2359    Extends the standard floating-point comparison to handle the extended
2360    floating-point types found in FIR.
2361  }];
2362
2363  let arguments = (ins AnyRealLike:$lhs, AnyRealLike:$rhs);
2364
2365  let results = (outs AnyLogicalLike);
2366
2367  let builders = [
2368    OpBuilderDAG<(ins "CmpFPredicate":$predicate, "Value":$lhs, "Value":$rhs),
2369    [{
2370      buildCmpFOp($_builder, $_state, predicate, lhs, rhs);
2371  }]>];
2372
2373  let parser = [{ return parseCmpfOp(parser, result); }];
2374
2375  let printer = [{ printCmpfOp(p, *this); }];
2376
2377  let extraClassDeclaration = [{
2378    static constexpr llvm::StringRef getPredicateAttrName() {
2379      return "predicate";
2380    }
2381    static CmpFPredicate getPredicateByName(llvm::StringRef name);
2382
2383    CmpFPredicate getPredicate() {
2384      return (CmpFPredicate)(*this)->getAttrOfType<mlir::IntegerAttr>(
2385          getPredicateAttrName()).getInt();
2386    }
2387  }];
2388}
2389
2390def fir_ConstcOp : fir_Op<"constc", [NoSideEffect]> {
2391  let summary = "create a complex constant";
2392
2393  let description = [{
2394    A complex constant. Similar to the standard dialect complex type, but this
2395    extension allows constants with APFloat values that are not supported in
2396    the standard dialect.
2397  }];
2398
2399  let results = (outs fir_ComplexType);
2400
2401  let parser = [{
2402    fir::RealAttr realp;
2403    fir::RealAttr imagp;
2404    mlir::Type type;
2405    if (parser.parseLParen() ||
2406        parser.parseAttribute(realp, realAttrName(), result.attributes) ||
2407        parser.parseComma() ||
2408        parser.parseAttribute(imagp, imagAttrName(), result.attributes) ||
2409        parser.parseRParen() ||
2410        parser.parseColonType(type) ||
2411        parser.addTypesToList(type, result.types))
2412      return mlir::failure();
2413    return mlir::success();
2414  }];
2415
2416  let printer = [{
2417    p << getOperationName() << " (0x";
2418    auto f1 = (*this)->getAttr(realAttrName()).cast<mlir::FloatAttr>();
2419    auto i1 = f1.getValue().bitcastToAPInt();
2420    p.getStream().write_hex(i1.getZExtValue());
2421    p << ", 0x";
2422    auto f2 = (*this)->getAttr(imagAttrName()).cast<mlir::FloatAttr>();
2423    auto i2 = f2.getValue().bitcastToAPInt();
2424    p.getStream().write_hex(i2.getZExtValue());
2425    p << ") : ";
2426    p.printType(getType());
2427  }];
2428
2429  let verifier = [{
2430    if (!getType().isa<fir::CplxType>())
2431      return emitOpError("must be a !fir.complex type");
2432    return mlir::success();
2433  }];
2434
2435  let extraClassDeclaration = [{
2436    static constexpr llvm::StringRef realAttrName() { return "real"; }
2437    static constexpr llvm::StringRef imagAttrName() { return "imaginary"; }
2438
2439    mlir::Attribute getReal() { return (*this)->getAttr(realAttrName()); }
2440    mlir::Attribute getImaginary() { return (*this)->getAttr(imagAttrName()); }
2441  }];
2442}
2443
2444class ComplexUnaryArithmeticOp<string mnemonic, list<OpTrait> traits = []> :
2445      fir_UnaryArithmeticOp<mnemonic, traits>,
2446      Arguments<(ins fir_ComplexType:$operand)>;
2447
2448def fir_NegcOp : ComplexUnaryArithmeticOp<"negc">;
2449
2450class ComplexArithmeticOp<string mnemonic, list<OpTrait> traits = []> :
2451      fir_ArithmeticOp<mnemonic, traits>,
2452      Arguments<(ins fir_ComplexType:$lhs, fir_ComplexType:$rhs)>;
2453
2454def fir_AddcOp : ComplexArithmeticOp<"addc", [Commutative]>;
2455def fir_SubcOp : ComplexArithmeticOp<"subc">;
2456def fir_MulcOp : ComplexArithmeticOp<"mulc", [Commutative]>;
2457def fir_DivcOp : ComplexArithmeticOp<"divc">;
2458// Pow is a builtin call and not a primitive
2459
2460def fir_CmpcOp : fir_Op<"cmpc",
2461    [NoSideEffect, SameTypeOperands, SameOperandsAndResultShape]> {
2462  let summary = "complex floating-point comparison operator";
2463
2464  let description = [{
2465    A complex comparison to handle complex types found in FIR.
2466  }];
2467
2468  let arguments = (ins fir_ComplexType:$lhs, fir_ComplexType:$rhs);
2469
2470  let results = (outs AnyLogicalLike);
2471
2472  let parser = "return parseCmpcOp(parser, result);";
2473
2474  let printer = "printCmpcOp(p, *this);";
2475
2476  let builders = [
2477    OpBuilderDAG<(ins "CmpFPredicate":$predicate, "Value":$lhs, "Value":$rhs),
2478    [{
2479      buildCmpCOp($_builder, $_state, predicate, lhs, rhs);
2480  }]>];
2481
2482  let extraClassDeclaration = [{
2483    static constexpr llvm::StringRef getPredicateAttrName() {
2484      return "predicate";
2485    }
2486
2487    CmpFPredicate getPredicate() {
2488      return (CmpFPredicate)(*this)->getAttrOfType<mlir::IntegerAttr>(
2489          getPredicateAttrName()).getInt();
2490    }
2491  }];
2492}
2493
2494// Other misc. operations
2495
2496def fir_AddrOfOp : fir_OneResultOp<"address_of", [NoSideEffect]> {
2497  let summary = "convert a symbol to an SSA value";
2498
2499  let description = [{
2500    Convert a symbol (a function or global reference) to an SSA-value to be
2501    used in other Operations.
2502
2503    ```mlir
2504      %p = fir.address_of(@symbol) : !fir.ref<f64>
2505    ```
2506  }];
2507
2508  let arguments = (ins SymbolRefAttr:$symbol);
2509
2510  let results = (outs fir_ReferenceType:$resTy);
2511
2512  let assemblyFormat = "`(` $symbol `)` attr-dict `:` type($resTy)";
2513}
2514
2515def fir_ConvertOp : fir_OneResultOp<"convert", [NoSideEffect]> {
2516  let summary = "encapsulates all Fortran scalar type conversions";
2517
2518  let description = [{
2519    Generalized type conversion. Convert the ssa value from type T to type U.
2520    Not all pairs of types have conversions. When types T and U are the same
2521    type, this instruction is a NOP and may be folded away.
2522
2523    ```mlir
2524      %v = ... : i64
2525      %w = fir.convert %v : (i64) -> i32
2526    ```
2527
2528    The example truncates the value `%v` from an i64 to an i32.
2529  }];
2530
2531  let arguments = (ins AnyType:$value);
2532
2533  let assemblyFormat = [{
2534    $value attr-dict `:` functional-type($value, results)
2535  }];
2536
2537  let hasFolder = 1;
2538
2539  let verifier = [{
2540    auto inType = value().getType();
2541    auto outType = getType();
2542    if (inType == outType)
2543      return mlir::success();
2544    if ((isPointerCompatible(inType) && isPointerCompatible(outType)) ||
2545        (isIntegerCompatible(inType) && isIntegerCompatible(outType)) ||
2546        (isIntegerCompatible(inType) && isFloatCompatible(outType)) ||
2547        (isFloatCompatible(inType) && isIntegerCompatible(outType)) ||
2548        (isFloatCompatible(inType) && isFloatCompatible(outType)) ||
2549        (isIntegerCompatible(inType) && isPointerCompatible(outType)) ||
2550        (isPointerCompatible(inType) && isIntegerCompatible(outType)) ||
2551        (inType.isa<fir::BoxType>() && outType.isa<fir::BoxType>()) ||
2552        (fir::isa_complex(inType) && fir::isa_complex(outType)))
2553      return mlir::success();
2554    return emitOpError("invalid type conversion");
2555  }];
2556
2557  let extraClassDeclaration = [{
2558    static bool isIntegerCompatible(mlir::Type ty);
2559    static bool isFloatCompatible(mlir::Type ty);
2560    static bool isPointerCompatible(mlir::Type ty);
2561  }];
2562}
2563
2564def FortranTypeAttr : Attr<And<[CPred<"$_self.isa<TypeAttr>()">,
2565    Or<[CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::CharacterType>()">,
2566        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::CplxType>()">,
2567        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::IntType>()">,
2568        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::LogicalType>()">,
2569        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::RealType>()">,
2570        CPred<"$_self.cast<TypeAttr>().getValue().isa<fir::RecordType>()">]>]>,
2571    "Fortran surface type"> {
2572  let storageType = [{ TypeAttr }];
2573  let returnType = "Type";
2574  let convertFromStorage = "$_self.getValue().cast<Type>()";
2575}
2576
2577def fir_GenTypeDescOp : fir_OneResultOp<"gentypedesc", [NoSideEffect]> {
2578  let summary = "generate a type descriptor for a given type";
2579  let description = [{
2580    Generates a constant object that is an abstract type descriptor of the
2581    specified type.  The meta-type of a type descriptor for the type `T`
2582    is `!fir.tdesc<T>`.
2583
2584    ```mlir
2585      !T = type !fir.type<T{...}>
2586      %t = fir.gentypedesc !T  // returns value of !fir.tdesc<!T>
2587    ```
2588  }];
2589
2590  let arguments = (ins FortranTypeAttr:$in_type);
2591
2592  let parser = [{
2593    mlir::Type intype;
2594    if (parser.parseType(intype))
2595      return mlir::failure();
2596    result.addAttribute("in_type", mlir::TypeAttr::get(intype));
2597    mlir::Type restype = TypeDescType::get(intype);
2598    if (parser.addTypeToList(restype, result.types))
2599      return mlir::failure();
2600    return mlir::success();
2601  }];
2602
2603  let printer = [{
2604    p << getOperationName() << ' ' << (*this)->getAttr("in_type");
2605    p.printOptionalAttrDict(getAttrs(), {"in_type"});
2606  }];
2607
2608  let builders = [
2609    OpBuilderDAG<(ins "mlir::TypeAttr":$inty)>
2610  ];
2611
2612  let verifier = [{
2613    mlir::Type resultTy = getType();
2614    if (auto tdesc = resultTy.dyn_cast<TypeDescType>()) {
2615      if (tdesc.getOfTy() != getInType())
2616        return emitOpError("wrapped type mismatched");
2617    } else {
2618      return emitOpError("must be !fir.tdesc type");
2619    }
2620    return mlir::success();
2621  }];
2622
2623  let extraClassDeclaration = [{
2624    mlir::Type getInType() {
2625      // get the type that the type descriptor describes
2626      return (*this)->getAttrOfType<mlir::TypeAttr>("in_type").getValue();
2627    }
2628  }];
2629}
2630
2631def fir_NoReassocOp : fir_OneResultOp<"no_reassoc",
2632    [NoSideEffect, SameOperandsAndResultType]> {
2633  let summary = "synthetic op to prevent reassociation";
2634  let description = [{
2635    Primitive operation meant to intrusively prevent operator reassociation.
2636    The operation is otherwise a nop and the value returned is the same as the
2637    argument.
2638
2639    The presence of this operation prevents any local optimizations. In the
2640    example below, this would prevent possibly replacing the multiply and add
2641    operations with a single FMA operation.
2642
2643    ```mlir
2644      %98 = mulf %96, %97 : f32
2645      %99 = fir.no_reassoc %98 : f32
2646      %a0 = addf %99, %95 : f32
2647    ```
2648  }];
2649
2650  let arguments = (ins AnyType:$val);
2651
2652  let assemblyFormat = "$val attr-dict `:` type($val)";
2653}
2654
2655class AtMostRegion<int numBlocks> : Region<
2656  CPred<"$_self.getBlocks().size() <= " # numBlocks>,
2657  "region with " # numBlocks # " blocks">;
2658
2659def fir_GlobalOp : fir_Op<"global", [IsolatedFromAbove, Symbol]> {
2660  let summary = "Global data";
2661  let description = [{
2662    A global variable or constant with initial values.
2663
2664    The example creates a global variable (writable) named
2665    `@_QV_Mquark_Vvarble` with some initial values. The initializer should
2666    conform to the variable's type.
2667
2668    ```mlir
2669      fir.global @_QV_Mquark_Vvarble : tuple<i32, f32> {
2670        %1 = constant 1 : i32
2671        %2 = constant 2.0 : f32
2672        %3 = fir.undefined tuple<i32, f32>
2673        %z = constant 0 : index
2674        %o = constant 1 : index
2675        %4 = fir.insert_value %3, %1, %z : (tuple<i32, f32>, i32, index) -> tuple<i32, f32>
2676        %5 = fir.insert_value %4, %2, %o : (tuple<i32, f32>, f32, index) -> tuple<i32, f32>
2677        fir.has_value %5 : tuple<i32, f32>
2678      }
2679    ```
2680  }];
2681
2682  let arguments = (ins
2683    StrAttr:$sym_name,
2684    SymbolRefAttr:$symref,
2685    TypeAttr:$type,
2686    OptionalAttr<AnyAttr>:$initVal,
2687    OptionalAttr<UnitAttr>:$constant,
2688    OptionalAttr<StrAttr>:$linkName
2689  );
2690
2691  let regions = (region AtMostRegion<1>:$region);
2692
2693  let parser = "return parseGlobalOp(parser, result);";
2694
2695  let printer = [{
2696    p << getOperationName();
2697    if (linkName().hasValue())
2698      p << ' ' << linkName().getValue();
2699    p << ' ';
2700    p.printAttributeWithoutType((*this)->getAttr(symbolAttrName()));
2701    if (auto val = getValueOrNull())
2702      p << '(' << val << ')';
2703    if ((*this)->getAttr(constantAttrName()))
2704      p << " constant";
2705    p << " : ";
2706    p.printType(getType());
2707    if (hasInitializationBody())
2708      p.printRegion((*this)->getRegion(0), /*printEntryBlockArgs=*/false,
2709                    /*printBlockTerminators=*/true);
2710  }];
2711
2712  let skipDefaultBuilders = 1;
2713  let builders = [
2714    OpBuilderDAG<(ins "StringRef":$name, "Type":$type,
2715      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
2716    OpBuilderDAG<(ins "StringRef":$name, "bool":$isConstant, "Type":$type,
2717      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
2718    OpBuilderDAG<(ins "StringRef":$name, "Type":$type,
2719      CArg<"StringAttr", "{}">:$linkage,
2720      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
2721    OpBuilderDAG<(ins "StringRef":$name, "bool":$isConstant, "Type":$type,
2722      CArg<"StringAttr", "{}">:$linkage,
2723      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
2724    OpBuilderDAG<(ins "StringRef":$name, "Type":$type, "Attribute":$initVal,
2725      CArg<"StringAttr", "{}">:$linkage,
2726      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
2727    OpBuilderDAG<(ins "StringRef":$name, "bool":$isConstant, "Type":$type,
2728      "Attribute":$initVal, CArg<"StringAttr", "{}">:$linkage,
2729      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs)>,
2730  ];
2731
2732  let extraClassDeclaration = [{
2733    static constexpr llvm::StringRef symbolAttrName() { return "symref"; }
2734    static constexpr llvm::StringRef constantAttrName() { return "constant"; }
2735    static constexpr llvm::StringRef initValAttrName() { return "initVal"; }
2736    static constexpr llvm::StringRef linkageAttrName() { return "linkName"; }
2737    static constexpr llvm::StringRef typeAttrName() { return "type"; }
2738
2739    /// The printable type of the global
2740    mlir::Type getType() {
2741      return (*this)->getAttrOfType<TypeAttr>(typeAttrName()).getValue();
2742    }
2743
2744    /// The semantic type of the global
2745    mlir::Type resultType() {
2746      return fir::AllocaOp::wrapResultType(getType());
2747    }
2748
2749    /// Return the initializer attribute if it exists, or a null attribute.
2750    Attribute getValueOrNull() { return initVal().getValueOr(Attribute()); }
2751
2752    /// Append the next initializer value to the `GlobalOp` to construct
2753    /// the variable's initial value.
2754    void appendInitialValue(mlir::Operation *op);
2755
2756    /// A GlobalOp has one region.
2757    mlir::Region &getRegion() { return (*this)->getRegion(0); }
2758
2759    /// A GlobalOp has one block.
2760    mlir::Block &getBlock() { return getRegion().front(); }
2761
2762    /// Determine if `linkage` is a supported keyword
2763    static mlir::ParseResult verifyValidLinkage(StringRef linkage);
2764
2765    bool hasInitializationBody() {
2766      return ((*this)->getNumRegions() == 1) && !getRegion().empty() &&
2767        !isa<fir::FirEndOp>(getBlock().front());
2768    }
2769
2770    mlir::FlatSymbolRefAttr getSymbol() {
2771      return mlir::FlatSymbolRefAttr::get(
2772          (*this)->getAttrOfType<mlir::StringAttr>(
2773              mlir::SymbolTable::getSymbolAttrName()).getValue(), getContext());
2774    }
2775  }];
2776}
2777
2778def fir_GlobalLenOp : fir_Op<"global_len", []> {
2779  let summary = "map a LEN parameter to a global";
2780  let description = [{
2781    A global entity (that is not an automatic data object) can have extra LEN
2782    parameter (compile-time) constants associated with the instance's type.
2783    These values can be bound to the global instance used `fir.global_len`.
2784
2785    ```mlir
2786      global @g : !fir.type<t(len1:i32)> {
2787        fir.global_len len1, 10 : i32
2788        %1 = fir.undefined : !fir.type<t(len1:i32)>
2789        return %1 : !fir.type<t(len1:i32)>
2790      }
2791    ```
2792  }];
2793
2794  let arguments = (ins StrAttr:$lenparam, APIntAttr:$intval);
2795
2796  let parser = [{
2797    llvm::StringRef fieldName;
2798    if (failed(parser.parseOptionalKeyword(&fieldName))) {
2799      mlir::StringAttr fieldAttr;
2800      if (parser.parseAttribute(fieldAttr, lenParamAttrName(),
2801                                result.attributes))
2802        return mlir::failure();
2803    } else {
2804      result.addAttribute(lenParamAttrName(),
2805          parser.getBuilder().getStringAttr(fieldName));
2806    }
2807    mlir::IntegerAttr constant;
2808    if (parser.parseComma() ||
2809        parser.parseAttribute(constant, intAttrName(), result.attributes))
2810      return mlir::failure();
2811    return mlir::success();
2812  }];
2813
2814  let printer = [{
2815    p << getOperationName() << ' ' << (*this)->getAttr(lenParamAttrName())
2816      << ", " << (*this)->getAttr(intAttrName());
2817  }];
2818
2819  let extraClassDeclaration = [{
2820    static constexpr llvm::StringRef lenParamAttrName() { return "lenparam"; }
2821    static constexpr llvm::StringRef intAttrName() { return "intval"; }
2822  }];
2823}
2824
2825def ImplicitFirTerminator : SingleBlockImplicitTerminator<"FirEndOp">;
2826
2827def fir_DispatchTableOp : fir_Op<"dispatch_table",
2828    [IsolatedFromAbove, Symbol, ImplicitFirTerminator]> {
2829  let summary = "Dispatch table definition";
2830
2831  let description = [{
2832    Define a dispatch table for a derived type with type-bound procedures.
2833
2834    A dispatch table is an untyped symbol that contains a list of associations
2835    between method identifiers and corresponding `FuncOp` symbols.
2836
2837    The ordering of associations in the map is determined by the front-end.
2838
2839    ```mlir
2840      fir.dispatch_table @_QDTMquuzTfoo {
2841        fir.dt_entry method1, @_QFNMquuzTfooPmethod1AfooR
2842        fir.dt_entry method2, @_QFNMquuzTfooPmethod2AfooII
2843      }
2844    ```
2845  }];
2846
2847  let parser = [{
2848    // Parse the name as a symbol reference attribute.
2849    SymbolRefAttr nameAttr;
2850    if (parser.parseAttribute(nameAttr, mlir::SymbolTable::getSymbolAttrName(),
2851                              result.attributes))
2852      return failure();
2853
2854    // Convert the parsed name attr into a string attr.
2855    result.attributes.set(mlir::SymbolTable::getSymbolAttrName(),
2856      parser.getBuilder().getStringAttr(nameAttr.getRootReference()));
2857
2858    // Parse the optional table body.
2859    mlir::Region *body = result.addRegion();
2860    OptionalParseResult parseResult = parser.parseOptionalRegion(*body);
2861    if (parseResult.hasValue() && failed(*parseResult))
2862      return mlir::failure();
2863
2864    ensureTerminator(*body, parser.getBuilder(), result.location);
2865    return mlir::success();
2866  }];
2867
2868  let printer = [{
2869    auto tableName = (*this)->getAttrOfType<StringAttr>(
2870      mlir::SymbolTable::getSymbolAttrName()).getValue();
2871    p << getOperationName() << " @" << tableName;
2872
2873    Region &body = (*this)->getRegion(0);
2874    if (!body.empty())
2875      p.printRegion(body, /*printEntryBlockArgs=*/false,
2876                          /*printBlockTerminators=*/false);
2877  }];
2878
2879  let verifier = [{
2880    for (auto &op : getBlock())
2881      if (!(isa<fir::DTEntryOp>(op) || isa<fir::FirEndOp>(op)))
2882        return emitOpError("dispatch table must contain dt_entry");
2883    return mlir::success();
2884  }];
2885
2886  let regions = (region SizedRegion<1>:$region);
2887
2888  let skipDefaultBuilders = 1;
2889  let builders = [
2890    OpBuilderDAG<(ins "StringRef":$name, "Type":$type,
2891      CArg<"ArrayRef<NamedAttribute>", "{}">:$attrs),
2892    [{
2893      $_state.addAttribute(mlir::SymbolTable::getSymbolAttrName(),
2894                           $_builder.getStringAttr(name));
2895      $_state.addAttributes(attrs);
2896    }]>
2897  ];
2898
2899  let extraClassDeclaration = [{
2900    /// Append a dispatch table entry to the table.
2901    void appendTableEntry(mlir::Operation *op);
2902
2903    mlir::Region &getRegion() {
2904      return (*this)->getRegion(0);
2905    }
2906
2907    mlir::Block &getBlock() {
2908      return getRegion().front();
2909    }
2910  }];
2911}
2912
2913def fir_DTEntryOp : fir_Op<"dt_entry", []> {
2914  let summary = "map entry in a dispatch table";
2915
2916  let description = [{
2917    An entry in a dispatch table.  Allows a function symbol to be bound
2918    to a specifier method identifier.  A dispatch operation uses the dynamic
2919    type of a distinguished argument to determine an exact dispatch table
2920    and uses the method identifier to select the type-bound procedure to
2921    be called.
2922
2923    ```mlir
2924      fir.dt_entry method_name, @uniquedProcedure
2925    ```
2926  }];
2927
2928  let arguments = (ins StrAttr:$method, SymbolRefAttr:$proc);
2929
2930  let parser = [{
2931    llvm::StringRef methodName;
2932    // allow `methodName` or `"methodName"`
2933    if (failed(parser.parseOptionalKeyword(&methodName))) {
2934      mlir::StringAttr methodAttr;
2935      if (parser.parseAttribute(methodAttr, methodAttrName(),
2936                                result.attributes))
2937        return mlir::failure();
2938    } else {
2939      result.addAttribute(methodAttrName(),
2940          parser.getBuilder().getStringAttr(methodName));
2941    }
2942    mlir::SymbolRefAttr calleeAttr;
2943    if (parser.parseComma() ||
2944        parser.parseAttribute(calleeAttr, procAttrName(), result.attributes))
2945      return mlir::failure();
2946    return mlir::success();
2947  }];
2948
2949  let printer = [{
2950    p << getOperationName() << ' ' << (*this)->getAttr(methodAttrName()) << ", "
2951      << (*this)->getAttr(procAttrName());
2952  }];
2953
2954  let extraClassDeclaration = [{
2955    static constexpr llvm::StringRef methodAttrName() { return "method"; }
2956    static constexpr llvm::StringRef procAttrName() { return "proc"; }
2957  }];
2958}
2959
2960#endif
2961